Partly fullfill feature wish #1693393 "Selection of charset and engine at creation"

By turning the CREATE DATABASE dialog from an InputQuery into a real form with 2 additional pulldowns:
- character set
- collation

See also: http://www.heidisql.com/forum/viewtopic.php?p=1322#1322

packages/delphi10/heidisql.dpr

@@ -37,7 +37,8 @@ uses
   mysql in '..\..\source\mysql.pas',
   column_selection in '..\..\source\column_selection.pas' {ColumnSelectionForm},
   data_sorting in '..\..\source\data_sorting.pas' {DataSortingForm},
-  runsqlfile in '..\..\source\runsqlfile.pas' {RunSQLFileForm};
+  runsqlfile in '..\..\source\runsqlfile.pas' {RunSQLFileForm},
+  createdatabase in '..\..\source\createdatabase.pas' {CreateDatabaseForm};
 
 {$R *.RES}
 

packages/delphi11/heidisql.dpr

@@ -36,7 +36,8 @@ uses
   mysql in '..\..\source\mysql.pas',
   column_selection in '..\..\source\column_selection.pas' {ColumnSelectionForm},
   data_sorting in '..\..\source\data_sorting.pas' {DataSortingForm},
-  runsqlfile in '..\..\source\runsqlfile.pas' {RunSQLFileForm};
+  runsqlfile in '..\..\source\runsqlfile.pas' {RunSQLFileForm},
+  createdatabase in '..\..\source\createdatabase.pas' {CreateDatabaseForm};
 
 {$R *.RES}
 

packages/delphi11/heidisql.dproj

@@ -79,6 +79,9 @@
     <DCCReference Include="..\..\source\copytable.pas">
       <Form>CopyTableForm</Form>
     </DCCReference>
+    <DCCReference Include="..\..\source\createdatabase.pas">
+      <Form>CreateDatabaseForm</Form>
+    </DCCReference>
     <DCCReference Include="..\..\source\createtable.pas">
       <Form>CreateTableForm</Form>
     </DCCReference>

source/childwin.pas

@@ -618,7 +618,7 @@ uses
   Main, createtable, fieldeditor, tbl_properties, tblcomment,
   optimizetables, copytable, sqlhelp, printlist,
   column_selection, data_sorting, runsqlfile, mysql,
-  Registry;
+  Registry, createdatabase;
 
 
 {$I const.inc}
@@ -3323,33 +3323,33 @@ end;
 
 
 procedure TMDIChild.CreateDatabase(Sender: TObject);
-var dbname : String;
+var
+  f : TCreateDatabaseForm;
 begin
-  // Create new Database:
-  if InputQuery('Create new Database...', 'Database Name:', dbname) then
+  // Create database:
+  // - create modal form
+  // - rely on the modalresult being set correctly
+  f := TCreateDatabaseForm.Create(Self);
+  if f.ShowModal = mrOK then
   begin
-    Screen.Cursor := crSQLWait;
-    Try
-      ExecUpdateQuery( 'CREATE DATABASE ' + mask( dbname ) );
-      // Add DB to OnlyDBs-regkey if this is not empty
-      if OnlyDBs.Count > 0 then
+    // Add DB to OnlyDBs-regkey if this is not empty
+    if OnlyDBs.Count > 0 then
+    begin
+      OnlyDBs.Add( f.editDBName.Text );
+      with TRegistry.Create do
       begin
-        OnlyDBs.Add( dbname );
-        with TRegistry.Create do
+        if OpenKey(REGPATH + '\Servers\' + FConn.Description, false) then
         begin
-          if OpenKey(REGPATH + '\Servers\' + FConn.Description, false) then
-          begin
-            WriteString( 'OnlyDBs', ImplodeStr( ';', OnlyDBs ) );
-            CloseKey;
-          end;
+          WriteString( 'OnlyDBs', ImplodeStr( ';', OnlyDBs ) );
+          CloseKey;
         end;
       end;
-      ReadDatabasesAndTables(self);
-      ActiveDatabase := dbname;
-    Finally
-      Screen.Cursor := crDefault;
-    End;
+    end;
+    // Todo: Don't expand node of old database in dbtree, just reload and switch to new one
+    ReadDatabasesAndTables(self);
+    ActiveDatabase := f.editDBName.Text;
   end;
+  FreeAndNil(f);
 end;
 
 

source/createdatabase.dfm

@@ -0,0 +1,102 @@
+object CreateDatabaseForm: TCreateDatabaseForm
+  Left = 0
+  Top = 0
+  BorderStyle = bsDialog
+  Caption = 'Create database ...'
+  ClientHeight = 135
+  ClientWidth = 317
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poOwnerFormCenter
+  OnCreate = FormCreate
+  DesignSize = (
+    317
+    135)
+  PixelsPerInch = 96
+  TextHeight = 13
+  object lblDBName: TLabel
+    Left = 8
+    Top = 19
+    Width = 31
+    Height = 13
+    Caption = '&Name:'
+    FocusControl = editDBName
+  end
+  object lblCharset: TLabel
+    Left = 8
+    Top = 46
+    Width = 70
+    Height = 13
+    Caption = '&Character set:'
+    FocusControl = comboCharset
+  end
+  object lblCollation: TLabel
+    Left = 8
+    Top = 73
+    Width = 45
+    Height = 13
+    Caption = 'C&ollation:'
+    FocusControl = comboCollation
+  end
+  object editDBName: TEdit
+    Left = 88
+    Top = 16
+    Width = 221
+    Height = 21
+    Anchors = [akLeft, akTop, akRight]
+    TabOrder = 0
+    OnChange = editDBNameChange
+  end
+  object comboCharset: TComboBox
+    Left = 88
+    Top = 43
+    Width = 221
+    Height = 21
+    Style = csDropDownList
+    Anchors = [akLeft, akTop, akRight]
+    Enabled = False
+    ItemHeight = 13
+    Sorted = True
+    TabOrder = 1
+    OnChange = comboCharsetChange
+  end
+  object btnOK: TButton
+    Left = 153
+    Top = 102
+    Width = 75
+    Height = 25
+    Anchors = [akRight, akBottom]
+    Caption = 'OK'
+    Default = True
+    Enabled = False
+    TabOrder = 3
+    OnClick = btnOKClick
+  end
+  object btnCancel: TButton
+    Left = 234
+    Top = 102
+    Width = 75
+    Height = 25
+    Anchors = [akRight, akBottom]
+    Cancel = True
+    Caption = 'Cancel'
+    ModalResult = 2
+    TabOrder = 4
+  end
+  object comboCollation: TComboBox
+    Left = 88
+    Top = 70
+    Width = 221
+    Height = 21
+    Style = csDropDownList
+    Enabled = False
+    ItemHeight = 13
+    Sorted = True
+    TabOrder = 2
+  end
+end

source/createdatabase.pas

@@ -0,0 +1,149 @@
+unit createdatabase;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, db, Registry;
+
+type
+  TCreateDatabaseForm = class(TForm)
+    editDBName: TEdit;
+    lblDBName: TLabel;
+    comboCharset: TComboBox;
+    lblCharset: TLabel;
+    btnOK: TButton;
+    btnCancel: TButton;
+    lblCollation: TLabel;
+    comboCollation: TComboBox;
+    procedure btnOKClick(Sender: TObject);
+    procedure comboCharsetChange(Sender: TObject);
+    procedure editDBNameChange(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+    { Private declarations }
+    listCharsets : TStringList;
+    dsCollations : TDataSet;
+  public
+    { Public declarations }
+  end;
+
+
+implementation
+
+uses main, childwin, helpers;
+
+{$R *.dfm}
+
+
+{**
+  Fetch list with character sets and collations from the server
+}
+procedure TCreateDatabaseForm.FormCreate(Sender: TObject);
+var
+  defaultCharset : String;
+begin
+  try
+    listCharsets := Mainform.Childwin.GetCol('SHOW CHARACTER SET');
+    dsCollations := Mainform.Childwin.ExecSelectQuery('SHOW COLLATION');
+  except
+    // Ignore it when the above statements don't work on pre 4.1 servers.
+    // If the list(s) are nil, disable the combobox(es), so we create the db without charset.
+  end;
+
+  if (listCharsets <> nil) and (listCharsets.Count > 0) then
+  begin
+    comboCharset.Enabled := True;
+    comboCharset.Items := listCharsets;
+    // Select servers default charset if possible
+    defaultCharset := Mainform.Childwin.GetVar( 'SHOW VARIABLES LIKE '+esc('character_set_database'), 1 );
+    if comboCharset.Items.IndexOf(defaultCharset) > -1 then
+      comboCharset.ItemIndex := comboCharset.Items.IndexOf(defaultCharset)
+    else
+      comboCharset.ItemIndex := 0;
+  end;
+
+  comboCollation.Enabled := dsCollations <> nil;
+  comboCharsetChange( Sender );
+end;
+
+
+{**
+  Charset has been selected: Display fitting collations
+  and select default one.
+}
+procedure TCreateDatabaseForm.comboCharsetChange(Sender: TObject);
+var
+  defaultCollation : String;
+begin
+  // Abort if collations were not fetched successfully
+  if dsCollations = nil then
+    Exit;
+
+  // Fill pulldown with fitting collations
+  comboCollation.Items.BeginUpdate;
+  comboCollation.Items.Clear;
+  dsCollations.First;
+  while not dsCollations.Eof do
+  begin
+    if dsCollations.FieldByName('Charset').AsString = comboCharset.Text then
+    begin
+      comboCollation.Items.Add( dsCollations.FieldByName('Collation').AsString );
+      if dsCollations.FieldByName('Default').AsString = 'Yes' then
+        defaultCollation := dsCollations.FieldByName('Collation').AsString;
+    end;
+    dsCollations.Next;
+  end;
+  // Preselect default collation
+  if comboCollation.Items.IndexOf(defaultCollation) > -1 then
+    comboCollation.ItemIndex := comboCollation.Items.IndexOf(defaultCollation)
+  else
+    comboCollation.ItemIndex := 0;
+  comboCollation.Items.EndUpdate;
+end;
+
+
+{**
+  User writes something into editDBName
+}
+procedure TCreateDatabaseForm.editDBNameChange(Sender: TObject);
+begin
+  try
+    ensureValidIdentifier( editDBName.Text );
+    editDBName.Font.Color := clWindowText;
+    editDBName.Color := clWindow;
+    // Enable "OK"-Button if we have a valid name
+    btnOK.Enabled := True;
+  except
+    editDBName.Font.Color := clRed;
+    editDBName.Color := clYellow;
+    btnOK.Enabled := False;
+  end;
+end;
+
+
+{**
+  Create the database
+}
+procedure TCreateDatabaseForm.btnOKClick(Sender: TObject);
+var
+  sql : String;
+begin
+  sql := 'CREATE DATABASE ' + Mainform.Childwin.mask( editDBName.Text );
+  if comboCharset.Enabled and (comboCharset.Text <> '') then
+    sql := sql + ' CHARACTER SET ' + comboCharset.Text;
+  if comboCollation.Enabled and (comboCollation.Text <> '') then
+    sql := sql + ' COLLATE ' + comboCollation.Text;
+  Try
+    Mainform.Childwin.ExecUpdateQuery( sql );
+    // Close form
+    ModalResult := mrOK;
+  except
+    On E:Exception do
+      MessageDlg( 'Creating database "'+editDBName.Text+'" failed:'+CRLF+CRLF+E.Message, mtError, [mbOK], 0 );
+    // Keep form open
+  end;
+end;
+
+
+end.