From fc6d4c2a483e7295eaa36f44d0a706aaa11a3cf4 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Thu, 4 Feb 2010 23:50:47 +0000 Subject: [PATCH] Try to fix most DPI related glitches. Especially TFrames need a ScaleBy() call, which is done automatically on TForms. Fixes issue #1656. --- source/const.inc | 3 + source/helpers.pas | 34 +++--- source/main.dfm | 23 ++-- source/main.pas | 1 + source/routine_editor.dfm | 6 - source/routine_editor.pas | 1 + source/table_editor.dfm | 231 +++++++++++++++++--------------------- source/table_editor.pas | 14 +-- source/tabletools.dfm | 6 +- source/trigger_editor.pas | 1 + source/view.dfm | 6 - source/view.pas | 1 + 12 files changed, 146 insertions(+), 181 deletions(-) diff --git a/source/const.inc b/source/const.inc index f4ff1600..d060fafa 100644 --- a/source/const.inc +++ b/source/const.inc @@ -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; + diff --git a/source/helpers.pas b/source/helpers.pas index cd706466..d63897d2 100644 --- a/source/helpers.pas +++ b/source/helpers.pas @@ -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,29 +2516,17 @@ 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 VT.Header.Height := Trunc(ReadOnlyNodeHeight * 1.2); - // Disable hottracking in non-Vista mode, looks ugly in XP, but nice in Vista + // Disable hottracking in non-Vista mode, looks ugly in XP, but nice in Vista if (toUseExplorerTheme in VT.TreeOptions.PaintOptions) and IsWindowsVista then VT.TreeOptions.PaintOptions := VT.TreeOptions.PaintOptions + [toHotTrack] else @@ -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; diff --git a/source/main.dfm b/source/main.dfm index c99c0c79..39fb55a3 100644 --- a/source/main.dfm +++ b/source/main.dfm @@ -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 diff --git a/source/main.pas b/source/main.pas index 38f1e9cf..18dbde8e 100644 --- a/source/main.pas +++ b/source/main.pas @@ -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); diff --git a/source/routine_editor.dfm b/source/routine_editor.dfm index 2056ea0a..41722709 100644 --- a/source/routine_editor.dfm +++ b/source/routine_editor.dfm @@ -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 diff --git a/source/routine_editor.pas b/source/routine_editor.pas index de0cc909..42bf558f 100644 --- a/source/routine_editor.pas +++ b/source/routine_editor.pas @@ -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)'); diff --git a/source/table_editor.dfm b/source/table_editor.dfm index 867696a7..49a2cb54 100644 --- a/source/table_editor.dfm +++ b/source/table_editor.dfm @@ -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,71 +523,81 @@ object frmTableEditor: TfrmTableEditor OnClick = btnClearForeignKeysClick end end - object listForeignKeys: TVirtualStringTree - Left = 75 - Top = 3 - Width = 515 - Height = 103 - Anchors = [akLeft, akTop, akRight, akBottom] - 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] - Images = MainForm.PngImageListMain + object pnlNoForeignKeys: TPanel + Left = 66 + Top = 0 + Width = 527 + Height = 121 + Align = alClient + BevelOuter = bvNone + Caption = 'pnlNoForeignKeys' TabOrder = 1 - TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] - TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowHorzGridLines, toShowTreeLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toUseExplorerTheme, toHideTreeLinesIfThemed] - TreeOptions.SelectionOptions = [toExtendedFocus] - OnBeforePaint = listForeignKeysBeforePaint - OnClick = treeIndexesClick - OnCreateEditor = listForeignKeysCreateEditor - OnEditing = listForeignKeysEditing - OnFocusChanged = listForeignKeysFocusChanged - OnGetText = listForeignKeysGetText - OnGetImageIndex = listForeignKeysGetImageIndex - OnNewText = listForeignKeysNewText - Columns = < - item - Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] - Position = 0 - Width = 91 - WideText = 'Key name' - end - item - Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] - Position = 1 - Width = 80 - WideText = 'Columns' - end - item - Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] - Position = 2 - Width = 100 - WideText = 'Reference table' - end - item - Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] - Position = 3 - Width = 80 - WideText = 'Foreign columns' - end - item - Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] - Position = 4 - Width = 80 - WideText = 'On UPDATE' - end - item - Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] - Position = 5 - Width = 80 - WideText = 'On DELETE' - end> + VerticalAlignment = taAlignBottom + object listForeignKeys: TVirtualStringTree + 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.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible] + Header.ParentFont = True + Images = MainForm.PngImageListMain + 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] + OnBeforePaint = listForeignKeysBeforePaint + OnClick = treeIndexesClick + OnCreateEditor = listForeignKeysCreateEditor + OnEditing = listForeignKeysEditing + OnFocusChanged = listForeignKeysFocusChanged + OnGetText = listForeignKeysGetText + OnGetImageIndex = listForeignKeysGetImageIndex + OnNewText = listForeignKeysNewText + Columns = < + item + Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] + Position = 0 + Width = 101 + WideText = 'Key name' + end + item + Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] + Position = 1 + Width = 80 + WideText = 'Columns' + end + item + Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] + Position = 2 + Width = 100 + WideText = 'Reference table' + end + item + Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] + Position = 3 + Width = 80 + WideText = 'Foreign columns' + end + item + Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] + Position = 4 + Width = 80 + WideText = 'On UPDATE' + end + item + Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] + Position = 5 + Width = 80 + WideText = 'On DELETE' + end> + end end end object tabCREATEcode: TTabSheet @@ -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 diff --git a/source/table_editor.pas b/source/table_editor.pas index 30494a1c..980febdf 100644 --- a/source/table_editor.pas +++ b/source/table_editor.pas @@ -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; diff --git a/source/tabletools.dfm b/source/tabletools.dfm index 39c95a71..ecb08637 100644 --- a/source/tabletools.dfm +++ b/source/tabletools.dfm @@ -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] diff --git a/source/trigger_editor.pas b/source/trigger_editor.pas index 1b56bc9d..84771fff 100644 --- a/source/trigger_editor.pas +++ b/source/trigger_editor.pas @@ -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'; diff --git a/source/view.dfm b/source/view.dfm index c7d86ba0..5a542f74 100644 --- a/source/view.dfm +++ b/source/view.dfm @@ -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 diff --git a/source/view.pas b/source/view.pas index 1e6c2ff0..1af50446 100644 --- a/source/view.pas +++ b/source/view.pas @@ -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;