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

SpkToolbar: Export Appearance properties as Pascal code.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5353 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-11-15 22:28:06 +00:00
parent 6868957c04
commit 588166bb4c
3 changed files with 336 additions and 191 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -33,20 +33,21 @@ type TSpkTabAppearance = class(TPersistent)
FGradientType: TBackgroundKind;
FInactiveHeaderFontColor: TColor;
// *** Gettery i settery ***
// Getter & setter methods
procedure SetHeaderFont(const Value: TFont);
procedure SetBorderColor(const Value: TColor);
procedure SetGradientFromColor(const Value: TColor);
procedure SetGradientToColor(const Value: TColor);
procedure SetGradientType(const Value: TBackgroundKind);
procedure SetInactiveHeaderFontColor(const Value: TColor);
public
// *** Konstruktor, destruktor, assign ***
// <remarks>Appearance musi mieæ assign, bo wystêpuje jako w³asnoœæ
// opublikowana.</remarks>
procedure Assign(Source: TPersistent); override;
constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
procedure SaveToPascal(AList: TStrings);
procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode);
destructor Destroy; override;
@ -82,11 +83,12 @@ type TSpkPaneAppearance = class(TPersistent)
procedure SetGradientType(const Value: TBackgroundKind);
procedure SetStyle(const Value: TSpkPaneStyle);
public
procedure Assign(Source: TPersistent); override;
constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure SaveToPascal(AList: TStrings);
procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode);
destructor Destroy; override;
procedure Reset;
published
property BorderDarkColor: TColor read FBorderDarkColor write SetBorderDarkColor;
@ -149,11 +151,12 @@ type TSpkElementAppearance = class(TPersistent)
procedure SetIdleInnerDarkColor(const Value: TColor);
procedure SetIdleInnerLightColor(const Value: TColor);
public
procedure Assign(Source : TPersistent); override;
constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure SaveToPascal(AList: TStrings);
procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode);
destructor Destroy; override;
procedure Reset;
published
property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
@ -198,19 +201,17 @@ type TSpkToolbarAppearance = class;
FTab: TSpkTabAppearance;
FPane: TSpkPaneAppearance;
FElement: TSpkElementAppearance;
FDispatch: TSpkBaseAppearanceDispatch;
procedure SetElementAppearance(const Value: TSpkElementAppearance);
procedure SetPaneAppearance(const Value: TSpkPaneAppearance);
procedure SetTabAppearance(const Value: TSpkTabAppearance);
public
procedure NotifyAppearanceChanged;
constructor Create(ADispatch: TSpkBaseAppearanceDispatch); reintroduce;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure NotifyAppearanceChanged;
procedure Reset;
procedure SaveToPascal(AList: TStrings);
procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode);
published
@ -219,10 +220,29 @@ type TSpkToolbarAppearance = class;
property Element: TSpkElementAppearance read FElement write SetElementAppearance;
end;
implementation
uses
LCLIntf, LCLType;
LCLIntf, LCLType, typinfo;
procedure SaveFontToPascal(AList: TStrings; AFont: TFont; AName: String);
var
sty: String;
begin
sty := '';
if fsBold in AFont.Style then sty := sty + 'fsBold,';
if fsItalic in AFont.Style then sty := sty + 'fsItalic,';
if fsUnderline in AFont.Style then sty := sty + 'fsUnderline,';
if fsStrikeout in AFont.Style then sty := sty + 'fsStrikeout,';
if sty <> '' then Delete(sty, Length(sty), 1);
with AList do begin
Add(AName + '.Name := ''' + AFont.Name + ''';');
Add(AName + '.Size := ' + IntToStr(AFont.Size) + ';');
Add(AName + '.Style := [' + sty + '];');
Add(AName + '.Color := $' + IntToHex(AFont.Color, 8) + ';');
end;
end;
{ TSpkBaseToolbarAppearance }
@ -334,6 +354,20 @@ begin
FInactiveHeaderFontColor := FTabHeaderFont.Color;
end;
procedure TSpkTabAppearance.SaveToPascal(AList: TStrings);
begin
with AList do begin
Add(' with Tab do begin');
SaveFontToPascal(AList, FTabHeaderFont, ' TabHeaderFont');
Add(' BorderColor := $' + IntToHex(FBorderColor, 8) + ';');
Add(' GradientFromColor := $' + IntToHex(FGradientFromColor, 8) + ';');
Add(' GradientToColor := $' + IntToHex(FGradientToColor, 8) + ';');
Add(' GradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FGradientType)) + ';');
Add(' InactiveTabHeaderFontColor := $' + IntToHex(FInactiveHeaderFontColor, 8) + ';');
Add(' end;');
end;
end;
procedure TSpkTabAppearance.SaveToXML(Node: TSpkXMLNode);
var
Subnode: TSpkXMLNode;
@ -525,11 +559,27 @@ begin
FStyle := psRectangleEtched;
end;
procedure TSpkPaneAppearance.SaveToPascal(AList: TStrings);
begin
with AList do begin
Add(' with Pane do begin');
SaveFontToPascal(AList, FCaptionFont, ' CaptionFont');
Add(' BorderDarkColor := $' + IntToHex(FBorderDarkColor, 8) + ';');
Add(' BorderLightColor := $' + IntToHex(FBorderLightColor, 8) + ';');
Add(' CaptionBgColor := $' + IntToHex(FcaptionBgColor, 8) + ';');
Add(' GradientFromColor := $' + IntToHex(FGradientFromColor, 8) + ';');
Add(' GradientToColor := $' + IntToHex(FGradientToColor, 8) + ';');
Add(' GradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FGradientType)) + ';');
Add(' Style := ' + GetEnumName(TypeInfo(TSpkPaneStyle), ord(FStyle)));
Add(' end;');
end;
end;
procedure TSpkPaneAppearance.SaveToXML(Node: TSpkXMLNode);
var
Subnode: TSpkXMLNode;
begin
if not(Assigned(Node)) then
if not Assigned(Node) then
exit;
Subnode := Node['CaptionFont',true];
@ -830,19 +880,50 @@ begin
FActiveCaptionColor := rgb(110, 66, 128);
end;
procedure TSpkElementAppearance.SaveToXML(Node: TSpkXMLNode);
var Subnode : TSpkXMLNode;
procedure TSpkElementAppearance.SaveToPascal(AList: TStrings);
begin
if not(assigned(Node)) then
with AList do begin
Add(' with Element do begin');
SaveFontToPascal(AList, FCaptionFont, ' CaptionFont');
Add(' IdleFrameColor := $' + IntToHex(FIdleFrameColor, 8) + ';');
Add(' IdleGradientFromColor := $' + IntToHex(FIdleGradientFromColor, 8) + ';');
Add(' IdleGradientToColor := $' + IntToHex(FIdleGradientToColor, 8) + ';');
Add(' IdleGradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FIdleGradientType)) + ';');
Add(' IdleInnerDarkColor := $' + IntToHex(FIdleInnerDarkColor, 8) + ';');
Add(' IdleInnerLightColor := $' + IntToHex(FIdleInnerLightColor, 8) + ';');
Add(' IdleCaptionColor := $' + IntToHex(FIdleCaptionColor, 8) + ';');
Add(' HotTrackFrameColor := $' + IntToHex(FHotTrackFrameColor, 8) + ';');
Add(' HotTrackGradientFromColor := $' + IntToHex(FHotTrackGradientFromColor, 8) + ';');
Add(' HotTrackGradientToColor := $' + IntToHex(FHotTrackGradientToColor, 8) + ';');
Add(' HotTrackGradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FHotTrackGradientType)) + ';');
Add(' HotTrackInnerDarkColor := $' + IntToHex(FHotTrackInnerDarkColor, 8) + ';');
Add(' HotTrackInnerLightColor := $' + IntToHex(FHotTrackInnerLightColor, 8) + ';');
Add(' HotTrackCaptionColor := $' + IntToHex(FHotTrackCaptionColor, 8) + ';');
Add(' ActiveFrameColor := $' + IntToHex(FActiveFrameColor, 8) + ';');
Add(' ActiveGradientFromColor := $' + IntToHex(FActiveGradientFromColor, 8) + ';');
Add(' ActiveGradientToColor := $' + IntToHex(FActiveGradientToColor, 8) + ';');
Add(' ActiveGradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FActiveGradientType)) + ';');
Add(' ActiveInnerDarkColor := $' + IntToHex(FActiveInnerDarkColor, 8) + ';');
Add(' ActiveInnerLightColor := $' + IntToHex(FActiveInnerLightColor, 8) + ';');
Add(' ActiveCaptionColor := $' + IntToHex(FActiveCaptionColor, 8) + ';');
Add(' end;');
end;
end;
procedure TSpkElementAppearance.SaveToXML(Node: TSpkXMLNode);
var
Subnode: TSpkXMLNode;
begin
if not Assigned(Node) then
exit;
Subnode := Node['CaptionFont',true];
TSpkXMLTools.Save(Subnode, FCaptionFont);
// *** Idle ***
Subnode := Node['IdleFrameColor',true];
Subnode.TextAsColor:=FIdleFrameColor;
@ -865,7 +946,6 @@ Subnode:=Node['IdleCaptionColor',true];
Subnode.TextAsColor:=FIdleCaptionColor;
// *** Hottrack ***
Subnode := Node['HottrackFrameColor',true];
Subnode.TextAsColor:=FHottrackFrameColor;
@ -888,7 +968,6 @@ Subnode:=Node['HottrackCaptionColor',true];
Subnode.TextAsColor:=FHottrackCaptionColor;
// *** Active ***
Subnode := Node['ActiveFrameColor',true];
Subnode.TextAsColor:=FActiveFrameColor;
@ -1178,10 +1257,18 @@ begin
FAppearanceDispatch.NotifyAppearanceChanged;
end;
procedure TSpkToolbarAppearance.SaveToPascal(AList: TStrings);
begin
AList.Add('with Appearance do begin');
FTab.SaveToPascal(AList);
FPane.SaveToPascal(AList);
FElement.SaveToPascal(AList);
AList.ADd('end;');
end;
procedure TSpkToolbarAppearance.SaveToXML(Node: TSpkXMLNode);
var Subnode : TSpkXMLNode;
var
Subnode: TSpkXMLNode;
begin
Subnode:=Node['Tab',true];
FTab.SaveToXML(Subnode);

54
components/spktoolbar/designtime/spkte_AppearanceEditor.lfm
View File

@ -321,9 +321,9 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
Height = 368
Top = 132
Width = 562
ActivePage = TabSheet1
ActivePage = TabSheet3
Align = alClient
TabIndex = 0
TabIndex = 2
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Tab'
@ -1985,14 +1985,14 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
end
object TabSheet4: TTabSheet
Caption = 'Import / export'
ClientHeight = 326
ClientWidth = 549
ClientHeight = 340
ClientWidth = 554
ImageIndex = 3
object bImport: TButton
AnchorSideLeft.Control = bExport
AnchorSideLeft.Control = bExportToXML
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = TabSheet4
Left = 118
Left = 260
Height = 25
Top = 4
Width = 110
@ -2002,17 +2002,18 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
OnClick = bImportClick
TabOrder = 0
end
object bExport: TButton
AnchorSideLeft.Control = TabSheet4
object bExportToXML: TButton
AnchorSideLeft.Control = bExportToPascal
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = TabSheet4
Left = 4
Left = 146
Height = 25
Top = 4
Width = 110
BorderSpacing.Left = 4
BorderSpacing.Top = 4
Caption = 'Export to XML'
OnClick = bExportClick
OnClick = bExportToXMLClick
TabOrder = 1
end
object mXML: TMemo
@ -2024,9 +2025,9 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
AnchorSideBottom.Control = TabSheet4
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 289
Height = 303
Top = 33
Width = 541
Width = 546
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 4
@ -2036,8 +2037,37 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
Font.Height = -11
Font.Name = 'Courier New'
ParentFont = False
ScrollBars = ssAutoBoth
TabOrder = 2
end
object bExportToPascal: TButton
AnchorSideLeft.Control = TabSheet4
AnchorSideTop.Control = TabSheet4
Left = 4
Height = 25
Top = 4
Width = 138
BorderSpacing.Left = 4
BorderSpacing.Top = 4
Caption = 'Export to Pascal code'
OnClick = bExportToPascalClick
TabOrder = 3
end
object bCopyToClipboard: TButton
AnchorSideTop.Control = TabSheet4
AnchorSideRight.Control = TabSheet4
AnchorSideRight.Side = asrBottom
Left = 475
Height = 25
Top = 4
Width = 75
Anchors = [akTop, akRight]
BorderSpacing.Top = 4
BorderSpacing.Right = 4
Caption = 'Copy'
OnClick = bCopyToClipboardClick
TabOrder = 4
end
end
object TabSheet5: TTabSheet
Caption = 'Tools'

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

@ -44,6 +44,8 @@ type
bTabGradientFromColor: TSpeedButton;
bTabGradientToColor: TSpeedButton;
bActiveTabHeaderFontColor: TSpeedButton;
bExportToPascal: TButton;
bCopyToClipboard: TButton;
cbPaneStyle: TComboBox;
ColorView: TShape;
gbPreview: TGroupBox;
@ -143,7 +145,7 @@ type
pPaneCaptionFontColor: TPanel;
TabSheet4: TTabSheet;
bImport: TButton;
bExport: TButton;
bExportToXML: TButton;
mXML: TMemo;
sTabRectangle: TShape;
cbLinkTab: TCheckBox;
@ -155,7 +157,8 @@ type
Label17: TLabel;
bReset: TButton;
procedure bExportClick(Sender: TObject);
procedure bExportToPascalClick(Sender: TObject);
procedure bExportToXMLClick(Sender: TObject);
procedure bImportClick(Sender: TObject);
procedure bInactiveTabHeaderFontColorClick(Sender: TObject);
procedure bItemActiveCaptionColorClick(Sender: TObject);
@ -188,7 +191,7 @@ type
procedure bTabGradientFromColorClick(Sender: TObject);
procedure bTabGradientToColorClick(Sender: TObject);
procedure bActiveTabHeaderFontColorClick(Sender: TObject);
procedure bCopyToClipboardClick(Sender: TObject);
procedure cbItemActiveGradientKindChange(Sender: TObject);
procedure cbItemHottrackGradientKindChange(Sender: TObject);
procedure cbItemIdleGradientKindChange(Sender: TObject);
@ -285,6 +288,9 @@ implementation
{$R *.lfm}
uses
clipbrd;
var
CurrPageIndex: Integer = 0;
@ -404,6 +410,12 @@ begin
(Sender as TSpeedButton).Down := false;
end;
procedure TfrmAppearanceEditWindow.bCopyToClipboardClick(Sender: TObject);
begin
if mXML.Lines.Count > 0 then
Clipboard.AsText := mXML.Text;
end;
procedure TfrmAppearanceEditWindow.bActiveTabHeaderFontColorClick(
Sender: TObject);
begin
@ -415,6 +427,36 @@ begin
(Sender as TSpeedButton).Down := false;
end;
procedure TfrmAppearanceEditWindow.bExportToPascalClick(Sender: TObject);
var
L: TStrings;
begin
L := TStringList.Create;
try
tbPreview.Appearance.SaveToPascal(L);
mXML.Clear;
mXML.Lines.Assign(L);
finally
L.Free;
end;
end;
procedure TfrmAppearanceEditWindow.bExportToXMLClick(Sender: TObject);
var
Xml: TSpkXMLParser;
Node: TSpkXMLNode;
begin
XML:=TSpkXMLParser.Create;
try
Node := XML['Appearance', true];
tbPreview.Appearance.SaveToXML(Node);
mXML.Clear;
mXml.Text:=XML.Generate;
finally
XML.Free;
end;
end;
procedure TfrmAppearanceEditWindow.bInactiveTabHeaderFontColorClick(
Sender: TObject);
begin
@ -540,7 +582,7 @@ end;
procedure TfrmAppearanceEditWindow.bItemIdleCaptionColorClick(Sender: TObject);
begin
(Sender as TSpeedButton).Down := true;
if PickColor(pItemIdleFrame) then begin
if PickColor(pItemIdleCaptionColor) then begin
tbPreview.Appearance.Element.IdleCaptionColor := pItemIdleCaptionColor.Color;
if cbLinkTab.checked then
SetLinkedFrameColor(pItemIdleCaptionColor.Color)
@ -879,22 +921,6 @@ begin
tbPreview.Appearance.Element.ActiveGradientFromColor:=(Sender as TPanel).Color;
end;
procedure TfrmAppearanceEditWindow.bExportClick(Sender: TObject);
var
Xml: TSpkXMLParser;
Node: TSpkXMLNode;
begin
XML:=TSpkXMLParser.Create;
try
Node := XML['Appearance', true];
tbPreview.Appearance.SaveToXML(Node);
mXML.Clear;
mXml.Text:=XML.Generate;
finally
XML.Free;
end;
end;
procedure TfrmAppearanceEditWindow.bImportClick(Sender: TObject);
var
XML: TSpkXMLParser;
@ -1265,3 +1291,5 @@ begin
end;
end.