SpkToolbar: Export Appearance properties as Pascal code.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5353 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/spktoolbar/SpkToolbar/spkt_Appearance.pas

@@ -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);
+procedure TSpkElementAppearance.SaveToPascal(AList: TStrings);
-
-var Subnode : TSpkXMLNode;
-
 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
-var Subnode : TSpkXMLNode;
+  Subnode: TSpkXMLNode;
-
 begin
   Subnode:=Node['Tab',true];
   FTab.SaveToXML(Subnode);

components/spktoolbar/designtime/spkte_AppearanceEditor.lfm

@@ -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
+      ClientHeight = 340
-      ClientWidth = 549
+      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
+      object bExportToXML: TButton
-        AnchorSideLeft.Control = TabSheet4
+        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'

components/spktoolbar/designtime/spkte_AppearanceEditor.pas

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