From a1c84ae578ef3bca71e39f26033b5c2560e71bb3 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 17 Nov 2025 20:44:56 +0100 Subject: [PATCH] fix: compiler warnings, re-enable active line background --- source/createdatabase.pas | 552 +++---- source/dbconnection.pas | 15 +- source/main.pas | 10 +- source/preferences.pas | 3256 ++++++++++++++++++------------------- source/table_editor.pas | 2 - source/updatecheck.pas | 686 ++++---- 6 files changed, 2268 insertions(+), 2253 deletions(-) diff --git a/source/createdatabase.pas b/source/createdatabase.pas index a6f35b57..be4422c4 100644 --- a/source/createdatabase.pas +++ b/source/createdatabase.pas @@ -1,275 +1,277 @@ -unit createdatabase; - -{$mode delphi}{$H+} - -interface - -uses - SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, SynEdit, - dbconnection, dbstructures, RegExpr, extra_controls; - -type - TCreateDatabaseForm = class(TExtForm) - editDBName: TEdit; - lblDBName: TLabel; - btnOK: TButton; - btnCancel: TButton; - lblCollation: TLabel; - comboCollation: TComboBox; - lblCreateCode: TLabel; - SynMemoCreateCode: TSynEdit; - lblServerDefaultCollation: TLabel; - procedure btnOKClick(Sender: TObject); - procedure Modified(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure FormCreate(Sender: TObject); - procedure FormShow(Sender: TObject); - function GetCreateStatement: String; - private - { Private declarations } - FConnection: TDBConnection; - public - { Public declarations } - modifyDB : String; - end; - - -implementation - -uses main, apphelpers; - -{$R *.lfm} - - -procedure TCreateDatabaseForm.FormCreate(Sender: TObject); -begin - lblCreateCode.Caption := lblCreateCode.Caption + ':'; - // Setup SynMemoPreview - SynMemoCreateCode.Highlighter := Mainform.SynSQLSynUsed; -end; - - -{** - Form gets displayed: Set default values. -} -procedure TCreateDatabaseForm.FormShow(Sender: TObject); -var - ServerCollation, PreviousCollation, CurrentCollation: String; - Charset, CreateCode: String; - CollationTable: TDBQuery; - rx: TRegExpr; -begin - FConnection := MainForm.ActiveConnection; - CollationTable := FConnection.CollationTable; - CurrentCollation := ''; - PreviousCollation := AppSettings.ReadString(asCreateDbCollation); - - // Detect servers default collation - case FConnection.Parameters.NetTypeGroup of - ngMySQL: - ServerCollation := FConnection.GetSessionVariable('collation_server'); - else // TODO: Find out how to retrieve the server's default collation here - ServerCollation := ''; - end; - lblServerDefaultCollation.Caption := f_('Servers default: %s', [ServerCollation]); - - if modifyDB.IsEmpty then begin - Caption := _('Create database ...'); - editDBName.Text := ''; - end - else begin - Caption := _('Alter database ...'); - editDBName.Text := modifyDB; - - // Detect current collation - CreateCode := FConnection.GetVar('SHOW CREATE DATABASE '+FConnection.QuoteIdent(modifyDB), 1); - rx := TRegExpr.Create; - rx.Expression := '\sCHARACTER\s+SET\s+(\w+)\b'; - if rx.Exec(CreateCode) then - Charset := rx.Match[1]; - rx.Expression := '\sCOLLATE\s+(\w+)\b'; - if rx.Exec(CreateCode) then - CurrentCollation := rx.Match[1]; - rx.Free; - // Find default collation of given charset - if (CurrentCollation = '') and (Charset <> '') and Assigned(CollationTable) then begin - while not CollationTable.Eof do begin - if (CollationTable.Col('Charset') = Charset) and (LowerCase(CollationTable.Col('Default')) = 'yes') then - CurrentCollation := CollationTable.Col('Collation'); - CollationTable.Next; - end; - end; - end; - - // Populate collation combo box - comboCollation.Enabled := Assigned(CollationTable); - lblCollation.Enabled := comboCollation.Enabled; - comboCollation.Clear; - if comboCollation.Enabled then begin - CollationTable.First; - while not CollationTable.Eof do begin - comboCollation.Items.Add(CollationTable.Col('Collation')); - CollationTable.Next; - end; - // Pre-select best fitting collation - comboCollation.ItemIndex := comboCollation.Items.IndexOf(CurrentCollation); - if comboCollation.ItemIndex = -1 then - comboCollation.ItemIndex := comboCollation.Items.IndexOf(PreviousCollation); - if comboCollation.ItemIndex = -1 then - comboCollation.ItemIndex := comboCollation.Items.IndexOf(ServerCollation); - if comboCollation.ItemIndex = -1 then - comboCollation.ItemIndex := comboCollation.Items.IndexOf('utf8mb4_unicode_ci'); - if comboCollation.ItemIndex = -1 then - comboCollation.ItemIndex := 0; // give up, use the first one - end; - - editDBName.SetFocus; - editDBName.SelectAll; - - // Invoke SQL preview - Modified(Sender); - MainForm.SetupSynEditors(Self); -end; - - -{** - Create the database -} -procedure TCreateDatabaseForm.btnOKClick(Sender: TObject); -var - sql : String; - AllDatabases: TStringList; - ObjectsLeft: TDBObjectList; - ObjectsInNewDb, ObjectsInOldDb: TDBObjectList; - i, j: Integer; -begin - if modifyDB.IsEmpty then try - sql := GetCreateStatement; - FConnection.Query(sql); - FConnection.ShowWarnings; - AppSettings.WriteString(asCreateDbCollation, comboCollation.Text); - MainForm.RefreshTree; - // Close form - ModalResult := mrOK; - except - on E:EDbError do - ErrorDialog(f_('Creating database "%s" failed.', [editDBName.Text]), E.Message); - // Keep form open - end else try - sql := 'ALTER DATABASE ' + FConnection.QuoteIdent(modifyDB); - if comboCollation.Text <> '' then - sql := sql + ' COLLATE ' + FConnection.EscapeString(comboCollation.Text); - - if modifyDB = editDBName.Text then begin - // Alter database - FConnection.Query(sql); - FConnection.ShowWarnings; - end else begin - // Rename database - ObjectsInOldDb := FConnection.GetDBObjects(modifyDB, True); - AllDatabases := FConnection.GetCol('SHOW DATABASES'); - if AllDatabases.IndexOf(editDBName.Text) > -1 then - ObjectsInNewDb := FConnection.GetDBObjects(editDBName.Text, True) - else - ObjectsInNewDb := nil; // Silence compiler warning - // Warn if there are tables with same names in new db - for i:=0 to ObjectsInOldDb.Count-1 do begin - if not (ObjectsInOldDb[i].NodeType in [lntTable, lntView]) then - Raise Exception.CreateFmt(_('Database "%s" contains stored routine(s), which cannot be moved.'), [modifyDB]); - if Assigned(ObjectsInNewDb) then begin - for j:=0 to ObjectsInNewDb.Count-1 do begin - if (ObjectsInOldDb[i].Name = ObjectsInNewDb[j].Name) - and (ObjectsInOldDb[i].NodeType = ObjectsInNewDb[j].NodeType) then begin - // One or more objects have a naming conflict - Raise Exception.CreateFmt(_('Database "%s" exists and has objects with same names as in "%s"'), [editDBName.Text, modifyDB]); - end; - end; - end; - end; - - if AllDatabases.IndexOf(editDBName.Text) = -1 then begin - // Target db does not exist - create it - FConnection.Query(GetCreateStatement); - FConnection.ShowWarnings; - end else begin - if MessageDialog(f_('Database "%s" exists. But it does not contain objects with same names as in "%s", so it''s uncritical to move everything. Move all objects to "%s"?', [editDBName.Text, modifyDB, editDBName.Text]), - mtConfirmation, [mbYes, mbCancel]) <> mrYes then - Exit; - end; - // Move all tables, views and procedures to target db - sql := ''; - for i:=0 to ObjectsInOldDb.Count-1 do begin - sql := sql + FConnection.QuoteIdent(modifyDb)+'.'+FConnection.QuoteIdent(ObjectsInOldDb[i].Name)+' TO '+ - FConnection.QuoteIdent(editDBName.Text)+'.'+FConnection.QuoteIdent(ObjectsInOldDb[i].Name)+', '; - end; - if sql <> '' then begin - Delete(sql, Length(sql)-1, 2); - sql := 'RENAME TABLE '+sql; - FConnection.Query(sql); - FConnection.ShowWarnings; - FConnection.ClearDbObjects(modifyDB); - FConnection.ClearDbObjects(editDBName.Text); - end; - // Last check if old db is really empty, before we drop it. - ObjectsLeft := FConnection.GetDBObjects(modifyDB); - if ObjectsLeft.Count = 0 then begin - FConnection.Query('DROP DATABASE '+FConnection.QuoteIdent(modifyDB)); - FConnection.ShowWarnings; - MainForm.RefreshTree; - end; - end; - // Close form - ModalResult := mrOK; - except - on E:Exception do - ErrorDialog(f_('Altering database "%s" failed.', [editDBName.Text]), E.Message); - // Keep form open - end; - - // Save new db name to registry - AllDatabases := Explode(';', FConnection.Parameters.AllDatabasesStr); - if AllDatabases.Count > 0 then begin - i := AllDatabases.IndexOf(modifyDB); - if i > -1 then - AllDatabases[i] := editDBname.Text - else - AllDatabases.Add(editDBname.Text); - AppSettings.SessionPath := FConnection.Parameters.SessionPath; - FConnection.Parameters.AllDatabasesStr := Implode(';', AllDatabases); - AppSettings.WriteString(asDatabases, FConnection.Parameters.AllDatabasesStr); - end; -end; - - -{** - Called on each change -} -procedure TCreateDatabaseForm.Modified(Sender: TObject); -begin - SynMemoCreateCode.Clear; - SynMemoCreateCode.Text := GetCreateStatement; -end; - - -{** - Generate CREATE DATABASE statement, used for preview and execution -} -function TCreateDatabaseForm.GetCreateStatement: String; -begin - Result := 'CREATE DATABASE ' + FConnection.QuoteIdent( editDBName.Text ); - if comboCollation.Enabled and (comboCollation.Text <> '') then - Result := Result + ' /*!40100 COLLATE ' + FConnection.EscapeString(comboCollation.Text) + ' */'; -end; - - -{** - Form gets closed: Reset potential modifyDB-value. -} -procedure TCreateDatabaseForm.FormClose(Sender: TObject; var Action: - TCloseAction); -begin - modifyDB := ''; -end; - - -end. +unit createdatabase; + +{$mode delphi}{$H+} + +interface + +uses + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, SynEdit, + dbconnection, dbstructures, RegExpr, extra_controls; + +type + TCreateDatabaseForm = class(TExtForm) + editDBName: TEdit; + lblDBName: TLabel; + btnOK: TButton; + btnCancel: TButton; + lblCollation: TLabel; + comboCollation: TComboBox; + lblCreateCode: TLabel; + SynMemoCreateCode: TSynEdit; + lblServerDefaultCollation: TLabel; + procedure btnOKClick(Sender: TObject); + procedure Modified(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + function GetCreateStatement: String; + private + { Private declarations } + FConnection: TDBConnection; + public + { Public declarations } + modifyDB : String; + end; + + +implementation + +uses main, apphelpers; + +{$R *.lfm} + + +procedure TCreateDatabaseForm.FormCreate(Sender: TObject); +begin + lblCreateCode.Caption := lblCreateCode.Caption + ':'; + // Setup SynMemoPreview + SynMemoCreateCode.Highlighter := Mainform.SynSQLSynUsed; +end; + + +{** + Form gets displayed: Set default values. +} +procedure TCreateDatabaseForm.FormShow(Sender: TObject); +var + ServerCollation, PreviousCollation, CurrentCollation: String; + Charset, CreateCode: String; + CollationTable: TDBQuery; + rx: TRegExpr; +begin + FConnection := MainForm.ActiveConnection; + CollationTable := FConnection.CollationTable; + CurrentCollation := ''; + PreviousCollation := AppSettings.ReadString(asCreateDbCollation); + + // Detect servers default collation + case FConnection.Parameters.NetTypeGroup of + ngMySQL: + ServerCollation := FConnection.GetSessionVariable('collation_server'); + else // TODO: Find out how to retrieve the server's default collation here + ServerCollation := ''; + end; + lblServerDefaultCollation.Caption := f_('Servers default: %s', [ServerCollation]); + + if modifyDB.IsEmpty then begin + Caption := _('Create database ...'); + editDBName.Text := ''; + end + else begin + Caption := _('Alter database ...'); + editDBName.Text := modifyDB; + + // Detect current collation + CreateCode := FConnection.GetVar('SHOW CREATE DATABASE '+FConnection.QuoteIdent(modifyDB), 1); + rx := TRegExpr.Create; + rx.Expression := '\sCHARACTER\s+SET\s+(\w+)\b'; + if rx.Exec(CreateCode) then + Charset := rx.Match[1] + else + Charset := ''; + rx.Expression := '\sCOLLATE\s+(\w+)\b'; + if rx.Exec(CreateCode) then + CurrentCollation := rx.Match[1]; + rx.Free; + // Find default collation of given charset + if (CurrentCollation = '') and (Charset <> '') and Assigned(CollationTable) then begin + while not CollationTable.Eof do begin + if (CollationTable.Col('Charset') = Charset) and (LowerCase(CollationTable.Col('Default')) = 'yes') then + CurrentCollation := CollationTable.Col('Collation'); + CollationTable.Next; + end; + end; + end; + + // Populate collation combo box + comboCollation.Enabled := Assigned(CollationTable); + lblCollation.Enabled := comboCollation.Enabled; + comboCollation.Clear; + if comboCollation.Enabled then begin + CollationTable.First; + while not CollationTable.Eof do begin + comboCollation.Items.Add(CollationTable.Col('Collation')); + CollationTable.Next; + end; + // Pre-select best fitting collation + comboCollation.ItemIndex := comboCollation.Items.IndexOf(CurrentCollation); + if comboCollation.ItemIndex = -1 then + comboCollation.ItemIndex := comboCollation.Items.IndexOf(PreviousCollation); + if comboCollation.ItemIndex = -1 then + comboCollation.ItemIndex := comboCollation.Items.IndexOf(ServerCollation); + if comboCollation.ItemIndex = -1 then + comboCollation.ItemIndex := comboCollation.Items.IndexOf('utf8mb4_unicode_ci'); + if comboCollation.ItemIndex = -1 then + comboCollation.ItemIndex := 0; // give up, use the first one + end; + + editDBName.SetFocus; + editDBName.SelectAll; + + // Invoke SQL preview + Modified(Sender); + MainForm.SetupSynEditors(Self); +end; + + +{** + Create the database +} +procedure TCreateDatabaseForm.btnOKClick(Sender: TObject); +var + sql : String; + AllDatabases: TStringList; + ObjectsLeft: TDBObjectList; + ObjectsInNewDb, ObjectsInOldDb: TDBObjectList; + i, j: Integer; +begin + if modifyDB.IsEmpty then try + sql := GetCreateStatement; + FConnection.Query(sql); + FConnection.ShowWarnings; + AppSettings.WriteString(asCreateDbCollation, comboCollation.Text); + MainForm.RefreshTree; + // Close form + ModalResult := mrOK; + except + on E:EDbError do + ErrorDialog(f_('Creating database "%s" failed.', [editDBName.Text]), E.Message); + // Keep form open + end else try + sql := 'ALTER DATABASE ' + FConnection.QuoteIdent(modifyDB); + if comboCollation.Text <> '' then + sql := sql + ' COLLATE ' + FConnection.EscapeString(comboCollation.Text); + + if modifyDB = editDBName.Text then begin + // Alter database + FConnection.Query(sql); + FConnection.ShowWarnings; + end else begin + // Rename database + ObjectsInOldDb := FConnection.GetDBObjects(modifyDB, True); + AllDatabases := FConnection.GetCol('SHOW DATABASES'); + if AllDatabases.IndexOf(editDBName.Text) > -1 then + ObjectsInNewDb := FConnection.GetDBObjects(editDBName.Text, True) + else + ObjectsInNewDb := nil; // Silence compiler warning + // Warn if there are tables with same names in new db + for i:=0 to ObjectsInOldDb.Count-1 do begin + if not (ObjectsInOldDb[i].NodeType in [lntTable, lntView]) then + Raise Exception.CreateFmt(_('Database "%s" contains stored routine(s), which cannot be moved.'), [modifyDB]); + if Assigned(ObjectsInNewDb) then begin + for j:=0 to ObjectsInNewDb.Count-1 do begin + if (ObjectsInOldDb[i].Name = ObjectsInNewDb[j].Name) + and (ObjectsInOldDb[i].NodeType = ObjectsInNewDb[j].NodeType) then begin + // One or more objects have a naming conflict + Raise Exception.CreateFmt(_('Database "%s" exists and has objects with same names as in "%s"'), [editDBName.Text, modifyDB]); + end; + end; + end; + end; + + if AllDatabases.IndexOf(editDBName.Text) = -1 then begin + // Target db does not exist - create it + FConnection.Query(GetCreateStatement); + FConnection.ShowWarnings; + end else begin + if MessageDialog(f_('Database "%s" exists. But it does not contain objects with same names as in "%s", so it''s uncritical to move everything. Move all objects to "%s"?', [editDBName.Text, modifyDB, editDBName.Text]), + mtConfirmation, [mbYes, mbCancel]) <> mrYes then + Exit; + end; + // Move all tables, views and procedures to target db + sql := ''; + for i:=0 to ObjectsInOldDb.Count-1 do begin + sql := sql + FConnection.QuoteIdent(modifyDb)+'.'+FConnection.QuoteIdent(ObjectsInOldDb[i].Name)+' TO '+ + FConnection.QuoteIdent(editDBName.Text)+'.'+FConnection.QuoteIdent(ObjectsInOldDb[i].Name)+', '; + end; + if sql <> '' then begin + Delete(sql, Length(sql)-1, 2); + sql := 'RENAME TABLE '+sql; + FConnection.Query(sql); + FConnection.ShowWarnings; + FConnection.ClearDbObjects(modifyDB); + FConnection.ClearDbObjects(editDBName.Text); + end; + // Last check if old db is really empty, before we drop it. + ObjectsLeft := FConnection.GetDBObjects(modifyDB); + if ObjectsLeft.Count = 0 then begin + FConnection.Query('DROP DATABASE '+FConnection.QuoteIdent(modifyDB)); + FConnection.ShowWarnings; + MainForm.RefreshTree; + end; + end; + // Close form + ModalResult := mrOK; + except + on E:Exception do + ErrorDialog(f_('Altering database "%s" failed.', [editDBName.Text]), E.Message); + // Keep form open + end; + + // Save new db name to registry + AllDatabases := Explode(';', FConnection.Parameters.AllDatabasesStr); + if AllDatabases.Count > 0 then begin + i := AllDatabases.IndexOf(modifyDB); + if i > -1 then + AllDatabases[i] := editDBname.Text + else + AllDatabases.Add(editDBname.Text); + AppSettings.SessionPath := FConnection.Parameters.SessionPath; + FConnection.Parameters.AllDatabasesStr := Implode(';', AllDatabases); + AppSettings.WriteString(asDatabases, FConnection.Parameters.AllDatabasesStr); + end; +end; + + +{** + Called on each change +} +procedure TCreateDatabaseForm.Modified(Sender: TObject); +begin + SynMemoCreateCode.Clear; + SynMemoCreateCode.Text := GetCreateStatement; +end; + + +{** + Generate CREATE DATABASE statement, used for preview and execution +} +function TCreateDatabaseForm.GetCreateStatement: String; +begin + Result := 'CREATE DATABASE ' + FConnection.QuoteIdent( editDBName.Text ); + if comboCollation.Enabled and (comboCollation.Text <> '') then + Result := Result + ' /*!40100 COLLATE ' + FConnection.EscapeString(comboCollation.Text) + ' */'; +end; + + +{** + Form gets closed: Reset potential modifyDB-value. +} +procedure TCreateDatabaseForm.FormClose(Sender: TObject; var Action: + TCloseAction); +begin + modifyDB := ''; +end; + + +end. diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 07441014..e54548ea 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -2584,11 +2584,10 @@ end; procedure TSqlSrvConnection.SetActive(Value: Boolean); var - Error, NetLib, DataSource, QuotedPassword, ServerVersion, ErrorHint: String; + Error, ServerVersion, ErrorHint: String; FinalHost: String; rx: TRegExpr; - FinalPort, i: Integer; - IsOldProvider: Boolean; + FinalPort: Integer; begin if Value then begin DoBeforeConnect; @@ -5078,6 +5077,8 @@ begin Result := escChars(Text, EscChar, c1, c2, c3, c4); end; + else Result := ''; + end; if DoQuote then begin @@ -5248,6 +5249,7 @@ begin if rx.Exec(SQL) then begin LitStart := rx.MatchLen[0]+1; InLiteral := True; + i := 0; for i:=LitStart to Length(SQL) do begin if SQL[i] = '''' then InLiteral := not InLiteral @@ -6718,6 +6720,7 @@ begin frInvisibleColumns: Result := (FParameters.IsMariaDB and (ServerVersionInt >= 100303)) or (FParameters.IsMySQL(True) and (ServerVersionInt >= 80023)); frCompressedColumns: Result := (FParameters.IsMariaDB and (ServerVersionInt >= 100301)); + else Result := False; end; else Result := False; end; @@ -8963,6 +8966,7 @@ var c: Char; Field: PMYSQL_FIELD; begin + Result := ''; if ColumnExists(Column) then begin if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin // Row was edited and only valid in a TGridRow @@ -9035,6 +9039,7 @@ function TPGQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; var AnsiStr: AnsiString; begin + Result := ''; if ColumnExists(Column) then begin if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin Result := FCurrentUpdateRow[Column].NewText; @@ -9054,6 +9059,7 @@ end; function TSQLiteQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; begin + Result := ''; if ColumnExists(Column) then begin if FEditingPrepared and Assigned(FCurrentUpdateRow) then begin Result := FCurrentUpdateRow[Column].NewText; @@ -9084,6 +9090,7 @@ var begin // ColumnNames is case insensitive, so we can select wrong cased columns in MariaDB 10.4 // See #599 + Result := ''; idx := ColumnNames.IndexOf(ColumnName); if idx > -1 then Result := Col(idx) @@ -9858,6 +9865,7 @@ begin end else begin // Return first available Field.db property, or just the current database as fallback. // For a view in db1 selecting from db2, this returns db2, which triggers errors in GetCreateViewCode! + Result := ''; for i:=0 to ColumnCount-1 do begin Field := FConnection.Lib.mysql_fetch_field_direct(FCurrentResults, i); if Field.db <> '' then begin @@ -10871,6 +10879,7 @@ begin InLiteral := False; ParenthLeft := Pos('(', Source); if (ParenthLeft > 0) and DataType.HasLength then begin + i := 0; for i:=ParenthLeft+1 to Length(Source) do begin if (Source[i] = ')') and (not InLiteral) then break; diff --git a/source/main.pas b/source/main.pas index 290dcc31..e2f55501 100644 --- a/source/main.pas +++ b/source/main.pas @@ -12313,7 +12313,7 @@ begin //QueryTab.Memo.Gutter.Parts.Add(TSynGutterCodeFolding.Create(QueryTab.Memo.Gutter.Parts)); //QueryTab.Memo.Gutter.Parts[1].Width := SynMemoQuery.Gutter.Parts[1].Width; QueryTab.Memo.Font.Assign(SynMemoQuery.Font); - //QueryTab.Memo.ActiveLineColor := SynMemoQuery.ActiveLineColor; + QueryTab.Memo.LineHighlightColor.Background := SynMemoQuery.LineHighlightColor.Background; QueryTab.Memo.OnStatusChange := SynMemoQuery.OnStatusChange; QueryTab.Memo.OnSpecialLineColors := SynMemoQuery.OnSpecialLineColors; QueryTab.Memo.OnDragDrop := SynMemoQuery.OnDragDrop; @@ -13253,7 +13253,8 @@ begin else if tab = tabDatabase then f := FFilterTextDatabase else if tab = tabEditor then f := FFilterTextEditor else if tab = tabData then f := FFilterTextData - else if QueryTabs.HasActiveTab and (QueryTabs.ActiveTab.ActiveResultTab <> nil) then f := QueryTabs.ActiveTab.ActiveResultTab.FilterText; + else if QueryTabs.HasActiveTab and (QueryTabs.ActiveTab.ActiveResultTab <> nil) then f := QueryTabs.ActiveTab.ActiveResultTab.FilterText + else f := ''; if editFilterVT.Text <> f then editFilterVT.Text := f else @@ -13392,7 +13393,7 @@ begin Editor.OnScanForFoldRanges := BaseEditor.OnScanForFoldRanges; Editor.UseCodeFolding := actCodeFolding.Checked;} end; - //Editor.ActiveLineColor := StringToColor(AppSettings.ReadString(asSQLColActiveLine)); + Editor.LineHighlightColor.Background := StringToColor(AppSettings.ReadString(asSQLColActiveLine)); Editor.Options := BaseEditor.Options; if Editor = SynMemoSQLLog then Editor.Options := Editor.Options + [eoRightMouseMovesCursor]; @@ -13550,7 +13551,10 @@ begin end else if MenuItem = menuQueryHelpersGenerateDelete then begin sql := 'DELETE FROM '+ActiveDbObj.QuotedName(False)+' WHERE ' + WhereClause; + end else begin + sql := ''; end; + //QueryTabs.ActiveMemo.UndoList.AddGroupBreak; QueryTabs.ActiveMemo.SelText := sql; end; diff --git a/source/preferences.pas b/source/preferences.pas index b2ae26ec..2c50e471 100644 --- a/source/preferences.pas +++ b/source/preferences.pas @@ -1,1628 +1,1628 @@ -unit preferences; - -{$mode delphi}{$H+} - -// ------------------------------------- -// Preferences -// ------------------------------------- - - -interface - -uses - SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ComCtrls, SynEditHighlighter, SynHighlighterSQL, - SynEdit, laz.VirtualTrees, SynEditKeyCmds, ActnList, Menus, - dbstructures, RegExpr, Generics.Collections, EditBtn, - extra_controls, reformatter, Buttons, ColorBox, LCLProc, LCLIntf, lazaruscompat, FileUtil; - -type - TShortcutItemData = record - Action: TAction; - KeyStroke: TSynEditKeyStroke; - ShortCut1, ShortCut2: TShortCut; - end; - PShortcutItemData = ^TShortcutItemData; - - // Color set for grid text, and preset class with a name - TGridTextColors = Array[TDBDatatypeCategoryIndex] of TColor; - TGridColorsPreset = class - TextColors: TGridTextColors; - Name: String; - end; - TGridColorsPresetList = TObjectList; - - { TfrmPreferences } - - TfrmPreferences = class(TExtForm) - pagecontrolMain: TPageControl; - tabMisc: TTabSheet; - btnCancel: TButton; - btnOK: TButton; - btnApply: TButton; - tabSQL: TTabSheet; - chkAutoReconnect: TCheckBox; - tabGridFormatting: TTabSheet; - lblDataFont: TLabel; - comboDataFontName: TComboBox; - editDataFontSize: TEdit; - lblDataFontHint: TLabel; - lblMaxColWidth: TLabel; - editMaxColWidth: TEdit; - chkRestoreLastDB: TCheckBox; - chkUpdatecheck: TCheckBox; - editUpdatecheckInterval: TEdit; - chkUpdateCheckBuilds: TCheckBox; - SynSQLSynSQLSample: TSynSQLSyn; - btnRestoreDefaults: TButton; - lblMaxTotalRows: TLabel; - editGridRowCountMax: TEdit; - chkDoStatistics: TCheckBox; - tabShortcuts: TTabSheet; - TreeShortcutItems: TLazVirtualStringTree; - lblShortcut1: TLabel; - lblShortcutHint: TLabel; - lblShortcut2: TLabel; - chkAllowMultiInstances: TCheckBox; - tabLogging: TTabSheet; - Label4: TLabel; - editLogLines: TEdit; - lblLogLinesHint: TLabel; - lblLogSnipHint: TLabel; - editLogSnip: TEdit; - lblLogSnip: TLabel; - chkLogToFile: TCheckBox; - editLogDir: TEditButton; - lblLogLevel: TLabel; - chkLogEventErrors: TCheckBox; - chkLogEventUserGeneratedSQL: TCheckBox; - chkLogEventSQL: TCheckBox; - chkLogEventInfo: TCheckBox; - chkLogEventDebug: TCheckBox; - editGridRowCountStep: TEdit; - lblGridRowsLinecount: TLabel; - editGridRowsLineCount: TEdit; - chkColorBars: TCheckBox; - comboSQLFontName: TComboBox; - lblFont: TLabel; - editSQLFontSize: TEdit; - lblSQLFontSizeUnit: TLabel; - chkCompletionProposal: TCheckBox; - chkTabsToSpaces: TCheckBox; - editSQLTabWidth: TEdit; - Label1: TLabel; - lblMaxQueryResults: TLabel; - editMaxQueryResults: TEdit; - lblGridTextColors: TLabel; - comboGridTextColors: TComboBox; - colorBoxGridTextColors: TColorBox; - lblNullBackground: TLabel; - cboxNullBackground: TColorBox; - lblMySQLBinaries: TLabel; - editMySQLBinaries: TEditButton; - lblLanguage: TLabel; - comboAppLanguage: TComboBox; - chkQueryHistory: TCheckBox; - cboxRowBackgroundOdd: TColorBox; - cboxRowBackgroundEven: TColorBox; - Label2: TLabel; - tabDataEditors: TTabSheet; - chkEditorBinary: TCheckBox; - chkEditorDatetime: TCheckBox; - chkPrefillDateTime: TCheckBox; - chkEditorEnum: TCheckBox; - chkEditorSet: TCheckBox; - chkReuseEditorConfiguration: TCheckBox; - chkForeignDropDown: TCheckBox; - chkLocalNumberFormat: TCheckBox; - lblSQLColElement: TLabel; - comboSQLColElement: TComboBox; - chkSQLBold: TCheckBox; - chkSQLItalic: TCheckBox; - lblSQLColBackground: TLabel; - lblSQLColForeground: TLabel; - cboxSQLColForeground: TColorBox; - cboxSQLColBackground: TColorBox; - SynMemoSQLSample: TSynEdit; - editCustomSnippetsDirectory: TEditButton; - lblCustomSnippetsDirectory: TLabel; - chkHintsOnResultTabs: TCheckBox; - lblLineBreakStyle: TLabel; - comboLineBreakStyle: TComboBox; - lblGUIFont: TLabel; - comboGUIFont: TComboBox; - editGUIFontSize: TEdit; - lblGUIFontSize: TLabel; - chkHorizontalScrollbar: TCheckBox; - editQueryHistoryKeepDays: TEdit; - lblQueryHistoryKeepDays: TLabel; - Label3: TLabel; - cboxRowHighlightSameText: TColorBox; - chkWheelZoom: TCheckBox; - chkAutoUppercase: TCheckBox; - lblTheme: TLabel; - comboTheme: TComboBox; - lblEditorColorsPreset: TLabel; - comboEditorColorsPreset: TComboBox; - SynSQLSyn_Dark: TSynSQLSyn; - SynSQLSyn_Light: TSynSQLSyn; - SynSQLSyn_Black: TSynSQLSyn; - SynSQLSyn_White: TSynSQLSyn; - comboGridTextColorsPreset: TComboBox; - lblIconPack: TLabel; - comboIconPack: TComboBox; - tabFiles: TTabSheet; - chkAskFileSave: TCheckBox; - chkRestoreTabs: TCheckBox; - chkLogEventScript: TCheckBox; - lblWebSearchBaseUrl: TLabel; - comboWebSearchBaseUrl: TComboBox; - chkThemePreview: TCheckBox; - chkCompletionProposalSearchOnMid: TCheckBox; - lblLongSortRowNum: TLabel; - editLongSortRowNum: TEdit; - chkLowercaseHex: TCheckBox; - chkTabCloseOnDoubleClick: TCheckBox; - lblRealTrailingZeros: TLabel; - editRealTrailingZeros: TEdit; - lblRealTrailingZerosHint: TLabel; - chkLogTimestamp: TCheckBox; - lblCompletionProposal: TLabel; - editCompletionProposalInterval: TEdit; - lblCompletionProposalIntervalUnit: TLabel; - chkColumnHeaderClick: TCheckBox; - chkIncrementalSearch: TCheckBox; - chkShowRowId: TCheckBox; - chkTabCloseOnMiddleClick: TCheckBox; - btnRemoveHotKey1: TSpeedButton; - btnRemoveHotKey2: TSpeedButton; - comboTabIconsGrayscaleMode: TComboBox; - Label5: TLabel; - lblReformatter: TLabel; - comboReformatter: TComboBox; - procedure FormDestroy(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure Modified(Sender: TObject); - procedure Apply(Sender: TObject); - procedure SQLFontChange(Sender: TObject); - procedure DataFontsChange(Sender: TObject); - procedure anyUpDownLimitChanging(Sender: TObject; - var AllowChange: Boolean); - procedure editLogDirRightButtonClick(Sender: TObject); - procedure chkLogToFileClick(Sender: TObject); - procedure chkUpdatecheckClick(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure comboSQLColElementChange(Sender: TObject); - procedure pagecontrolMainChanging(Sender: TObject; - var AllowChange: Boolean); - procedure pagecontrolMainChange(Sender: TObject); - procedure updownSQLFontSizeClick(Sender: TObject; Button: TUDBtnType); - procedure SynMemoSQLSampleClick(Sender: TObject); - procedure btnRestoreDefaultsClick(Sender: TObject); - procedure TreeShortcutItemsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; - var InitialStates: TVirtualNodeInitStates); - procedure TreeShortcutItemsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - TextType: TVSTTextType; var CellText: String); - procedure TreeShortcutItemsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); - procedure TreeShortcutItemsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; - Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); - procedure TreeShortcutItemsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); - procedure TreeShortcutItemsGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); - procedure HotKeyEnter(Sender: TObject); - procedure HotKeyExit(Sender: TObject); - procedure comboGridTextColorsSelect(Sender: TObject); - procedure colorBoxGridTextColorsSelect(Sender: TObject); - procedure editMySQLBinariesRightButtonClick(Sender: TObject); - procedure editGridRowCountExit(Sender: TObject); - procedure editCustomSnippetsDirectoryRightButtonClick(Sender: TObject); - procedure comboGUIFontChange(Sender: TObject); - procedure chkQueryHistoryClick(Sender: TObject); - procedure comboEditorColorsPresetChange(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure comboGridTextColorsPresetSelect(Sender: TObject); - procedure chkCompletionProposalClick(Sender: TObject); - procedure HotKeyChange(Sender: TObject); - procedure btnRemoveHotKeyClick(Sender: TObject); - private - { Private declarations } - FWasModified: Boolean; - FShortcutCategories: TStringList; - FGridTextColors: TGridTextColors; - FGridColorsPresets: TGridColorsPresetList; - FLanguages: TStringList; - FRestartOptionTouched: Boolean; - FRestartOptionApplied: Boolean; - //FHotKey1: TExtSynHotKey; - //FHotKey2: TExtSynHotKey; - procedure InitLanguages; - procedure SelectDirectory(Sender: TObject; NewFolderButton: Boolean); - function EnsureShortcutIsUnused(RequestShortcut: TShortCut): Boolean; - public - { Public declarations } - end; - - -var - frmPreferences: TfrmPreferences; - -//function EnumFixedProc(lpelf: PEnumLogFont; lpntm: PNewTextMetric; FontType: Integer; Data: LPARAM): Integer; stdcall; - - -implementation -uses main, apphelpers; -{$R *.lfm} - - -procedure TfrmPreferences.Modified(Sender: TObject); -begin - // Modified - btnApply.Enabled := True; - // Sending controls with a Tag property > 0 (normally 1) need an application restart - if (Sender is TComponent) and (TComponent(Sender).Tag <> 0) then begin - FRestartOptionTouched := True; - end; -end; - - -procedure TfrmPreferences.pagecontrolMainChanging(Sender: TObject; - var AllowChange: Boolean); -begin - // Remember modification state. First tab switch leads TEdit's with TUpDown - // to fire OnChange. Avoid enabling the buttons in that case. - FWasModified := btnApply.Enabled; -end; - - -procedure TfrmPreferences.pagecontrolMainChange(Sender: TObject); -begin - // See OnChanging procedure - btnApply.Enabled := FWasModified; - TExtForm.PageControlTabHighlight(pagecontrolMain); -end; - - -{** - Apply settings to registry and mainform -} -procedure TfrmPreferences.Apply(Sender: TObject); -var - i: Integer; - Attri: TSynHighlighterAttributes; - CatNode, ItemNode: PVirtualNode; - Data: PShortcutItemData; - LangCode: String; -begin - Screen.Cursor := crHourGlass; - - // Save values - AppSettings.WriteBool(asAutoReconnect, chkAutoReconnect.Checked); - AppSettings.WriteBool(asAllowMultipleInstances, chkAllowMultiInstances.Checked); - AppSettings.WriteBool(asRestoreLastUsedDB, chkRestoreLastDB.Checked); - AppSettings.WriteString(asFontName, comboSQLFontName.Text); - AppSettings.WriteInt(asFontSize, MakeInt(editSQLFontSize.Text)); - AppSettings.WriteInt(asTabWidth, MakeInt(editSQLTabWidth.Text)); - AppSettings.WriteInt(asLogsqlnum, MakeInt(editLogLines.Text)); - AppSettings.WriteInt(asLogsqlwidth, MakeInt(editLogSnip.Text)); - AppSettings.WriteString(asSessionLogsDirectory, editLogDir.Text); - AppSettings.WriteBool(asLogErrors, chkLogEventErrors.Checked); - AppSettings.WriteBool(asLogUserSQL, chkLogEventUserGeneratedSQL.Checked); - AppSettings.WriteBool(asLogSQL, chkLogEventSQL.Checked); - AppSettings.WriteBool(asLogScript, chkLogEventScript.Checked); - AppSettings.WriteBool(asLogInfos, chkLogEventInfo.Checked); - AppSettings.WriteBool(asLogDebug, chkLogEventDebug.Checked); - AppSettings.WriteBool(asQueryHistoryEnabled, chkQueryHistory.Checked); - AppSettings.WriteInt(asQueryHistoryKeepDays, MakeInt(editQueryHistoryKeepDays.Text)); - AppSettings.WriteBool(asLogHorizontalScrollbar, chkHorizontalScrollbar.Checked); - AppSettings.WriteBool(asLogTimestamp, chkLogTimestamp.Checked); - for i:=0 to SynSQLSynSQLSample.AttrCount - 1 do begin - Attri := SynSQLSynSQLSample.Attribute[i]; - AppSettings.WriteInt(asHighlighterForeground, Attri.Foreground, Attri.Name); - AppSettings.WriteInt(asHighlighterBackground, Attri.Background, Attri.Name); - AppSettings.WriteInt(asHighlighterStyle, Attri.IntegerStyle, Attri.Name); - end; - //AppSettings.WriteString(asSQLColActiveLine, ColorToString(SynMemoSQLSample.ActiveLineColor)); - AppSettings.WriteString(asSQLColMatchingBraceForeground, ColorToString(MainForm.MatchingBraceForegroundColor)); - AppSettings.WriteString(asSQLColMatchingBraceBackground, ColorToString(MainForm.MatchingBraceBackgroundColor)); - - AppSettings.WriteInt(asMaxColWidth, MakeInt(editMaxColWidth.Text)); - AppSettings.WriteInt(asDatagridRowsPerStep, StrToIntDef(editGridRowCountStep.Text, -1)); - AppSettings.WriteInt(asDatagridMaximumRows, StrToIntDef(editGridRowCountMax.Text, -1)); - AppSettings.WriteInt(asGridRowLineCount, MakeInt(editGridRowsLineCount.Text)); - AppSettings.WriteString(asDataFontName, comboDataFontName.Text); - AppSettings.WriteInt(asDataFontSize, MakeInt(editDataFontSize.Text)); - AppSettings.WriteBool(asLogToFile, chkLogToFile.Checked); - AppSettings.WriteBool(asUpdatecheck, chkUpdatecheck.Checked); - AppSettings.WriteBool(asUpdatecheckBuilds, chkUpdatecheckBuilds.Checked); - AppSettings.WriteInt(asUpdatecheckInterval, MakeInt(editUpdatecheckInterval.Text)); - AppSettings.WriteBool(asDoUsageStatistics, chkDoStatistics.Checked); - AppSettings.WriteBool(asWheelZoom, chkWheelZoom.Checked); - AppSettings.WriteBool(asDisplayBars, chkColorBars.Checked); - AppSettings.WriteString(asMySQLBinaries, editMySQLBinaries.Text); - AppSettings.WriteString(asCustomSnippetsDirectory, editCustomSnippetsDirectory.Text); - - if comboAppLanguage.ItemIndex > 0 then begin - // Get language code from the left text in the dropdown item text, up to the colon - LangCode := RegExprGetMatch('^(\w+)\b', comboAppLanguage.Text, 1); - end else begin - LangCode := ''; - end; - AppSettings.WriteString(asAppLanguage, LangCode); - - if comboGUIFont.ItemIndex = 0 then - AppSettings.WriteString(asGUIFontName, '') - else - AppSettings.WriteString(asGUIFontName, comboGUIFont.Text); - AppSettings.WriteInt(asGUIFontSize, MakeInt(editGUIFontSize.Text)); - AppSettings.WriteString(asIconPack, comboIconPack.Text); - AppSettings.WriteString(asWebSearchBaseUrl, comboWebSearchBaseUrl.Text); - - AppSettings.WriteInt(asMaxQueryResults, MakeInt(editMaxQueryResults.Text)); - // Save color settings - AppSettings.WriteInt(asFieldColorNumeric, FGridTextColors[dtcInteger]); - AppSettings.WriteInt(asFieldColorReal, FGridTextColors[dtcReal]); - AppSettings.WriteInt(asFieldColorText, FGridTextColors[dtcText]); - AppSettings.WriteInt(asFieldColorBinary, FGridTextColors[dtcBinary]); - AppSettings.WriteInt(asFieldColorDatetime, FGridTextColors[dtcTemporal]); - AppSettings.WriteInt(asFieldColorSpatial, FGridTextColors[dtcSpatial]); - AppSettings.WriteInt(asFieldColorOther, FGridTextColors[dtcOther]); - AppSettings.WriteInt(asFieldNullBackground, cboxNullBackground.Selected); - AppSettings.WriteInt(asRowBackgroundEven, cboxRowBackgroundEven.Selected); - AppSettings.WriteInt(asRowBackgroundOdd, cboxRowBackgroundOdd.Selected); - AppSettings.WriteInt(asHightlightSameTextBackground, cboxRowHighlightSameText.Selected); - AppSettings.WriteInt(asRealTrailingZeros, MakeInt(editRealTrailingZeros.Text)); - AppSettings.WriteInt(asQueryGridLongSortRowNum, MakeInt(editLongSortRowNum.Text)); - AppSettings.WriteBool(asDataLocalNumberFormat, chkLocalNumberFormat.Checked); - AppSettings.WriteBool(asLowercaseHex, chkLowercaseHex.Checked); - AppSettings.WriteBool(asHintsOnResultTabs, chkHintsOnResultTabs.Checked); - AppSettings.WriteBool(asShowRowId, chkShowRowId.Checked); - - // Editor Configuration - AppSettings.WriteBool(asFieldEditorBinary, chkEditorBinary.Checked); - AppSettings.WriteBool(asFieldEditorDatetime, chkEditorDatetime.Checked); - AppSettings.WriteBool(asFieldEditorDatetimePrefill, chkPrefillDatetime.Checked); - AppSettings.WriteBool(asFieldEditorEnum, chkEditorEnum.Checked); - AppSettings.WriteBool(asFieldEditorSet, chkEditorSet.Checked); - AppSettings.WriteBool(asColumnHeaderClick, chkColumnHeaderClick.Checked); - AppSettings.WriteBool(asReuseEditorConfiguration, chkReuseEditorConfiguration.Checked); - AppSettings.WriteBool(asForeignDropDown, chkForeignDropDown.Checked); - AppSettings.WriteBool(asIncrementalSearch, chkIncrementalSearch.Checked); - case comboLineBreakStyle.ItemIndex of - 1: AppSettings.WriteInt(asLineBreakStyle, Integer(lbsUnix)); - 2: AppSettings.WriteInt(asLineBreakStyle, Integer(lbsMac)); - else AppSettings.WriteInt(asLineBreakStyle, Integer(lbsWindows)); - end; - - AppSettings.WriteBool(asCompletionProposal, chkCompletionProposal.Checked); - AppSettings.WriteInt(asCompletionProposalInterval, MakeInt(editCompletionProposalInterval.Text)); - AppSettings.WriteBool(asCompletionProposalSearchOnMid, chkCompletionProposalSearchOnMid.Checked); - AppSettings.WriteBool(asAutoUppercase, chkAutoUppercase.Checked); - AppSettings.WriteBool(asTabsToSpaces, chkTabsToSpaces.Checked); - - // Shortcuts - CatNode := TreeShortcutItems.GetFirst; - while Assigned(CatNode) do begin - ItemNode := TreeShortcutItems.GetFirstChild(CatNode); - while Assigned(ItemNode) do begin - Data := TreeShortcutItems.GetNodeData(ItemNode); - // Save modified shortcuts - if Assigned(Data.KeyStroke) then begin - if Data.Shortcut1 <> Data.KeyStroke.ShortCut then - AppSettings.WriteInt(asActionShortcut1, Data.Shortcut1, EditorCommandToCodeString(Data.KeyStroke.Command)); - if Data.Shortcut2 <> Data.KeyStroke.ShortCut2 then - AppSettings.WriteInt(asActionShortcut2, Data.Shortcut2, EditorCommandToCodeString(Data.KeyStroke.Command)); - end else begin - if Data.Shortcut1 <> Data.Action.ShortCut then - AppSettings.WriteInt(asActionShortcut1, Data.Shortcut1, Data.Action.Name); - // Apply shortcut for this session - Data.Action.ShortCut := Data.Shortcut1; - end; - ItemNode := TreeShortcutItems.GetNextSibling(ItemNode); - end; - CatNode := TreeShortcutItems.GetNextSibling(CatNode); - end; - // Populate SynMemo settings to all instances - Mainform.SetupSynEditors; - - // Files and tabs - AppSettings.WriteBool(asPromptSaveFileOnTabClose, chkAskFileSave.Checked); - AppSettings.WriteBool(asRestoreTabs, chkRestoreTabs.Checked); - AppSettings.WriteBool(asTabCloseOnDoubleClick, chkTabCloseOnDoubleClick.Checked); - AppSettings.WriteBool(asTabCloseOnMiddleClick, chkTabCloseOnMiddleClick.Checked); - AppSettings.WriteInt(asTabIconsGrayscaleMode, comboTabIconsGrayscaleMode.ItemIndex); - AppSettings.WriteInt(asReformatterNoDialog, comboReformatter.ItemIndex); - - // Set relevant properties in mainform - MainForm.ApplyFontToGrids; - MainForm.PrepareImageList; - //MainForm.SynCompletionProposal.TimerInterval := updownCompletionProposalInterval.Position; - Mainform.LogToFile := chkLogToFile.Checked; - MainForm.actLogHorizontalScrollbar.Checked := chkHorizontalScrollbar.Checked; - MainForm.actLogHorizontalScrollbar.OnExecute(MainForm.actLogHorizontalScrollbar); - DatatypeCategories[dtcInteger].Color := FGridTextColors[dtcInteger]; - DatatypeCategories[dtcReal].Color := FGridTextColors[dtcReal]; - DatatypeCategories[dtcText].Color := FGridTextColors[dtcText]; - DatatypeCategories[dtcBinary].Color := FGridTextColors[dtcBinary]; - DatatypeCategories[dtcTemporal].Color := FGridTextColors[dtcTemporal]; - DatatypeCategories[dtcSpatial].Color := FGridTextColors[dtcSpatial]; - DatatypeCategories[dtcOther].Color := FGridTextColors[dtcOther]; - Mainform.DataLocalNumberFormat := chkLocalNumberFormat.Checked; - Mainform.CalcNullColors; - Mainform.DataGrid.Repaint; - Mainform.QueryGrid.Repaint; - Mainform.ListTables.Invalidate; - Mainform.ListProcesses.Invalidate; - Mainform.ListCommandStats.Invalidate; - - - FRestartOptionApplied := FRestartOptionTouched; - - // Settings have been applied, send a signal to the user - btnApply.Enabled := False; - Screen.Cursor := crDefault; -end; - - -// Callback function used by EnumFontFamilies() -{function EnumFixedProc( - lpelf: PEnumLogFont; - lpntm: PNewTextMetric; - FontType: Integer; - Data: LPARAM - ): Integer; stdcall; -begin - Result := 1; // don't cancel - if (lpelf^.elfLogFont.lfPitchAndFamily and FIXED_PITCH) <> 0 then - (TStrings(Data)).Add(String(lpelf^.elfLogFont.lfFaceName)); -end;} - - -procedure TfrmPreferences.FormClose(Sender: TObject; var Action: TCloseAction); -begin - if FRestartOptionApplied then begin - MessageDialog(f_('You should restart %s to apply changed critical settings, and to prevent unexpected behaviour.', [APPNAME]), - mtInformation, - [mbOk]); - end; - MainForm.ActionList1.State := asNormal; -end; - - -procedure TfrmPreferences.FormCreate(Sender: TObject); -const - // Define grid colors as constants, for easy assignment - GridColorsLight: TGridTextColors = ($00FF0000, $00FF0048, $00008000, $00800080, $00000080, $00808000, $00008080); - GridColorsDark: TGridTextColors = ($00FF9785, $00D07D7D, $0073D573, $00C9767F, $007373C9, $00CECE73, $0073C1C1); - GridColorsBlack: TGridTextColors = ($00000000, $00000000, $00000000, $00000000, $00000000, $00000000, $00000000); - GridColorsWhite: TGridTextColors = ($00FFFFFF, $00FFFFFF, $00FFFFFF, $00FFFFFF, $00FFFFFF, $00FFFFFF, $00FFFFFF); -var - i: Integer; - dtc: TDBDatatypeCategoryIndex; - //Styles: TArray; - Highlighter: TSynSQLSyn; - Name: String; - GridColorsPreset: TGridColorsPreset; - //IconPack: String; - Reformatter: TfrmReformatter; -begin - HasSizeGrip := True; - Width := AppSettings.ReadInt(asPreferencesWindowWidth); - Height := AppSettings.ReadInt(asPreferencesWindowHeight); - - // Misecllaneous - // Hide browse button on Wine, as the browse dialog returns Windows-style paths, while we need a Unix path - if IsWine then begin - editMySQLBinaries.Button.Enabled := False; - editMySQLBinaries.OnDblClick := nil; - end; - - InitLanguages; - comboAppLanguage.Items.AddStrings(FLanguages); - - comboGUIFont.Items.Assign(Screen.Fonts); - comboGUIFont.Items.Insert(0, '<'+_('Default system font')+'>'); - - lblTheme.Enabled := False; - comboTheme.Items.Text := 'Themes are not supported in the Lazarus release'; - comboTheme.ItemIndex := 0; - comboTheme.Enabled := False; - chkThemePreview.Enabled := False; - - // Populate icon pack dropdown from image collections on main form - comboIconPack.Items.Clear; - {for i:=0 to MainForm.ComponentCount-1 do begin - if MainForm.Components[i] is TImageCollection then begin - IconPack := MainForm.Components[i].Name; - IconPack := StringReplace(IconPack, 'ImageCollection', '', [rfIgnoreCase]); - comboIconPack.Items.Add(IconPack); - end; - end;} - - // Data - // Populate datatype categories pulldown - for dtc:=Low(TDBDatatypeCategoryIndex) to High(TDBDatatypeCategoryIndex) do - comboGridTextColors.Items.Add(DatatypeCategories[dtc].Name); - - // SQL - //EnumFontFamilies(Canvas.Handle, nil, @EnumFixedProc, LPARAM(Pointer(comboSQLFontName.Items))); - comboSQLFontName.Items.Assign(Screen.Fonts); - comboSQLFontName.Sorted := True; - SynMemoSQLSample.Text := 'SELECT DATE_SUB(NOW(), INTERVAL 1 DAY),' + sLineBreak + - CodeIndent + '''String literal'' AS lit' + sLineBreak + - 'FROM tableA AS ta' + sLineBreak + - 'WHERE `columnA` IS NULL;' + sLineBreak + - sLineBreak + - '-- A comment' + sLineBreak + - '# Old style comment' + sLineBreak + - '/* Multi line comment */' + sLineBreak + - sLineBreak + - 'CREATE TABLE /*!32312 IF NOT EXISTS*/ tableB (' + sLineBreak + - CodeIndent + 'id INT,' + sLineBreak + - CodeIndent + 'name VARCHAR(30) DEFAULT "standard"' + sLineBreak + - ')'; - SynSQLSynSQLSample.TableNames.CommaText := 'tableA,tableB'; - for i:=0 to SynSQLSynSQLSample.AttrCount - 1 do begin - SynSQLSynSQLSample.Attribute[i].AssignColorAndStyle(MainForm.SynSQLSynUsed.Attribute[i]); - comboSQLColElement.Items.Add(SynSQLSynSQLSample.Attribute[i].Name); - end; - comboSQLColElement.Items.Add(_('Active line background')); - comboSQLColElement.Items.Add(_('Brace matching color')); - comboSQLColElement.ItemIndex := 0; - // Enumerate highlighter presets - for i:=0 to ComponentCount-1 do begin - if (Components[i] is TSynSQLSyn) - and (Components[i] <> SynMemoSQLSample.Highlighter) - then begin - Highlighter := Components[i] as TSynSQLSyn; - Name := Highlighter.Name; - Name := RegExprGetMatch('_([^_]+)$', Name, 1); - if Name <> '' then begin - comboEditorColorsPreset.Items.Add(_(Name)); - end; - end; - end; - - // Grid formatting - FGridColorsPresets := TGridColorsPresetList.Create; - // Current colors - assign from global DatatypeCategories array - GridColorsPreset := TGridColorsPreset.Create; - GridColorsPreset.Name := _('Current custom settings'); - for dtc:=Low(TDBDatatypeCategoryIndex) to High(TDBDatatypeCategoryIndex) do begin - GridColorsPreset.TextColors[dtc] := DatatypeCategories[dtc].Color; - end; - FGridColorsPresets.Add(GridColorsPreset); - // Light - default values - GridColorsPreset := TGridColorsPreset.Create; - GridColorsPreset.Name := _('Light'); - GridColorsPreset.TextColors := GridColorsLight; - FGridColorsPresets.Add(GridColorsPreset); - // Dark - GridColorsPreset := TGridColorsPreset.Create; - GridColorsPreset.Name := _('Dark'); - GridColorsPreset.TextColors := GridColorsDark; - FGridColorsPresets.Add(GridColorsPreset); - // Black - GridColorsPreset := TGridColorsPreset.Create; - GridColorsPreset.Name := _('Black'); - GridColorsPreset.TextColors := GridColorsBlack; - FGridColorsPresets.Add(GridColorsPreset); - // White - GridColorsPreset := TGridColorsPreset.Create; - GridColorsPreset.Name := _('White'); - GridColorsPreset.TextColors := GridColorsWhite; - FGridColorsPresets.Add(GridColorsPreset); - // Add all to combo box - comboGridTextColorsPreset.Clear; - for GridColorsPreset in FGridColorsPresets do begin - comboGridTextColorsPreset.Items.Add(GridColorsPreset.Name); - end; - - // Shortcuts - {FHotKey1 := TExtSynHotKey.Create(Self); - FHotKey1.Parent := tabShortcuts; - FHotKey1.Left := lblShortcut1.Left; - FHotKey1.Top := lblShortcut1.Top + lblShortcut1.Height + 4; - FHotKey1.Width := tabShortcuts.Width - FHotKey1.Left - btnRemoveHotKey1.Width - 4 - 4; - FHotKey1.Height := editDataFontSize.Height; - FHotKey1.Anchors := [akLeft, akTop, akRight]; - FHotKey1.HotKey := 0; - FHotKey1.InvalidKeys := []; - FHotKey1.Modifiers := []; - FHotKey1.Enabled := False; - FHotKey1.OnChange := HotKeyChange; - FHotKey1.OnEnter := HotKeyEnter; - FHotKey1.OnExit := HotKeyExit; - btnRemoveHotKey1.Left := FHotKey1.Left + FHotKey1.Width + 4; - btnRemoveHotKey1.Top := FHotKey1.Top;} - btnRemoveHotKey1.Enabled := False; - - {FHotKey2 := TExtSynHotKey.Create(Self); - FHotKey2.Parent := tabShortcuts; - FHotKey2.Left := lblShortcut2.Left; - FHotKey2.Top := lblShortcut2.Top + lblShortcut2.Height + 4; - FHotKey2.Width := tabShortcuts.Width - FHotKey2.Left - btnRemoveHotKey2.Width - 4 - 4; - FHotKey2.Height := editDataFontSize.Height; - FHotKey2.Anchors := [akLeft, akTop, akRight]; - FHotKey2.HotKey := 0; - FHotKey2.InvalidKeys := []; - FHotKey2.Modifiers := []; - FHotKey2.Enabled := False; - FHotKey2.OnChange := HotKeyChange; - FHotKey2.OnEnter := HotKeyEnter; - FHotKey2.OnExit := HotKeyExit; - btnRemoveHotKey2.Left := FHotKey2.Left + FHotKey2.Width + 4; - btnRemoveHotKey2.Top := FHotKey2.Top;} - btnRemoveHotKey2.Enabled := False; - - FShortcutCategories := TStringList.Create; - for i:=0 to Mainform.ActionList1.ActionCount-1 do begin - if FShortcutCategories.IndexOf(Mainform.ActionList1.Actions[i].Category) = -1 then - FShortcutCategories.Add(Mainform.ActionList1.Actions[i].Category); - end; - FShortcutCategories.Add(_('SQL editing')); - TreeShortcutItems.RootNodeCount := FShortcutCategories.Count; - comboLineBreakStyle.Items := Explode(',', _('Windows linebreaks')+','+_('UNIX linebreaks')+','+_('Mac OS linebreaks')); - - comboReformatter.Items.Add(_('Always ask')); - Reformatter := TfrmReformatter.Create(Self); - comboReformatter.Items.AddStrings(Reformatter.grpReformatter.Items); - Reformatter.Free; -end; - - -procedure TfrmPreferences.FormShow(Sender: TObject); -var - LangCode, GUIFont: String; - i: Integer; -begin - Screen.Cursor := crHourGlass; - - // Read and display values - chkAutoReconnect.Checked := AppSettings.ReadBool(asAutoReconnect);; - chkAllowMultiInstances.Checked := AppSettings.ReadBool(asAllowMultipleInstances); - chkRestoreLastDB.Checked := AppSettings.ReadBool(asRestoreLastUsedDB); - chkUpdatecheck.Checked := AppSettings.ReadBool(asUpdatecheck); - chkUpdatecheckBuilds.Checked := AppSettings.ReadBool(asUpdatecheckBuilds); - editUpdatecheckInterval.Text := AppSettings.ReadInt(asUpdatecheckInterval).ToString; - chkUpdatecheckClick(Sender); - chkDoStatistics.Checked := AppSettings.ReadBool(asDoUsageStatistics); - chkWheelZoom.Checked := AppSettings.ReadBool(asWheelZoom); - chkColorBars.Checked := AppSettings.ReadBool(asDisplayBars); - editMySQLBinaries.Text := AppSettings.ReadString(asMySQLBinaries); - editCustomSnippetsDirectory.Text := AppSettings.ReadString(asCustomSnippetsDirectory); - LangCode := AppSettings.ReadString(asAppLanguage); - for i:=0 to comboAppLanguage.Items.Count-1 do begin - if RegExprGetMatch('^(\w+)\b', comboAppLanguage.Items[i], 1) = LangCode then begin - comboAppLanguage.ItemIndex := i; - Break; - end; - end; - if comboAppLanguage.ItemIndex = -1 then - comboAppLanguage.ItemIndex := 0; - GUIFont := AppSettings.ReadString(asGUIFontName); - if GUIFont.IsEmpty then - comboGUIFont.ItemIndex := 0 - else - comboGUIFont.ItemIndex := comboGUIFont.Items.IndexOf(GUIFont); - editGUIFontSize.Text := AppSettings.ReadInt(asGUIFontSize).ToString; - comboGUIFont.OnChange(comboGUIFont); - comboIconPack.ItemIndex := comboIconPack.Items.IndexOf(AppSettings.ReadString(asIconPack)); - comboWebSearchBaseUrl.Text := AppSettings.ReadString(asWebSearchBaseUrl); - - // Logging - editLogLines.Text := AppSettings.ReadInt(asLogsqlnum).ToString; - editLogSnip.Text := AppSettings.ReadInt(asLogsqlwidth).ToString; - chkLogToFile.Checked := AppSettings.ReadBool(asLogToFile); - editLogDir.Text := AppSettings.ReadString(asSessionLogsDirectory); - chkLogEventErrors.Checked := AppSettings.ReadBool(asLogErrors); - chkLogEventUserGeneratedSQL.Checked := AppSettings.ReadBool(asLogUserSQL); - chkLogEventSQL.Checked := AppSettings.ReadBool(asLogSQL); - chkLogEventScript.Checked := AppSettings.ReadBool(asLogScript); - chkLogEventInfo.Checked := AppSettings.ReadBool(asLogInfos); - chkLogEventDebug.Checked := AppSettings.ReadBool(asLogDebug); - chkQueryHistory.Checked := AppSettings.ReadBool(asQueryHistoryEnabled); - editQueryHistoryKeepDays.Text := AppSettings.ReadInt(asQueryHistoryKeepDays).ToString; - chkHorizontalScrollbar.Checked := AppSettings.ReadBool(asLogHorizontalScrollbar); - chkLogTimestamp.Checked := AppSettings.ReadBool(asLogTimestamp); - - // Default column width in grids: - editMaxColWidth.Text := AppSettings.ReadInt(asMaxColWidth).ToString; - editGridRowCountStep.Text := IntToStr(AppSettings.ReadInt(asDatagridRowsPerStep)); - editGridRowCountMax.Text := IntToStr(AppSettings.ReadInt(asDatagridMaximumRows)); - editGridRowsLineCount.Text := AppSettings.ReadInt(asGridRowLineCount).ToString; - - // SQL: - Mainform.SetupSynEditor(SynMemoSQLSample); - comboSQLFontName.ItemIndex := comboSQLFontName.Items.IndexOf(SynMemoSQLSample.Font.Name); - editSQLFontSize.Text := SynMemoSQLSample.Font.Size.ToString; - editSQLTabWidth.Text := SynMemoSQLSample.TabWidth.ToString; - chkCompletionProposal.Checked := AppSettings.ReadBool(asCompletionProposal); - editCompletionProposalInterval.Text := AppSettings.ReadInt(asCompletionProposalInterval).ToString; - chkCompletionProposalSearchOnMid.Checked := AppSettings.ReadBool(asCompletionProposalSearchOnMid); - chkAutoUppercase.Checked := AppSettings.ReadBool(asAutoUppercase); - chkTabsToSpaces.Checked := AppSettings.ReadBool(asTabsToSpaces); - comboSQLColElementChange(Sender); - - // Grid formatting: - comboDataFontName.Items := Screen.Fonts; - comboDataFontName.ItemIndex := comboDataFontName.Items.IndexOf(AppSettings.ReadString(asDataFontName)); - editDataFontSize.Text := AppSettings.ReadInt(asDataFontSize).ToString; - editMaxQueryResults.Text := AppSettings.ReadINt(asMaxQueryResults).ToString; - // Load color settings - FGridTextColors[dtcInteger] := AppSettings.ReadInt(asFieldColorNumeric); - FGridTextColors[dtcReal] := AppSettings.ReadInt(asFieldColorReal); - FGridTextColors[dtcText] := AppSettings.ReadInt(asFieldColorText); - FGridTextColors[dtcBinary] := AppSettings.ReadInt(asFieldColorBinary); - FGridTextColors[dtcTemporal] := AppSettings.ReadInt(asFieldColorDatetime); - FGridTextColors[dtcSpatial] := AppSettings.ReadInt(asFieldColorSpatial); - FGridTextColors[dtcOther] := AppSettings.ReadInt(asFieldColorOther); - comboGridTextColorsPreset.ItemIndex := 0; - comboGridTextColors.ItemIndex := 0; - comboGridTextColors.OnSelect(comboGridTextColors); - cboxNullBackground.Selected := AppSettings.ReadInt(asFieldNullBackground); - cboxRowBackgroundEven.Selected := AppSettings.ReadInt(asRowBackgroundEven); - cboxRowBackgroundOdd.Selected := AppSettings.ReadInt(asRowBackgroundOdd); - cboxRowHighlightSameText.Selected := AppSettings.ReadInt(asHightlightSameTextBackground); - editRealTrailingZeros.Text := AppSettings.ReadInt(asRealTrailingZeros).ToString; - editLongSortRowNum.Text := AppSettings.ReadInt(asQueryGridLongSortRowNum).ToString; - chkLocalNumberFormat.Checked := AppSettings.ReadBool(asDataLocalNumberFormat); - chkLowercaseHex.Checked := AppSettings.ReadBool(asLowercaseHex); - chkHintsOnResultTabs.Checked := AppSettings.ReadBool(asHintsOnResultTabs); - chkShowRowId.Checked := AppSettings.ReadBool(asShowRowId); - - // Editor Configuration - chkEditorBinary.Checked := AppSettings.ReadBool(asFieldEditorBinary); - chkEditorDatetime.Checked := AppSettings.ReadBool(asFieldEditorDatetime); - chkPrefillDateTime.Checked := AppSettings.ReadBool(asFieldEditorDatetimePrefill); - chkEditorEnum.Checked := AppSettings.ReadBool(asFieldEditorEnum); - chkEditorSet.Checked := AppSettings.ReadBool(asFieldEditorEnum); - chkColumnHeaderClick.Checked := AppSettings.ReadBool(asColumnHeaderClick); - chkReuseEditorConfiguration.Checked := AppSettings.ReadBool(asReuseEditorConfiguration); - chkForeignDropDown.Checked := AppSettings.ReadBool(asForeignDropDown); - chkIncrementalSearch.Checked := AppSettings.ReadBool(asIncrementalSearch); - case TLineBreaks(AppSettings.ReadInt(asLineBreakStyle)) of - lbsNone, lbsWindows: comboLineBreakStyle.ItemIndex := 0; - lbsUnix: comboLineBreakStyle.ItemIndex := 1; - lbsMac: comboLineBreakStyle.ItemIndex := 2; - end; - - // Shortcuts - TreeShortcutItems.ReinitChildren(nil, True); - SelectNode(TreeShortcutItems, nil); - - // Files and tabs - chkAskFileSave.Checked := AppSettings.ReadBool(asPromptSaveFileOnTabClose); - chkRestoreTabs.Checked := AppSettings.ReadBool(asRestoreTabs); - chkTabCloseOnDoubleClick.Checked := AppSettings.ReadBool(asTabCloseOnDoubleClick); - chkTabCloseOnMiddleClick.Checked := AppSettings.ReadBool(asTabCloseOnMiddleClick); - comboTabIconsGrayscaleMode.ItemIndex := AppSettings.ReadInt(asTabIconsGrayscaleMode); - comboReformatter.ItemIndex := AppSettings.ReadInt(asReformatterNoDialog); - - // Disable global shortcuts - MainForm.ActionList1.State := asSuspended; - - TExtForm.PageControlTabHighlight(pagecontrolMain); - - FRestartOptionTouched := False; - btnApply.Enabled := False; - screen.Cursor := crdefault; -end; - -procedure TfrmPreferences.FormDestroy(Sender: TObject); -begin - AppSettings.WriteInt(asPreferencesWindowWidth, ScaleFormToDesign(Width)); - AppSettings.WriteInt(asPreferencesWindowHeight, ScaleFormToDesign(Height)); -end; - - - -procedure TfrmPreferences.SQLFontChange(Sender: TObject); -var - AttriIdx: Integer; - Attri: TSynHighlighterAttributes; - Foreground, Background: TColor; -begin - if comboSQLFontName.ItemIndex > -1 then - SynMemoSQLSample.Font.Name := comboSQLFontName.Items[comboSQLFontName.ItemIndex]; - SynMemoSQLSample.Font.Size := MakeInt(editSQLFontSize.Text); - SynMemoSQLSample.TabWidth := MakeInt(editSQLTabWidth.Text); - AttriIdx := comboSQLColElement.ItemIndex; - Foreground := cboxSQLColForeground.Selected; - Background := cboxSQLColBackground.Selected; - if AttriIdx = comboSQLColElement.Items.Count-1 then begin - MainForm.MatchingBraceForegroundColor := Foreground; - MainForm.MatchingBraceBackgroundColor := Background; - end else if AttriIdx = comboSQLColElement.Items.Count-2 then begin - //SynMemoSQLSample.ActiveLineColor := Foreground; - end else begin - Attri := SynSqlSynSQLSample.Attribute[AttriIdx]; - Attri.Foreground := Foreground; - Attri.Background := Background; - if chkSQLBold.Checked then Attri.Style := Attri.Style + [fsBold] - else Attri.Style := Attri.Style - [fsBold]; - if chkSQLItalic.Checked then Attri.Style := Attri.Style + [fsItalic] - else Attri.Style := Attri.Style - [fsItalic]; - end; - Modified(Sender); -end; - - -procedure TfrmPreferences.DataFontsChange(Sender: TObject); -begin - Modified(Sender); -end; - -procedure TfrmPreferences.anyUpDownLimitChanging(Sender: TObject; - var AllowChange: Boolean); -begin - Modified(Sender); -end; - - -procedure TfrmPreferences.editGridRowCountExit(Sender: TObject); -var - Edit: TEdit; -begin - // Row count step and maximum shall never be "0", to avoid problems in - // data grids. See issue #3080. - Edit := Sender as TEdit; - if MakeInt(Edit.Text) <= 0 then - Edit.Text := '1'; -end; - - -procedure TfrmPreferences.SelectDirectory(Sender: TObject; NewFolderButton: Boolean); -var - Browse: TSelectDirectoryDialog; - Edit: TEditButton; -begin - // Select folder for any option - Edit := Sender as TEditButton; - Browse := TSelectDirectoryDialog.Create(Self); - Browse.InitialDir := Edit.Text; - Browse.Title := _(Edit.TextHint); - //Browse.BrowseOptions := Browse.BrowseOptions + [bifNewDialogStyle]; - //if not NewFolderButton then - // Browse.BrowseOptions := Browse.BrowseOptions + [bifNoNewFolderButton]; - if Browse.Execute then begin - Edit.Text := Browse.FileName; - Modified(Sender); - end; - Browse.Free; -end; - - -procedure TfrmPreferences.editLogDirRightButtonClick(Sender: TObject); -begin - // Select folder for session logs - SelectDirectory(Sender, True); -end; - - -procedure TfrmPreferences.editMySQLBinariesRightButtonClick(Sender: TObject); -begin - // Select folder where MySQL binaries reside - SelectDirectory(Sender, False); -end; - - -procedure TfrmPreferences.editCustomSnippetsDirectoryRightButtonClick(Sender: TObject); -begin - // Set custom snippets directory - SelectDirectory(Sender, True); -end; - - -{** - Updatecheck checkbox was clicked -} -procedure TfrmPreferences.chkUpdatecheckClick(Sender: TObject); -begin - editUpdatecheckInterval.Enabled := chkUpdatecheck.Checked; - chkUpdatecheckBuilds.Enabled := chkUpdatecheck.Checked; - Modified(Sender); -end; - - -procedure TfrmPreferences.chkCompletionProposalClick(Sender: TObject); -var - Enable: Boolean; -begin - Enable := TCheckBox(Sender).Checked; - editCompletionProposalInterval.Enabled := Enable; - lblCompletionProposalIntervalUnit.Enabled := Enable; - chkCompletionProposalSearchOnMid.Enabled := Enable; - Modified(Sender); -end; - -procedure TfrmPreferences.chkLogToFileClick(Sender: TObject); -begin - editLogDir.Enabled := TCheckBox(Sender).Checked; - Modified(Sender); -end; - - -procedure TfrmPreferences.chkQueryHistoryClick(Sender: TObject); -begin - editQueryHistoryKeepDays.Enabled := chkQueryHistory.Checked; - lblQueryHistoryKeepDays.Enabled := chkQueryHistory.Checked; - Modified(Sender); -end; - - -procedure TfrmPreferences.comboEditorColorsPresetChange(Sender: TObject); -var - i, j: Integer; - Highlighter: TSynSQLSyn; - FoundHighlighter: Boolean; - rx: TRegExpr; - TranslatedHighlighterName: String; -begin - // Color preset selected - FoundHighlighter := False; - rx := TRegExpr.Create; - rx.Expression := '.+_([a-zA-Z0-9]+)$'; - for i:=0 to ComponentCount-1 do begin - if (Components[i] is TSynSQLSyn) and (Components[i] <> SynMemoSQLSample.Highlighter) then begin - Highlighter := Components[i] as TSynSQLSyn; - - // Translate highlighter postfix after last underscore: SynSQLSyn_White, SynSQLSyn_Black, ... - TranslatedHighlighterName := ''; - if rx.Exec(Highlighter.Name) then begin - TranslatedHighlighterName := _(rx.Match[1]); - end; - // ... so we can compare that with the selected dropdown text - if TranslatedHighlighterName = comboEditorColorsPreset.Text then begin - FoundHighlighter := True; - for j:=0 to SynSQLSynSQLSample.AttrCount - 1 do begin - SynSQLSynSQLSample.Attribute[j].AssignColorAndStyle(Highlighter.Attribute[j]); - end; - // Use 3 hardcoded default values for additional colors, which are not part - // of the highlighter's attributes - //SynMemoSQLSample.ActiveLineColor := StringToColor(AppSettings.GetDefaultString(asSQLColActiveLine)); - if ThemeIsDark(comboTheme.Text) then begin - MainForm.MatchingBraceForegroundColor := $0028EFFF; - MainForm.MatchingBraceBackgroundColor := $004D513B; - end else begin - MainForm.MatchingBraceForegroundColor := StringToColor(AppSettings.GetDefaultString(asSQLColMatchingBraceForeground)); - MainForm.MatchingBraceBackgroundColor := StringToColor(AppSettings.GetDefaultString(asSQLColMatchingBraceBackground)); - end; - Break; - end; - end; - end; - if not FoundHighlighter then begin - // Show current custom settings - for i:=0 to SynSQLSynSQLSample.AttrCount - 1 do begin - SynSQLSynSQLSample.Attribute[i].AssignColorAndStyle(MainForm.SynSQLSynUsed.Attribute[i]); - end; - end; - Modified(Sender); -end; - - -procedure TfrmPreferences.comboGridTextColorsPresetSelect(Sender: TObject); -var - Preset: TGridColorsPreset; - dtc: TDBDatatypeCategoryIndex; -begin - // Grid colors preset selected - Preset := FGridColorsPresets[comboGridTextColorsPreset.ItemIndex]; - for dtc:=Low(Preset.TextColors) to High(Preset.TextColors) do begin - FGridTextColors[dtc] := Preset.TextColors[dtc]; - end; - comboGridTextColors.OnSelect(comboGridTextColors); - if comboGridTextColorsPreset.ItemIndex > 0 then - Modified(Sender); -end; - - -procedure TfrmPreferences.comboGridTextColorsSelect(Sender: TObject); -begin - // Data type category selected - colorboxGridTextColors.Selected := FGridTextColors[TDBDatatypeCategoryIndex(comboGridTextColors.ItemIndex)]; -end; - - -procedure TfrmPreferences.comboGUIFontChange(Sender: TObject); -var - UseCustomFont: Boolean; -begin - // System font selected - UseCustomFont := comboGUIFont.ItemIndex > 0; - editGUIFontSize.Enabled := UseCustomFont; - lblGUIFontSize.Enabled := UseCustomFont; - Modified(Sender); -end; - - -procedure TfrmPreferences.colorBoxGridTextColorsSelect(Sender: TObject); -begin - // Color selected - FGridTextColors[TDBDatatypeCategoryIndex(comboGridTextColors.ItemIndex)] := colorboxGridTextColors.Selected; - Modified(Sender); -end; - - -procedure TfrmPreferences.comboSQLColElementChange(Sender: TObject); -var - AttriIdx: Integer; - Attri: TSynHighlighterAttributes; - Foreground, Background: TColor; -begin - AttriIdx := comboSQLColElement.ItemIndex; - if AttriIdx = comboSQLColElement.Items.Count-1 then begin - Foreground := MainForm.MatchingBraceForegroundColor; - Background := MainForm.MatchingBraceBackgroundColor; - chkSQLBold.Enabled := False; - chkSQLItalic.Enabled := False; - end else if AttriIdx = comboSQLColElement.Items.Count-2 then begin - //Foreground := SynMemoSQLSample.ActiveLineColor; - Background := clNone; - chkSQLBold.Enabled := False; - chkSQLItalic.Enabled := False; - end else begin - Attri := SynSqlSynSQLSample.Attribute[AttriIdx]; - Foreground := Attri.Foreground; - Background := Attri.Background; - chkSQLBold.Enabled := True; - chkSQLItalic.Enabled := True; - chkSQLBold.OnClick := nil; - chkSQLItalic.OnClick := nil; - chkSQLBold.Checked := fsBold in Attri.Style; - chkSQLItalic.Checked := fsItalic in Attri.Style; - chkSQLBold.OnClick := SQLFontChange; - chkSQLItalic.OnClick := SQLFontChange; - end; - cboxSQLColForeground.Selected := Foreground; - cboxSQLColBackground.Selected := Background; -end; - - -procedure TfrmPreferences.updownSQLFontSizeClick(Sender: TObject; - Button: TUDBtnType); -begin - SQLFontChange(Sender); -end; - - -{** - Select attribute in pulldown by click into SynMemo -} -procedure TfrmPreferences.SynMemoSQLSampleClick(Sender: TObject); -var - Token: String; - Attri: TSynHighlighterAttributes; - AttriIdx: Integer; - sm: TSynEdit; -begin - sm := Sender as TSynEdit; - sm.GetHighlighterAttriAtRowCol(sm.CaretXY, Token, Attri); - if Attri = nil then - Exit; - AttriIdx := ComboSQLColElement.Items.IndexOf(Attri.Name); - if AttriIdx = -1 then - Exit; - ComboSQLColElement.ItemIndex := AttriIdx; - ComboSQLColElement.OnChange(Sender); -end; - - -procedure TfrmPreferences.btnRemoveHotKeyClick(Sender: TObject); -begin - // Clear current shortcut - if Sender = btnRemoveHotKey1 then begin - //FHotKey1.HotKey := 0; - //HotKeyChange(FHotKey1); - end - else if Sender = btnRemoveHotKey2 then begin - //FHotKey2.HotKey := 0; - //HotKeyChange(FHotKey2); - end - else - Beep; -end; - -procedure TfrmPreferences.btnRestoreDefaultsClick(Sender: TObject); -var - ValueList: TStringlist; - i: Integer; -begin - // Restore defaults - if MessageDialog(_('Reset all preference options to default values?'), - _('This also applies to automatic settings, e.g. toolbar positions.'), - mtConfirmation, [mbOK, mbCancel]) = mrCancel then - Exit; - AppSettings.ResetPath; - ValueList := AppSettings.GetValueNames; - for i:=0 to ValueList.Count-1 do - AppSettings.DeleteValue(ValueList[i]); - FormShow(Sender); -end; - - -procedure TfrmPreferences.TreeShortcutItemsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; - Column: TColumnIndex); -var - ShortcutFocused: Boolean; - Data: PShortcutItemData; -begin - // Shortcut item focus change in tree - ShortcutFocused := Assigned(Node) and (Sender.GetNodeLevel(Node) = 1); - lblShortcutHint.Enabled := ShortcutFocused; - lblShortcut1.Enabled := ShortcutFocused; - lblShortcut2.Enabled := ShortcutFocused; - //FHotKey1.Enabled := lblShortcut1.Enabled; - btnRemoveHotKey1.Enabled := lblShortcut1.Enabled; - if ShortcutFocused then begin - Data := Sender.GetNodeData(Node); - lblShortcutHint.Caption := TreeShortcutItems.Text[Node, 0]; - if Assigned(Data.Action) then begin - lblShortcut2.Enabled := False; - if MainForm.ActionList1DefaultHints[Data.Action.Index] <> '' then - lblShortcutHint.Caption := MainForm.ActionList1DefaultHints[Data.Action.Index]; - end; - //FHotKey1.HotKey := Data.ShortCut1; - //FHotKey2.HotKey := Data.ShortCut2; - end; - //FHotKey2.Enabled := lblShortcut2.Enabled; - btnRemoveHotKey2.Enabled := lblShortcut2.Enabled; -end; - - -procedure TfrmPreferences.TreeShortcutItemsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; - Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); -var - Data: PShortcutItemData; -begin - // Fetch icon number of shortcut item - if not (Kind in [ikNormal, ikSelected]) then Exit; - if Sender.GetNodeLevel(Node) = 1 then begin - Data := Sender.GetNodeData(Node); - if Assigned(Data.KeyStroke) then - ImageIndex := 114 - else if Assigned(Data.Action) then - ImageIndex := Data.Action.ImageIndex; - end; -end; - - -procedure TfrmPreferences.TreeShortcutItemsGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); -begin - NodeDataSize := SizeOf(TShortcutItemData); -end; - - -procedure TfrmPreferences.TreeShortcutItemsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; - TextType: TVSTTextType; var CellText: String); -var - Data: PShortcutItemData; - i: Integer; - t: String; -begin - // Fetch text of shortcut item - case Sender.GetNodeLevel(Node) of - 0: CellText := FShortcutCategories[Node.Index]; - 1: begin - Data := Sender.GetNodeData(Node); - if Assigned(Data.KeyStroke) then begin - t := EditorCommandToCodeString(Data.KeyStroke.Command); - t := Copy(t, 3, Length(t)-2); - // Insert spaces before uppercase chars - CellText := ''; - for i:=1 to Length(t) do begin - if (i > 1) and (UpperCase(t[i]) = t[i]) then - CellText := CellText + ' '; - CellText := CellText + t[i]; - end; - CellText := _(CellText); - end else if Assigned(Data.Action) then begin - CellText := StripHotkey(MainForm.ActionList1DefaultCaptions[Data.Action.Index]); - end; - end; - end; -end; - - -procedure TfrmPreferences.TreeShortcutItemsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; - var ChildCount: Cardinal); -var - i: Integer; - Category: String; -begin - // First initialization of shortcut items - if Sender.GetNodeLevel(Node) = 0 then begin - ChildCount := 0; - if Integer(Node.Index) = FShortcutCategories.Count-1 then - ChildCount := Mainform.SynMemoQuery.Keystrokes.Count - else begin - Category := (Sender as TLazVirtualStringTree).Text[Node, 0]; - for i:=0 to Mainform.ActionList1.ActionCount-1 do begin - if Mainform.ActionList1.Actions[i].Category = Category then - Inc(ChildCount); - end; - end; - end; -end; - -procedure TfrmPreferences.TreeShortcutItemsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; - var InitialStates: TVirtualNodeInitStates); -var - Data: PShortcutItemData; - ItemIndex, i: Integer; - Category: String; -begin - if Sender.GetNodeLevel(Node) = 0 then - Include(InitialStates, ivsHasChildren); - Data := Sender.GetNodeData(Node); - - if Sender.GetNodeLevel(Node) = 1 then begin - if Integer(Node.Parent.Index) = FShortcutCategories.Count-1 then begin - Data^.KeyStroke := Mainform.SynMemoQuery.Keystrokes[Node.Index]; - Data^.Shortcut1 := Data.KeyStroke.ShortCut; - Data^.Shortcut2 := Data.KeyStroke.ShortCut2; - end else begin - ItemIndex := -1; - Category := (Sender as TLazVirtualStringTree).Text[Node.Parent, 0]; - for i:=0 to Mainform.ActionList1.ActionCount-1 do begin - if Mainform.ActionList1.Actions[i].Category = Category then - Inc(ItemIndex); - if ItemIndex = Integer(Node.Index) then begin - Data^.Action := TAction(Mainform.ActionList1.Actions[i]); - Data^.Shortcut1 := Data.Action.ShortCut; - break; - end; - end; - end; - end; -end; - - -function TfrmPreferences.EnsureShortcutIsUnused(RequestShortcut: TShortCut): Boolean; -var - Node, NodeWantsIt: PVirtualNode; - Data: PShortcutItemData; - Tree: TLazVirtualStringTree; - MsgFormat, Msg: String; -begin - Result := True; - if RequestShortcut = 0 then - Exit; - MsgFormat := _('Keyboard shortcut [%s] is already assigned to "%s".') + sLineBreak + sLineBreak + - _('Remove it there and assign to "%s" instead?') + sLineBreak + sLineBreak + - _('Press ignore to keep both and ignore all conflicts.'); - Tree := TreeShortcutItems; - NodeWantsIt := Tree.FocusedNode; - Node := GetNextNode(Tree, nil, False); - while Assigned(Node) do begin - if Tree.GetNodeLevel(Node) = 1 then begin - Data := Tree.GetNodeData(Node); - Msg := Format(MsgFormat, [ - ShortCutToText(RequestShortcut), - Tree.Text[Node.Parent, 0] + ' > ' + StripHotkey(Tree.Text[Node, 0]), - Tree.Text[NodeWantsIt.Parent, 0] + ' > ' + StripHotkey(Tree.Text[NodeWantsIt, 0]) - ]); - if Node = NodeWantsIt then begin - // Ignore requesting node - end else begin - if Data.ShortCut1 = RequestShortcut then begin - case MessageDialog(Msg, mtConfirmation, [mbYes, mbNo, mbIgnore]) of - mrYes: Data.ShortCut1 := 0; // Unassign shortcut 1 - mrNo: Result := False; - mrIgnore: Break; // Keep Result=True and exit loop, ignore further conflicts - end; - end; - if Data.ShortCut2 = RequestShortcut then begin - case MessageDialog(Msg, mtConfirmation, [mbYes, mbNo, mbIgnore]) of - mrYes: Data.ShortCut2 := 0; // Unassign shortcut 2 - mrNo: Result := False; - mrIgnore: Break; - end; - end; - end; - end; - if Result = False then - Break; - Node := GetNextNode(Tree, Node, False); - end; - -end; - - -procedure TfrmPreferences.HotKeyChange(Sender: TObject); -//var -// Data: PShortcutItemData; -// HotKeyEdit: TExtSynHotKey; -// EventHandler: TNotifyEvent; -begin - // Shortcut 1 or 2 changed - {HotKeyEdit := Sender as TExtSynHotKey; - Data := TreeShortcutItems.GetNodeData(TreeShortcutItems.FocusedNode); - if EnsureShortcutIsUnused(HotKeyEdit.HotKey) then begin - if HotKeyEdit = FHotKey1 then - Data.Shortcut1 := HotKeyEdit.HotKey - else - Data.Shortcut2 := HotKeyEdit.HotKey; - Modified(Sender); - end else begin - // Undo change in hotkey editor, without triggering OnChange event - EventHandler := HotKeyEdit.OnChange; - if HotKeyEdit = FHotKey1 then - HotKeyEdit.HotKey := Data.ShortCut1 - else - HotKeyEdit.HotKey := Data.ShortCut2; - HotKeyEdit.OnChange := EventHandler; - end;} -end; - - -procedure TfrmPreferences.HotKeyEnter(Sender: TObject); -begin - // Remove Esc and Enter shortcuts from buttons - btnOk.Default := False; - btnCancel.Cancel := False; -end; - - -procedure TfrmPreferences.HotKeyExit(Sender: TObject); -begin - // Readd Esc and Enter shortcuts to buttons - btnOk.Default := True; - btnCancel.Cancel := True; -end; - - -procedure TfrmPreferences.InitLanguages; -var - LangNames: String; - MoFilePath, LangCode: String; - AvailLangCodes: TStringList; - AvailMoFiles: TStringList; - i: Integer; - - procedure AddLang(LangCode: String); - var - LangName: String; - rx: TRegExpr; - begin - rx := TRegExpr.Create; - rx.Expression := '\b'+QuoteRegExprMetaChars(LangCode)+'\:([^#]+)'; - rx.ModifierI := True; - if rx.Exec(LangNames) then - LangName := rx.Match[1] - else - LangName := ''; - rx.Free; - FLanguages.Add(LangCode + ': ' + LangName); - end; - -begin - // Create list with present language code => language name - // List taken from dxgettext/languagecodes.pas - - LangNames := 'aa:Afar#'+ - 'aa:Afar#'+ - 'ab:Abkhazian#'+ - 'ae:Avestan#'+ - 'af:Afrikaans#'+ - 'ak:Akan#'+ - 'am:Amharic#'+ - 'an:Aragonese#'+ - 'ar:Arabic#'+ - 'as:Assamese#'+ - 'av:Avaric#'+ - 'ay:Aymara#'+ - 'az:Azerbaijani#'+ - 'ba:Bashkir#'+ - 'be:Belarusian#'+ - 'bg:Bulgarian#'+ - 'bh:Bihari#'+ - 'bi:Bislama#'+ - 'bm:Bambara#'+ - 'bn:Bengali#'+ - 'bo:Tibetan#'+ - 'br:Breton#'+ - 'bs:Bosnian#'+ - 'ca:Catalan#'+ - 'ce:Chechen#'+ - 'ch:Chamorro#'+ - 'co:Corsican#'+ - 'cr:Cree#'+ - 'cs:Czech#'+ - 'cv:Chuvash#'+ - 'cy:Welsh#'+ - 'da:Danish#'+ - 'de:German#'+ - 'de_AT:Austrian German#'+ - 'de_CH:Swiss German#'+ - 'dv:Divehi#'+ - 'dz:Dzongkha#'+ - 'ee:Ewe#'+ - 'el:Greek#'+ - 'en:English#'+ - 'en_AU:Australian English#'+ - 'en_CA:Canadian English#'+ - 'en_GB:British English#'+ - 'en_US:American English#'+ - 'eo:Esperanto#'+ - 'es:Spanish#'+ - 'et:Estonian#'+ - 'eu:Basque#'+ - 'fa:Persian#'+ - 'ff:Fulah#'+ - 'fi:Finnish#'+ - 'fj:Fijian#'+ - 'fo:Faroese#'+ - 'fr:French#'+ - 'fr_BE:Walloon#'+ - 'fy:Frisian#'+ - 'ga:Irish#'+ - 'gd:Gaelic#'+ - 'gl:Gallegan#'+ - 'gn:Guarani#'+ - 'gu:Gujarati#'+ - 'gv:Manx#'+ - 'ha:Hausa#'+ - 'he:Hebrew#'+ - 'hi:Hindi#'+ - 'ho:Hiri Motu#'+ - 'hr:Croatian#'+ - 'hr_HR:Croatian#'+ // Added, exists on Transifex - 'ht:Haitian#'+ - 'hu:Hungarian#'+ - 'hy:Armenian#'+ - 'hz:Herero#'+ - 'ia:Interlingua#'+ - 'id:Indonesian#'+ - 'ie:Interlingue#'+ - 'ig:Igbo#'+ - 'ii:Sichuan Yi#'+ - 'ik:Inupiaq#'+ - 'io:Ido#'+ - 'is:Icelandic#'+ - 'it:Italian#'+ - 'iu:Inuktitut#'+ - 'ja:Japanese#'+ - 'jv:Javanese#'+ - 'ka:Georgian#'+ - 'kg:Kongo#'+ - 'ki:Kikuyu#'+ - 'kj:Kuanyama#'+ - 'kk:Kazakh#'+ - 'kl:Greenlandic#'+ - 'km:Khmer#'+ - 'kn:Kannada#'+ - 'ko:Korean#'+ - 'kr:Kanuri#'+ - 'ks:Kashmiri#'+ - 'ku:Kurdish#'+ - 'kw:Cornish#'+ - 'kv:Komi#'+ - 'ky:Kirghiz#'+ - 'la:Latin#'+ - 'lb:Luxembourgish#'+ - 'lg:Ganda#'+ - 'li:Limburgan#'+ - 'ln:Lingala#'+ - 'lo:Lao#'+ - 'lt:Lithuanian#'+ - 'lu:Luba-Katanga#'+ - 'lv:Latvian#'+ - 'mg:Malagasy#'+ - 'mh:Marshallese#'+ - 'mi:Maori#'+ - 'mk:Macedonian#'+ - 'ml:Malayalam#'+ - 'mn:Mongolian#'+ - 'mo:Moldavian#'+ - 'mr:Marathi#'+ - 'ms:Malay#'+ - 'mt:Maltese#'+ - 'my:Burmese#'+ - 'na:Nauru#'+ - 'nb:Norwegian Bokmaal#'+ - 'nd:Ndebele, North#'+ - 'ne:Nepali#'+ - 'ng:Ndonga#'+ - 'nl:Dutch#'+ - 'nl_BE:Flemish#'+ - 'nn:Norwegian Nynorsk#'+ - 'no:Norwegian#'+ - 'nr:Ndebele, South#'+ - 'nv:Navajo#'+ - 'ny:Chichewa#'+ - 'oc:Occitan#'+ - 'oj:Ojibwa#'+ - 'om:Oromo#'+ - 'or:Oriya#'+ - 'os:Ossetian#'+ - 'pa:Panjabi#'+ - 'pi:Pali#'+ - 'pl:Polish#'+ - 'ps:Pushto#'+ - 'pt:Portuguese#'+ - 'pt_BR:Brazilian Portuguese#'+ - 'qu:Quechua#'+ - 'rm:Raeto-Romance#'+ - 'rn:Rundi#'+ - 'ro:Romanian#'+ - 'ru:Russian#'+ - 'rw:Kinyarwanda#'+ - 'sa:Sanskrit#'+ - 'sc:Sardinian#'+ - 'sd:Sindhi#'+ - 'se:Northern Sami#'+ - 'sg:Sango#'+ - 'si:Sinhalese#'+ - 'sk:Slovak#'+ - 'sl:Slovenian#'+ - 'sm:Samoan#'+ - 'sn:Shona#'+ - 'so:Somali#'+ - 'sq:Albanian#'+ - 'sr:Serbian#'+ - 'ss:Swati#'+ - 'st:Sotho, Southern#'+ - 'su:Sundanese#'+ - 'sv:Swedish#'+ - 'sw:Swahili#'+ - 'ta:Tamil#'+ - 'te:Telugu#'+ - 'tg:Tajik#'+ - 'th:Thai#'+ - 'ti:Tigrinya#'+ - 'tk:Turkmen#'+ - 'tl:Tagalog#'+ - 'tn:Tswana#'+ - 'to:Tonga#'+ - 'tr:Turkish#'+ - 'ts:Tsonga#'+ - 'tt:Tatar#'+ - 'tw:Twi#'+ - 'ty:Tahitian#'+ - 'ug:Uighur#'+ - 'uk:Ukrainian#'+ - 'ur:Urdu#'+ - 'uz:Uzbek#'+ - 've:Venda#'+ - 'vi:Vietnamese#'+ - 'vo:Volapuk#'+ - 'wa:Walloon#'+ - 'wo:Wolof#'+ - 'xh:Xhosa#'+ - 'yi:Yiddish#'+ - 'yo:Yoruba#'+ - 'za:Zhuang#'+ - 'zh:Chinese (Simplified)#'+ // Added, see #498 - 'zh_CN:Chinese (China)#'+ - 'zh_TW:Chinese (Traditional)#'+ - 'zu:Zulu#'; - - FLanguages := TStringList.Create; - AvailLangCodes := TStringList.Create; - AvailMoFiles := FindAllFiles( - ExtractFilePath(AppLanguageMoBasePath), - ExtractFileName(AppLanguageMoBasePath) + '*.mo', - False - ); - for MoFilePath in AvailMoFiles do begin - LangCode := RegExprGetMatch('\.(\w+)\.\w+$', ExtractFileName(MoFilePath), 1); - if not LangCode.IsEmpty then - AvailLangCodes.Add(LangCode) - else - AvailLangCodes.Add('en'); // Default en file has just ".mo" extension, not ".en.mo" - end; - for i:=0 to AvailLangCodes.Count-1 do begin - AddLang(AvailLangCodes[i]); - end; - - FLanguages.Sort; - FLanguages.Insert(0, '*** '+f_('Auto detect (%s)', [SysLanguage])); - if FLanguages.Count <= 1 then - FLanguages[0] := 'English only - no .mo files found in ' + ExtractFilePath(AppLanguageMoBasePath); - - AvailMoFiles.Free; - AvailLangCodes.Free; -end; - - -end. +unit preferences; + +{$mode delphi}{$H+} + +// ------------------------------------- +// Preferences +// ------------------------------------- + + +interface + +uses + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComCtrls, SynEditHighlighter, SynHighlighterSQL, + SynEdit, laz.VirtualTrees, SynEditKeyCmds, ActnList, Menus, + dbstructures, RegExpr, Generics.Collections, EditBtn, + extra_controls, reformatter, Buttons, ColorBox, LCLProc, LCLIntf, lazaruscompat, FileUtil; + +type + TShortcutItemData = record + Action: TAction; + KeyStroke: TSynEditKeyStroke; + ShortCut1, ShortCut2: TShortCut; + end; + PShortcutItemData = ^TShortcutItemData; + + // Color set for grid text, and preset class with a name + TGridTextColors = Array[TDBDatatypeCategoryIndex] of TColor; + TGridColorsPreset = class + TextColors: TGridTextColors; + Name: String; + end; + TGridColorsPresetList = TObjectList; + + { TfrmPreferences } + + TfrmPreferences = class(TExtForm) + pagecontrolMain: TPageControl; + tabMisc: TTabSheet; + btnCancel: TButton; + btnOK: TButton; + btnApply: TButton; + tabSQL: TTabSheet; + chkAutoReconnect: TCheckBox; + tabGridFormatting: TTabSheet; + lblDataFont: TLabel; + comboDataFontName: TComboBox; + editDataFontSize: TEdit; + lblDataFontHint: TLabel; + lblMaxColWidth: TLabel; + editMaxColWidth: TEdit; + chkRestoreLastDB: TCheckBox; + chkUpdatecheck: TCheckBox; + editUpdatecheckInterval: TEdit; + chkUpdateCheckBuilds: TCheckBox; + SynSQLSynSQLSample: TSynSQLSyn; + btnRestoreDefaults: TButton; + lblMaxTotalRows: TLabel; + editGridRowCountMax: TEdit; + chkDoStatistics: TCheckBox; + tabShortcuts: TTabSheet; + TreeShortcutItems: TLazVirtualStringTree; + lblShortcut1: TLabel; + lblShortcutHint: TLabel; + lblShortcut2: TLabel; + chkAllowMultiInstances: TCheckBox; + tabLogging: TTabSheet; + Label4: TLabel; + editLogLines: TEdit; + lblLogLinesHint: TLabel; + lblLogSnipHint: TLabel; + editLogSnip: TEdit; + lblLogSnip: TLabel; + chkLogToFile: TCheckBox; + editLogDir: TEditButton; + lblLogLevel: TLabel; + chkLogEventErrors: TCheckBox; + chkLogEventUserGeneratedSQL: TCheckBox; + chkLogEventSQL: TCheckBox; + chkLogEventInfo: TCheckBox; + chkLogEventDebug: TCheckBox; + editGridRowCountStep: TEdit; + lblGridRowsLinecount: TLabel; + editGridRowsLineCount: TEdit; + chkColorBars: TCheckBox; + comboSQLFontName: TComboBox; + lblFont: TLabel; + editSQLFontSize: TEdit; + lblSQLFontSizeUnit: TLabel; + chkCompletionProposal: TCheckBox; + chkTabsToSpaces: TCheckBox; + editSQLTabWidth: TEdit; + Label1: TLabel; + lblMaxQueryResults: TLabel; + editMaxQueryResults: TEdit; + lblGridTextColors: TLabel; + comboGridTextColors: TComboBox; + colorBoxGridTextColors: TColorBox; + lblNullBackground: TLabel; + cboxNullBackground: TColorBox; + lblMySQLBinaries: TLabel; + editMySQLBinaries: TEditButton; + lblLanguage: TLabel; + comboAppLanguage: TComboBox; + chkQueryHistory: TCheckBox; + cboxRowBackgroundOdd: TColorBox; + cboxRowBackgroundEven: TColorBox; + Label2: TLabel; + tabDataEditors: TTabSheet; + chkEditorBinary: TCheckBox; + chkEditorDatetime: TCheckBox; + chkPrefillDateTime: TCheckBox; + chkEditorEnum: TCheckBox; + chkEditorSet: TCheckBox; + chkReuseEditorConfiguration: TCheckBox; + chkForeignDropDown: TCheckBox; + chkLocalNumberFormat: TCheckBox; + lblSQLColElement: TLabel; + comboSQLColElement: TComboBox; + chkSQLBold: TCheckBox; + chkSQLItalic: TCheckBox; + lblSQLColBackground: TLabel; + lblSQLColForeground: TLabel; + cboxSQLColForeground: TColorBox; + cboxSQLColBackground: TColorBox; + SynMemoSQLSample: TSynEdit; + editCustomSnippetsDirectory: TEditButton; + lblCustomSnippetsDirectory: TLabel; + chkHintsOnResultTabs: TCheckBox; + lblLineBreakStyle: TLabel; + comboLineBreakStyle: TComboBox; + lblGUIFont: TLabel; + comboGUIFont: TComboBox; + editGUIFontSize: TEdit; + lblGUIFontSize: TLabel; + chkHorizontalScrollbar: TCheckBox; + editQueryHistoryKeepDays: TEdit; + lblQueryHistoryKeepDays: TLabel; + Label3: TLabel; + cboxRowHighlightSameText: TColorBox; + chkWheelZoom: TCheckBox; + chkAutoUppercase: TCheckBox; + lblTheme: TLabel; + comboTheme: TComboBox; + lblEditorColorsPreset: TLabel; + comboEditorColorsPreset: TComboBox; + SynSQLSyn_Dark: TSynSQLSyn; + SynSQLSyn_Light: TSynSQLSyn; + SynSQLSyn_Black: TSynSQLSyn; + SynSQLSyn_White: TSynSQLSyn; + comboGridTextColorsPreset: TComboBox; + lblIconPack: TLabel; + comboIconPack: TComboBox; + tabFiles: TTabSheet; + chkAskFileSave: TCheckBox; + chkRestoreTabs: TCheckBox; + chkLogEventScript: TCheckBox; + lblWebSearchBaseUrl: TLabel; + comboWebSearchBaseUrl: TComboBox; + chkThemePreview: TCheckBox; + chkCompletionProposalSearchOnMid: TCheckBox; + lblLongSortRowNum: TLabel; + editLongSortRowNum: TEdit; + chkLowercaseHex: TCheckBox; + chkTabCloseOnDoubleClick: TCheckBox; + lblRealTrailingZeros: TLabel; + editRealTrailingZeros: TEdit; + lblRealTrailingZerosHint: TLabel; + chkLogTimestamp: TCheckBox; + lblCompletionProposal: TLabel; + editCompletionProposalInterval: TEdit; + lblCompletionProposalIntervalUnit: TLabel; + chkColumnHeaderClick: TCheckBox; + chkIncrementalSearch: TCheckBox; + chkShowRowId: TCheckBox; + chkTabCloseOnMiddleClick: TCheckBox; + btnRemoveHotKey1: TSpeedButton; + btnRemoveHotKey2: TSpeedButton; + comboTabIconsGrayscaleMode: TComboBox; + Label5: TLabel; + lblReformatter: TLabel; + comboReformatter: TComboBox; + procedure FormDestroy(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure Modified(Sender: TObject); + procedure Apply(Sender: TObject); + procedure SQLFontChange(Sender: TObject); + procedure DataFontsChange(Sender: TObject); + procedure anyUpDownLimitChanging(Sender: TObject; + var AllowChange: Boolean); + procedure editLogDirRightButtonClick(Sender: TObject); + procedure chkLogToFileClick(Sender: TObject); + procedure chkUpdatecheckClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure comboSQLColElementChange(Sender: TObject); + procedure pagecontrolMainChanging(Sender: TObject; + var AllowChange: Boolean); + procedure pagecontrolMainChange(Sender: TObject); + procedure updownSQLFontSizeClick(Sender: TObject; Button: TUDBtnType); + procedure SynMemoSQLSampleClick(Sender: TObject); + procedure btnRestoreDefaultsClick(Sender: TObject); + procedure TreeShortcutItemsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates); + procedure TreeShortcutItemsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType; var CellText: String); + procedure TreeShortcutItemsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); + procedure TreeShortcutItemsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; + Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); + procedure TreeShortcutItemsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); + procedure TreeShortcutItemsGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); + procedure HotKeyEnter(Sender: TObject); + procedure HotKeyExit(Sender: TObject); + procedure comboGridTextColorsSelect(Sender: TObject); + procedure colorBoxGridTextColorsSelect(Sender: TObject); + procedure editMySQLBinariesRightButtonClick(Sender: TObject); + procedure editGridRowCountExit(Sender: TObject); + procedure editCustomSnippetsDirectoryRightButtonClick(Sender: TObject); + procedure comboGUIFontChange(Sender: TObject); + procedure chkQueryHistoryClick(Sender: TObject); + procedure comboEditorColorsPresetChange(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure comboGridTextColorsPresetSelect(Sender: TObject); + procedure chkCompletionProposalClick(Sender: TObject); + procedure HotKeyChange(Sender: TObject); + procedure btnRemoveHotKeyClick(Sender: TObject); + private + { Private declarations } + FWasModified: Boolean; + FShortcutCategories: TStringList; + FGridTextColors: TGridTextColors; + FGridColorsPresets: TGridColorsPresetList; + FLanguages: TStringList; + FRestartOptionTouched: Boolean; + FRestartOptionApplied: Boolean; + //FHotKey1: TExtSynHotKey; + //FHotKey2: TExtSynHotKey; + procedure InitLanguages; + procedure SelectDirectory(Sender: TObject; NewFolderButton: Boolean); + function EnsureShortcutIsUnused(RequestShortcut: TShortCut): Boolean; + public + { Public declarations } + end; + + +var + frmPreferences: TfrmPreferences; + +//function EnumFixedProc(lpelf: PEnumLogFont; lpntm: PNewTextMetric; FontType: Integer; Data: LPARAM): Integer; stdcall; + + +implementation +uses main, apphelpers; +{$R *.lfm} + + +procedure TfrmPreferences.Modified(Sender: TObject); +begin + // Modified + btnApply.Enabled := True; + // Sending controls with a Tag property > 0 (normally 1) need an application restart + if (Sender is TComponent) and (TComponent(Sender).Tag <> 0) then begin + FRestartOptionTouched := True; + end; +end; + + +procedure TfrmPreferences.pagecontrolMainChanging(Sender: TObject; + var AllowChange: Boolean); +begin + // Remember modification state. First tab switch leads TEdit's with TUpDown + // to fire OnChange. Avoid enabling the buttons in that case. + FWasModified := btnApply.Enabled; +end; + + +procedure TfrmPreferences.pagecontrolMainChange(Sender: TObject); +begin + // See OnChanging procedure + btnApply.Enabled := FWasModified; + TExtForm.PageControlTabHighlight(pagecontrolMain); +end; + + +{** + Apply settings to registry and mainform +} +procedure TfrmPreferences.Apply(Sender: TObject); +var + i: Integer; + Attri: TSynHighlighterAttributes; + CatNode, ItemNode: PVirtualNode; + Data: PShortcutItemData; + LangCode: String; +begin + Screen.Cursor := crHourGlass; + + // Save values + AppSettings.WriteBool(asAutoReconnect, chkAutoReconnect.Checked); + AppSettings.WriteBool(asAllowMultipleInstances, chkAllowMultiInstances.Checked); + AppSettings.WriteBool(asRestoreLastUsedDB, chkRestoreLastDB.Checked); + AppSettings.WriteString(asFontName, comboSQLFontName.Text); + AppSettings.WriteInt(asFontSize, MakeInt(editSQLFontSize.Text)); + AppSettings.WriteInt(asTabWidth, MakeInt(editSQLTabWidth.Text)); + AppSettings.WriteInt(asLogsqlnum, MakeInt(editLogLines.Text)); + AppSettings.WriteInt(asLogsqlwidth, MakeInt(editLogSnip.Text)); + AppSettings.WriteString(asSessionLogsDirectory, editLogDir.Text); + AppSettings.WriteBool(asLogErrors, chkLogEventErrors.Checked); + AppSettings.WriteBool(asLogUserSQL, chkLogEventUserGeneratedSQL.Checked); + AppSettings.WriteBool(asLogSQL, chkLogEventSQL.Checked); + AppSettings.WriteBool(asLogScript, chkLogEventScript.Checked); + AppSettings.WriteBool(asLogInfos, chkLogEventInfo.Checked); + AppSettings.WriteBool(asLogDebug, chkLogEventDebug.Checked); + AppSettings.WriteBool(asQueryHistoryEnabled, chkQueryHistory.Checked); + AppSettings.WriteInt(asQueryHistoryKeepDays, MakeInt(editQueryHistoryKeepDays.Text)); + AppSettings.WriteBool(asLogHorizontalScrollbar, chkHorizontalScrollbar.Checked); + AppSettings.WriteBool(asLogTimestamp, chkLogTimestamp.Checked); + for i:=0 to SynSQLSynSQLSample.AttrCount - 1 do begin + Attri := SynSQLSynSQLSample.Attribute[i]; + AppSettings.WriteInt(asHighlighterForeground, Attri.Foreground, Attri.Name); + AppSettings.WriteInt(asHighlighterBackground, Attri.Background, Attri.Name); + AppSettings.WriteInt(asHighlighterStyle, Attri.IntegerStyle, Attri.Name); + end; + AppSettings.WriteString(asSQLColActiveLine, ColorToString(SynMemoSQLSample.LineHighlightColor.Background)); + AppSettings.WriteString(asSQLColMatchingBraceForeground, ColorToString(MainForm.MatchingBraceForegroundColor)); + AppSettings.WriteString(asSQLColMatchingBraceBackground, ColorToString(MainForm.MatchingBraceBackgroundColor)); + + AppSettings.WriteInt(asMaxColWidth, MakeInt(editMaxColWidth.Text)); + AppSettings.WriteInt(asDatagridRowsPerStep, StrToIntDef(editGridRowCountStep.Text, -1)); + AppSettings.WriteInt(asDatagridMaximumRows, StrToIntDef(editGridRowCountMax.Text, -1)); + AppSettings.WriteInt(asGridRowLineCount, MakeInt(editGridRowsLineCount.Text)); + AppSettings.WriteString(asDataFontName, comboDataFontName.Text); + AppSettings.WriteInt(asDataFontSize, MakeInt(editDataFontSize.Text)); + AppSettings.WriteBool(asLogToFile, chkLogToFile.Checked); + AppSettings.WriteBool(asUpdatecheck, chkUpdatecheck.Checked); + AppSettings.WriteBool(asUpdatecheckBuilds, chkUpdatecheckBuilds.Checked); + AppSettings.WriteInt(asUpdatecheckInterval, MakeInt(editUpdatecheckInterval.Text)); + AppSettings.WriteBool(asDoUsageStatistics, chkDoStatistics.Checked); + AppSettings.WriteBool(asWheelZoom, chkWheelZoom.Checked); + AppSettings.WriteBool(asDisplayBars, chkColorBars.Checked); + AppSettings.WriteString(asMySQLBinaries, editMySQLBinaries.Text); + AppSettings.WriteString(asCustomSnippetsDirectory, editCustomSnippetsDirectory.Text); + + if comboAppLanguage.ItemIndex > 0 then begin + // Get language code from the left text in the dropdown item text, up to the colon + LangCode := RegExprGetMatch('^(\w+)\b', comboAppLanguage.Text, 1); + end else begin + LangCode := ''; + end; + AppSettings.WriteString(asAppLanguage, LangCode); + + if comboGUIFont.ItemIndex = 0 then + AppSettings.WriteString(asGUIFontName, '') + else + AppSettings.WriteString(asGUIFontName, comboGUIFont.Text); + AppSettings.WriteInt(asGUIFontSize, MakeInt(editGUIFontSize.Text)); + AppSettings.WriteString(asIconPack, comboIconPack.Text); + AppSettings.WriteString(asWebSearchBaseUrl, comboWebSearchBaseUrl.Text); + + AppSettings.WriteInt(asMaxQueryResults, MakeInt(editMaxQueryResults.Text)); + // Save color settings + AppSettings.WriteInt(asFieldColorNumeric, FGridTextColors[dtcInteger]); + AppSettings.WriteInt(asFieldColorReal, FGridTextColors[dtcReal]); + AppSettings.WriteInt(asFieldColorText, FGridTextColors[dtcText]); + AppSettings.WriteInt(asFieldColorBinary, FGridTextColors[dtcBinary]); + AppSettings.WriteInt(asFieldColorDatetime, FGridTextColors[dtcTemporal]); + AppSettings.WriteInt(asFieldColorSpatial, FGridTextColors[dtcSpatial]); + AppSettings.WriteInt(asFieldColorOther, FGridTextColors[dtcOther]); + AppSettings.WriteInt(asFieldNullBackground, cboxNullBackground.Selected); + AppSettings.WriteInt(asRowBackgroundEven, cboxRowBackgroundEven.Selected); + AppSettings.WriteInt(asRowBackgroundOdd, cboxRowBackgroundOdd.Selected); + AppSettings.WriteInt(asHightlightSameTextBackground, cboxRowHighlightSameText.Selected); + AppSettings.WriteInt(asRealTrailingZeros, MakeInt(editRealTrailingZeros.Text)); + AppSettings.WriteInt(asQueryGridLongSortRowNum, MakeInt(editLongSortRowNum.Text)); + AppSettings.WriteBool(asDataLocalNumberFormat, chkLocalNumberFormat.Checked); + AppSettings.WriteBool(asLowercaseHex, chkLowercaseHex.Checked); + AppSettings.WriteBool(asHintsOnResultTabs, chkHintsOnResultTabs.Checked); + AppSettings.WriteBool(asShowRowId, chkShowRowId.Checked); + + // Editor Configuration + AppSettings.WriteBool(asFieldEditorBinary, chkEditorBinary.Checked); + AppSettings.WriteBool(asFieldEditorDatetime, chkEditorDatetime.Checked); + AppSettings.WriteBool(asFieldEditorDatetimePrefill, chkPrefillDatetime.Checked); + AppSettings.WriteBool(asFieldEditorEnum, chkEditorEnum.Checked); + AppSettings.WriteBool(asFieldEditorSet, chkEditorSet.Checked); + AppSettings.WriteBool(asColumnHeaderClick, chkColumnHeaderClick.Checked); + AppSettings.WriteBool(asReuseEditorConfiguration, chkReuseEditorConfiguration.Checked); + AppSettings.WriteBool(asForeignDropDown, chkForeignDropDown.Checked); + AppSettings.WriteBool(asIncrementalSearch, chkIncrementalSearch.Checked); + case comboLineBreakStyle.ItemIndex of + 1: AppSettings.WriteInt(asLineBreakStyle, Integer(lbsUnix)); + 2: AppSettings.WriteInt(asLineBreakStyle, Integer(lbsMac)); + else AppSettings.WriteInt(asLineBreakStyle, Integer(lbsWindows)); + end; + + AppSettings.WriteBool(asCompletionProposal, chkCompletionProposal.Checked); + AppSettings.WriteInt(asCompletionProposalInterval, MakeInt(editCompletionProposalInterval.Text)); + AppSettings.WriteBool(asCompletionProposalSearchOnMid, chkCompletionProposalSearchOnMid.Checked); + AppSettings.WriteBool(asAutoUppercase, chkAutoUppercase.Checked); + AppSettings.WriteBool(asTabsToSpaces, chkTabsToSpaces.Checked); + + // Shortcuts + CatNode := TreeShortcutItems.GetFirst; + while Assigned(CatNode) do begin + ItemNode := TreeShortcutItems.GetFirstChild(CatNode); + while Assigned(ItemNode) do begin + Data := TreeShortcutItems.GetNodeData(ItemNode); + // Save modified shortcuts + if Assigned(Data.KeyStroke) then begin + if Data.Shortcut1 <> Data.KeyStroke.ShortCut then + AppSettings.WriteInt(asActionShortcut1, Data.Shortcut1, EditorCommandToCodeString(Data.KeyStroke.Command)); + if Data.Shortcut2 <> Data.KeyStroke.ShortCut2 then + AppSettings.WriteInt(asActionShortcut2, Data.Shortcut2, EditorCommandToCodeString(Data.KeyStroke.Command)); + end else begin + if Data.Shortcut1 <> Data.Action.ShortCut then + AppSettings.WriteInt(asActionShortcut1, Data.Shortcut1, Data.Action.Name); + // Apply shortcut for this session + Data.Action.ShortCut := Data.Shortcut1; + end; + ItemNode := TreeShortcutItems.GetNextSibling(ItemNode); + end; + CatNode := TreeShortcutItems.GetNextSibling(CatNode); + end; + // Populate SynMemo settings to all instances + Mainform.SetupSynEditors; + + // Files and tabs + AppSettings.WriteBool(asPromptSaveFileOnTabClose, chkAskFileSave.Checked); + AppSettings.WriteBool(asRestoreTabs, chkRestoreTabs.Checked); + AppSettings.WriteBool(asTabCloseOnDoubleClick, chkTabCloseOnDoubleClick.Checked); + AppSettings.WriteBool(asTabCloseOnMiddleClick, chkTabCloseOnMiddleClick.Checked); + AppSettings.WriteInt(asTabIconsGrayscaleMode, comboTabIconsGrayscaleMode.ItemIndex); + AppSettings.WriteInt(asReformatterNoDialog, comboReformatter.ItemIndex); + + // Set relevant properties in mainform + MainForm.ApplyFontToGrids; + MainForm.PrepareImageList; + //MainForm.SynCompletionProposal.TimerInterval := updownCompletionProposalInterval.Position; + Mainform.LogToFile := chkLogToFile.Checked; + MainForm.actLogHorizontalScrollbar.Checked := chkHorizontalScrollbar.Checked; + MainForm.actLogHorizontalScrollbar.OnExecute(MainForm.actLogHorizontalScrollbar); + DatatypeCategories[dtcInteger].Color := FGridTextColors[dtcInteger]; + DatatypeCategories[dtcReal].Color := FGridTextColors[dtcReal]; + DatatypeCategories[dtcText].Color := FGridTextColors[dtcText]; + DatatypeCategories[dtcBinary].Color := FGridTextColors[dtcBinary]; + DatatypeCategories[dtcTemporal].Color := FGridTextColors[dtcTemporal]; + DatatypeCategories[dtcSpatial].Color := FGridTextColors[dtcSpatial]; + DatatypeCategories[dtcOther].Color := FGridTextColors[dtcOther]; + Mainform.DataLocalNumberFormat := chkLocalNumberFormat.Checked; + Mainform.CalcNullColors; + Mainform.DataGrid.Repaint; + Mainform.QueryGrid.Repaint; + Mainform.ListTables.Invalidate; + Mainform.ListProcesses.Invalidate; + Mainform.ListCommandStats.Invalidate; + + + FRestartOptionApplied := FRestartOptionTouched; + + // Settings have been applied, send a signal to the user + btnApply.Enabled := False; + Screen.Cursor := crDefault; +end; + + +// Callback function used by EnumFontFamilies() +{function EnumFixedProc( + lpelf: PEnumLogFont; + lpntm: PNewTextMetric; + FontType: Integer; + Data: LPARAM + ): Integer; stdcall; +begin + Result := 1; // don't cancel + if (lpelf^.elfLogFont.lfPitchAndFamily and FIXED_PITCH) <> 0 then + (TStrings(Data)).Add(String(lpelf^.elfLogFont.lfFaceName)); +end;} + + +procedure TfrmPreferences.FormClose(Sender: TObject; var Action: TCloseAction); +begin + if FRestartOptionApplied then begin + MessageDialog(f_('You should restart %s to apply changed critical settings, and to prevent unexpected behaviour.', [APPNAME]), + mtInformation, + [mbOk]); + end; + MainForm.ActionList1.State := asNormal; +end; + + +procedure TfrmPreferences.FormCreate(Sender: TObject); +const + // Define grid colors as constants, for easy assignment + GridColorsLight: TGridTextColors = ($00FF0000, $00FF0048, $00008000, $00800080, $00000080, $00808000, $00008080); + GridColorsDark: TGridTextColors = ($00FF9785, $00D07D7D, $0073D573, $00C9767F, $007373C9, $00CECE73, $0073C1C1); + GridColorsBlack: TGridTextColors = ($00000000, $00000000, $00000000, $00000000, $00000000, $00000000, $00000000); + GridColorsWhite: TGridTextColors = ($00FFFFFF, $00FFFFFF, $00FFFFFF, $00FFFFFF, $00FFFFFF, $00FFFFFF, $00FFFFFF); +var + i: Integer; + dtc: TDBDatatypeCategoryIndex; + //Styles: TArray; + Highlighter: TSynSQLSyn; + Name: String; + GridColorsPreset: TGridColorsPreset; + //IconPack: String; + Reformatter: TfrmReformatter; +begin + HasSizeGrip := True; + Width := AppSettings.ReadInt(asPreferencesWindowWidth); + Height := AppSettings.ReadInt(asPreferencesWindowHeight); + + // Misecllaneous + // Hide browse button on Wine, as the browse dialog returns Windows-style paths, while we need a Unix path + if IsWine then begin + editMySQLBinaries.Button.Enabled := False; + editMySQLBinaries.OnDblClick := nil; + end; + + InitLanguages; + comboAppLanguage.Items.AddStrings(FLanguages); + + comboGUIFont.Items.Assign(Screen.Fonts); + comboGUIFont.Items.Insert(0, '<'+_('Default system font')+'>'); + + lblTheme.Enabled := False; + comboTheme.Items.Text := 'Themes are not supported in the Lazarus release'; + comboTheme.ItemIndex := 0; + comboTheme.Enabled := False; + chkThemePreview.Enabled := False; + + // Populate icon pack dropdown from image collections on main form + comboIconPack.Items.Clear; + {for i:=0 to MainForm.ComponentCount-1 do begin + if MainForm.Components[i] is TImageCollection then begin + IconPack := MainForm.Components[i].Name; + IconPack := StringReplace(IconPack, 'ImageCollection', '', [rfIgnoreCase]); + comboIconPack.Items.Add(IconPack); + end; + end;} + + // Data + // Populate datatype categories pulldown + for dtc:=Low(TDBDatatypeCategoryIndex) to High(TDBDatatypeCategoryIndex) do + comboGridTextColors.Items.Add(DatatypeCategories[dtc].Name); + + // SQL + //EnumFontFamilies(Canvas.Handle, nil, @EnumFixedProc, LPARAM(Pointer(comboSQLFontName.Items))); + comboSQLFontName.Items.Assign(Screen.Fonts); + comboSQLFontName.Sorted := True; + SynMemoSQLSample.Text := 'SELECT DATE_SUB(NOW(), INTERVAL 1 DAY),' + sLineBreak + + CodeIndent + '''String literal'' AS lit' + sLineBreak + + 'FROM tableA AS ta' + sLineBreak + + 'WHERE `columnA` IS NULL;' + sLineBreak + + sLineBreak + + '-- A comment' + sLineBreak + + '# Old style comment' + sLineBreak + + '/* Multi line comment */' + sLineBreak + + sLineBreak + + 'CREATE TABLE /*!32312 IF NOT EXISTS*/ tableB (' + sLineBreak + + CodeIndent + 'id INT,' + sLineBreak + + CodeIndent + 'name VARCHAR(30) DEFAULT "standard"' + sLineBreak + + ')'; + SynSQLSynSQLSample.TableNames.CommaText := 'tableA,tableB'; + for i:=0 to SynSQLSynSQLSample.AttrCount - 1 do begin + SynSQLSynSQLSample.Attribute[i].AssignColorAndStyle(MainForm.SynSQLSynUsed.Attribute[i]); + comboSQLColElement.Items.Add(SynSQLSynSQLSample.Attribute[i].Name); + end; + comboSQLColElement.Items.Add(_('Active line background')); + comboSQLColElement.Items.Add(_('Brace matching color')); + comboSQLColElement.ItemIndex := 0; + // Enumerate highlighter presets + for i:=0 to ComponentCount-1 do begin + if (Components[i] is TSynSQLSyn) + and (Components[i] <> SynMemoSQLSample.Highlighter) + then begin + Highlighter := Components[i] as TSynSQLSyn; + Name := Highlighter.Name; + Name := RegExprGetMatch('_([^_]+)$', Name, 1); + if Name <> '' then begin + comboEditorColorsPreset.Items.Add(_(Name)); + end; + end; + end; + + // Grid formatting + FGridColorsPresets := TGridColorsPresetList.Create; + // Current colors - assign from global DatatypeCategories array + GridColorsPreset := TGridColorsPreset.Create; + GridColorsPreset.Name := _('Current custom settings'); + for dtc:=Low(TDBDatatypeCategoryIndex) to High(TDBDatatypeCategoryIndex) do begin + GridColorsPreset.TextColors[dtc] := DatatypeCategories[dtc].Color; + end; + FGridColorsPresets.Add(GridColorsPreset); + // Light - default values + GridColorsPreset := TGridColorsPreset.Create; + GridColorsPreset.Name := _('Light'); + GridColorsPreset.TextColors := GridColorsLight; + FGridColorsPresets.Add(GridColorsPreset); + // Dark + GridColorsPreset := TGridColorsPreset.Create; + GridColorsPreset.Name := _('Dark'); + GridColorsPreset.TextColors := GridColorsDark; + FGridColorsPresets.Add(GridColorsPreset); + // Black + GridColorsPreset := TGridColorsPreset.Create; + GridColorsPreset.Name := _('Black'); + GridColorsPreset.TextColors := GridColorsBlack; + FGridColorsPresets.Add(GridColorsPreset); + // White + GridColorsPreset := TGridColorsPreset.Create; + GridColorsPreset.Name := _('White'); + GridColorsPreset.TextColors := GridColorsWhite; + FGridColorsPresets.Add(GridColorsPreset); + // Add all to combo box + comboGridTextColorsPreset.Clear; + for GridColorsPreset in FGridColorsPresets do begin + comboGridTextColorsPreset.Items.Add(GridColorsPreset.Name); + end; + + // Shortcuts + {FHotKey1 := TExtSynHotKey.Create(Self); + FHotKey1.Parent := tabShortcuts; + FHotKey1.Left := lblShortcut1.Left; + FHotKey1.Top := lblShortcut1.Top + lblShortcut1.Height + 4; + FHotKey1.Width := tabShortcuts.Width - FHotKey1.Left - btnRemoveHotKey1.Width - 4 - 4; + FHotKey1.Height := editDataFontSize.Height; + FHotKey1.Anchors := [akLeft, akTop, akRight]; + FHotKey1.HotKey := 0; + FHotKey1.InvalidKeys := []; + FHotKey1.Modifiers := []; + FHotKey1.Enabled := False; + FHotKey1.OnChange := HotKeyChange; + FHotKey1.OnEnter := HotKeyEnter; + FHotKey1.OnExit := HotKeyExit; + btnRemoveHotKey1.Left := FHotKey1.Left + FHotKey1.Width + 4; + btnRemoveHotKey1.Top := FHotKey1.Top;} + btnRemoveHotKey1.Enabled := False; + + {FHotKey2 := TExtSynHotKey.Create(Self); + FHotKey2.Parent := tabShortcuts; + FHotKey2.Left := lblShortcut2.Left; + FHotKey2.Top := lblShortcut2.Top + lblShortcut2.Height + 4; + FHotKey2.Width := tabShortcuts.Width - FHotKey2.Left - btnRemoveHotKey2.Width - 4 - 4; + FHotKey2.Height := editDataFontSize.Height; + FHotKey2.Anchors := [akLeft, akTop, akRight]; + FHotKey2.HotKey := 0; + FHotKey2.InvalidKeys := []; + FHotKey2.Modifiers := []; + FHotKey2.Enabled := False; + FHotKey2.OnChange := HotKeyChange; + FHotKey2.OnEnter := HotKeyEnter; + FHotKey2.OnExit := HotKeyExit; + btnRemoveHotKey2.Left := FHotKey2.Left + FHotKey2.Width + 4; + btnRemoveHotKey2.Top := FHotKey2.Top;} + btnRemoveHotKey2.Enabled := False; + + FShortcutCategories := TStringList.Create; + for i:=0 to Mainform.ActionList1.ActionCount-1 do begin + if FShortcutCategories.IndexOf(Mainform.ActionList1.Actions[i].Category) = -1 then + FShortcutCategories.Add(Mainform.ActionList1.Actions[i].Category); + end; + FShortcutCategories.Add(_('SQL editing')); + TreeShortcutItems.RootNodeCount := FShortcutCategories.Count; + comboLineBreakStyle.Items := Explode(',', _('Windows linebreaks')+','+_('UNIX linebreaks')+','+_('Mac OS linebreaks')); + + comboReformatter.Items.Add(_('Always ask')); + Reformatter := TfrmReformatter.Create(Self); + comboReformatter.Items.AddStrings(Reformatter.grpReformatter.Items); + Reformatter.Free; +end; + + +procedure TfrmPreferences.FormShow(Sender: TObject); +var + LangCode, GUIFont: String; + i: Integer; +begin + Screen.Cursor := crHourGlass; + + // Read and display values + chkAutoReconnect.Checked := AppSettings.ReadBool(asAutoReconnect);; + chkAllowMultiInstances.Checked := AppSettings.ReadBool(asAllowMultipleInstances); + chkRestoreLastDB.Checked := AppSettings.ReadBool(asRestoreLastUsedDB); + chkUpdatecheck.Checked := AppSettings.ReadBool(asUpdatecheck); + chkUpdatecheckBuilds.Checked := AppSettings.ReadBool(asUpdatecheckBuilds); + editUpdatecheckInterval.Text := AppSettings.ReadInt(asUpdatecheckInterval).ToString; + chkUpdatecheckClick(Sender); + chkDoStatistics.Checked := AppSettings.ReadBool(asDoUsageStatistics); + chkWheelZoom.Checked := AppSettings.ReadBool(asWheelZoom); + chkColorBars.Checked := AppSettings.ReadBool(asDisplayBars); + editMySQLBinaries.Text := AppSettings.ReadString(asMySQLBinaries); + editCustomSnippetsDirectory.Text := AppSettings.ReadString(asCustomSnippetsDirectory); + LangCode := AppSettings.ReadString(asAppLanguage); + for i:=0 to comboAppLanguage.Items.Count-1 do begin + if RegExprGetMatch('^(\w+)\b', comboAppLanguage.Items[i], 1) = LangCode then begin + comboAppLanguage.ItemIndex := i; + Break; + end; + end; + if comboAppLanguage.ItemIndex = -1 then + comboAppLanguage.ItemIndex := 0; + GUIFont := AppSettings.ReadString(asGUIFontName); + if GUIFont.IsEmpty then + comboGUIFont.ItemIndex := 0 + else + comboGUIFont.ItemIndex := comboGUIFont.Items.IndexOf(GUIFont); + editGUIFontSize.Text := AppSettings.ReadInt(asGUIFontSize).ToString; + comboGUIFont.OnChange(comboGUIFont); + comboIconPack.ItemIndex := comboIconPack.Items.IndexOf(AppSettings.ReadString(asIconPack)); + comboWebSearchBaseUrl.Text := AppSettings.ReadString(asWebSearchBaseUrl); + + // Logging + editLogLines.Text := AppSettings.ReadInt(asLogsqlnum).ToString; + editLogSnip.Text := AppSettings.ReadInt(asLogsqlwidth).ToString; + chkLogToFile.Checked := AppSettings.ReadBool(asLogToFile); + editLogDir.Text := AppSettings.ReadString(asSessionLogsDirectory); + chkLogEventErrors.Checked := AppSettings.ReadBool(asLogErrors); + chkLogEventUserGeneratedSQL.Checked := AppSettings.ReadBool(asLogUserSQL); + chkLogEventSQL.Checked := AppSettings.ReadBool(asLogSQL); + chkLogEventScript.Checked := AppSettings.ReadBool(asLogScript); + chkLogEventInfo.Checked := AppSettings.ReadBool(asLogInfos); + chkLogEventDebug.Checked := AppSettings.ReadBool(asLogDebug); + chkQueryHistory.Checked := AppSettings.ReadBool(asQueryHistoryEnabled); + editQueryHistoryKeepDays.Text := AppSettings.ReadInt(asQueryHistoryKeepDays).ToString; + chkHorizontalScrollbar.Checked := AppSettings.ReadBool(asLogHorizontalScrollbar); + chkLogTimestamp.Checked := AppSettings.ReadBool(asLogTimestamp); + + // Default column width in grids: + editMaxColWidth.Text := AppSettings.ReadInt(asMaxColWidth).ToString; + editGridRowCountStep.Text := IntToStr(AppSettings.ReadInt(asDatagridRowsPerStep)); + editGridRowCountMax.Text := IntToStr(AppSettings.ReadInt(asDatagridMaximumRows)); + editGridRowsLineCount.Text := AppSettings.ReadInt(asGridRowLineCount).ToString; + + // SQL: + Mainform.SetupSynEditor(SynMemoSQLSample); + comboSQLFontName.ItemIndex := comboSQLFontName.Items.IndexOf(SynMemoSQLSample.Font.Name); + editSQLFontSize.Text := SynMemoSQLSample.Font.Size.ToString; + editSQLTabWidth.Text := SynMemoSQLSample.TabWidth.ToString; + chkCompletionProposal.Checked := AppSettings.ReadBool(asCompletionProposal); + editCompletionProposalInterval.Text := AppSettings.ReadInt(asCompletionProposalInterval).ToString; + chkCompletionProposalSearchOnMid.Checked := AppSettings.ReadBool(asCompletionProposalSearchOnMid); + chkAutoUppercase.Checked := AppSettings.ReadBool(asAutoUppercase); + chkTabsToSpaces.Checked := AppSettings.ReadBool(asTabsToSpaces); + comboSQLColElementChange(Sender); + + // Grid formatting: + comboDataFontName.Items := Screen.Fonts; + comboDataFontName.ItemIndex := comboDataFontName.Items.IndexOf(AppSettings.ReadString(asDataFontName)); + editDataFontSize.Text := AppSettings.ReadInt(asDataFontSize).ToString; + editMaxQueryResults.Text := AppSettings.ReadINt(asMaxQueryResults).ToString; + // Load color settings + FGridTextColors[dtcInteger] := AppSettings.ReadInt(asFieldColorNumeric); + FGridTextColors[dtcReal] := AppSettings.ReadInt(asFieldColorReal); + FGridTextColors[dtcText] := AppSettings.ReadInt(asFieldColorText); + FGridTextColors[dtcBinary] := AppSettings.ReadInt(asFieldColorBinary); + FGridTextColors[dtcTemporal] := AppSettings.ReadInt(asFieldColorDatetime); + FGridTextColors[dtcSpatial] := AppSettings.ReadInt(asFieldColorSpatial); + FGridTextColors[dtcOther] := AppSettings.ReadInt(asFieldColorOther); + comboGridTextColorsPreset.ItemIndex := 0; + comboGridTextColors.ItemIndex := 0; + comboGridTextColors.OnSelect(comboGridTextColors); + cboxNullBackground.Selected := AppSettings.ReadInt(asFieldNullBackground); + cboxRowBackgroundEven.Selected := AppSettings.ReadInt(asRowBackgroundEven); + cboxRowBackgroundOdd.Selected := AppSettings.ReadInt(asRowBackgroundOdd); + cboxRowHighlightSameText.Selected := AppSettings.ReadInt(asHightlightSameTextBackground); + editRealTrailingZeros.Text := AppSettings.ReadInt(asRealTrailingZeros).ToString; + editLongSortRowNum.Text := AppSettings.ReadInt(asQueryGridLongSortRowNum).ToString; + chkLocalNumberFormat.Checked := AppSettings.ReadBool(asDataLocalNumberFormat); + chkLowercaseHex.Checked := AppSettings.ReadBool(asLowercaseHex); + chkHintsOnResultTabs.Checked := AppSettings.ReadBool(asHintsOnResultTabs); + chkShowRowId.Checked := AppSettings.ReadBool(asShowRowId); + + // Editor Configuration + chkEditorBinary.Checked := AppSettings.ReadBool(asFieldEditorBinary); + chkEditorDatetime.Checked := AppSettings.ReadBool(asFieldEditorDatetime); + chkPrefillDateTime.Checked := AppSettings.ReadBool(asFieldEditorDatetimePrefill); + chkEditorEnum.Checked := AppSettings.ReadBool(asFieldEditorEnum); + chkEditorSet.Checked := AppSettings.ReadBool(asFieldEditorEnum); + chkColumnHeaderClick.Checked := AppSettings.ReadBool(asColumnHeaderClick); + chkReuseEditorConfiguration.Checked := AppSettings.ReadBool(asReuseEditorConfiguration); + chkForeignDropDown.Checked := AppSettings.ReadBool(asForeignDropDown); + chkIncrementalSearch.Checked := AppSettings.ReadBool(asIncrementalSearch); + case TLineBreaks(AppSettings.ReadInt(asLineBreakStyle)) of + lbsNone, lbsWindows: comboLineBreakStyle.ItemIndex := 0; + lbsUnix: comboLineBreakStyle.ItemIndex := 1; + lbsMac: comboLineBreakStyle.ItemIndex := 2; + end; + + // Shortcuts + TreeShortcutItems.ReinitChildren(nil, True); + SelectNode(TreeShortcutItems, nil); + + // Files and tabs + chkAskFileSave.Checked := AppSettings.ReadBool(asPromptSaveFileOnTabClose); + chkRestoreTabs.Checked := AppSettings.ReadBool(asRestoreTabs); + chkTabCloseOnDoubleClick.Checked := AppSettings.ReadBool(asTabCloseOnDoubleClick); + chkTabCloseOnMiddleClick.Checked := AppSettings.ReadBool(asTabCloseOnMiddleClick); + comboTabIconsGrayscaleMode.ItemIndex := AppSettings.ReadInt(asTabIconsGrayscaleMode); + comboReformatter.ItemIndex := AppSettings.ReadInt(asReformatterNoDialog); + + // Disable global shortcuts + MainForm.ActionList1.State := asSuspended; + + TExtForm.PageControlTabHighlight(pagecontrolMain); + + FRestartOptionTouched := False; + btnApply.Enabled := False; + screen.Cursor := crdefault; +end; + +procedure TfrmPreferences.FormDestroy(Sender: TObject); +begin + AppSettings.WriteInt(asPreferencesWindowWidth, ScaleFormToDesign(Width)); + AppSettings.WriteInt(asPreferencesWindowHeight, ScaleFormToDesign(Height)); +end; + + + +procedure TfrmPreferences.SQLFontChange(Sender: TObject); +var + AttriIdx: Integer; + Attri: TSynHighlighterAttributes; + Foreground, Background: TColor; +begin + if comboSQLFontName.ItemIndex > -1 then + SynMemoSQLSample.Font.Name := comboSQLFontName.Items[comboSQLFontName.ItemIndex]; + SynMemoSQLSample.Font.Size := MakeInt(editSQLFontSize.Text); + SynMemoSQLSample.TabWidth := MakeInt(editSQLTabWidth.Text); + AttriIdx := comboSQLColElement.ItemIndex; + Foreground := cboxSQLColForeground.Selected; + Background := cboxSQLColBackground.Selected; + if AttriIdx = comboSQLColElement.Items.Count-1 then begin + MainForm.MatchingBraceForegroundColor := Foreground; + MainForm.MatchingBraceBackgroundColor := Background; + end else if AttriIdx = comboSQLColElement.Items.Count-2 then begin + SynMemoSQLSample.LineHighlightColor.Background := Background; + end else begin + Attri := SynSqlSynSQLSample.Attribute[AttriIdx]; + Attri.Foreground := Foreground; + Attri.Background := Background; + if chkSQLBold.Checked then Attri.Style := Attri.Style + [fsBold] + else Attri.Style := Attri.Style - [fsBold]; + if chkSQLItalic.Checked then Attri.Style := Attri.Style + [fsItalic] + else Attri.Style := Attri.Style - [fsItalic]; + end; + Modified(Sender); +end; + + +procedure TfrmPreferences.DataFontsChange(Sender: TObject); +begin + Modified(Sender); +end; + +procedure TfrmPreferences.anyUpDownLimitChanging(Sender: TObject; + var AllowChange: Boolean); +begin + Modified(Sender); +end; + + +procedure TfrmPreferences.editGridRowCountExit(Sender: TObject); +var + Edit: TEdit; +begin + // Row count step and maximum shall never be "0", to avoid problems in + // data grids. See issue #3080. + Edit := Sender as TEdit; + if MakeInt(Edit.Text) <= 0 then + Edit.Text := '1'; +end; + + +procedure TfrmPreferences.SelectDirectory(Sender: TObject; NewFolderButton: Boolean); +var + Browse: TSelectDirectoryDialog; + Edit: TEditButton; +begin + // Select folder for any option + Edit := Sender as TEditButton; + Browse := TSelectDirectoryDialog.Create(Self); + Browse.InitialDir := Edit.Text; + Browse.Title := _(Edit.TextHint); + //Browse.BrowseOptions := Browse.BrowseOptions + [bifNewDialogStyle]; + //if not NewFolderButton then + // Browse.BrowseOptions := Browse.BrowseOptions + [bifNoNewFolderButton]; + if Browse.Execute then begin + Edit.Text := Browse.FileName; + Modified(Sender); + end; + Browse.Free; +end; + + +procedure TfrmPreferences.editLogDirRightButtonClick(Sender: TObject); +begin + // Select folder for session logs + SelectDirectory(Sender, True); +end; + + +procedure TfrmPreferences.editMySQLBinariesRightButtonClick(Sender: TObject); +begin + // Select folder where MySQL binaries reside + SelectDirectory(Sender, False); +end; + + +procedure TfrmPreferences.editCustomSnippetsDirectoryRightButtonClick(Sender: TObject); +begin + // Set custom snippets directory + SelectDirectory(Sender, True); +end; + + +{** + Updatecheck checkbox was clicked +} +procedure TfrmPreferences.chkUpdatecheckClick(Sender: TObject); +begin + editUpdatecheckInterval.Enabled := chkUpdatecheck.Checked; + chkUpdatecheckBuilds.Enabled := chkUpdatecheck.Checked; + Modified(Sender); +end; + + +procedure TfrmPreferences.chkCompletionProposalClick(Sender: TObject); +var + Enable: Boolean; +begin + Enable := TCheckBox(Sender).Checked; + editCompletionProposalInterval.Enabled := Enable; + lblCompletionProposalIntervalUnit.Enabled := Enable; + chkCompletionProposalSearchOnMid.Enabled := Enable; + Modified(Sender); +end; + +procedure TfrmPreferences.chkLogToFileClick(Sender: TObject); +begin + editLogDir.Enabled := TCheckBox(Sender).Checked; + Modified(Sender); +end; + + +procedure TfrmPreferences.chkQueryHistoryClick(Sender: TObject); +begin + editQueryHistoryKeepDays.Enabled := chkQueryHistory.Checked; + lblQueryHistoryKeepDays.Enabled := chkQueryHistory.Checked; + Modified(Sender); +end; + + +procedure TfrmPreferences.comboEditorColorsPresetChange(Sender: TObject); +var + i, j: Integer; + Highlighter: TSynSQLSyn; + FoundHighlighter: Boolean; + rx: TRegExpr; + TranslatedHighlighterName: String; +begin + // Color preset selected + FoundHighlighter := False; + rx := TRegExpr.Create; + rx.Expression := '.+_([a-zA-Z0-9]+)$'; + for i:=0 to ComponentCount-1 do begin + if (Components[i] is TSynSQLSyn) and (Components[i] <> SynMemoSQLSample.Highlighter) then begin + Highlighter := Components[i] as TSynSQLSyn; + + // Translate highlighter postfix after last underscore: SynSQLSyn_White, SynSQLSyn_Black, ... + TranslatedHighlighterName := ''; + if rx.Exec(Highlighter.Name) then begin + TranslatedHighlighterName := _(rx.Match[1]); + end; + // ... so we can compare that with the selected dropdown text + if TranslatedHighlighterName = comboEditorColorsPreset.Text then begin + FoundHighlighter := True; + for j:=0 to SynSQLSynSQLSample.AttrCount - 1 do begin + SynSQLSynSQLSample.Attribute[j].AssignColorAndStyle(Highlighter.Attribute[j]); + end; + // Use 3 hardcoded default values for additional colors, which are not part + // of the highlighter's attributes + SynMemoSQLSample.LineHighlightColor.Background := StringToColor(AppSettings.GetDefaultString(asSQLColActiveLine)); + if ThemeIsDark(comboTheme.Text) then begin + MainForm.MatchingBraceForegroundColor := $0028EFFF; + MainForm.MatchingBraceBackgroundColor := $004D513B; + end else begin + MainForm.MatchingBraceForegroundColor := StringToColor(AppSettings.GetDefaultString(asSQLColMatchingBraceForeground)); + MainForm.MatchingBraceBackgroundColor := StringToColor(AppSettings.GetDefaultString(asSQLColMatchingBraceBackground)); + end; + Break; + end; + end; + end; + if not FoundHighlighter then begin + // Show current custom settings + for i:=0 to SynSQLSynSQLSample.AttrCount - 1 do begin + SynSQLSynSQLSample.Attribute[i].AssignColorAndStyle(MainForm.SynSQLSynUsed.Attribute[i]); + end; + end; + Modified(Sender); +end; + + +procedure TfrmPreferences.comboGridTextColorsPresetSelect(Sender: TObject); +var + Preset: TGridColorsPreset; + dtc: TDBDatatypeCategoryIndex; +begin + // Grid colors preset selected + Preset := FGridColorsPresets[comboGridTextColorsPreset.ItemIndex]; + for dtc:=Low(Preset.TextColors) to High(Preset.TextColors) do begin + FGridTextColors[dtc] := Preset.TextColors[dtc]; + end; + comboGridTextColors.OnSelect(comboGridTextColors); + if comboGridTextColorsPreset.ItemIndex > 0 then + Modified(Sender); +end; + + +procedure TfrmPreferences.comboGridTextColorsSelect(Sender: TObject); +begin + // Data type category selected + colorboxGridTextColors.Selected := FGridTextColors[TDBDatatypeCategoryIndex(comboGridTextColors.ItemIndex)]; +end; + + +procedure TfrmPreferences.comboGUIFontChange(Sender: TObject); +var + UseCustomFont: Boolean; +begin + // System font selected + UseCustomFont := comboGUIFont.ItemIndex > 0; + editGUIFontSize.Enabled := UseCustomFont; + lblGUIFontSize.Enabled := UseCustomFont; + Modified(Sender); +end; + + +procedure TfrmPreferences.colorBoxGridTextColorsSelect(Sender: TObject); +begin + // Color selected + FGridTextColors[TDBDatatypeCategoryIndex(comboGridTextColors.ItemIndex)] := colorboxGridTextColors.Selected; + Modified(Sender); +end; + + +procedure TfrmPreferences.comboSQLColElementChange(Sender: TObject); +var + AttriIdx: Integer; + Attri: TSynHighlighterAttributes; + Foreground, Background: TColor; +begin + AttriIdx := comboSQLColElement.ItemIndex; + if AttriIdx = comboSQLColElement.Items.Count-1 then begin + Foreground := MainForm.MatchingBraceForegroundColor; + Background := MainForm.MatchingBraceBackgroundColor; + chkSQLBold.Enabled := False; + chkSQLItalic.Enabled := False; + end else if AttriIdx = comboSQLColElement.Items.Count-2 then begin + Foreground := clNone; + Background := SynMemoSQLSample.LineHighlightColor.Background; + chkSQLBold.Enabled := False; + chkSQLItalic.Enabled := False; + end else begin + Attri := SynSqlSynSQLSample.Attribute[AttriIdx]; + Foreground := Attri.Foreground; + Background := Attri.Background; + chkSQLBold.Enabled := True; + chkSQLItalic.Enabled := True; + chkSQLBold.OnClick := nil; + chkSQLItalic.OnClick := nil; + chkSQLBold.Checked := fsBold in Attri.Style; + chkSQLItalic.Checked := fsItalic in Attri.Style; + chkSQLBold.OnClick := SQLFontChange; + chkSQLItalic.OnClick := SQLFontChange; + end; + cboxSQLColForeground.Selected := Foreground; + cboxSQLColBackground.Selected := Background; +end; + + +procedure TfrmPreferences.updownSQLFontSizeClick(Sender: TObject; + Button: TUDBtnType); +begin + SQLFontChange(Sender); +end; + + +{** + Select attribute in pulldown by click into SynMemo +} +procedure TfrmPreferences.SynMemoSQLSampleClick(Sender: TObject); +var + Token: String; + Attri: TSynHighlighterAttributes; + AttriIdx: Integer; + sm: TSynEdit; +begin + sm := Sender as TSynEdit; + sm.GetHighlighterAttriAtRowCol(sm.CaretXY, Token, Attri); + if Attri = nil then + Exit; + AttriIdx := ComboSQLColElement.Items.IndexOf(Attri.Name); + if AttriIdx = -1 then + Exit; + ComboSQLColElement.ItemIndex := AttriIdx; + ComboSQLColElement.OnChange(Sender); +end; + + +procedure TfrmPreferences.btnRemoveHotKeyClick(Sender: TObject); +begin + // Clear current shortcut + if Sender = btnRemoveHotKey1 then begin + //FHotKey1.HotKey := 0; + //HotKeyChange(FHotKey1); + end + else if Sender = btnRemoveHotKey2 then begin + //FHotKey2.HotKey := 0; + //HotKeyChange(FHotKey2); + end + else + Beep; +end; + +procedure TfrmPreferences.btnRestoreDefaultsClick(Sender: TObject); +var + ValueList: TStringlist; + i: Integer; +begin + // Restore defaults + if MessageDialog(_('Reset all preference options to default values?'), + _('This also applies to automatic settings, e.g. toolbar positions.'), + mtConfirmation, [mbOK, mbCancel]) = mrCancel then + Exit; + AppSettings.ResetPath; + ValueList := AppSettings.GetValueNames; + for i:=0 to ValueList.Count-1 do + AppSettings.DeleteValue(ValueList[i]); + FormShow(Sender); +end; + + +procedure TfrmPreferences.TreeShortcutItemsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex); +var + ShortcutFocused: Boolean; + Data: PShortcutItemData; +begin + // Shortcut item focus change in tree + ShortcutFocused := Assigned(Node) and (Sender.GetNodeLevel(Node) = 1); + lblShortcutHint.Enabled := ShortcutFocused; + lblShortcut1.Enabled := ShortcutFocused; + lblShortcut2.Enabled := ShortcutFocused; + //FHotKey1.Enabled := lblShortcut1.Enabled; + btnRemoveHotKey1.Enabled := lblShortcut1.Enabled; + if ShortcutFocused then begin + Data := Sender.GetNodeData(Node); + lblShortcutHint.Caption := TreeShortcutItems.Text[Node, 0]; + if Assigned(Data.Action) then begin + lblShortcut2.Enabled := False; + if MainForm.ActionList1DefaultHints[Data.Action.Index] <> '' then + lblShortcutHint.Caption := MainForm.ActionList1DefaultHints[Data.Action.Index]; + end; + //FHotKey1.HotKey := Data.ShortCut1; + //FHotKey2.HotKey := Data.ShortCut2; + end; + //FHotKey2.Enabled := lblShortcut2.Enabled; + btnRemoveHotKey2.Enabled := lblShortcut2.Enabled; +end; + + +procedure TfrmPreferences.TreeShortcutItemsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); +var + Data: PShortcutItemData; +begin + // Fetch icon number of shortcut item + if not (Kind in [ikNormal, ikSelected]) then Exit; + if Sender.GetNodeLevel(Node) = 1 then begin + Data := Sender.GetNodeData(Node); + if Assigned(Data.KeyStroke) then + ImageIndex := 114 + else if Assigned(Data.Action) then + ImageIndex := Data.Action.ImageIndex; + end; +end; + + +procedure TfrmPreferences.TreeShortcutItemsGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); +begin + NodeDataSize := SizeOf(TShortcutItemData); +end; + + +procedure TfrmPreferences.TreeShortcutItemsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType; var CellText: String); +var + Data: PShortcutItemData; + i: Integer; + t: String; +begin + // Fetch text of shortcut item + case Sender.GetNodeLevel(Node) of + 0: CellText := FShortcutCategories[Node.Index]; + 1: begin + Data := Sender.GetNodeData(Node); + if Assigned(Data.KeyStroke) then begin + t := EditorCommandToCodeString(Data.KeyStroke.Command); + t := Copy(t, 3, Length(t)-2); + // Insert spaces before uppercase chars + CellText := ''; + for i:=1 to Length(t) do begin + if (i > 1) and (UpperCase(t[i]) = t[i]) then + CellText := CellText + ' '; + CellText := CellText + t[i]; + end; + CellText := _(CellText); + end else if Assigned(Data.Action) then begin + CellText := StripHotkey(MainForm.ActionList1DefaultCaptions[Data.Action.Index]); + end; + end; + end; +end; + + +procedure TfrmPreferences.TreeShortcutItemsInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; + var ChildCount: Cardinal); +var + i: Integer; + Category: String; +begin + // First initialization of shortcut items + if Sender.GetNodeLevel(Node) = 0 then begin + ChildCount := 0; + if Integer(Node.Index) = FShortcutCategories.Count-1 then + ChildCount := Mainform.SynMemoQuery.Keystrokes.Count + else begin + Category := (Sender as TLazVirtualStringTree).Text[Node, 0]; + for i:=0 to Mainform.ActionList1.ActionCount-1 do begin + if Mainform.ActionList1.Actions[i].Category = Category then + Inc(ChildCount); + end; + end; + end; +end; + +procedure TfrmPreferences.TreeShortcutItemsInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates); +var + Data: PShortcutItemData; + ItemIndex, i: Integer; + Category: String; +begin + if Sender.GetNodeLevel(Node) = 0 then + Include(InitialStates, ivsHasChildren); + Data := Sender.GetNodeData(Node); + + if Sender.GetNodeLevel(Node) = 1 then begin + if Integer(Node.Parent.Index) = FShortcutCategories.Count-1 then begin + Data^.KeyStroke := Mainform.SynMemoQuery.Keystrokes[Node.Index]; + Data^.Shortcut1 := Data.KeyStroke.ShortCut; + Data^.Shortcut2 := Data.KeyStroke.ShortCut2; + end else begin + ItemIndex := -1; + Category := (Sender as TLazVirtualStringTree).Text[Node.Parent, 0]; + for i:=0 to Mainform.ActionList1.ActionCount-1 do begin + if Mainform.ActionList1.Actions[i].Category = Category then + Inc(ItemIndex); + if ItemIndex = Integer(Node.Index) then begin + Data^.Action := TAction(Mainform.ActionList1.Actions[i]); + Data^.Shortcut1 := Data.Action.ShortCut; + break; + end; + end; + end; + end; +end; + + +function TfrmPreferences.EnsureShortcutIsUnused(RequestShortcut: TShortCut): Boolean; +var + Node, NodeWantsIt: PVirtualNode; + Data: PShortcutItemData; + Tree: TLazVirtualStringTree; + MsgFormat, Msg: String; +begin + Result := True; + if RequestShortcut = 0 then + Exit; + MsgFormat := _('Keyboard shortcut [%s] is already assigned to "%s".') + sLineBreak + sLineBreak + + _('Remove it there and assign to "%s" instead?') + sLineBreak + sLineBreak + + _('Press ignore to keep both and ignore all conflicts.'); + Tree := TreeShortcutItems; + NodeWantsIt := Tree.FocusedNode; + Node := GetNextNode(Tree, nil, False); + while Assigned(Node) do begin + if Tree.GetNodeLevel(Node) = 1 then begin + Data := Tree.GetNodeData(Node); + Msg := Format(MsgFormat, [ + ShortCutToText(RequestShortcut), + Tree.Text[Node.Parent, 0] + ' > ' + StripHotkey(Tree.Text[Node, 0]), + Tree.Text[NodeWantsIt.Parent, 0] + ' > ' + StripHotkey(Tree.Text[NodeWantsIt, 0]) + ]); + if Node = NodeWantsIt then begin + // Ignore requesting node + end else begin + if Data.ShortCut1 = RequestShortcut then begin + case MessageDialog(Msg, mtConfirmation, [mbYes, mbNo, mbIgnore]) of + mrYes: Data.ShortCut1 := 0; // Unassign shortcut 1 + mrNo: Result := False; + mrIgnore: Break; // Keep Result=True and exit loop, ignore further conflicts + end; + end; + if Data.ShortCut2 = RequestShortcut then begin + case MessageDialog(Msg, mtConfirmation, [mbYes, mbNo, mbIgnore]) of + mrYes: Data.ShortCut2 := 0; // Unassign shortcut 2 + mrNo: Result := False; + mrIgnore: Break; + end; + end; + end; + end; + if Result = False then + Break; + Node := GetNextNode(Tree, Node, False); + end; + +end; + + +procedure TfrmPreferences.HotKeyChange(Sender: TObject); +//var +// Data: PShortcutItemData; +// HotKeyEdit: TExtSynHotKey; +// EventHandler: TNotifyEvent; +begin + // Shortcut 1 or 2 changed + {HotKeyEdit := Sender as TExtSynHotKey; + Data := TreeShortcutItems.GetNodeData(TreeShortcutItems.FocusedNode); + if EnsureShortcutIsUnused(HotKeyEdit.HotKey) then begin + if HotKeyEdit = FHotKey1 then + Data.Shortcut1 := HotKeyEdit.HotKey + else + Data.Shortcut2 := HotKeyEdit.HotKey; + Modified(Sender); + end else begin + // Undo change in hotkey editor, without triggering OnChange event + EventHandler := HotKeyEdit.OnChange; + if HotKeyEdit = FHotKey1 then + HotKeyEdit.HotKey := Data.ShortCut1 + else + HotKeyEdit.HotKey := Data.ShortCut2; + HotKeyEdit.OnChange := EventHandler; + end;} +end; + + +procedure TfrmPreferences.HotKeyEnter(Sender: TObject); +begin + // Remove Esc and Enter shortcuts from buttons + btnOk.Default := False; + btnCancel.Cancel := False; +end; + + +procedure TfrmPreferences.HotKeyExit(Sender: TObject); +begin + // Readd Esc and Enter shortcuts to buttons + btnOk.Default := True; + btnCancel.Cancel := True; +end; + + +procedure TfrmPreferences.InitLanguages; +var + LangNames: String; + MoFilePath, LangCode: String; + AvailLangCodes: TStringList; + AvailMoFiles: TStringList; + i: Integer; + + procedure AddLang(LangCode: String); + var + LangName: String; + rx: TRegExpr; + begin + rx := TRegExpr.Create; + rx.Expression := '\b'+QuoteRegExprMetaChars(LangCode)+'\:([^#]+)'; + rx.ModifierI := True; + if rx.Exec(LangNames) then + LangName := rx.Match[1] + else + LangName := ''; + rx.Free; + FLanguages.Add(LangCode + ': ' + LangName); + end; + +begin + // Create list with present language code => language name + // List taken from dxgettext/languagecodes.pas + + LangNames := 'aa:Afar#'+ + 'aa:Afar#'+ + 'ab:Abkhazian#'+ + 'ae:Avestan#'+ + 'af:Afrikaans#'+ + 'ak:Akan#'+ + 'am:Amharic#'+ + 'an:Aragonese#'+ + 'ar:Arabic#'+ + 'as:Assamese#'+ + 'av:Avaric#'+ + 'ay:Aymara#'+ + 'az:Azerbaijani#'+ + 'ba:Bashkir#'+ + 'be:Belarusian#'+ + 'bg:Bulgarian#'+ + 'bh:Bihari#'+ + 'bi:Bislama#'+ + 'bm:Bambara#'+ + 'bn:Bengali#'+ + 'bo:Tibetan#'+ + 'br:Breton#'+ + 'bs:Bosnian#'+ + 'ca:Catalan#'+ + 'ce:Chechen#'+ + 'ch:Chamorro#'+ + 'co:Corsican#'+ + 'cr:Cree#'+ + 'cs:Czech#'+ + 'cv:Chuvash#'+ + 'cy:Welsh#'+ + 'da:Danish#'+ + 'de:German#'+ + 'de_AT:Austrian German#'+ + 'de_CH:Swiss German#'+ + 'dv:Divehi#'+ + 'dz:Dzongkha#'+ + 'ee:Ewe#'+ + 'el:Greek#'+ + 'en:English#'+ + 'en_AU:Australian English#'+ + 'en_CA:Canadian English#'+ + 'en_GB:British English#'+ + 'en_US:American English#'+ + 'eo:Esperanto#'+ + 'es:Spanish#'+ + 'et:Estonian#'+ + 'eu:Basque#'+ + 'fa:Persian#'+ + 'ff:Fulah#'+ + 'fi:Finnish#'+ + 'fj:Fijian#'+ + 'fo:Faroese#'+ + 'fr:French#'+ + 'fr_BE:Walloon#'+ + 'fy:Frisian#'+ + 'ga:Irish#'+ + 'gd:Gaelic#'+ + 'gl:Gallegan#'+ + 'gn:Guarani#'+ + 'gu:Gujarati#'+ + 'gv:Manx#'+ + 'ha:Hausa#'+ + 'he:Hebrew#'+ + 'hi:Hindi#'+ + 'ho:Hiri Motu#'+ + 'hr:Croatian#'+ + 'hr_HR:Croatian#'+ // Added, exists on Transifex + 'ht:Haitian#'+ + 'hu:Hungarian#'+ + 'hy:Armenian#'+ + 'hz:Herero#'+ + 'ia:Interlingua#'+ + 'id:Indonesian#'+ + 'ie:Interlingue#'+ + 'ig:Igbo#'+ + 'ii:Sichuan Yi#'+ + 'ik:Inupiaq#'+ + 'io:Ido#'+ + 'is:Icelandic#'+ + 'it:Italian#'+ + 'iu:Inuktitut#'+ + 'ja:Japanese#'+ + 'jv:Javanese#'+ + 'ka:Georgian#'+ + 'kg:Kongo#'+ + 'ki:Kikuyu#'+ + 'kj:Kuanyama#'+ + 'kk:Kazakh#'+ + 'kl:Greenlandic#'+ + 'km:Khmer#'+ + 'kn:Kannada#'+ + 'ko:Korean#'+ + 'kr:Kanuri#'+ + 'ks:Kashmiri#'+ + 'ku:Kurdish#'+ + 'kw:Cornish#'+ + 'kv:Komi#'+ + 'ky:Kirghiz#'+ + 'la:Latin#'+ + 'lb:Luxembourgish#'+ + 'lg:Ganda#'+ + 'li:Limburgan#'+ + 'ln:Lingala#'+ + 'lo:Lao#'+ + 'lt:Lithuanian#'+ + 'lu:Luba-Katanga#'+ + 'lv:Latvian#'+ + 'mg:Malagasy#'+ + 'mh:Marshallese#'+ + 'mi:Maori#'+ + 'mk:Macedonian#'+ + 'ml:Malayalam#'+ + 'mn:Mongolian#'+ + 'mo:Moldavian#'+ + 'mr:Marathi#'+ + 'ms:Malay#'+ + 'mt:Maltese#'+ + 'my:Burmese#'+ + 'na:Nauru#'+ + 'nb:Norwegian Bokmaal#'+ + 'nd:Ndebele, North#'+ + 'ne:Nepali#'+ + 'ng:Ndonga#'+ + 'nl:Dutch#'+ + 'nl_BE:Flemish#'+ + 'nn:Norwegian Nynorsk#'+ + 'no:Norwegian#'+ + 'nr:Ndebele, South#'+ + 'nv:Navajo#'+ + 'ny:Chichewa#'+ + 'oc:Occitan#'+ + 'oj:Ojibwa#'+ + 'om:Oromo#'+ + 'or:Oriya#'+ + 'os:Ossetian#'+ + 'pa:Panjabi#'+ + 'pi:Pali#'+ + 'pl:Polish#'+ + 'ps:Pushto#'+ + 'pt:Portuguese#'+ + 'pt_BR:Brazilian Portuguese#'+ + 'qu:Quechua#'+ + 'rm:Raeto-Romance#'+ + 'rn:Rundi#'+ + 'ro:Romanian#'+ + 'ru:Russian#'+ + 'rw:Kinyarwanda#'+ + 'sa:Sanskrit#'+ + 'sc:Sardinian#'+ + 'sd:Sindhi#'+ + 'se:Northern Sami#'+ + 'sg:Sango#'+ + 'si:Sinhalese#'+ + 'sk:Slovak#'+ + 'sl:Slovenian#'+ + 'sm:Samoan#'+ + 'sn:Shona#'+ + 'so:Somali#'+ + 'sq:Albanian#'+ + 'sr:Serbian#'+ + 'ss:Swati#'+ + 'st:Sotho, Southern#'+ + 'su:Sundanese#'+ + 'sv:Swedish#'+ + 'sw:Swahili#'+ + 'ta:Tamil#'+ + 'te:Telugu#'+ + 'tg:Tajik#'+ + 'th:Thai#'+ + 'ti:Tigrinya#'+ + 'tk:Turkmen#'+ + 'tl:Tagalog#'+ + 'tn:Tswana#'+ + 'to:Tonga#'+ + 'tr:Turkish#'+ + 'ts:Tsonga#'+ + 'tt:Tatar#'+ + 'tw:Twi#'+ + 'ty:Tahitian#'+ + 'ug:Uighur#'+ + 'uk:Ukrainian#'+ + 'ur:Urdu#'+ + 'uz:Uzbek#'+ + 've:Venda#'+ + 'vi:Vietnamese#'+ + 'vo:Volapuk#'+ + 'wa:Walloon#'+ + 'wo:Wolof#'+ + 'xh:Xhosa#'+ + 'yi:Yiddish#'+ + 'yo:Yoruba#'+ + 'za:Zhuang#'+ + 'zh:Chinese (Simplified)#'+ // Added, see #498 + 'zh_CN:Chinese (China)#'+ + 'zh_TW:Chinese (Traditional)#'+ + 'zu:Zulu#'; + + FLanguages := TStringList.Create; + AvailLangCodes := TStringList.Create; + AvailMoFiles := FindAllFiles( + ExtractFilePath(AppLanguageMoBasePath), + ExtractFileName(AppLanguageMoBasePath) + '*.mo', + False + ); + for MoFilePath in AvailMoFiles do begin + LangCode := RegExprGetMatch('\.(\w+)\.\w+$', ExtractFileName(MoFilePath), 1); + if not LangCode.IsEmpty then + AvailLangCodes.Add(LangCode) + else + AvailLangCodes.Add('en'); // Default en file has just ".mo" extension, not ".en.mo" + end; + for i:=0 to AvailLangCodes.Count-1 do begin + AddLang(AvailLangCodes[i]); + end; + + FLanguages.Sort; + FLanguages.Insert(0, '*** '+f_('Auto detect (%s)', [SysLanguage])); + if FLanguages.Count <= 1 then + FLanguages[0] := 'English only - no .mo files found in ' + ExtractFilePath(AppLanguageMoBasePath); + + AvailMoFiles.Free; + AvailLangCodes.Free; +end; + + +end. diff --git a/source/table_editor.pas b/source/table_editor.pas index 0e63fd7d..b5c1dd4f 100644 --- a/source/table_editor.pas +++ b/source/table_editor.pas @@ -620,7 +620,6 @@ var Col, PreviousCol: TTableColumn; TblKey: TTableKey; Constraint: TCheckConstraint; - Node: PVirtualNode; Conn: TDBConnection; procedure FinishSpecs; @@ -714,7 +713,6 @@ begin end; // Update columns - Node := listColumns.GetFirst; PreviousCol := nil; for Col in FColumns do begin if Col.Status <> esUntouched then begin diff --git a/source/updatecheck.pas b/source/updatecheck.pas index 1c78b769..9185575e 100644 --- a/source/updatecheck.pas +++ b/source/updatecheck.pas @@ -1,342 +1,344 @@ -unit updatecheck; - -{$mode delphi}{$H+} - -interface - -uses - SysUtils, Classes, Forms, StdCtrls, IniFiles, Controls, Graphics, - apphelpers, ExtCtrls, extra_controls, StrUtils, Dialogs, - Menus, Clipbrd, generic_types, DateUtils; - -type - - { TfrmUpdateCheck } - - TfrmUpdateCheck = class(TExtForm) - btnCancel: TButton; - groupBuild: TGroupBox; - btnBuild: TButton; - groupRelease: TGroupBox; - LinkLabelRelease: TLabel; - lblStatus: TLabel; - memoRelease: TMemo; - memoBuild: TMemo; - btnChangelog: TButton; - popupDownloadRelease: TPopupMenu; - CopydownloadURL1: TMenuItem; - btnDonate: TButton; - procedure FormCreate(Sender: TObject); - procedure btnBuildClick(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure LinkLabelReleaseLinkClick(Sender: TObject); - procedure FormShow(Sender: TObject); - procedure btnChangelogClick(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure CopydownloadURL1Click(Sender: TObject); - const - SLinkDownloadRelease= 'download-release'; - SLinkInstructionsPortable = 'instructions-portable'; - SLinkChangelog = 'changelog'; - private - { Private declarations } - BuildURL: String; - FRestartTaskName: String; - procedure Status(txt: String); - function GetLinkUrl(Sender: TObject; LinkType: String): String; - function GetTaskXmlFileContents: String; - public - { Public declarations } - BuildRevision: Integer; - procedure ReadCheckFile; - end; - -procedure DeleteRestartTask; - - -implementation - -uses main; - -{$R *.lfm} - -{$I const.inc} - - - -{** - Set defaults -} -procedure TfrmUpdateCheck.FormCreate(Sender: TObject); -begin - // Should be false by default. Callers can set this to True after Create() - btnDonate.OnClick := MainForm.DonateClick; - btnDonate.Visible := MainForm.HasDonated(False) = nbFalse; - btnDonate.Caption := f_('Donate to the %s project', [APPNAME]); - HasSizeGrip := True; - Width := AppSettings.ReadInt(asUpdateCheckWindowWidth); - Height := AppSettings.ReadInt(asUpdateCheckWindowHeight); - FRestartTaskName := 'yet_invalid'; -end; - -procedure TfrmUpdateCheck.FormClose(Sender: TObject; var Action: TCloseAction); -begin - if ModalResult <> btnBuild.ModalResult then begin - DeleteRestartTask; - end; -end; - -{** - Update status text -} -procedure TfrmUpdateCheck.Status(txt: String); -begin - lblStatus.Caption := txt; - lblStatus.Repaint; -end; - - -{** - Download check file -} -procedure TfrmUpdateCheck.FormShow(Sender: TObject); -begin - Caption := f_('Check for %s updates', [APPNAME]) + ' ...'; - Screen.Cursor := crHourglass; - try - Status(_('Downloading check file')+' ...'); - ReadCheckFile; - // Developer versions probably have "unknown" (0) as revision, - // which makes it impossible to compare the revisions. - if Mainform.AppVerRevision = 0 then - Status(_('Error: Cannot determine current revision. Using a developer version?')) - else if Mainform.AppVerRevision = BuildRevision then - Status(f_('Your %s is up-to-date (no update available).', [APPNAME])) - else if groupRelease.Enabled or btnBuild.Enabled then - Status(_('Updates available.')); - except - // Do not popup errors, just display them in the status label - on E:Exception do - Status(E.Message); - end; - Screen.Cursor := crDefault; - btnCancel.TrySetFocus; -end; - - -{** - Parse check file for updated version + release -} -procedure TfrmUpdateCheck.ReadCheckFile; -var - CheckfileDownload: THttpDownLoad; - CheckFilename, TaskXmlFile: String; - Ini: TIniFile; - ReleaseVersion, ReleasePackage: String; - ReleaseRevision: Integer; - Note: String; - Compiled: TDateTime; -const - INISECT_RELEASE = 'Release'; - INISECT_BUILD = 'Build'; -begin - // Init GUI controls - LinkLabelRelease.Enabled := False; - btnBuild.Enabled := False; - memoRelease.Clear; - memoBuild.Clear; - - // Prepare download - CheckfileDownload := THttpDownload.Create(Self); - CheckfileDownload.TimeOut := 5; - CheckfileDownload.URL := APPDOMAIN+'updatecheck.php?r='+IntToStr(Mainform.AppVerRevision)+'&bits='+IntToStr(GetExecutableBits)+'&os='+EncodeURLParam(GetOS.ToLower)+'&t='+EncodeURLParam(DateTimeToStr(Now)); - CheckFilename := GetTempDir + APPNAME + '_updatecheck.ini'; - - // Download the check file - CheckfileDownload.SendRequest(CheckFilename); - // Remember when we did the updatecheck to enable the automatic interval - AppSettings.WriteString(asUpdatecheckLastrun, DateTimeToStr(Now)); - - // Read [Release] section of check file - Ini := TIniFile.Create(CheckFilename); - if Ini.SectionExists(INISECT_RELEASE) then begin - ReleaseVersion := Ini.ReadString(INISECT_RELEASE, 'Version', 'unknown'); - ReleaseRevision := Ini.ReadInteger(INISECT_RELEASE, 'Revision', 0); - ReleasePackage := IfThen(AppSettings.PortableMode, 'portable', 'installer'); - memoRelease.Lines.Add(f_('Version %s (yours: %s)', [ReleaseVersion, Mainform.AppVersion])); - memoRelease.Lines.Add(f_('Released: %s', [Ini.ReadString(INISECT_RELEASE, 'Date', '')])); - Note := Ini.ReadString(INISECT_RELEASE, 'Note', ''); - if Note <> '' then - memoRelease.Lines.Add(_('Notes') + ': ' + Note); - - LinkLabelRelease.Caption := f_('Download version %s (%s)', [ReleaseVersion, ReleasePackage]); - //LinkLabelRelease.Caption := '' + LinkLabelRelease.Caption + ''; - //if AppSettings.PortableMode then begin - // LinkLabelRelease.Caption := LinkLabelRelease.Caption + ' '+_('Update instructions')+''; - //end; - - // Enable the download button if the current version is outdated - groupRelease.Enabled := ReleaseRevision > Mainform.AppVerRevision; - LinkLabelRelease.Enabled := groupRelease.Enabled; - LinkLabelRelease.Font.Style := LinkLabelRelease.Font.Style + [fsUnderline]; - memoRelease.Enabled := groupRelease.Enabled; - if not memoRelease.Enabled then - memoRelease.Font.Color := GetThemeColor(cl3DDkShadow) - else - memoRelease.Font.Color := GetThemeColor(clWindowText); - end; - - // Read [Build] section of check file - if Ini.SectionExists(INISECT_BUILD) then begin - BuildRevision := Ini.ReadInteger(INISECT_BUILD, 'Revision', 0); - BuildURL := Ini.ReadString(INISECT_BUILD, 'URL', ''); - memoBuild.Lines.Add(f_('Revision %d (yours: %d)', [BuildRevision, Mainform.AppVerRevision])); - FileAge(ParamStr(0), Compiled); - memoBuild.Lines.Add(f_('Compiled: %s (yours: %s)', [Ini.ReadString(INISECT_BUILD, 'Date', ''), DateToStr(Compiled)])); - Note := Ini.ReadString(INISECT_BUILD, 'Note', ''); - if Note <> '' then - memoBuild.Lines.Add(_('Notes') + ': * ' + StringReplace(Note, '%||%', CRLF+'* ', [rfReplaceAll] ) ); - if GetExecutableBits = 64 then begin - btnBuild.Caption := f_('Download and install build %d', [BuildRevision]); - // A new release should have priority over a new nightly build. - // So the user should not be able to download a newer build here - // before having installed the new release. - //btnBuild.Enabled := (Mainform.AppVerRevision = 0) or ((BuildRevision > Mainform.AppVerRevision) and (not LinkLabelRelease.Enabled)); - end - else begin - btnBuild.Caption := _('No build updates for 32 bit version'); - end; - - if btnBuild.Enabled then begin - TaskXmlFile := GetTempDir + APPNAME + '_task_restart.xml'; - SaveUnicodeFile(TaskXmlFile, GetTaskXmlFileContents, UTF8NoBOMEncoding); - FRestartTaskName := ValidFilename(ParamStr(0)); - ShellExec('schtasks', '', '/Create /TN "'+FRestartTaskName+'" /xml '+TaskXmlFile, True); - end; - - end; - - if FileExists(CheckFilename) then - DeleteFile(CheckFilename); - FreeAndNil(CheckfileDownload); -end; - - -{** - Download release package via web browser -} -procedure TfrmUpdateCheck.LinkLabelReleaseLinkClick(Sender: TObject); -begin - ShellExec(GetLinkUrl(LinkLabelRelease, SLinkDownloadRelease)); -end; - - -procedure TfrmUpdateCheck.btnChangelogClick(Sender: TObject); -begin - ShellExec(GetLinkUrl(Sender, SLinkChangelog)); -end; - - -procedure TfrmUpdateCheck.CopydownloadURL1Click(Sender: TObject); -begin - Clipboard.TryAsText := GetLinkUrl(LinkLabelRelease, SLinkDownloadRelease); -end; - -procedure TfrmUpdateCheck.btnBuildClick(Sender: TObject); -begin - // No auto-update -end; - -procedure TfrmUpdateCheck.FormDestroy(Sender: TObject); -begin - AppSettings.WriteInt(asUpdateCheckWindowWidth, ScaleFormToDesign(Width)); - AppSettings.WriteInt(asUpdateCheckWindowHeight, ScaleFormToDesign(Height)); -end; - - -function TfrmUpdateCheck.GetLinkUrl(Sender: TObject; LinkType: String): String; -var - DownloadParam, PlaceParam, OsParam: String; -begin - PlaceParam := 'place='+EncodeURLParam(TWinControl(Sender).Name); - OsParam := 'os='+EncodeURLParam(GetOS.ToLower); - - if LinkType = SLinkDownloadRelease then begin - if AppSettings.PortableMode then begin - if GetExecutableBits = 64 then - DownloadParam := 'download=portable-64' - else - DownloadParam := 'download=portable'; - end else begin - DownloadParam := 'download=installer'; - end; - Result := 'download.php?'+DownloadParam+'&'+PlaceParam+'&'+OsParam; - end - - else if LinkType = SLinkChangelog then begin - Result := 'changes-lazarus'; - end; - - Result := APPDOMAIN + Result; -end; - - -function TfrmUpdateCheck.GetTaskXmlFileContents: String; -begin - Result := '' + sLineBreak + - '' + sLineBreak + - ' ' + sLineBreak + - ' 2022-12-24T12:39:17.5068755' + sLineBreak + - ' ' + APPNAME + ' ' + MainForm.AppVersion + '' + sLineBreak + - ' \' + APPNAME + '_restart' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ' 2022-12-24T12:42:36' + sLineBreak + - ' true' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - // Note: no with the current users SID - ' InteractiveToken' + sLineBreak + - ' LeastPrivilege' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ' IgnoreNew' + sLineBreak + - ' true' + sLineBreak + - ' true' + sLineBreak + - ' true' + sLineBreak + - ' false' + sLineBreak + - ' false' + sLineBreak + - ' ' + sLineBreak + - ' true' + sLineBreak + - ' false' + sLineBreak + - ' ' + sLineBreak + - ' true' + sLineBreak + - ' true' + sLineBreak + - ' false' + sLineBreak + - ' false' + sLineBreak + - ' false' + sLineBreak + - ' PT72H' + sLineBreak + - ' 7' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ' "' + ParamStr(0) + '"' + sLineBreak + - ' --runfrom=scheduler' + sLineBreak + - ' ' + sLineBreak + - ' ' + sLineBreak + - ''; -end; - - -procedure DeleteRestartTask; -begin - // TN = Task Name - // F = Force, suppress prompt - ShellExec('schtasks', '', '/Delete /TN "'+ValidFilename(ParamStr(0))+'" /F', True); -end; - -end. +unit updatecheck; + +{$mode delphi}{$H+} + +interface + +uses + SysUtils, Classes, Forms, StdCtrls, IniFiles, Controls, Graphics, + apphelpers, ExtCtrls, extra_controls, StrUtils, Dialogs, + Menus, Clipbrd, generic_types, DateUtils; + +type + + { TfrmUpdateCheck } + + TfrmUpdateCheck = class(TExtForm) + btnCancel: TButton; + groupBuild: TGroupBox; + btnBuild: TButton; + groupRelease: TGroupBox; + LinkLabelRelease: TLabel; + lblStatus: TLabel; + memoRelease: TMemo; + memoBuild: TMemo; + btnChangelog: TButton; + popupDownloadRelease: TPopupMenu; + CopydownloadURL1: TMenuItem; + btnDonate: TButton; + procedure FormCreate(Sender: TObject); + procedure btnBuildClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure LinkLabelReleaseLinkClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure btnChangelogClick(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure CopydownloadURL1Click(Sender: TObject); + const + SLinkDownloadRelease= 'download-release'; + SLinkInstructionsPortable = 'instructions-portable'; + SLinkChangelog = 'changelog'; + private + { Private declarations } + BuildURL: String; + FRestartTaskName: String; + procedure Status(txt: String); + function GetLinkUrl(Sender: TObject; LinkType: String): String; + function GetTaskXmlFileContents: String; + public + { Public declarations } + BuildRevision: Integer; + procedure ReadCheckFile; + end; + +procedure DeleteRestartTask; + + +implementation + +uses main; + +{$R *.lfm} + +{$I const.inc} + + + +{** + Set defaults +} +procedure TfrmUpdateCheck.FormCreate(Sender: TObject); +begin + // Should be false by default. Callers can set this to True after Create() + btnDonate.OnClick := MainForm.DonateClick; + btnDonate.Visible := MainForm.HasDonated(False) = nbFalse; + btnDonate.Caption := f_('Donate to the %s project', [APPNAME]); + HasSizeGrip := True; + Width := AppSettings.ReadInt(asUpdateCheckWindowWidth); + Height := AppSettings.ReadInt(asUpdateCheckWindowHeight); + FRestartTaskName := 'yet_invalid'; +end; + +procedure TfrmUpdateCheck.FormClose(Sender: TObject; var Action: TCloseAction); +begin + if ModalResult <> btnBuild.ModalResult then begin + DeleteRestartTask; + end; +end; + +{** + Update status text +} +procedure TfrmUpdateCheck.Status(txt: String); +begin + lblStatus.Caption := txt; + lblStatus.Repaint; +end; + + +{** + Download check file +} +procedure TfrmUpdateCheck.FormShow(Sender: TObject); +begin + Caption := f_('Check for %s updates', [APPNAME]) + ' ...'; + Screen.Cursor := crHourglass; + try + Status(_('Downloading check file')+' ...'); + ReadCheckFile; + // Developer versions probably have "unknown" (0) as revision, + // which makes it impossible to compare the revisions. + if Mainform.AppVerRevision = 0 then + Status(_('Error: Cannot determine current revision. Using a developer version?')) + else if Mainform.AppVerRevision = BuildRevision then + Status(f_('Your %s is up-to-date (no update available).', [APPNAME])) + else if groupRelease.Enabled or btnBuild.Enabled then + Status(_('Updates available.')); + except + // Do not popup errors, just display them in the status label + on E:Exception do + Status(E.Message); + end; + Screen.Cursor := crDefault; + btnCancel.TrySetFocus; +end; + + +{** + Parse check file for updated version + release +} +procedure TfrmUpdateCheck.ReadCheckFile; +var + CheckfileDownload: THttpDownLoad; + CheckFilename, TaskXmlFile: String; + Ini: TIniFile; + ReleaseVersion, ReleasePackage: String; + ReleaseRevision: Integer; + Note: String; + Compiled: TDateTime; +const + INISECT_RELEASE = 'Release'; + INISECT_BUILD = 'Build'; +begin + // Init GUI controls + LinkLabelRelease.Enabled := False; + btnBuild.Enabled := False; + memoRelease.Clear; + memoBuild.Clear; + + // Prepare download + CheckfileDownload := THttpDownload.Create(Self); + CheckfileDownload.TimeOut := 5; + CheckfileDownload.URL := APPDOMAIN+'updatecheck.php?r='+IntToStr(Mainform.AppVerRevision)+'&bits='+IntToStr(GetExecutableBits)+'&os='+EncodeURLParam(GetOS.ToLower)+'&t='+EncodeURLParam(DateTimeToStr(Now)); + CheckFilename := GetTempDir + APPNAME + '_updatecheck.ini'; + + // Download the check file + CheckfileDownload.SendRequest(CheckFilename); + // Remember when we did the updatecheck to enable the automatic interval + AppSettings.WriteString(asUpdatecheckLastrun, DateTimeToStr(Now)); + + // Read [Release] section of check file + Ini := TIniFile.Create(CheckFilename); + if Ini.SectionExists(INISECT_RELEASE) then begin + ReleaseVersion := Ini.ReadString(INISECT_RELEASE, 'Version', 'unknown'); + ReleaseRevision := Ini.ReadInteger(INISECT_RELEASE, 'Revision', 0); + ReleasePackage := IfThen(AppSettings.PortableMode, 'portable', 'installer'); + memoRelease.Lines.Add(f_('Version %s (yours: %s)', [ReleaseVersion, Mainform.AppVersion])); + memoRelease.Lines.Add(f_('Released: %s', [Ini.ReadString(INISECT_RELEASE, 'Date', '')])); + Note := Ini.ReadString(INISECT_RELEASE, 'Note', ''); + if Note <> '' then + memoRelease.Lines.Add(_('Notes') + ': ' + Note); + + LinkLabelRelease.Caption := f_('Download version %s (%s)', [ReleaseVersion, ReleasePackage]); + //LinkLabelRelease.Caption := '' + LinkLabelRelease.Caption + ''; + //if AppSettings.PortableMode then begin + // LinkLabelRelease.Caption := LinkLabelRelease.Caption + ' '+_('Update instructions')+''; + //end; + + // Enable the download button if the current version is outdated + groupRelease.Enabled := ReleaseRevision > Mainform.AppVerRevision; + LinkLabelRelease.Enabled := groupRelease.Enabled; + LinkLabelRelease.Font.Style := LinkLabelRelease.Font.Style + [fsUnderline]; + memoRelease.Enabled := groupRelease.Enabled; + if not memoRelease.Enabled then + memoRelease.Font.Color := GetThemeColor(cl3DDkShadow) + else + memoRelease.Font.Color := GetThemeColor(clWindowText); + end; + + // Read [Build] section of check file + if Ini.SectionExists(INISECT_BUILD) then begin + BuildRevision := Ini.ReadInteger(INISECT_BUILD, 'Revision', 0); + BuildURL := Ini.ReadString(INISECT_BUILD, 'URL', ''); + memoBuild.Lines.Add(f_('Revision %d (yours: %d)', [BuildRevision, Mainform.AppVerRevision])); + FileAge(ParamStr(0), Compiled); + memoBuild.Lines.Add(f_('Compiled: %s (yours: %s)', [Ini.ReadString(INISECT_BUILD, 'Date', ''), DateToStr(Compiled)])); + Note := Ini.ReadString(INISECT_BUILD, 'Note', ''); + if Note <> '' then + memoBuild.Lines.Add(_('Notes') + ': * ' + StringReplace(Note, '%||%', CRLF+'* ', [rfReplaceAll] ) ); + if GetExecutableBits = 64 then begin + btnBuild.Caption := f_('Download and install build %d', [BuildRevision]); + // A new release should have priority over a new nightly build. + // So the user should not be able to download a newer build here + // before having installed the new release. + //btnBuild.Enabled := (Mainform.AppVerRevision = 0) or ((BuildRevision > Mainform.AppVerRevision) and (not LinkLabelRelease.Enabled)); + end + else begin + btnBuild.Caption := _('No build updates for 32 bit version'); + end; + + if btnBuild.Enabled then begin + TaskXmlFile := GetTempDir + APPNAME + '_task_restart.xml'; + SaveUnicodeFile(TaskXmlFile, GetTaskXmlFileContents, UTF8NoBOMEncoding); + FRestartTaskName := ValidFilename(ParamStr(0)); + ShellExec('schtasks', '', '/Create /TN "'+FRestartTaskName+'" /xml '+TaskXmlFile, True); + end; + + end; + + if FileExists(CheckFilename) then + DeleteFile(CheckFilename); + FreeAndNil(CheckfileDownload); +end; + + +{** + Download release package via web browser +} +procedure TfrmUpdateCheck.LinkLabelReleaseLinkClick(Sender: TObject); +begin + ShellExec(GetLinkUrl(LinkLabelRelease, SLinkDownloadRelease)); +end; + + +procedure TfrmUpdateCheck.btnChangelogClick(Sender: TObject); +begin + ShellExec(GetLinkUrl(Sender, SLinkChangelog)); +end; + + +procedure TfrmUpdateCheck.CopydownloadURL1Click(Sender: TObject); +begin + Clipboard.TryAsText := GetLinkUrl(LinkLabelRelease, SLinkDownloadRelease); +end; + +procedure TfrmUpdateCheck.btnBuildClick(Sender: TObject); +begin + // No auto-update +end; + +procedure TfrmUpdateCheck.FormDestroy(Sender: TObject); +begin + AppSettings.WriteInt(asUpdateCheckWindowWidth, ScaleFormToDesign(Width)); + AppSettings.WriteInt(asUpdateCheckWindowHeight, ScaleFormToDesign(Height)); +end; + + +function TfrmUpdateCheck.GetLinkUrl(Sender: TObject; LinkType: String): String; +var + DownloadParam, PlaceParam, OsParam: String; +begin + PlaceParam := 'place='+EncodeURLParam(TWinControl(Sender).Name); + OsParam := 'os='+EncodeURLParam(GetOS.ToLower); + + if LinkType = SLinkDownloadRelease then begin + if AppSettings.PortableMode then begin + if GetExecutableBits = 64 then + DownloadParam := 'download=portable-64' + else + DownloadParam := 'download=portable'; + end else begin + DownloadParam := 'download=installer'; + end; + Result := 'download.php?'+DownloadParam+'&'+PlaceParam+'&'+OsParam; + end + + else if LinkType = SLinkChangelog then + Result := 'changes-lazarus' + + else + Result := ''; + + Result := APPDOMAIN + Result; +end; + + +function TfrmUpdateCheck.GetTaskXmlFileContents: String; +begin + Result := '' + sLineBreak + + '' + sLineBreak + + ' ' + sLineBreak + + ' 2022-12-24T12:39:17.5068755' + sLineBreak + + ' ' + APPNAME + ' ' + MainForm.AppVersion + '' + sLineBreak + + ' \' + APPNAME + '_restart' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' 2022-12-24T12:42:36' + sLineBreak + + ' true' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + // Note: no with the current users SID + ' InteractiveToken' + sLineBreak + + ' LeastPrivilege' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' IgnoreNew' + sLineBreak + + ' true' + sLineBreak + + ' true' + sLineBreak + + ' true' + sLineBreak + + ' false' + sLineBreak + + ' false' + sLineBreak + + ' ' + sLineBreak + + ' true' + sLineBreak + + ' false' + sLineBreak + + ' ' + sLineBreak + + ' true' + sLineBreak + + ' true' + sLineBreak + + ' false' + sLineBreak + + ' false' + sLineBreak + + ' false' + sLineBreak + + ' PT72H' + sLineBreak + + ' 7' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ' "' + ParamStr(0) + '"' + sLineBreak + + ' --runfrom=scheduler' + sLineBreak + + ' ' + sLineBreak + + ' ' + sLineBreak + + ''; +end; + + +procedure DeleteRestartTask; +begin + // TN = Task Name + // F = Force, suppress prompt + ShellExec('schtasks', '', '/Delete /TN "'+ValidFilename(ParamStr(0))+'" /F', True); +end; + +end.