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

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

@ -24,53 +24,54 @@ type
type TSpkTabAppearance = class(TPersistent) type TSpkTabAppearance = class(TPersistent)
private private
FDispatch : TSpkBaseAppearanceDispatch; FDispatch: TSpkBaseAppearanceDispatch;
protected protected
FTabHeaderFont : TFont; FTabHeaderFont: TFont;
FBorderColor : TColor; FBorderColor: TColor;
FGradientFromColor : TColor; FGradientFromColor: TColor;
FGradientToColor : TColor; FGradientToColor: TColor;
FGradientType : TBackgroundKind; FGradientType: TBackgroundKind;
FInactiveHeaderFontColor: TColor; FInactiveHeaderFontColor: TColor;
// *** Gettery i settery *** // Getter & setter methods
procedure SetHeaderFont(const Value: TFont); procedure SetHeaderFont(const Value: TFont);
procedure SetBorderColor(const Value: TColor); procedure SetBorderColor(const Value: TColor);
procedure SetGradientFromColor(const Value: TColor); procedure SetGradientFromColor(const Value: TColor);
procedure SetGradientToColor(const Value: TColor); procedure SetGradientToColor(const Value: TColor);
procedure SetGradientType(const Value: TBackgroundKind); procedure SetGradientType(const Value: TBackgroundKind);
procedure SetInactiveHeaderFontColor(const Value: TColor); procedure SetInactiveHeaderFontColor(const Value: TColor);
public public
// *** Konstruktor, destruktor, assign *** // *** Konstruktor, destruktor, assign ***
// <remarks>Appearance musi mieæ assign, bo wystêpuje jako w³asnoœæ // <remarks>Appearance musi mieæ assign, bo wystêpuje jako w³asnoœæ
// opublikowana.</remarks> // opublikowana.</remarks>
procedure Assign(Source : TPersistent); override; procedure Assign(Source: TPersistent); override;
constructor Create(ADispatch : TSpkBaseAppearanceDispatch); constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
procedure SaveToXML(Node : TSpkXMLNode); procedure SaveToPascal(AList: TStrings);
procedure LoadFromXML(Node : TSpkXMLNode); procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode);
destructor Destroy; override; destructor Destroy; override;
procedure Reset; procedure Reset;
published published
property TabHeaderFont : TFont read FTabHeaderFont write SetHeaderFont; property TabHeaderFont: TFont read FTabHeaderFont write SetHeaderFont;
property BorderColor : TColor read FBorderColor write SetBorderColor; property BorderColor: TColor read FBorderColor write SetBorderColor;
property GradientFromColor : TColor read FGradientFromColor write SetGradientFromColor; property GradientFromColor: TColor read FGradientFromColor write SetGradientFromColor;
property GradientToColor : TColor read FGradientToColor write SetGradientToColor; property GradientToColor: TColor read FGradientToColor write SetGradientToColor;
property GradientType : TBackgroundKind read FGradientType write SetGradientType; property GradientType: TBackgroundKind read FGradientType write SetGradientType;
property InactiveTabHeaderFontColor: TColor read FInactiveHeaderFontColor write SetInactiveHeaderFontColor; property InactiveTabHeaderFontColor: TColor read FInactiveHeaderFontColor write SetInactiveHeaderFontColor;
end; end;
type TSpkPaneAppearance = class(TPersistent) type TSpkPaneAppearance = class(TPersistent)
private private
FDispatch : TSpkBaseAppearanceDispatch; FDispatch: TSpkBaseAppearanceDispatch;
protected protected
FCaptionFont : TFont; FCaptionFont: TFont;
FBorderDarkColor : TColor; FBorderDarkColor: TColor;
FBorderLightColor : TColor; FBorderLightColor: TColor;
FCaptionBgColor : TColor; FCaptionBgColor: TColor;
FGradientFromColor : TColor; FGradientFromColor: TColor;
FGradientToColor : TColor; FGradientToColor: TColor;
FGradientType : TBackgroundKind; FGradientType: TBackgroundKind;
FStyle: TSpkPaneStyle; FStyle: TSpkPaneStyle;
procedure SetCaptionBgColor(const Value: TColor); procedure SetCaptionBgColor(const Value: TColor);
@ -82,11 +83,12 @@ type TSpkPaneAppearance = class(TPersistent)
procedure SetGradientType(const Value: TBackgroundKind); procedure SetGradientType(const Value: TBackgroundKind);
procedure SetStyle(const Value: TSpkPaneStyle); procedure SetStyle(const Value: TSpkPaneStyle);
public public
procedure Assign(Source: TPersistent); override;
constructor Create(ADispatch: TSpkBaseAppearanceDispatch); constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure SaveToPascal(AList: TStrings);
procedure SaveToXML(Node: TSpkXMLNode); procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode); procedure LoadFromXML(Node: TSpkXMLNode);
destructor Destroy; override;
procedure Reset; procedure Reset;
published published
property BorderDarkColor: TColor read FBorderDarkColor write SetBorderDarkColor; property BorderDarkColor: TColor read FBorderDarkColor write SetBorderDarkColor;
@ -101,30 +103,30 @@ type TSpkPaneAppearance = class(TPersistent)
type TSpkElementAppearance = class(TPersistent) type TSpkElementAppearance = class(TPersistent)
private private
FDispatch : TSpkBaseAppearanceDispatch; FDispatch: TSpkBaseAppearanceDispatch;
protected protected
FCaptionFont : TFont; FCaptionFont: TFont;
FIdleFrameColor : TColor; FIdleFrameColor: TColor;
FIdleGradientFromColor : TColor; FIdleGradientFromColor: TColor;
FIdleGradientToColor : TColor; FIdleGradientToColor: TColor;
FIdleGradientType : TBackgroundKind; FIdleGradientType: TBackgroundKind;
FIdleInnerLightColor : TColor; FIdleInnerLightColor: TColor;
FIdleInnerDarkColor : TColor; FIdleInnerDarkColor: TColor;
FIdleCaptionColor : TColor; FIdleCaptionColor: TColor;
FHotTrackFrameColor : TColor; FHotTrackFrameColor: TColor;
FHotTrackGradientFromColor : TColor; FHotTrackGradientFromColor: TColor;
FHotTrackGradientToColor : TColor; FHotTrackGradientToColor: TColor;
FHotTrackGradientType : TBackgroundKind; FHotTrackGradientType: TBackgroundKind;
FHotTrackInnerLightColor : TColor; FHotTrackInnerLightColor: TColor;
FHotTrackInnerDarkColor : TColor; FHotTrackInnerDarkColor: TColor;
FHotTrackCaptionColor : TColor; FHotTrackCaptionColor: TColor;
FActiveFrameColor : TColor; FActiveFrameColor: TColor;
FActiveGradientFromColor : TColor; FActiveGradientFromColor: TColor;
FActiveGradientToColor : TColor; FActiveGradientToColor: TColor;
FActiveGradientType : TBackgroundKind; FActiveGradientType: TBackgroundKind;
FActiveInnerLightColor : TColor; FActiveInnerLightColor: TColor;
FActiveInnerDarkColor : TColor; FActiveInnerDarkColor: TColor;
FActiveCaptionColor : TColor; FActiveCaptionColor: TColor;
procedure SetActiveCaptionColor(const Value: TColor); procedure SetActiveCaptionColor(const Value: TColor);
procedure SetActiveFrameColor(const Value: TColor); procedure SetActiveFrameColor(const Value: TColor);
@ -149,80 +151,98 @@ type TSpkElementAppearance = class(TPersistent)
procedure SetIdleInnerDarkColor(const Value: TColor); procedure SetIdleInnerDarkColor(const Value: TColor);
procedure SetIdleInnerLightColor(const Value: TColor); procedure SetIdleInnerLightColor(const Value: TColor);
public public
procedure Assign(Source : TPersistent); override; constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
constructor Create(ADispatch : TSpkBaseAppearanceDispatch);
procedure SaveToXML(Node : TSpkXMLNode);
procedure LoadFromXML(Node : TSpkXMLNode);
destructor Destroy; override; destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure SaveToPascal(AList: TStrings);
procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode);
procedure Reset; procedure Reset;
published published
property CaptionFont : TFont read FCaptionFont write SetCaptionFont; property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
property IdleFrameColor : TColor read FIdleFrameColor write SetIdleFrameColor; property IdleFrameColor: TColor read FIdleFrameColor write SetIdleFrameColor;
property IdleGradientFromColor : TColor read FIdleGradientFromColor write SetIdleGradientFromColor; property IdleGradientFromColor: TColor read FIdleGradientFromColor write SetIdleGradientFromColor;
property IdleGradientToColor : TColor read FIdleGradientToColor write SetIdleGradientToColor; property IdleGradientToColor: TColor read FIdleGradientToColor write SetIdleGradientToColor;
property IdleGradientType : TBackgroundKind read FIdleGradientType write SetIdleGradientType; property IdleGradientType: TBackgroundKind read FIdleGradientType write SetIdleGradientType;
property IdleInnerLightColor : TColor read FIdleInnerLightColor write SetIdleInnerLightColor; property IdleInnerLightColor: TColor read FIdleInnerLightColor write SetIdleInnerLightColor;
property IdleInnerDarkColor : TColor read FIdleInnerDarkColor write SetIdleInnerDarkColor; property IdleInnerDarkColor: TColor read FIdleInnerDarkColor write SetIdleInnerDarkColor;
property IdleCaptionColor : TColor read FIdleCaptionColor write SetIdleCaptionColor; property IdleCaptionColor: TColor read FIdleCaptionColor write SetIdleCaptionColor;
property HotTrackFrameColor : TColor read FHotTrackFrameColor write SetHotTrackFrameColor; property HotTrackFrameColor: TColor read FHotTrackFrameColor write SetHotTrackFrameColor;
property HotTrackGradientFromColor : TColor read FHotTrackGradientFromColor write SetHotTrackGradientFromColor; property HotTrackGradientFromColor: TColor read FHotTrackGradientFromColor write SetHotTrackGradientFromColor;
property HotTrackGradientToColor : TColor read FHotTrackGradientToColor write SetHotTrackGradientToColor; property HotTrackGradientToColor: TColor read FHotTrackGradientToColor write SetHotTrackGradientToColor;
property HotTrackGradientType : TBackgroundKind read FHotTrackGradientType write SetHotTrackGradientType; property HotTrackGradientType: TBackgroundKind read FHotTrackGradientType write SetHotTrackGradientType;
property HotTrackInnerLightColor : TColor read FHotTrackInnerLightColor write SetHotTrackInnerLightColor; property HotTrackInnerLightColor: TColor read FHotTrackInnerLightColor write SetHotTrackInnerLightColor;
property HotTrackInnerDarkColor : TColor read FHotTrackInnerDarkColor write SetHotTrackInnerDarkColor; property HotTrackInnerDarkColor: TColor read FHotTrackInnerDarkColor write SetHotTrackInnerDarkColor;
property HotTrackCaptionColor : TColor read FHotTrackCaptionColor write SetHotTrackCaptionColor; property HotTrackCaptionColor: TColor read FHotTrackCaptionColor write SetHotTrackCaptionColor;
property ActiveFrameColor : TColor read FActiveFrameColor write SetActiveFrameColor; property ActiveFrameColor: TColor read FActiveFrameColor write SetActiveFrameColor;
property ActiveGradientFromColor : TColor read FActiveGradientFromColor write SetActiveGradientFromColor; property ActiveGradientFromColor: TColor read FActiveGradientFromColor write SetActiveGradientFromColor;
property ActiveGradientToColor : TColor read FActiveGradientToColor write SetActiveGradientToColor; property ActiveGradientToColor: TColor read FActiveGradientToColor write SetActiveGradientToColor;
property ActiveGradientType : TBackgroundKind read FActiveGradientType write SetActiveGradientType; property ActiveGradientType: TBackgroundKind read FActiveGradientType write SetActiveGradientType;
property ActiveInnerLightColor : TColor read FActiveInnerLightColor write SetActiveInnerLightColor; property ActiveInnerLightColor: TColor read FActiveInnerLightColor write SetActiveInnerLightColor;
property ActiveInnerDarkColor : TColor read FActiveInnerDarkColor write SetActiveInnerDarkColor; property ActiveInnerDarkColor: TColor read FActiveInnerDarkColor write SetActiveInnerDarkColor;
property ActiveCaptionColor : TColor read FActiveCaptionColor write SetActiveCaptionColor; property ActiveCaptionColor: TColor read FActiveCaptionColor write SetActiveCaptionColor;
end; end;
type TSpkToolbarAppearance = class; type TSpkToolbarAppearance = class;
TSpkToolbarAppearanceDispatch = class(TSpkBaseAppearanceDispatch) TSpkToolbarAppearanceDispatch = class(TSpkBaseAppearanceDispatch)
private private
FToolbarAppearance : TSpkToolbarAppearance; FToolbarAppearance: TSpkToolbarAppearance;
protected protected
public public
constructor Create(AToolbarAppearance : TSpkToolbarAppearance); constructor Create(AToolbarAppearance: TSpkToolbarAppearance);
procedure NotifyAppearanceChanged; override; procedure NotifyAppearanceChanged; override;
end; end;
TSpkToolbarAppearance = class(TPersistent) TSpkToolbarAppearance = class(TPersistent)
private private
FAppearanceDispatch : TSpkToolbarAppearanceDispatch; FAppearanceDispatch: TSpkToolbarAppearanceDispatch;
protected protected
FTab : TSpkTabAppearance; FTab: TSpkTabAppearance;
FPane : TSpkPaneAppearance; FPane: TSpkPaneAppearance;
FElement : TSpkElementAppearance; FElement: TSpkElementAppearance;
FDispatch: TSpkBaseAppearanceDispatch;
FDispatch : TSpkBaseAppearanceDispatch;
procedure SetElementAppearance(const Value: TSpkElementAppearance); procedure SetElementAppearance(const Value: TSpkElementAppearance);
procedure SetPaneAppearance(const Value: TSpkPaneAppearance); procedure SetPaneAppearance(const Value: TSpkPaneAppearance);
procedure SetTabAppearance(const Value: TSpkTabAppearance); procedure SetTabAppearance(const Value: TSpkTabAppearance);
public public
procedure NotifyAppearanceChanged; constructor Create(ADispatch: TSpkBaseAppearanceDispatch); reintroduce;
constructor Create(ADispatch : TSpkBaseAppearanceDispatch); reintroduce;
destructor Destroy; override; destructor Destroy; override;
procedure Assign(Source : TPersistent); override; procedure Assign(Source: TPersistent); override;
procedure NotifyAppearanceChanged;
procedure Reset; procedure Reset;
procedure SaveToXML(Node : TSpkXMLNode); procedure SaveToPascal(AList: TStrings);
procedure LoadFromXML(Node : TSpkXMLNode); procedure SaveToXML(Node: TSpkXMLNode);
procedure LoadFromXML(Node: TSpkXMLNode);
published published
property Tab : TSpkTabAppearance read FTab write SetTabAppearance; property Tab: TSpkTabAppearance read FTab write SetTabAppearance;
property Pane : TSpkPaneAppearance read FPane write SetPaneAppearance; property Pane: TSpkPaneAppearance read FPane write SetPaneAppearance;
property Element : TSpkElementAppearance read FElement write SetElementAppearance; property Element: TSpkElementAppearance read FElement write SetElementAppearance;
end; end;
implementation implementation
uses 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 } { TSpkBaseToolbarAppearance }
@ -334,6 +354,20 @@ begin
FInactiveHeaderFontColor := FTabHeaderFont.Color; FInactiveHeaderFontColor := FTabHeaderFont.Color;
end; 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); procedure TSpkTabAppearance.SaveToXML(Node: TSpkXMLNode);
var var
Subnode: TSpkXMLNode; Subnode: TSpkXMLNode;
@ -525,11 +559,27 @@ begin
FStyle := psRectangleEtched; FStyle := psRectangleEtched;
end; 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); procedure TSpkPaneAppearance.SaveToXML(Node: TSpkXMLNode);
var var
Subnode: TSpkXMLNode; Subnode: TSpkXMLNode;
begin begin
if not(Assigned(Node)) then if not Assigned(Node) then
exit; exit;
Subnode := Node['CaptionFont',true]; Subnode := Node['CaptionFont',true];
@ -830,85 +880,114 @@ begin
FActiveCaptionColor := rgb(110, 66, 128); FActiveCaptionColor := rgb(110, 66, 128);
end; end;
procedure TSpkElementAppearance.SaveToXML(Node: TSpkXMLNode); procedure TSpkElementAppearance.SaveToPascal(AList: TStrings);
var Subnode : TSpkXMLNode;
begin begin
if not(assigned(Node)) then with AList do begin
exit; Add(' with Element do begin');
SaveFontToPascal(AList, FCaptionFont, ' CaptionFont');
Subnode:=Node['CaptionFont',true]; Add(' IdleFrameColor := $' + IntToHex(FIdleFrameColor, 8) + ';');
TSpkXMLTools.Save(Subnode, FCaptionFont); 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) + ';');
// *** Idle *** 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) + ';');
Subnode:=Node['IdleFrameColor',true]; Add(' ActiveFrameColor := $' + IntToHex(FActiveFrameColor, 8) + ';');
Subnode.TextAsColor:=FIdleFrameColor; 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;
Subnode:=Node['IdleGradientFromColor',true]; procedure TSpkElementAppearance.SaveToXML(Node: TSpkXMLNode);
Subnode.TextAsColor:=FIdleGradientFromColor; var
Subnode: TSpkXMLNode;
begin
if not Assigned(Node) then
exit;
Subnode:=Node['IdleGradientToColor',true]; Subnode := Node['CaptionFont',true];
Subnode.TextAsColor:=FIdleGradientToColor; TSpkXMLTools.Save(Subnode, FCaptionFont);
Subnode:=Node['IdleGradientType',true]; // *** Idle ***
Subnode.TextAsInteger:=integer(FIdleGradientType); Subnode := Node['IdleFrameColor',true];
Subnode.TextAsColor:=FIdleFrameColor;
Subnode:=Node['IdleInnerLightColor',true]; Subnode := Node['IdleGradientFromColor',true];
Subnode.TextAsColor:=FIdleInnerLightColor; Subnode.TextAsColor:=FIdleGradientFromColor;
Subnode:=Node['IdleInnerDarkColor',true]; Subnode := Node['IdleGradientToColor',true];
Subnode.TextAsColor:=FIdleInnerDarkColor; Subnode.TextAsColor:=FIdleGradientToColor;
Subnode:=Node['IdleCaptionColor',true]; Subnode := Node['IdleGradientType',true];
Subnode.TextAsColor:=FIdleCaptionColor; Subnode.TextAsInteger:=integer(FIdleGradientType);
// *** Hottrack *** Subnode := Node['IdleInnerLightColor',true];
Subnode.TextAsColor:=FIdleInnerLightColor;
Subnode:=Node['HottrackFrameColor',true]; Subnode := Node['IdleInnerDarkColor',true];
Subnode.TextAsColor:=FHottrackFrameColor; Subnode.TextAsColor:=FIdleInnerDarkColor;
Subnode:=Node['HottrackGradientFromColor',true]; Subnode := Node['IdleCaptionColor',true];
Subnode.TextAsColor:=FHottrackGradientFromColor; Subnode.TextAsColor:=FIdleCaptionColor;
Subnode:=Node['HottrackGradientToColor',true]; // *** Hottrack ***
Subnode.TextAsColor:=FHottrackGradientToColor; Subnode := Node['HottrackFrameColor',true];
Subnode.TextAsColor:=FHottrackFrameColor;
Subnode:=Node['HottrackGradientType',true]; Subnode := Node['HottrackGradientFromColor',true];
Subnode.TextAsInteger:=integer(FHottrackGradientType); Subnode.TextAsColor:=FHottrackGradientFromColor;
Subnode:=Node['HottrackInnerLightColor',true]; Subnode := Node['HottrackGradientToColor',true];
Subnode.TextAsColor:=FHottrackInnerLightColor; Subnode.TextAsColor:=FHottrackGradientToColor;
Subnode:=Node['HottrackInnerDarkColor',true]; Subnode := Node['HottrackGradientType',true];
Subnode.TextAsColor:=FHottrackInnerDarkColor; Subnode.TextAsInteger:=integer(FHottrackGradientType);
Subnode:=Node['HottrackCaptionColor',true]; Subnode := Node['HottrackInnerLightColor',true];
Subnode.TextAsColor:=FHottrackCaptionColor; Subnode.TextAsColor:=FHottrackInnerLightColor;
// *** Active *** Subnode := Node['HottrackInnerDarkColor',true];
Subnode.TextAsColor:=FHottrackInnerDarkColor;
Subnode:=Node['ActiveFrameColor',true]; Subnode := Node['HottrackCaptionColor',true];
Subnode.TextAsColor:=FActiveFrameColor; Subnode.TextAsColor:=FHottrackCaptionColor;
Subnode:=Node['ActiveGradientFromColor',true]; // *** Active ***
Subnode.TextAsColor:=FActiveGradientFromColor; Subnode := Node['ActiveFrameColor',true];
Subnode.TextAsColor:=FActiveFrameColor;
Subnode:=Node['ActiveGradientToColor',true]; Subnode := Node['ActiveGradientFromColor',true];
Subnode.TextAsColor:=FActiveGradientToColor; Subnode.TextAsColor:=FActiveGradientFromColor;
Subnode:=Node['ActiveGradientType',true]; Subnode := Node['ActiveGradientToColor',true];
Subnode.TextAsInteger:=integer(FActiveGradientType); Subnode.TextAsColor:=FActiveGradientToColor;
Subnode:=Node['ActiveInnerLightColor',true]; Subnode := Node['ActiveGradientType',true];
Subnode.TextAsColor:=FActiveInnerLightColor; Subnode.TextAsInteger:=integer(FActiveGradientType);
Subnode:=Node['ActiveInnerDarkColor',true]; Subnode := Node['ActiveInnerLightColor',true];
Subnode.TextAsColor:=FActiveInnerDarkColor; Subnode.TextAsColor:=FActiveInnerLightColor;
Subnode:=Node['ActiveCaptionColor',true]; Subnode := Node['ActiveInnerDarkColor',true];
Subnode.TextAsColor:=FActiveCaptionColor; Subnode.TextAsColor:=FActiveInnerDarkColor;
Subnode := Node['ActiveCaptionColor',true];
Subnode.TextAsColor:=FActiveCaptionColor;
end; end;
procedure TSpkElementAppearance.SetActiveCaptionColor( procedure TSpkElementAppearance.SetActiveCaptionColor(
@ -1178,19 +1257,27 @@ begin
FAppearanceDispatch.NotifyAppearanceChanged; FAppearanceDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkToolbarAppearance.SaveToXML(Node: TSpkXMLNode); procedure TSpkToolbarAppearance.SaveToPascal(AList: TStrings);
var Subnode : TSpkXMLNode;
begin begin
Subnode:=Node['Tab',true]; AList.Add('with Appearance do begin');
FTab.SaveToXML(Subnode); FTab.SaveToPascal(AList);
FPane.SaveToPascal(AList);
FElement.SaveToPascal(AList);
AList.ADd('end;');
end;
Subnode:=Node['Pane',true]; procedure TSpkToolbarAppearance.SaveToXML(Node: TSpkXMLNode);
FPane.SaveToXML(Subnode); var
Subnode: TSpkXMLNode;
begin
Subnode:=Node['Tab',true];
FTab.SaveToXML(Subnode);
Subnode:=Node['Element',true]; Subnode:=Node['Pane',true];
FElement.SaveToXML(Subnode); FPane.SaveToXML(Subnode);
Subnode:=Node['Element',true];
FElement.SaveToXML(Subnode);
end; end;
procedure TSpkToolbarAppearance.SetElementAppearance( procedure TSpkToolbarAppearance.SetElementAppearance(

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

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

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

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