mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
Issue #1482: add data sorting dialog
This commit is contained in:
Ansgar Becker
11
heidisql.lpi
11
heidisql.lpi
@ -126,6 +126,17 @@
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="source\data_sorting.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmDataSorting"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="source\extra_controls.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
||||
@ -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}
|
||||
|
||||
76
source/data_sorting.lfm
Normal file
76
source/data_sorting.lfm
Normal file
@ -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
|
||||
342
source/data_sorting.pas
Normal file
342
source/data_sorting.pas
Normal file
@ -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.
|
||||
790
source/extra_controls.pas
Normal file
790
source/extra_controls.pas
Normal file
@ -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.
|
||||
@ -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'
|
||||
|
||||
@ -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];
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user