Try to fix most DPI related glitches. Especially TFrames need a ScaleBy() call, which is done automatically on TForms. Fixes issue #1656.

This commit is contained in:
Ansgar Becker
2010-02-04 23:50:47 +00:00
parent 7629b132cf
commit fc6d4c2a48
12 changed files with 146 additions and 181 deletions

View File

@ -316,3 +316,6 @@ const
SizeGripProp = 'SizeGrip';
// Forms are designed at 96 dpi. Use that to scale TFrames, which obviously do not auto-scale.
FORMS_DPI = 96;

View File

@ -223,6 +223,7 @@ type
function BinToWideHex(bin: AnsiString): String;
procedure CheckHex(text: String; errorMessage: string);
procedure FixVT(VT: TVirtualStringTree);
function GetTextHeight(Font: TFont): Integer;
function ColorAdjustBrightness(Col: TColor; Shift: SmallInt): TColor;
function ComposeOrderClause(Cols: TOrderColArray): String;
procedure OpenRegistry(Session: String = '');
@ -2515,24 +2516,12 @@ end;
procedure FixVT(VT: TVirtualStringTree);
var
ReadOnlyNodeHeight: Integer;
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
// Resize hardcoded node height to work with different DPI settings
ReadOnlyNodeHeight := VT.Canvas.TextHeight('A') + 6;
if toEditable in VT.TreeOptions.MiscOptions then begin
// Editable nodes must have enough height for a TEdit, including its cursor
// Code taken from StdCtrls.TCustomEdit.AdjustHeight
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, VT.Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
I := GetSystemMetrics(SM_CYBORDER) * 6;
VT.DefaultNodeHeight := Metrics.tmHeight + I;
VT.DefaultNodeHeight := GetTextHeight(VT.Font) + GetSystemMetrics(SM_CYBORDER) * 6;
end else
VT.DefaultNodeHeight := ReadOnlyNodeHeight;
// The header needs slightly more height than the normal nodes
@ -2551,6 +2540,23 @@ begin
end;
function GetTextHeight(Font: TFont): Integer;
var
DC: HDC;
SaveFont: HFont;
SysMetrics, Metrics: TTextMetric;
begin
// Code taken from StdCtrls.TCustomEdit.AdjustHeight
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
Result := Metrics.tmHeight;
end;
function ColorAdjustBrightness(Col: TColor; Shift: SmallInt): TColor;
var
Lightness: Byte;

View File

@ -487,7 +487,6 @@ object MainForm: TMainForm
Images = PngImageListMain
MultiLine = True
PopupMenu = popupMainTabs
TabHeight = 22
TabOrder = 1
OnChange = PageControlMainChange
OnContextPopup = PageControlMainContextPopup
@ -499,7 +498,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Width = 575
Height = 299
Height = 302
ActivePage = tabVariables
Align = alClient
HotTrack = True
@ -511,7 +510,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Width = 567
Height = 271
Height = 274
Align = alClient
DragOperations = []
Header.AutoSizeIndex = 1
@ -561,7 +560,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Width = 567
Height = 271
Height = 274
Align = alClient
DragOperations = []
Header.AutoSizeIndex = 1
@ -622,7 +621,7 @@ object MainForm: TMainForm
ImageIndex = 1
object Splitter3: TSplitter
Left = 0
Top = 198
Top = 201
Width = 567
Height = 4
Cursor = crSizeNS
@ -633,7 +632,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Width = 567
Height = 198
Height = 201
Align = alClient
Header.AutoSizeIndex = 7
Header.DefaultHeight = 17
@ -707,7 +706,7 @@ object MainForm: TMainForm
end
object pnlProcessViewBox: TPanel
Left = 0
Top = 202
Top = 205
Width = 567
Height = 69
Align = alBottom
@ -761,7 +760,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Width = 567
Height = 271
Height = 274
Align = alClient
Header.AutoSizeIndex = 4
Header.DefaultHeight = 17
@ -832,7 +831,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Width = 575
Height = 299
Height = 302
Align = alClient
EditDelay = 500
Header.AutoSizeIndex = -1
@ -992,7 +991,7 @@ object MainForm: TMainForm
Left = 0
Top = 91
Width = 575
Height = 208
Height = 211
Align = alClient
Alignment = taCenter
Caption = 'Stored routines don'#39't provide any data you could edit here.'
@ -1176,7 +1175,7 @@ object MainForm: TMainForm
Left = 0
Top = 91
Width = 575
Height = 208
Height = 211
Align = alClient
AutoScrollDelay = 50
EditDelay = 0
@ -1386,7 +1385,7 @@ object MainForm: TMainForm
Left = 0
Top = 113
Width = 575
Height = 186
Height = 189
Align = alClient
AutoScrollDelay = 50
EditDelay = 0

View File

@ -1240,6 +1240,7 @@ begin
InheritFont(Font);
InheritFont(tabsetQueryHelpers.Font);
InheritFont(SynCompletionProposal.Font);
StatusBar.Height := GetTextHeight(StatusBar.Font)+4;
// Enable auto completion in data tab, filter editor
SynCompletionProposal.AddEditor(SynMemoFilter);

View File

@ -3,12 +3,6 @@ object frmRoutineEditor: TfrmRoutineEditor
Top = 0
Width = 475
Height = 484
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
DesignSize = (
475

View File

@ -92,6 +92,7 @@ var
i: Integer;
begin
inherited;
ScaleControls(Screen.PixelsPerInch, FORMS_DPI);
// Combo items in a .dfm are sporadically lost after an IDE restart,
// so we set them here to avoid developer annoyance
comboType.Items.Add('Procedure (doesn''t return a result)');

View File

@ -3,12 +3,6 @@ object frmTableEditor: TfrmTableEditor
Top = 0
Width = 607
Height = 391
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
DesignSize = (
607
@ -68,12 +62,8 @@ object frmTableEditor: TfrmTableEditor
EditDelay = 0
Header.AutoSizeIndex = -1
Header.DefaultHeight = 17
Header.Font.Charset = DEFAULT_CHARSET
Header.Font.Color = clWindowText
Header.Font.Height = -11
Header.Font.Name = 'Tahoma'
Header.Font.Style = []
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoVisible]
Header.ParentFont = True
Images = MainForm.PngImageListMain
IncrementalSearch = isAll
PopupMenu = popupColumns
@ -379,25 +369,21 @@ object frmTableEditor: TfrmTableEditor
object tabIndexes: TTabSheet
Caption = 'Indexes'
ImageIndex = 13
DesignSize = (
593
121)
object treeIndexes: TVirtualStringTree
Left = 75
Top = 3
Width = 300
Height = 113
Anchors = [akLeft, akTop, akRight, akBottom]
AlignWithMargins = True
Left = 69
Top = 0
Width = 521
Height = 121
Margins.Top = 0
Margins.Bottom = 0
Align = alClient
DragMode = dmAutomatic
EditDelay = 0
Header.AutoSizeIndex = 0
Header.DefaultHeight = 17
Header.Font.Charset = DEFAULT_CHARSET
Header.Font.Color = clWindowText
Header.Font.Height = -11
Header.Font.Name = 'Tahoma'
Header.Font.Style = []
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
Header.ParentFont = True
Images = MainForm.PngImageListMain
PopupMenu = popupIndexes
TabOrder = 1
@ -421,7 +407,7 @@ object frmTableEditor: TfrmTableEditor
item
Options = [coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus]
Position = 0
Width = 116
Width = 341
WideText = 'Name'
end
item
@ -437,11 +423,11 @@ object frmTableEditor: TfrmTableEditor
end>
end
object tlbIndexes: TToolBar
Left = 3
Top = 3
Left = 0
Top = 0
Width = 66
Height = 110
Align = alNone
Height = 121
Align = alLeft
AutoSize = True
ButtonWidth = 66
Caption = 'tlbIndexes'
@ -494,46 +480,16 @@ object frmTableEditor: TfrmTableEditor
OnClick = btnMoveDownIndexClick
end
end
object StaticText1: TStaticText
Left = 381
Top = 25
Width = 188
Height = 66
Anchors = [akTop, akRight]
AutoSize = False
Caption =
'To add a column, drag it from the column list below into the ind' +
'ex tree.'
TabOrder = 2
end
end
object tabForeignKeys: TTabSheet
Caption = 'Foreign keys'
ImageIndex = 136
DesignSize = (
593
121)
object lblNoForeignKeys: TLabel
Left = 75
Top = 105
Width = 515
Height = 13
Anchors = [akLeft, akRight, akBottom]
AutoSize = False
Caption = 'lblNoForeignKeys'
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object tlbForeignKeys: TToolBar
Left = 3
Top = 3
Left = 0
Top = 0
Width = 66
Height = 66
Align = alNone
Height = 121
Align = alLeft
AutoSize = True
ButtonWidth = 66
Caption = 'tlbForeignKeys'
@ -567,23 +523,32 @@ object frmTableEditor: TfrmTableEditor
OnClick = btnClearForeignKeysClick
end
end
object pnlNoForeignKeys: TPanel
Left = 66
Top = 0
Width = 527
Height = 121
Align = alClient
BevelOuter = bvNone
Caption = 'pnlNoForeignKeys'
TabOrder = 1
VerticalAlignment = taAlignBottom
object listForeignKeys: TVirtualStringTree
Left = 75
Top = 3
Width = 515
Height = 103
Anchors = [akLeft, akTop, akRight, akBottom]
AlignWithMargins = True
Left = 3
Top = 0
Width = 521
Height = 121
Margins.Top = 0
Margins.Bottom = 0
Align = alClient
EditDelay = 0
Header.AutoSizeIndex = 0
Header.DefaultHeight = 17
Header.Font.Charset = DEFAULT_CHARSET
Header.Font.Color = clWindowText
Header.Font.Height = -11
Header.Font.Name = 'Tahoma'
Header.Font.Style = []
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
Header.ParentFont = True
Images = MainForm.PngImageListMain
TabOrder = 1
TabOrder = 0
TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowHorzGridLines, toShowTreeLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toUseExplorerTheme, toHideTreeLinesIfThemed]
TreeOptions.SelectionOptions = [toExtendedFocus]
@ -599,7 +564,7 @@ object frmTableEditor: TfrmTableEditor
item
Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus]
Position = 0
Width = 91
Width = 101
WideText = 'Key name'
end
item
@ -634,6 +599,7 @@ object frmTableEditor: TfrmTableEditor
end>
end
end
end
object tabCREATEcode: TTabSheet
Caption = 'CREATE code'
ImageIndex = 119
@ -716,11 +682,16 @@ object frmTableEditor: TfrmTableEditor
Caption = 'Columns:'
TabOrder = 1
object tlbColumns: TToolBar
Left = 61
AlignWithMargins = True
Left = 0
Top = 0
Width = 473
Width = 501
Height = 22
Align = alNone
Margins.Left = 100
Margins.Top = 0
Margins.Right = 0
Margins.Bottom = 0
Align = alClient
ButtonWidth = 66
Caption = 'Columns:'
Images = MainForm.PngImageListMain

View File

@ -47,7 +47,6 @@ type
btnClearIndexes: TToolButton;
btnMoveUpIndex: TToolButton;
btnMoveDownIndex: TToolButton;
StaticText1: TStaticText;
pnlColumnsTop: TPanel;
tlbColumns: TToolBar;
btnAddColumn: TToolButton;
@ -80,13 +79,13 @@ type
btnAddForeignKey: TToolButton;
btnRemoveForeignKey: TToolButton;
btnClearForeignKeys: TToolButton;
listForeignKeys: TVirtualStringTree;
lblNoForeignKeys: TLabel;
menuCopyColumnCell: TMenuItem;
N2: TMenuItem;
popupSQLmemo: TPopupMenu;
menuSQLCopy: TMenuItem;
menuSQLSelectAll: TMenuItem;
pnlNoForeignKeys: TPanel;
listForeignKeys: TVirtualStringTree;
procedure editNameChange(Sender: TObject);
procedure Modification(Sender: TObject);
procedure btnAddColumnClick(Sender: TObject);
@ -219,6 +218,7 @@ const
constructor TfrmTableEditor.Create(AOwner: TComponent);
begin
inherited;
ScaleControls(Screen.PixelsPerInch, FORMS_DPI);
PageControlMain.Height := GetRegValue(REGNAME_TABLEEDITOR_TABSHEIGHT, PageControlMain.Height);
FixVT(listColumns);
FixVT(treeIndexes);
@ -1753,13 +1753,11 @@ begin
SupportsForeignKeys := LowerCase(comboEngine.Text) = 'innodb';
ListForeignKeys.Enabled := SupportsForeignKeys;
tlbForeignKeys.Enabled := SupportsForeignKeys;
lblNoForeignKeys.Caption := 'The selected table engine ('+comboEngine.Text+') does not support foreign keys. '+
'To enable foreign keys you have to change the table engine in the "Options" tab to "InnoDB".';
pnlNoForeignKeys.Caption := 'The selected table engine ('+comboEngine.Text+') does not support foreign keys.';
if SupportsForeignKeys then
ListForeignKeys.Height := lblNoForeignKeys.Top - ListForeignKeys.Top + lblNoForeignKeys.Height
ListForeignKeys.Margins.Bottom := 0
else
ListForeignKeys.Height := lblNoForeignKeys.Top - ListForeignKeys.Top - 4;
lblNoForeignKeys.Visible := not SupportsForeignKeys;
ListForeignKeys.Margins.Bottom := GetTextHeight(pnlNoForeignKeys.Font)+4;
end;
UpdateSQLcode;
end;

View File

@ -126,14 +126,10 @@ object frmTableTools: TfrmTableTools
Align = alClient
Header.AutoSizeIndex = -1
Header.DefaultHeight = 17
Header.Font.Charset = DEFAULT_CHARSET
Header.Font.Color = clWindowText
Header.Font.Height = -11
Header.Font.Name = 'Tahoma'
Header.Font.Style = []
Header.Images = MainForm.PngImageListMain
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
Header.ParentFont = True
TabOrder = 0
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick]

View File

@ -54,6 +54,7 @@ var
i: Integer;
begin
inherited;
ScaleControls(Screen.PixelsPerInch, FORMS_DPI);
SynMemoStatement.Highlighter := Mainform.SynSQLSyn1;
editName.MaxLength := NAME_LEN;
comboTiming.Items.Text := 'BEFORE'+CRLF+'AFTER';

View File

@ -3,12 +3,6 @@ object frmView: TfrmView
Top = 0
Width = 451
Height = 304
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
DesignSize = (
451

View File

@ -47,6 +47,7 @@ uses main;
constructor TfrmView.Create(AOwner: TComponent);
begin
inherited;
ScaleControls(Screen.PixelsPerInch, FORMS_DPI);
SynMemoSelect.Highlighter := Mainform.SynSQLSyn1;
Mainform.SynCompletionProposal.AddEditor(SynMemoSelect);
editName.MaxLength := NAME_LEN;