From 68aaa451a88a5471e4faa361c42d22ba0717d3c0 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Tue, 4 Mar 2025 19:52:01 +0100 Subject: [PATCH] Issue #1482: add data sorting dialog --- heidisql.lpi | 11 + heidisql.lpr | 2 +- source/data_sorting.lfm | 76 ++++ source/data_sorting.pas | 342 +++++++++++++++++ source/extra_controls.pas | 790 ++++++++++++++++++++++++++++++++++++++ source/loginform.lfm | 89 +++-- source/loginform.pas | 1 - source/main.lfm | 54 ++- source/main.pas | 5 +- 9 files changed, 1289 insertions(+), 81 deletions(-) create mode 100644 source/data_sorting.lfm create mode 100644 source/data_sorting.pas create mode 100644 source/extra_controls.pas diff --git a/heidisql.lpi b/heidisql.lpi index 40d02129..a80f80c5 100644 --- a/heidisql.lpi +++ b/heidisql.lpi @@ -126,6 +126,17 @@ + + + + + + + + + + + diff --git a/heidisql.lpr b/heidisql.lpr index 092248b0..fe05c334 100644 --- a/heidisql.lpr +++ b/heidisql.lpr @@ -16,7 +16,7 @@ uses main, apphelpers, dbconnection, { gnugettext,} dbstructures, dbstructures.mysql, About, generic_types, dbstructures.interbase, dbstructures.mssql, dbstructures.postgresql, - dbstructures.sqlite, change_password, loginform {, printlist (EnablePrint not defined) } + dbstructures.sqlite, change_password, loginform, data_sorting, extra_controls {, printlist (EnablePrint not defined) } ; {$R *.res} diff --git a/source/data_sorting.lfm b/source/data_sorting.lfm new file mode 100644 index 00000000..f57d202c --- /dev/null +++ b/source/data_sorting.lfm @@ -0,0 +1,76 @@ +object frmDataSorting: TfrmDataSorting + Left = 0 + Height = 121 + Top = 0 + Width = 255 + BorderStyle = bsNone + Caption = 'DataSortingForm' + ClientHeight = 121 + ClientWidth = 255 + Color = clBtnFace + DesignTimePPI = 120 + Font.Color = clWindowText + Font.Height = -15 + Font.Name = 'Tahoma' + OnClose = FormClose + OnCreate = FormCreate + OnDeactivate = FormDeactivate + LCLVersion = '3.8.0.0' + object pnlBevel: TPanel + Left = 0 + Height = 97 + Top = 0 + Width = 204 + Align = alClient + BorderWidth = 3 + ClientHeight = 97 + ClientWidth = 204 + ParentBackground = False + TabOrder = 0 + object btnOK: TButton + Left = 4 + Height = 31 + Top = 61 + Width = 75 + Anchors = [akLeft, akBottom] + Caption = 'OK' + Default = True + Enabled = False + ModalResult = 1 + TabOrder = 0 + OnClick = btnOKClick + end + object btnCancel: TButton + Left = 85 + Height = 31 + Top = 61 + Width = 75 + Anchors = [akLeft, akBottom] + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + OnClick = btnCancelClick + end + object btnAddCol: TButton + Left = 168 + Height = 31 + Top = 61 + Width = 75 + Anchors = [akLeft, akBottom] + Caption = 'Add Col' + TabOrder = 2 + OnClick = btnAddColClick + end + object btnReset: TSpeedButton + Left = 36 + Height = 31 + Top = 25 + Width = 156 + Action = MainForm.actDataResetSorting + Anchors = [akRight, akBottom] + Images = MainForm.ImageListIcons8 + ImageIndex = 139 + end + end +end diff --git a/source/data_sorting.pas b/source/data_sorting.pas new file mode 100644 index 00000000..508141ee --- /dev/null +++ b/source/data_sorting.pas @@ -0,0 +1,342 @@ +unit data_sorting; + +interface + +uses + Windows, SysUtils, Classes, Controls, Forms, StdCtrls, ExtCtrls, ComCtrls, Buttons, + Graphics, apphelpers, extra_controls, dbconnection; + + +type + TfrmDataSorting = class(TExtForm) + pnlBevel: TPanel; + btnOK: TButton; + btnCancel: TButton; + btnAddCol: TButton; + btnReset: TSpeedButton; + procedure btnAddColClick(Sender: TObject); + procedure btnCancelClick(Sender: TObject); + procedure btnOKClick(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormDeactivate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure DisplaySortingControls(Sender: TObject); + private + { Private declarations } + FColumnNames: TStringList; + FSortItems: TSortItems; + FOldOrderClause: String; + FDeleteTimer: TTimer; + FDeleteButtonPressed: TSpeedButton; + procedure DeleteTimerTimer(Sender: TObject); + procedure comboColumnsChange(Sender: TObject); + procedure btnOrderClick(Sender: TObject); + procedure btnDeleteClick(Sender: TObject); + procedure Modified; + public + { Public declarations } + end; + + + +implementation + +uses main; + +{$R *.lfm} + + +procedure TfrmDataSorting.FormCreate(Sender: TObject); +var + i: Integer; +begin + FColumnNames := TStringList.Create; + // Take column names from listColumns and add here + for i:=0 to Mainform.SelectedTableColumns.Count-1 do begin + FColumnNames.Add(Mainform.SelectedTableColumns[i].Name); + end; + + FSortItems := TSortItems.Create(True); + FSortItems.Assign(MainForm.DataGridSortItems); + FOldOrderClause := FSortItems.ComposeOrderClause(MainForm.ActiveConnection); + + FDeleteTimer := TTimer.Create(Self); + FDeleteTimer.Interval := 100; + FDeleteTimer.Enabled := False; + FDeleteTimer.OnTimer := DeleteTimerTimer; + + // First creation of controls + DisplaySortingControls(Sender); +end; + + +{** + Create controls for order columns +} +procedure TfrmDataSorting.DisplaySortingControls(Sender: TObject); +var + SortItem: TSortItem; + lblNumber: TLabel; + btnDelete: TSpeedButton; + comboColumns: TComboBox; + btnOrder: TSpeedButton; + i, TopPos, + Width1, Width2, Width3, Width4, // Width of controls per row + Margin, // Space between controls + MarginBig: Integer; // Space above the very first and last controls, used to separate stuff +begin + // Remove previously created components, which all have a tag > 0 + for i := ComponentCount - 1 downto 0 do begin + if Components[i].Tag > 0 then + Components[i].Free; + end; + + Margin := ScaleSize(3); + MarginBig := ScaleSize(Margin * 2); + Width1 := ScaleSize(15); + Width2 := ScaleSize(160); + Width3 := ScaleSize(23); + Width4 := ScaleSize(23); + + // Set initial width to avoid resizing form to 0 + TopPos := pnlBevel.BorderWidth + MarginBig; + + // Create line with controls for each order column + // TODO: disable repaint on every created control. Sending WM_SETREDRAW=0 message creates artefacts. + LockWindowUpdate(pnlBevel.Handle); + for i:=0 to FSortItems.Count-1 do begin + SortItem := FSortItems[i]; + // 1. Label with number + lblNumber := TLabel.Create(self); + lblNumber.Parent := pnlBevel; + lblNumber.AutoSize := False; // Avoids automatic changes to width + height + lblNumber.Left := pnlBevel.BorderWidth + MarginBig; + lblNumber.Top := TopPos; + lblNumber.Width := Width1; + lblNumber.Alignment := taRightJustify; + lblNumber.Layout := tlCenter; + lblNumber.Caption := IntToStr(i+1) + '.'; + lblNumber.Tag := i+1; + + // 2. Dropdown with column names + comboColumns := TComboBox.Create(self); + comboColumns.Parent := pnlBevel; + comboColumns.Width := Width2; + comboColumns.Left := lblNumber.Left + lblNumber.Width + Margin; + comboColumns.Top := TopPos; + comboColumns.Items.Text := FColumnNames.Text; + comboColumns.Style := csDropDownList; // Not editable + comboColumns.ItemIndex := FColumnNames.IndexOf(SortItem.Column); + comboColumns.Tag := i+1; + comboColumns.OnChange := comboColumnsChange; + lblNumber.Height := comboColumns.Height; + + // 3. A button for selecting ASC/DESC + btnOrder := TSpeedButton.Create(self); + btnOrder.Parent := pnlBevel; + btnOrder.Width := Width3; + btnOrder.Height := comboColumns.Height; + btnOrder.Left := comboColumns.Left + comboColumns.Width + Margin; + btnOrder.Top := TopPos; + btnOrder.AllowAllUp := True; // Enables Down = False + btnOrder.GroupIndex := i+1; // if > 0 enables Down = True + btnOrder.Glyph.Transparent := True; + //btnOrder.Glyph.AlphaFormat := afDefined; + if SortItem.Order = sioDescending then begin + MainForm.VirtualImageListMain.GetBitmap(110, btnOrder.Glyph); + btnOrder.Down := True; + end else begin + MainForm.VirtualImageListMain.GetBitmap(109, btnOrder.Glyph); + end; + btnOrder.Hint := _('Toggle the sort direction for this column.'); + btnOrder.Tag := i+1; + btnOrder.OnClick := btnOrderClick; + + // 4. Button for deleting + btnDelete := TSpeedButton.Create(self); + btnDelete.Parent := pnlBevel; + btnDelete.Width := Width4; + btnDelete.Height := comboColumns.Height; + btnDelete.Left := btnOrder.Left + btnOrder.Width + Margin; + btnDelete.Top := TopPos; + btnDelete.Images := MainForm.VirtualImageListMain; + btnDelete.ImageIndex := 26; + btnDelete.Hint := _('Drops sorting by this column.'); + btnDelete.Tag := i+1; + btnDelete.OnClick := btnDeleteClick; + + TopPos := comboColumns.Top + comboColumns.Height + Margin; + end; + LockWindowUpdate(0); + + Inc(TopPos, MarginBig); + + // Auto-adjust size of form + Height := TopPos + + btnReset.Height + Margin + + btnOK.Height + MarginBig + + pnlBevel.BorderWidth; + Width := pnlBevel.BorderWidth + + MarginBig + Width1 + + Margin + Width2 + + Margin + Width3 + + Margin + Width4 + + MarginBig + pnlBevel.BorderWidth; + + // Auto-adjust width and position of main buttons at bottom + btnReset.Left := pnlBevel.BorderWidth + MarginBig; + btnReset.Top := TopPos; + btnReset.Width := Width - 2 * pnlBevel.BorderWidth - 2 * MarginBig; + btnReset.Enabled := Mainform.actDataResetSorting.Enabled; + + btnOK.Left := pnlBevel.BorderWidth + MarginBig; + btnOK.Top := btnReset.Top + btnReset.Height + Margin; + btnOK.Width := Round(btnReset.Width / 3) - Margin; + + btnCancel.Left := btnOK.Left + btnOK.Width + Margin; + btnCancel.Top := btnReset.Top + btnReset.Height + Margin; + btnCancel.Width := btnOK.Width; + + btnAddCol.Left := btnCancel.Left + btnCancel.Width + Margin; + btnAddCol.Top := btnReset.Top + btnReset.Height + Margin; + btnAddCol.Width := btnOK.Width; +end; + + +{** + Dropdown for column selection was changed +} +procedure TfrmDataSorting.comboColumnsChange( Sender: TObject ); +var + combo : TComboBox; +begin + combo := Sender as TComboBox; + FSortItems[combo.Tag-1].Column := combo.Text; + + // Enables OK button + Modified; +end; + + +{** + Button for selecting sort-direction was clicked +} +procedure TfrmDataSorting.btnOrderClick( Sender: TObject ); +var + btn: TSpeedButton; +begin + btn := Sender as TSpeedButton; + btn.Glyph := nil; + if FSortItems[btn.Tag-1].Order = sioAscending then begin + MainForm.VirtualImageListMain.GetBitmap(110, btn.Glyph); + FSortItems[btn.Tag-1].Order := sioDescending; + end else begin + MainForm.VirtualImageListMain.GetBitmap(109, btn.Glyph); + FSortItems[btn.Tag-1].Order := sioAscending; + end; + + // Enables OK button + Modified; +end; + + +{** + Delete order column +} +procedure TfrmDataSorting.btnDeleteClick(Sender: TObject); +begin + FDeleteButtonPressed := Sender as TSpeedButton; + FDeleteTimer.Enabled := True; +end; + + +procedure TfrmDataSorting.DeleteTimerTimer(Sender: TObject); +begin + FDeleteTimer.Enabled := False; + FSortItems.Delete(FDeleteButtonPressed.Tag-1); + // Refresh controls + DisplaySortingControls(Self); + // Enables OK button + Modified; +end; + + +{** + Add a new order column +} +procedure TfrmDataSorting.btnAddColClick(Sender: TObject); +var + UnusedColumns: TStringList; + NewSortItem, SortItem: TSortItem; +begin + NewSortItem := FSortItems.AddNew; + + // Take first unused column as default for new sort item + UnusedColumns := TStringList.Create; + UnusedColumns.AddStrings(FColumnNames); + for SortItem in FSortItems do begin + if UnusedColumns.IndexOf(SortItem.Column) > -1 then + UnusedColumns.Delete(UnusedColumns.IndexOf(SortItem.Column)); + end; + if UnusedColumns.Count > 0 then + NewSortItem.Column := UnusedColumns[0] + else + NewSortItem.Column := FColumnNames[0]; + MainForm.LogSQL('Created sorting for column '+NewSortItem.Column+'/'+Integer(NewSortItem.Order).ToString+' in TfrmDataSorting.btnAddColClick', lcDebug); + + // Refresh controls + DisplaySortingControls(Sender); + + // Enables OK button + Modified; +end; + + +{** + Gets called when any option has changed. + Enables the OK button if ORDER options have changed +} +procedure TfrmDataSorting.Modified; +begin + btnOk.Enabled := FSortItems.ComposeOrderClause(MainForm.ActiveConnection) <> FOldOrderClause; +end; + + +{** + OK clicked: Write ORDER clause to registry +} +procedure TfrmDataSorting.btnOKClick(Sender: TObject); +begin + // TODO: apply ordering + MainForm.DataGridSortItems.Assign(FSortItems); + InvalidateVT(Mainform.DataGrid, VTREE_NOTLOADED_PURGECACHE, False); + btnCancel.OnClick(Sender); +end; + + +procedure TfrmDataSorting.btnCancelClick(Sender: TObject); +begin + Mainform.tbtnDataSorting.Down := False; + Close; +end; + + +{** + Be sure the form is destroyed after closing. +} +procedure TfrmDataSorting.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Action := caFree; +end; + + +{** + Cancel this dialog if the user clicks elsewhere on mainform +} +procedure TfrmDataSorting.FormDeactivate(Sender: TObject); +begin + btnCancel.OnClick(Sender); +end; + + +end. diff --git a/source/extra_controls.pas b/source/extra_controls.pas new file mode 100644 index 00000000..54ae0c14 --- /dev/null +++ b/source/extra_controls.pas @@ -0,0 +1,790 @@ +unit extra_controls; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Types, StdCtrls, Clipbrd, + apphelpers, Graphics, Dialogs, ImgList, ComCtrls, + ExtCtrls, laz.VirtualTrees, RegExpr, Controls, EditBtn, + GraphUtil; + +type + // Form with a sizegrip in the lower right corner, without the need for a statusbar + TExtForm = class(TForm) + private + //FSizeGrip: TSizeGripXP; + FPixelsPerInchDesigned: Integer; + //function GetHasSizeGrip: Boolean; + //procedure SetHasSizeGrip(Value: Boolean); + protected + //procedure DoShow; override; + //procedure DoBeforeMonitorDpiChanged(OldDPI, NewDPI: Integer); override; + //procedure DoAfterMonitorDpiChanged(OldDPI, NewDPI: Integer); override; + procedure FilterNodesByEdit(Edit: TEditButton; Tree: TVirtualStringTree); + public + constructor Create(AOwner: TComponent); override; + class procedure InheritFont(AFont: TFont); + //property HasSizeGrip: Boolean read GetHasSizeGrip write SetHasSizeGrip default False; + //class procedure FixControls(ParentComp: TComponent); + class procedure SaveListSetup(List: TVirtualStringTree); + class procedure RestoreListSetup(List: TVirtualStringTree); + function ScaleSize(x: Extended): Integer; overload; + class function ScaleSize(x: Extended; Control: TControl): Integer; overload; + class procedure PageControlTabHighlight(PageControl: TPageControl); + property PixelsPerInchDesigned: Integer read FPixelsPerInchDesigned; + end; + + // Modern file-open-dialog with high DPI support and encoding selector + {TExtFileOpenDialog = class(TFileOpenDialog) + private + FEncodings: TStringList; + FEncodingIndex: Cardinal; + const idEncodingCombo = 1; + procedure FileOkClickNoOp(Sender: TObject; var CanClose: Boolean); + protected + procedure DoOnExecute; override; + function DoOnFileOkClick: Boolean; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AddFileType(FileMask, DisplayName: String); + property Encodings: TStringList read FEncodings write FEncodings; + property EncodingIndex: Cardinal read FEncodingIndex write FEncodingIndex; + end;} + + {TExtFileSaveDialog = class(TFileSaveDialog) + private + FLineBreaks: TStringList; + FLineBreakIndex: TLineBreaks; + const idLineBreakCombo = 1; + procedure FileOkClickNoOp(Sender: TObject; var CanClose: Boolean); + protected + procedure DoOnExecute; override; + function DoOnFileOkClick: Boolean; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AddFileType(FileMask, DisplayName: String); + property LineBreaks: TStringList read FLineBreaks; + property LineBreakIndex: TLineBreaks read FLineBreakIndex write FLineBreakIndex; + end;} + + {TExtSynHotKey = class(TSynHotKey) + private + FOnChange: TNotifyEvent; + FOnEnter: TNotifyEvent; + FOnExit: TNotifyEvent; + procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS; + procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS; + protected + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure Paint; override; + published + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; + property OnExit: TNotifyEvent read FOnExit write FOnExit; + end;} + + {TExtComboBox = class(TComboBox) + private + FcbHintIndex: Integer; + FHintWindow: THintWindow; + protected + procedure Change; override; + procedure DropDown; override; + procedure CloseUp; override; + procedure InitiateAction; override; + end;} + + {TExtHintWindow = class(THintWindow) + private + const Padding: Integer = 8; + protected + procedure Paint; override; + public + function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: TCustomData): TRect; override; + end;} + + +implementation + + +{ TExtForm } + +constructor TExtForm.Create(AOwner: TComponent); +var + OldImageList: TCustomImageList; +begin + inherited; + + FPixelsPerInchDesigned := DesignTimePPI; + InheritFont(Font); + //HasSizeGrip := False; + + // Reduce flicker on Windows 10 + // See https://www.heidisql.com/forum.php?t=19141 + //if CheckWin32Version(6, 2) then begin + // DoubleBuffered := True; + //end; + + // Translation and related fixes + // Issue #557: Apply images *after* translating main menu, so top items don't get unused + // space left besides them. + if (Menu <> nil) and (Menu.Images <> nil) then begin + OldImageList := Menu.Images; + Menu.Images := nil; + //TranslateComponent(Self); + Menu.Images := OldImageList; + end else begin + //TranslateComponent(Self); + end; + +end; + + +{procedure TExtForm.DoShow; +begin + // No need to fix anything + FixControls(Self); + inherited; +end;} + + +{procedure TExtForm.DoBeforeMonitorDpiChanged(OldDPI, NewDPI: Integer); +begin + // Reduce flicker + inherited; + LockWindowUpdate(Handle); +end;} + +{procedure TExtForm.DoAfterMonitorDpiChanged(OldDPI, NewDPI: Integer); +begin + // Release window updates + LockWindowUpdate(0); + inherited; +end;} + + +{class procedure TExtForm.FixControls(ParentComp: TComponent); +var + i: Integer; + + procedure ProcessSingleComponent(Cmp: TComponent); + begin + if (Cmp is TButton) and (TButton(Cmp).Style = bsSplitButton) then begin + // Work around broken dropdown (tool)button on Wine after translation: + // https://sourceforge.net/p/dxgettext/bugs/80/ + TButton(Cmp).Style := bsPushButton; + TButton(Cmp).Style := bsSplitButton; + end; + if (Cmp is TToolButton) and (TToolButton(Cmp).Style = tbsDropDown) then begin + // similar fix as above + TToolButton(Cmp).Style := tbsButton; + TToolButton(Cmp).Style := tbsDropDown; + end; + end; +begin + // Passed component itself may also be some control to be fixed + // e.g. TInplaceEditorLink.MainControl + ProcessSingleComponent(ParentComp); + for i:=0 to ParentComp.ComponentCount-1 do begin + ProcessSingleComponent(ParentComp.Components[i]); + end; +end;} + + +{function TExtForm.GetHasSizeGrip: Boolean; +begin + Result := FSizeGrip <> nil; +end;} + + +{procedure TExtForm.SetHasSizeGrip(Value: Boolean); +begin + if Value then begin + FSizeGrip := TSizeGripXP.Create(Self); + FSizeGrip.Enabled := True; + end else begin + if FSizeGrip <> nil then + FreeAndNil(FSizeGrip); + end; +end;} + + +class procedure TExtForm.InheritFont(AFont: TFont); +var + GUIFontName: String; +begin + // Set custom font if set, or default system font. + // In high-dpi mode, the font *size* is increased automatically somewhere in the VCL, + // caused by a form's .Scaled property. So we don't increase it here again. + // To test this, you really need to log off/on Windows! + GUIFontName := AppSettings.ReadString(asGUIFontName); + if not GUIFontName.IsEmpty then begin + // Apply user specified font + AFont.Name := GUIFontName; + // Set size on top of automatic dpi-increased size + AFont.Size := AppSettings.ReadInt(asGUIFontSize); + end else begin + // Apply system font. See issue #3204. + AFont.Orientation := Screen.SystemFont.Orientation; + AFont.CharSet := Screen.SystemFont.CharSet; + AFont.Name := Screen.SystemFont.Name; + AFont.Pitch := Screen.SystemFont.Pitch; + end; +end; + + +{** + Save setup of a VirtualStringTree to registry +} +class procedure TExtForm.SaveListSetup( List: TVirtualStringTree ); +var + i: Integer; + ColWidth: Int64; + ColWidths, ColsVisible, ColPos, Regname: String; + OwnerForm: TWinControl; +begin + // Prevent sporadic crash on startup + if List = nil then + Exit; + OwnerForm := GetParentFormOrFrame(List); + // On a windows shutdown, GetParentForm() seems sporadically unable to find the owner form + // In that case we would cause an exception when accessing it. Emergency break in that case. + // See issue #1462 + // TODO: Test this, probably fixed by implementing GetParentFormOrFrame, and then again, probably not. + if not Assigned(OwnerForm) then + Exit; + + ColWidths := ''; + ColsVisible := ''; + ColPos := ''; + + for i := 0 to List.Header.Columns.Count - 1 do + begin + // Column widths + if ColWidths <> '' then + ColWidths := ColWidths + ','; + ColWidth := List.Header.Columns[i].Width; // RoundCommercial(List.Header.Columns[i].Width / OwnerForm.ScaleFactor); + ColWidths := ColWidths + IntToStr(ColWidth); + + // Column visibility + if coVisible in List.Header.Columns[i].Options then + begin + if ColsVisible <> '' then + ColsVisible := ColsVisible + ','; + ColsVisible := ColsVisible + IntToStr(i); + end; + + // Column position + if ColPos <> '' then + ColPos := ColPos + ','; + ColPos := ColPos + IntToStr(List.Header.Columns[i].Position); + + end; + + // Lists can have the same name over different forms or frames. Find parent form or frame, + // so we can prepend its name into the registry value name. + Regname := OwnerForm.Name + '.' + List.Name; + AppSettings.ResetPath; + AppSettings.WriteString(asListColWidths, ColWidths, Regname); + AppSettings.WriteString(asListColsVisible, ColsVisible, Regname); + AppSettings.WriteString(asListColPositions, ColPos, Regname); + AppSettings.WriteString(asListColSort, IntToStr(List.Header.SortColumn) + ',' + IntToStr(Integer(List.Header.SortDirection)), RegName); +end; + + +{** + Restore setup of VirtualStringTree from registry +} +class procedure TExtForm.RestoreListSetup( List: TVirtualStringTree ); +var + i : Byte; + colpos : Integer; + ColWidth: Int64; + Value : String; + ValueList : TStringList; + Regname: String; + OwnerForm: TWinControl; +begin + ValueList := TStringList.Create; + + // Column widths + OwnerForm := GetParentFormOrFrame(List); + Regname := OwnerForm.Name + '.' + List.Name; + Value := AppSettings.ReadString(asListColWidths, Regname); + if Value <> '' then begin + ValueList := Explode( ',', Value ); + for i := 0 to ValueList.Count - 1 do + begin + ColWidth := MakeInt(ValueList[i]); + //ColWidth := RoundCommercial(ColWidth * OwnerForm.ScaleFactor); + // Check if column number exists and width is at least 1 pixel + if (List.Header.Columns.Count > i) and (ColWidth > 0) and (ColWidth < 1000) then + List.Header.Columns[i].Width := ColWidth; + end; + end; + + // Column visibility + Value := AppSettings.ReadString(asListColsVisible, Regname); + if Value <> '' then begin + ValueList := Explode( ',', Value ); + for i:=0 to List.Header.Columns.Count-1 do begin + if ValueList.IndexOf( IntToStr(i) ) > -1 then + List.Header.Columns[i].Options := List.Header.Columns[i].Options + [coVisible] + else + List.Header.Columns[i].Options := List.Header.Columns[i].Options - [coVisible]; + end; + end; + + // Column position + Value := AppSettings.ReadString(asListColPositions, Regname); + if Value <> '' then begin + ValueList := Explode( ',', Value ); + for i := 0 to ValueList.Count - 1 do + begin + colpos := MakeInt(ValueList[i]); + // Check if column number exists + if List.Header.Columns.Count > i then + List.Header.Columns[i].Position := colpos; + end; + end; + + // Sort column and direction + Value := AppSettings.ReadString(asListColSort, Regname); + if Value <> '' then begin + ValueList := Explode(',', Value); + if ValueList.Count = 2 then begin + List.Header.SortColumn := MakeInt(ValueList[0]); + if MakeInt(ValueList[1]) = 0 then + List.Header.SortDirection := sdAscending + else + List.Header.SortDirection := sdDescending; + end; + end; + + ValueList.Free; +end; + + +procedure TExtForm.FilterNodesByEdit(Edit: TEditButton; Tree: TVirtualStringTree); +var + rx: TRegExpr; + Node: PVirtualNode; + i: Integer; + match: Boolean; + CellText: String; +begin + // Loop through all tree nodes and hide non matching + Node := Tree.GetFirst; + rx := TRegExpr.Create; + rx.ModifierI := True; + rx.Expression := Edit.Text; + try + rx.Exec('abc'); + except + on E:ERegExpr do begin + if rx.Expression <> '' then begin + //LogSQL('Filter text is not a valid regular expression: "'+rx.Expression+'"', lcError); + rx.Expression := ''; + end; + end; + end; + + Tree.BeginUpdate; + while Assigned(Node) do begin + if not Tree.HasChildren[Node] then begin + // Don't filter anything if the filter text is empty + match := rx.Expression = ''; + // Search for given text in node's captions + if not match then for i := 0 to Tree.Header.Columns.Count - 1 do begin + CellText := Tree.Text[Node, i]; + match := rx.Exec(CellText); + if match then + break; + end; + Tree.IsVisible[Node] := match; + if match and IsNotEmpty(Edit.Text) then + Tree.VisiblePath[Node] := True; + end; + Node := Tree.GetNext(Node); + end; + Tree.EndUpdate; + Tree.Invalidate; + rx.Free; + + Edit.Button.Visible := IsNotEmpty(Edit.Text); +end; + + +function TExtForm.ScaleSize(x: Extended): Integer; +begin + // Shorthand for dpi scaling hardcoded width/height values of controls + Result := ScaleSize(x, Self); +end; + +class function TExtForm.ScaleSize(x: Extended; Control: TControl): Integer; +begin + // Same as above for callers without a form + Result := Control.Scale96ToForm(Round(x)); +end; + + +class procedure TExtForm.PageControlTabHighlight(PageControl: TPageControl); +var + i, CurrentImage, CountOriginals: Integer; + Images: TImageList; + GrayscaleMode: Integer; + IsQueryTab, DoGrayscale: Boolean; +begin + // Set grayscale icon on inactive tabs + if not (PageControl.Images is TImageList) then + Exit; + GrayscaleMode := AppSettings.ReadInt(asTabIconsGrayscaleMode); + + Images := PageControl.Images as TImageList; + CountOriginals := Images.Count; + + for i:=0 to PageControl.PageCount-1 do begin + CurrentImage := PageControl.Pages[i].ImageIndex; + if PageControl.ActivePageIndex = i then begin + if CurrentImage >= CountOriginals then begin + // Grayscaled => Color + PageControl.Pages[i].ImageIndex := CurrentImage - CountOriginals; + end; + end + else begin + if CurrentImage < CountOriginals then begin + // Color => Grayscaled + IsQueryTab := (PageControl.Owner.Name = 'MainForm') and ExecRegExpr('^tabQuery\d*$', PageControl.Pages[i].Name); + if ((GrayscaleMode = 1) and IsQueryTab) or (GrayscaleMode = 2) then + PageControl.Pages[i].ImageIndex := CurrentImage + CountOriginals; + end; + end; + end;; +end; + + +{ TExtFileOpenDialog } + +{constructor TExtFileOpenDialog.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FEncodings := TStringList.Create; + FEncodingIndex := 0; +end; + + +destructor TExtFileOpenDialog.Destroy; +begin + FEncodings.Free; + inherited; +end; + + +procedure TExtFileOpenDialog.AddFileType(FileMask, DisplayName: String); +var + FileType: TFileTypeItem; +begin + // Shorthand for callers + FileType := FileTypes.Add; + FileType.DisplayName := DisplayName; + FileType.FileMask := FileMask; +end; + + +procedure TExtFileOpenDialog.DoOnExecute; +var + iCustomize: IFileDialogCustomize; + i: Integer; +begin + // Add encodings selector + if Dialog.QueryInterface(IFileDialogCustomize, iCustomize) = S_OK then + begin + iCustomize.StartVisualGroup(0, PChar(_('Encoding:'))); + try + // note other controls available: AddCheckButton, AddEditBox, AddPushButton, AddRadioButtonList... + iCustomize.AddComboBox(idEncodingCombo); + for i:=0 to FEncodings.Count - 1 do begin + iCustomize.AddControlItem(idEncodingCombo, i, PChar(FEncodings[i])); + end; + iCustomize.SetSelectedControlItem(idEncodingCombo, FEncodingIndex); + if not Assigned(OnFileOkClick) then + OnFileOkClick := FileOkClickNoOp; + finally + iCustomize.EndVisualGroup; + end; + end; +end; + + +procedure TExtFileOpenDialog.FileOkClickNoOp(Sender: TObject; var CanClose: Boolean); +begin + // Dummy procedure, just makes sure parent class calls DoOnFileOkClick +end; + + +function TExtFileOpenDialog.DoOnFileOkClick: Boolean; +var + iCustomize: IFileDialogCustomize; +begin + Result := inherited; + if Dialog.QueryInterface(IFileDialogCustomize, iCustomize) = S_OK then + begin + iCustomize.GetSelectedControlItem(idEncodingCombo, FEncodingIndex); + end; +end;} + + + +{ TExtFileSaveDialog } + +{constructor TExtFileSaveDialog.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FLineBreaks := TStringList.Create; + FLineBreaks.Add(_('Windows linebreaks')); + FLineBreaks.Add(_('UNIX linebreaks')); + FLineBreaks.Add(_('Mac OS linebreaks')); + FLineBreakIndex := lbsWindows; +end; + + +destructor TExtFileSaveDialog.Destroy; +begin + FLineBreaks.Free; + inherited; +end; + + +procedure TExtFileSaveDialog.AddFileType(FileMask, DisplayName: String); +var + FileType: TFileTypeItem; +begin + // Shorthand for callers + FileType := FileTypes.Add; + FileType.DisplayName := DisplayName; + FileType.FileMask := FileMask; +end; + + +procedure TExtFileSaveDialog.DoOnExecute; +var + iCustomize: IFileDialogCustomize; + i, ComboIndex: Integer; +begin + // Add line break selector + if Dialog.QueryInterface(IFileDialogCustomize, iCustomize) = S_OK then + begin + iCustomize.StartVisualGroup(0, PChar(_('Linebreaks')+':')); + try + iCustomize.AddComboBox(idLineBreakCombo); + case FLineBreakIndex of + lbsUnix: ComboIndex := 1; + lbsMac: ComboIndex := 2; + else ComboIndex := 0; + end; + for i:=0 to FLineBreaks.Count - 1 do begin + iCustomize.AddControlItem(idLineBreakCombo, i, PChar(FLineBreaks[i])); + end; + iCustomize.SetSelectedControlItem(idLineBreakCombo, ComboIndex); + if not Assigned(OnFileOkClick) then + OnFileOkClick := FileOkClickNoOp; + finally + iCustomize.EndVisualGroup; + end; + end; +end; + + +procedure TExtFileSaveDialog.FileOkClickNoOp(Sender: TObject; var CanClose: Boolean); +begin + // Dummy procedure, just makes sure parent class calls DoOnFileOkClick +end; + + +function TExtFileSaveDialog.DoOnFileOkClick: Boolean; +var + iCustomize: IFileDialogCustomize; + ComboIndex: Cardinal; +begin + Result := inherited; + if Dialog.QueryInterface(IFileDialogCustomize, iCustomize) = S_OK then + begin + iCustomize.GetSelectedControlItem(idLineBreakCombo, ComboIndex); + case ComboIndex of + 0: FLineBreakIndex := lbsWindows; + 1: FLineBreakIndex := lbsUnix; + 2: FLineBreakIndex := lbsMac; + end; + end; +end;} + + +{ TExtSynHotKey } + +{procedure TExtSynHotKey.WMKillFocus(var Msg: TWMKillFocus); +begin + inherited; + if Assigned(FOnExit) then + FOnExit(Self); +end; + +procedure TExtSynHotKey.WMSetFocus(var Msg: TWMSetFocus); +begin + inherited; + if Assigned(FOnEnter) then + FOnEnter(Self); +end; + +procedure TExtSynHotKey.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited; + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TExtSynHotKey.Paint; +var + r: TRect; +begin + r := ClientRect; + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := Color; + InflateRect(r, -BorderWidth, -BorderWidth); + Canvas.FillRect(r); + if Enabled then + Canvas.Font.Color := clWindowText + else + Canvas.Font.Color := clGrayText; + SynUnicode.TextRect(Canvas, r, BorderWidth + 1, BorderWidth + 1, Text); +end;} + + + +{ TExtComboBox } + +{procedure TExtComboBox.Change; +var + P: TPoint; + HintRect: TRect; + HintText: String; + HintWidth, Padding: Integer; +begin + inherited; + if (ItemIndex > -1) and DroppedDown and GetCursorPos(P) then begin + HintText := Items[ItemIndex]; + HintWidth := Canvas.TextWidth(HintText); + if HintWidth > Width then begin + Padding := TExtForm.ScaleSize(10, Self); + HintRect := Rect( + P.X + Padding, + P.Y + Padding * 2, + P.X + HintWidth + Padding * 3, + P.Y + Padding * 4 + ); + FHintWindow.ActivateHint(HintRect, HintText); + end; + end; +end; + +procedure TExtComboBox.CloseUp; +begin + inherited; + FHintWindow.Hide; + ControlStyle := ControlStyle - [csActionClient]; +end; + +procedure TExtComboBox.DropDown; +begin + inherited; + if not Assigned(FHintWindow) then + FHintWindow := THintWindow.Create(Self); + FcbHintIndex := -1; + ControlStyle := ControlStyle + [csActionClient]; +end; + +procedure TExtComboBox.InitiateAction; +var + Idx: Integer; +begin + inherited; + Idx := ItemIndex; + if Idx <> FcbHintIndex then + begin + FcbHintIndex := ItemIndex; + Change; + end; +end;} + + + +{ TExtHintWindow } + + +{function TExtHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: TCustomData): TRect; +begin + Result := inherited; + // Customized: enlarge surrounding rect to make space for padding + if AHint.Contains(SLineBreak) then begin + Result.Right := Result.Right + 2 * ScaleValue(Padding); + Result.Bottom := Result.Bottom + 2 * ScaleValue(Padding); + end; +end; + + +procedure TExtHintWindow.Paint; +var + R, ClipRect: TRect; + LColor: TColor; + LStyle: TCustomStyleServices; + LDetails: TThemedElementDetails; + LGradientStart, LGradientEnd, LTextColor: TColor; +begin + R := ClientRect; + LStyle := StyleServices(Screen.ActiveForm); + LTextColor := Screen.HintFont.Color; + if LStyle.Enabled then + begin + ClipRect := R; + InflateRect(R, 4, 4); + if TOSVersion.Check(6) and LStyle.IsSystemStyle then + begin + // Paint Windows gradient background + LStyle.DrawElement(Canvas.Handle, LStyle.GetElementDetails(tttStandardNormal), R, ClipRect); + end + else + begin + LDetails := LStyle.GetElementDetails(thHintNormal); + if LStyle.GetElementColor(LDetails, ecGradientColor1, LColor) and (LColor <> clNone) then + LGradientStart := LColor + else + LGradientStart := clInfoBk; + if LStyle.GetElementColor(LDetails, ecGradientColor2, LColor) and (LColor <> clNone) then + LGradientEnd := LColor + else + LGradientEnd := clInfoBk; + if LStyle.GetElementColor(LDetails, ecTextColor, LColor) and (LColor <> clNone) then + LTextColor := LColor + else + LTextColor := Screen.HintFont.Color; + GradientFillCanvas(Canvas, LGradientStart, LGradientEnd, R, gdVertical); + end; + R := ClipRect; + end; + Inc(R.Left, 2); + Inc(R.Top, 2); + // Customized: move inner rect right+down to add padding to outer edge + if String(Caption).Contains(SLineBreak) then begin + Inc(R.Left, ScaleValue(Padding)); + Inc(R.Top, ScaleValue(Padding)); + end; + Canvas.Font.Color := LTextColor; + DrawText(Canvas.Handle, Caption, -1, R, DT_LEFT or DT_NOPREFIX or + DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly); +end;} + + +end. diff --git a/source/loginform.lfm b/source/loginform.lfm index dd8fd124..a87a89ed 100644 --- a/source/loginform.lfm +++ b/source/loginform.lfm @@ -1,28 +1,25 @@ object frmLogin: TfrmLogin Left = 0 + Height = 220 Top = 0 + Width = 338 BorderStyle = bsDialog Caption = 'Login' - ClientHeight = 176 - ClientWidth = 270 + ClientHeight = 220 + ClientWidth = 338 Color = clBtnFace - Font.Charset = DEFAULT_CHARSET + DesignTimePPI = 120 Font.Color = clWindowText - Font.Height = -12 + Font.Height = -15 Font.Name = 'Tahoma' - Font.Style = [] - Position = poScreenCenter OnCreate = FormCreate OnShow = FormShow - DesignSize = ( - 270 - 176) - TextHeight = 14 + Position = poScreenCenter object btnOK: TButton - Left = 164 - Top = 143 - Width = 98 - Height = 25 + Left = 206 + Height = 31 + Top = 179 + Width = 122 Anchors = [akRight, akBottom] Caption = 'Login' Default = True @@ -31,66 +28,68 @@ object frmLogin: TfrmLogin end object pnlBackground: TPanel Left = 0 + Height = 181 Top = 0 - Width = 270 - Height = 137 + Width = 338 Align = alTop - Anchors = [akLeft, akTop, akRight, akBottom] + Anchors = [akTop, akLeft, akRight, akBottom] BevelOuter = bvNone Caption = 'pnlBackground' + ClientHeight = 181 + ClientWidth = 338 Color = clWhite ParentBackground = False - ShowCaption = False + ParentColor = False TabOrder = 0 - DesignSize = ( - 270 - 137) object lblPrompt: TLabel - Left = 38 - Top = 13 - Width = 44 - Height = 13 + Left = 48 + Height = 18 + Top = 16 + Width = 59 Caption = 'lblPrompt' end object lblUsername: TLabel - Left = 38 - Top = 44 - Width = 52 - Height = 13 + Left = 48 + Height = 18 + Top = 63 + Width = 72 Anchors = [akLeft, akBottom] Caption = '&Username:' FocusControl = editUsername end object lblPassword: TLabel - Left = 38 - Top = 90 - Width = 50 - Height = 13 + Left = 48 + Height = 18 + Top = 121 + Width = 66 Anchors = [akLeft, akBottom] Caption = '&Password:' FocusControl = editPassword end object imgIcon: TImage - Left = 10 - Top = 13 - Width = 16 - Height = 16 + Left = 12 + Height = 20 + Top = 16 + Width = 20 + ImageIndex = 144 + Images = MainForm.ImageListIcons8 end object editPassword: TEdit - Left = 38 - Top = 109 - Width = 224 - Height = 21 + Left = 48 + Height = 26 + Top = 146 + Width = 280 Anchors = [akLeft, akRight, akBottom] + EchoMode = emPassword PasswordChar = '*' TabOrder = 1 Text = 'editPassword' end object editUsername: TEdit - Left = 38 - Top = 63 - Width = 224 - Height = 21 + Left = 48 + Height = 26 + Top = 89 + Width = 280 Anchors = [akLeft, akRight, akBottom] TabOrder = 0 Text = 'editUsername' diff --git a/source/loginform.pas b/source/loginform.pas index 950dd30c..89fdb000 100644 --- a/source/loginform.pas +++ b/source/loginform.pas @@ -39,7 +39,6 @@ uses apphelpers, main; procedure TfrmLogin.FormCreate(Sender: TObject); begin Caption := APPNAME + ' - Login'; - //MainForm.VirtualImageListMain.GetBitmap(144, imgIcon.Picture.Bitmap); lblPrompt.Font.Size := 10; lblPrompt.Font.Color := GetThemeColor(clHotlight); lblPrompt.Font.Style := lblPrompt.Font.Style + [fsBold]; diff --git a/source/main.lfm b/source/main.lfm index 95113fe5..77e27342 100644 --- a/source/main.lfm +++ b/source/main.lfm @@ -962,11 +962,11 @@ object MainForm: TMainForm Height = 316 Top = 0 Width = 780 - ActivePage = tabDatabase + ActivePage = tabData Align = alClient Images = ImageListIcons8 PopupMenu = popupMainTabs - TabIndex = 1 + TabIndex = 3 TabOrder = 1 OnChange = PageControlMainChange OnChanging = PageControlMainChanging @@ -2019,8 +2019,8 @@ object MainForm: TMainForm ImageIndex = 41 object lblSorryNoData: TLabel Left = 0 - Height = 192 - Top = 91 + Height = 185 + Top = 98 Width = 772 Align = alClient Alignment = taCenter @@ -2030,19 +2030,19 @@ object MainForm: TMainForm end object pnlDataTop: TPanel Left = 0 - Height = 25 + Height = 32 Top = 0 Width = 772 Align = alTop Alignment = taLeftJustify BevelOuter = bvNone BorderWidth = 1 - ClientHeight = 25 + ClientHeight = 32 ClientWidth = 772 TabOrder = 2 object lblDataTop: TLabel Left = 1 - Height = 23 + Height = 30 Top = 1 Width = 215 Align = alLeft @@ -2053,56 +2053,48 @@ object MainForm: TMainForm PopupMenu = popupDataTop end object tlbDataButtons: TToolBar - Left = 698 - Height = 23 + Left = 392 + Height = 30 Top = 1 - Width = 73 + Width = 379 Align = alRight - AutoSize = True ButtonHeight = 28 ButtonWidth = 72 Caption = 'tlbDataButtons' + Images = ImageListIcons8 List = True ParentShowHint = False ShowCaptions = True - ShowHint = True TabOrder = 0 - Wrapable = False object tbtnDataNext: TToolButton Left = 1 Top = 2 Action = actDataShowNext end object tbtnDataShowAll: TToolButton - Left = 1 - Top = 31 + Left = 73 + Top = 2 Action = actDataShowAll end - object ToolButton2: TToolButton - Left = 1 - Top = 60 - Caption = 'ToolButton2' - ImageIndex = 108 - end object tbtnDataSorting: TToolButton - Left = 1 - Top = 89 + Left = 145 + Top = 2 AllowAllUp = True Caption = 'Sorting' ImageIndex = 107 OnClick = btnDataClick end object tbtnDataColumns: TToolButton - Left = 1 - Top = 118 + Left = 217 + Top = 2 AllowAllUp = True Caption = 'Columns' ImageIndex = 107 OnClick = btnDataClick end object tbtnDataFilter: TToolButton - Left = 1 - Top = 147 + Left = 289 + Top = 2 AllowAllUp = True Caption = 'Filter' ImageIndex = 107 @@ -2113,7 +2105,7 @@ object MainForm: TMainForm object pnlFilter: TPanel Left = 0 Height = 66 - Top = 25 + Top = 32 Width = 772 Align = alTop BevelOuter = bvNone @@ -2682,8 +2674,8 @@ object MainForm: TMainForm end object DataGrid: TLazVirtualStringTree Left = 0 - Height = 192 - Top = 91 + Height = 185 + Top = 98 Width = 772 Align = alClient DefaultText = 'Node' @@ -19849,7 +19841,7 @@ object MainForm: TMainForm Top = 120 end object SynCompletionProposal: TSynCompletion - Position = 0 + Position = -1 LinesInWindow = 6 SelectedColor = clHighlight CaseSensitive = False diff --git a/source/main.pas b/source/main.pas index 9916bfbd..1b2d15b1 100644 --- a/source/main.pas +++ b/source/main.pas @@ -508,7 +508,6 @@ type actQueryFindAgain1: TMenuItem; Replacetext1: TMenuItem; menuExplainProcess: TMenuItem; - ToolButton2: TToolButton; tbtnDataShowAll: TToolButton; tbtnDataNext: TToolButton; actDataShowNext: TAction; @@ -1412,7 +1411,7 @@ const implementation uses - FileInfo, winpeimagereader, elfreader, machoreader, About; + FileInfo, winpeimagereader, elfreader, machoreader, About, data_sorting; {$R *.lfm} @@ -8520,7 +8519,7 @@ begin if btn = tbtnDataColumns then //frm := TfrmColumnSelection.Create(self) else if btn = tbtnDataSorting then - //frm := TfrmDataSorting.Create(self) + frm := TfrmDataSorting.Create(self) else frm := TForm.Create(self); // Dummy fallback, should never get created // Position new form relative to btn's position