From b70ca5e5d201450836bc4e3643cd7d42706c9adf Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 8 Jul 2017 16:24:34 +0000 Subject: [PATCH] spktoolbar: Fix fonts not changeable in OI git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5982 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../spktoolbar/SpkToolbar/SpkToolbar.pas | 3 + .../spktoolbar/SpkToolbar/spkt_Appearance.pas | 26 +++++ .../spktoolbar/SpkToolbar/spkt_Const.pas | 25 ++++- .../designtime/SpkToolbarEditor.pas | 96 +++++++++---------- .../designtime/spkte_AppearanceEditor.pas | 1 + 5 files changed, 100 insertions(+), 51 deletions(-) diff --git a/components/spktoolbar/SpkToolbar/SpkToolbar.pas b/components/spktoolbar/SpkToolbar/SpkToolbar.pas index 3fcc4afc0..d46a30112 100644 --- a/components/spktoolbar/SpkToolbar/SpkToolbar.pas +++ b/components/spktoolbar/SpkToolbar/SpkToolbar.pas @@ -1389,6 +1389,8 @@ procedure TSpkToolbar.ValidateBuffer; TabRect := FTabRects[index]; FBuffer.canvas.font.Assign(AFont); + SpkScaleFont(FBuffer.Canvas.Font); + if AOverrideTextColor <> clNone then clr := AOverrideTextColor else clr := AFont.Color; @@ -1730,6 +1732,7 @@ begin else TabAppearance := FAppearance; FBuffer.Canvas.font.Assign(TabAppearance.Tab.TabHeaderFont); + SpkScaleFont(FBuffer.Canvas.Font); TabWidth := 2 + // Frame 2 * TabCornerRadius + diff --git a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas index 011b59122..d6dbea9e1 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas @@ -53,6 +53,8 @@ type procedure SetGradientType(const Value: TBackgroundKind); procedure SetInactiveHeaderFontColor(const Value: TColor); + procedure TabHeaderFontChange(Sender: TObject); + public // *** Konstruktor, destruktor, assign *** // Appearance musi mieæ assign, bo wystêpuje jako w³asnoœæ @@ -100,6 +102,8 @@ type procedure SetHotTrackBrightnessChange(const Value: Integer); procedure SetStyle(const Value: TSpkPaneStyle); + procedure CaptionFontChange(Sender: TObject); + public constructor Create(ADispatch: TSpkBaseAppearanceDispatch); destructor Destroy; override; @@ -176,6 +180,7 @@ type procedure SetIdleInnerLightColor(const Value: TColor); procedure SetStyle(const Value: TSpkElementStyle); + procedure CaptionFontChange(Sender: TObject); public constructor Create(ADispatch: TSpkBaseAppearanceDispatch); destructor Destroy; override; @@ -297,6 +302,7 @@ begin inherited Create; FDispatch := ADispatch; FTabHeaderFont := TFont.Create; + FTabHeaderFont.OnChange := TabHeaderFontChange; Reset; end; @@ -491,6 +497,12 @@ begin FDispatch.NotifyAppearanceChanged; end; +procedure TSpkTabAppearance.TabHeaderFontChange(Sender: TObject); +begin + if FDispatch <> nil then + FDispatch.NotifyAppearanceChanged; +end; + { TSpkPaneAppearance } @@ -499,6 +511,7 @@ begin inherited Create; FDispatch := ADispatch; FCaptionFont := TFont.Create; + FCaptionFont.OnChange := CaptionFontChange; FHotTrackBrightnessChange := 20; FStyle := psRectangleEtched; Reset; @@ -534,6 +547,12 @@ begin raise AssignException.create('TSpkPaneAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkPaneAppearance!'); end; +procedure TSpkPaneAppearance.CaptionFontChange(Sender: TObject); +begin + if FDispatch <> nil then + FDispatch.NotifyAppearanceChanged; +end; + procedure TSpkPaneAppearance.LoadFromXML(Node: TSpkXMLNode); var Subnode: TSpkXMLNode; @@ -765,6 +784,7 @@ begin inherited Create; FDispatch := ADispatch; FCaptionFont := TFont.Create; + FCaptionFont.OnChange := CaptionFontChange; FHotTrackBrightnessChange := 40; Reset; end; @@ -814,6 +834,12 @@ begin raise AssignException.create('TSpkElementAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkElementAppearance!'); end; +procedure TSpkElementAppearance.CaptionFontChange(Sender: TObject); +begin + if FDispatch <> nil then + FDispatch.NotifyAppearanceChanged; +end; + procedure TSpkElementAppearance.GetActiveColors(IsChecked: Boolean; out AFrameColor, AInnerLightColor, AInnerDarkColor, AGradientFromColor, AGradientToColor: TColor; out AGradientKind: TBackgroundKind; diff --git a/components/spktoolbar/SpkToolbar/spkt_Const.pas b/components/spktoolbar/SpkToolbar/spkt_Const.pas index 9c3716859..71573ebb8 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Const.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Const.pas @@ -14,9 +14,13 @@ unit spkt_Const; interface +uses + Graphics; + procedure SpkInitLayoutConsts(FromDPI: Integer; ToDPI: Integer = 0); function SpkScaleX(Size: Integer; FromDPI: Integer; ToDPI: Integer = 0): integer; function SpkScaleY(Size: Integer; FromDPI: Integer; ToDPI: Integer = 0): integer; +procedure SpkScaleFont(AFont: TFont; ToDPI: Integer = 0); const // **************** @@ -262,7 +266,7 @@ const implementation uses - Graphics, LCLType; + LCLType; procedure SpkInitLayoutConsts(FromDPI: Integer; ToDPI: Integer = 0); begin @@ -383,6 +387,25 @@ begin end; +procedure SpkScaleFont(AFont: TFont; ToDPI: Integer = 0); +var + FromDPI: Integer; +begin + if ToDPI = 0 then + ToDPI := ScreenInfo.PixelsPerInchY; + + FromDPI := AFont.PixelsPerInch; + + if (not DPI_AWARE) or (ToDPI = FromDPI) then + exit; + + if AFont.Size = 0 then + AFont.Height := MulDiv(GetFontData(AFont.Reference.Handle).Height, FromDPI, ToDPI) + else + AFont.Height := MulDiv(AFont.Height, FromDPI, ToDPI); + AFont.PixelsPerInch := ToDPI; +end; + initialization diff --git a/components/spktoolbar/designtime/SpkToolbarEditor.pas b/components/spktoolbar/designtime/SpkToolbarEditor.pas index bc402fc30..c9d8072fa 100644 --- a/components/spktoolbar/designtime/SpkToolbarEditor.pas +++ b/components/spktoolbar/designtime/SpkToolbarEditor.pas @@ -261,43 +261,40 @@ implementation { TSpkToolbarEditor } procedure TSpkToolbarEditor.DoOpenContentsEditor; - var - Component : TComponent; - + Component: TComponent; begin -Component:=self.GetComponent; + Component:=self.GetComponent; + if not(Component is TSpkToolbar) then + exit; -if not(Component is TSpkToolbar) then - exit; - -EditWindow.SetData(TSpkToolbar(Component),Self.GetDesigner); -EditWindow.Show; + EditWindow.SetData(TSpkToolbar(Component),Self.GetDesigner); + EditWindow.Show; end; procedure TSpkToolbarEditor.Edit; begin -DoOpenContentsEditor; + DoOpenContentsEditor; end; procedure TSpkToolbarEditor.ExecuteVerb(Index: Integer); begin -case Index of - 0 : DoOpenContentsEditor; -end; + case Index of + 0 : DoOpenContentsEditor; + end; end; function TSpkToolbarEditor.GetVerb(Index: Integer): string; begin -case Index of - 0 : result:='Contents editor...'; -end; + case Index of + 0 : result:='Contents editor...'; + end; end; function TSpkToolbarEditor.GetVerbCount: Integer; begin -result:=1; + Result := 1; end; { TSpkToolbarCaptionEditor } @@ -325,48 +322,47 @@ end; { TSpkToolbarAppearanceEditor } procedure TSpkToolbarAppearanceEditor.Edit; - -var Obj : TObject; - Toolbar : TSpkToolbar; - Tab : TSpkTab; - AppearanceEditor : tfrmAppearanceEditWindow; - +var + Obj: TObject; + Toolbar: TSpkToolbar; + Tab: TSpkTab; + AppearanceEditor: tfrmAppearanceEditWindow; begin -Obj:=GetComponent(0); -if Obj is TSpkToolbar then - begin - Toolbar:=TSpkToolbar(Obj); + Obj:=GetComponent(0); + if Obj is TSpkToolbar then + begin + Toolbar := TSpkToolbar(Obj); - AppearanceEditor:=TfrmAppearanceEditWindow.Create(nil); - try - AppearanceEditor.Appearance.Assign(Toolbar.Appearance); - if AppearanceEditor.ShowModal = mrOK then - begin + AppearanceEditor:=TfrmAppearanceEditWindow.Create(nil); + try + AppearanceEditor.Appearance.Assign(Toolbar.Appearance); + if AppearanceEditor.ShowModal = mrOK then + begin Toolbar.Appearance.Assign(AppearanceEditor.Appearance); Modified; - end; - finally - AppearanceEditor.Free; - end; + end; + finally + AppearanceEditor.Free; + end; - end else -if Obj is TSpkTab then - begin - Tab:=TSpkTab(Obj); + end else + if Obj is TSpkTab then + begin + Tab:=TSpkTab(Obj); - AppearanceEditor:=TfrmAppearanceEditWindow.Create(nil); - try - AppearanceEditor.Appearance.Assign(Tab.CustomAppearance); - if AppearanceEditor.ShowModal = mrOK then + AppearanceEditor:=TfrmAppearanceEditWindow.Create(nil); + try + AppearanceEditor.Appearance.Assign(Tab.CustomAppearance); + if AppearanceEditor.ShowModal = mrOK then begin - Tab.CustomAppearance.Assign(AppearanceEditor.Appearance); - Modified; + Tab.CustomAppearance.Assign(AppearanceEditor.Appearance); + Modified; end; - finally - AppearanceEditor.Free; - end; + finally + AppearanceEditor.Free; + end; - end; + end; end; function TSpkToolbarAppearanceEditor.GetAttributes: TPropertyAttributes; diff --git a/components/spktoolbar/designtime/spkte_AppearanceEditor.pas b/components/spktoolbar/designtime/spkte_AppearanceEditor.pas index 8d036e836..a677925c1 100644 --- a/components/spktoolbar/designtime/spkte_AppearanceEditor.pas +++ b/components/spktoolbar/designtime/spkte_AppearanceEditor.pas @@ -207,6 +207,7 @@ type procedure bTabGradientToColorClick(Sender: TObject); procedure bActiveTabHeaderFontColorClick(Sender: TObject); procedure bCopyToClipboardClick(Sender: TObject); + procedure cbItemActiveGradientKindChange(Sender: TObject); procedure cbItemHottrackGradientKindChange(Sender: TObject); procedure cbItemIdleGradientKindChange(Sender: TObject);