pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

spktoolbar: Fix fonts not changeable in OI

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5982 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-07-08 16:24:34 +00:00
parent 9eb490f7e4
commit b70ca5e5d2
5 changed files with 100 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
components/spktoolbar/SpkToolbar/SpkToolbar.pas
View File

@ -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 +

26
components/spktoolbar/SpkToolbar/spkt_Appearance.pas
View File

@ -53,6 +53,8 @@ type
procedure SetGradientType(const Value: TBackgroundKind);
procedure SetInactiveHeaderFontColor(const Value: TColor);
procedure TabHeaderFontChange(Sender: TObject);
public
// *** Konstruktor, destruktor, assign ***
// <remarks>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;

25
components/spktoolbar/SpkToolbar/spkt_Const.pas
View File

@ -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

96
components/spktoolbar/designtime/SpkToolbarEditor.pas
View File

@ -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;

1
components/spktoolbar/designtime/spkte_AppearanceEditor.pas
View File

@ -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);