SpkToolbar: Add new pane property "Style". Update appearance editor. Minor refactoring of pane drawing code.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5350 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-11-14 16:13:10 +00:00
parent 812b1db7f8
commit b4cb2a0de2
4 changed files with 333 additions and 173 deletions
--- a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas
+++ b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas
@ -18,6 +18,10 @@ uses Graphics, Classes, Forms, SysUtils,
     SpkGUITools, SpkXMLParser, SpkXMLTools,
     spkt_Dispatch, spkt_Exceptions, spkt_Const;

+type
+  TSpkPaneStyle = (psRectangleFlat, psRectangleEtched, psRectangleRaised,
+    psDividerFlat, psDividerEtched, psDividerRaised);
+
 type TSpkTabAppearance = class(TPersistent)
     private
       FDispatch : TSpkBaseAppearanceDispatch;
@ -67,14 +71,16 @@ type TSpkPaneAppearance = class(TPersistent)
       FGradientFromColor : TColor;
       FGradientToColor : TColor;
       FGradientType : TBackgroundKind;
+       FStyle: TSpkPaneStyle;

+       procedure SetCaptionBgColor(const Value: TColor);
       procedure SetCaptionFont(const Value: TFont);
       procedure SetBorderDarkColor(const Value: TColor);
       procedure SetBorderLightColor(const Value: TColor);
       procedure SetGradientFromColor(const Value: TColor);
       procedure SetGradientToColor(const Value: TColor);
       procedure SetGradientType(const Value: TBackgroundKind);
-       procedure SetCaptionBgColor(const Value: TColor);
+       procedure SetStyle(const Value: TSpkPaneStyle);
     public
       procedure Assign(Source: TPersistent); override;
       constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
@ -90,6 +96,7 @@ type TSpkPaneAppearance = class(TPersistent)
       property GradientFromColor: TColor read FGradientFromColor write SetGradientFromColor;
       property GradientToColor: TColor read FGradientToColor write SetGradientToColor;
       property GradientType: TBackgroundKind read FGradientType write SetGradientType;
+       property Style: TSpkPaneStyle read FStyle write SetStyle default psRectangleEtched;
     end;

 type TSpkElementAppearance = class(TPersistent)
@ -414,6 +421,7 @@ begin
     FGradientFromColor := SrcAppearance.GradientFromColor;
     FGradientToColor := SrcAppearance.GradientToColor;
     FGradientType := SrcAppearance.GradientType;
+     FStyle := SrcAppearance.Style;

     if FDispatch<>nil then
        FDispatch.NotifyAppearanceChanged;
@ -426,6 +434,7 @@ begin
  inherited Create;
  FDispatch:=ADispatch;
  FCaptionFont:=TFont.Create;
+  FStyle := psRectangleEtched;
  Reset;
 end;

@ -436,40 +445,43 @@ begin
 end;

 procedure TSpkPaneAppearance.LoadFromXML(Node: TSpkXMLNode);
-
-var Subnode : TSpkXMLNode;
-
+var
+  Subnode: TSpkXMLNode;
 begin
-if not(assigned(Node)) then
+  if not(Assigned(Node)) then
    exit;

  Subnode := Node['CaptionFont', false];
-if assigned(Subnode) then
+  if Assigned(Subnode) then
    TSpkXMLTools.Load(Subnode, FCaptionFont);

  Subnode := Node['BorderDarkColor', false];
-if assigned(Subnode) then
+  if Assigned(Subnode) then
    FBorderDarkColor := Subnode.TextAsColor;

  Subnode := Node['BorderLightColor', false];
-if assigned(Subnode) then
+  if Assigned(Subnode) then
    FBorderLightColor := Subnode.TextAsColor;

  Subnode := Node['CaptionBgColor', false];
-if assigned(Subnode) then
+  if Assigned(Subnode) then
    FCaptionBgColor := Subnode.TextAsColor;

  Subnode := Node['GradientFromColor', false];
-if assigned(Subnode) then
+  if Assigned(Subnode) then
    FGradientFromColor := Subnode.TextAsColor;

  Subnode := Node['GradientToColor', false];
-if assigned(Subnode) then
+  if Assigned(Subnode) then
    FGradientToColor := Subnode.TextAsColor;

  Subnode := Node['GradientType', false];
  if assigned(Subnode) then
    FGradientType := TBackgroundKind(Subnode.TextAsInteger);
+
+  Subnode := Node['Style', false];
+  if Assigned(Subnode) then
+    FStyle := TSpkPaneStyle(SubNode.TextAsInteger);
 end;

 procedure TSpkPaneAppearance.Reset;
@ -510,14 +522,14 @@ begin
  FGradientFromColor := rgb(222, 232, 245);
  FGradientToColor := rgb(199, 216, 237);
  FGradientType := bkConcave;
+  FStyle := psRectangleEtched;
 end;

 procedure TSpkPaneAppearance.SaveToXML(Node: TSpkXMLNode);
-
-var Subnode : TSpkXMLNode;
-
+var
+  Subnode: TSpkXMLNode;
 begin
-if not(assigned(Node)) then
+  if not(Assigned(Node)) then
    exit;

  Subnode := Node['CaptionFont',true];
@ -540,6 +552,9 @@ Subnode.TextAsColor:=FGradientToColor;

  Subnode := Node['GradientType',true];
  Subnode.TextAsInteger := integer(FGradientType);
+
+  Subnode := Node['Style', true];
+  Subnode.TextAsInteger := integer(FStyle);
 end;

 procedure TSpkPaneAppearance.SetBorderDarkColor(const Value: TColor);
@ -591,6 +606,13 @@ begin
     FDispatch.NotifyAppearanceChanged;
 end;

+procedure TSpkPaneAppearance.SetStyle(const Value: TSpkPaneStyle);
+begin
+  FStyle := Value;
+  if FDispatch <> nil then
+    FDispatch.NotifyAppearanceChanged;
+end;
+

 { TSpkElementAppearance }

--- a/components/spktoolbar/SpkToolbar/spkt_Pane.pas
+++ b/components/spktoolbar/SpkToolbar/spkt_Pane.pas
@ -224,13 +224,13 @@ begin
 end;

 procedure TSpkPane.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect);
-
-var x: Integer;
+var
+  x: Integer;
  y: Integer;
-    BgFromColor, BgToColor, CaptionColor, FontColor, BorderLightColor,
-    BorderDarkColor : TColor;
+  BgFromColor, BgToColor, CaptionColor: TColor;
+  FontColor, BorderLightColor, BorderDarkColor, c: TColor;
  i: Integer;
-
+  R: T2DIntRect;
 begin
  // W niektórych warunkach nie jesteœmy w stanie rysowaæ:
  // * Brak dyspozytora
@ -261,37 +261,40 @@ if FPaneState = psIdle then
  end;

  // T³o
-TGuiTools.DrawRoundRect(ABuffer.Canvas,
  {$IFDEF EnhancedRecordSupport}
-                        T2DIntRect.Create(FRect.left,
-                                          FRect.top,
-                                          FRect.right - PaneBorderHalfSize,
-                                          FRect.Bottom - PaneBorderHalfSize),
+  R := T2DIntRect.Create(
  {$ELSE}
-                        Create2DIntRect(FRect.left,
-                                          FRect.top,
-                                          FRect.right - PaneBorderHalfSize,
-                                          FRect.Bottom - PaneBorderHalfSize),
+  R := Create2DIntRect(
  {$ENDIF}
+    FRect.Left,
+    FRect.Top,
+    FRect.Right - PaneBorderHalfSize,
+    FRect.Bottom - PaneBorderHalfSize
+  );
+  TGuiTools.DrawRoundRect(
+    ABuffer.Canvas,
+    R,
    PaneCornerRadius,
    BgFromColor,
    BgToColor,
    FAppearance.Pane.GradientType,
-                        ClipRect);
+    ClipRect
+  );

  // T³o etykiety tafli
-TGuiTools.DrawRoundRect(ABuffer.Canvas,
  {$IFDEF EnhancedRecordSupport}
-                        T2DIntRect.Create(FRect.Left,
-                                          FRect.Bottom - PaneCaptionHeight - PaneBorderHalfSize,
-                                          FRect.right - PaneBorderHalfSize,
-                                          FRect.bottom - PaneBorderHalfSize),
+  R := T2DIntRect.Create(
  {$ELSE}
-                        Create2DIntRect(FRect.Left,
+  R := Create2DIntRect(
+  {$ENDIF}
+    FRect.Left,
    FRect.Bottom - PaneCaptionHeight - PaneBorderHalfSize,
    FRect.Right - PaneBorderHalfSize,
-                                          FRect.Bottom - PaneBorderHalfSize),
-                        {$ENDIF}
+    FRect.Bottom - PaneBorderHalfSize
+  );
+  TGuiTools.DrawRoundRect(
+    ABuffer.Canvas,
+    R,
    PaneCornerRadius,
    CaptionColor,
    clNone,
@ -300,61 +303,131 @@ TGuiTools.DrawRoundRect(ABuffer.Canvas,
    false,
    false,
    true,
-                        true);
+    true
+  );

  // Etykieta tafli
-ABuffer.Canvas.Font.assign(FAppearance.Pane.CaptionFont);
-x:=FRect.left + (FRect.width - ABuffer.Canvas.TextWidth(FCaption)) div 2;
+  ABuffer.Canvas.Font.Assign(FAppearance.Pane.CaptionFont);
+  x := FRect.Left + (FRect.Width - ABuffer.Canvas.TextWidth(FCaption)) div 2;
  y := FRect.Bottom - PaneBorderSize - PaneCaptionHeight + 1 +
        (PaneCaptionHeight - ABuffer.Canvas.TextHeight('Wy')) div 2;

-TGUITools.DrawText(ABuffer.Canvas,
+  TGUITools.DrawText(
+    ABuffer.Canvas,
    x,
    y,
    FCaption,
    FontColor,
-                   ClipRect);
+    ClipRect
+  );

-// Ramki
-TGUITools.DrawAARoundFrame(ABuffer,
+  // Frames
+  case FAppearance.Pane.Style of
+    psRectangleFlat:
+      begin
         {$IFDEF EnhancedRecordSupport}
-                           T2DIntRect.create(FRect.left+1,
-                                             FRect.top+1,
-                                             FRect.Right,
-                                             FRect.bottom),
+         R := T2DIntRect.Create(
         {$ELSE}
-                           Create2DIntRect(FRect.left+1,
-                                             FRect.top+1,
+         R := Create2DIntRect(
+         {$ENDIF}
+           FRect.Left,
+           FRect.Top,
           FRect.Right,
-                                             FRect.bottom),
-                           {$ENDIF}
-                           PaneCornerRadius,
-                           BorderLightColor,
-                           ClipRect);
-TGUITools.DrawAARoundFrame(ABuffer,
-                           {$IFDEF EnhancedRecordSupport}
-                           T2DIntRect.create(FRect.left,
-                                             FRect.top,
-                                             FRect.Right-1,
-                                             FRect.bottom-1),
-                           {$ELSE}
-                           Create2DIntRect(FRect.left,
-                                             FRect.top,
-                                             FRect.Right-1,
-                                             FRect.bottom-1),
-                           {$ENDIF}
+           FRect.bottom
+         );
+         TGUITools.DrawAARoundFrame(
+           ABuffer,
+           R,
           PaneCornerRadius,
           BorderDarkColor,
-                           ClipRect);
+           ClipRect
+         );
+      end;
+
+    psRectangleEtched, psRectangleRaised:
+      begin
+        {$IFDEF EnhancedRecordSupport}
+        R := T2DIntRect.Create(
+        {$ELSE}
+        R := Create2DIntRect(
+        {$ENDIF}
+          FRect.Left + 1,
+          FRect.Top + 1,
+          FRect.Right,
+          FRect.bottom
+        );
+        if FAppearance.Pane.Style = psRectangleEtched then
+          c := BorderLightColor else
+          c := BorderDarkColor;
+        TGUITools.DrawAARoundFrame(
+          ABuffer,
+          R,
+          PaneCornerRadius,
+          c,
+          ClipRect
+        );
+
+        {$IFDEF EnhancedRecordSupport}
+        R := T2DIntRect.Create(
+        {$ELSE}
+        R := Create2DIntRect(
+        {$ENDIF}
+          FRect.Left,
+          FRect.Top,
+          FRect.Right-1,
+          FRect.Bottom-1
+        );
+        if FAppearance.Pane.Style = psRectangleEtched then
+          c := BorderDarkColor else
+          c := BorderLightColor;
+        TGUITools.DrawAARoundFrame(
+          ABuffer,
+          R,
+          PaneCornerRadius,
+          c,
+          ClipRect
+        );
+      end;
+
+    psDividerRaised, psDividerEtched:
+      begin
+        if FAppearance.Pane.Style = psDividerRaised then
+          c := BorderLightColor else
+          c := BorderDarkColor;
+        TGUITools.DrawVLine(
+          ABuffer,
+          FRect.Right + PaneBorderHalfSize - 1,
+          FRect.Top,
+          FRect.Bottom,
+          c
+        );
+        if FAppearance.Pane.Style = psDividerRaised then
+          c := BorderDarkColor else
+          c := BorderLightColor;
+        TGUITools.DrawVLine(
+          ABuffer,
+          FRect.Right + PaneBorderHalfSize,
+          FRect.Top,
+          FRect.Bottom,
+          c
+        );
+      end;
+
+    psDividerFlat:
+       TGUITools.DrawVLine(
+         ABuffer,
+         FRect.Right + PaneBorderHalfSize,
+         FRect.Top,
+         FRect.Bottom,
+         BorderDarkColor
+      );
+  end;

  // Elementy
-if FItems.Count>0 then
  for i := 0 to FItems.Count - 1 do
-       begin
    if FItems[i].Visible then
      Fitems[i].Draw(ABuffer, ClipRect);
 end;
-end;

 function TSpkPane.FindItemAt(x, y : integer) : integer;

--- a/components/spktoolbar/designtime/spkte_AppearanceEditor.lfm
+++ b/components/spktoolbar/designtime/spkte_AppearanceEditor.lfm
@ -9,8 +9,10 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
  Color = clBtnFace
  Font.Color = clWindowText
  Font.Height = -12
+  OnCloseQuery = FormCloseQuery
  OnCreate = FormCreate
  OnShow = FormShow
+  ShowHint = True
  LCLVersion = '1.7'
  object gbPreview: TGroupBox
    Left = 0
@ -319,14 +321,14 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
    Height = 347
    Top = 132
    Width = 536
-    ActivePage = TabSheet3
+    ActivePage = TabSheet2
    Align = alClient
-    TabIndex = 2
+    TabIndex = 1
    TabOrder = 1
    object TabSheet1: TTabSheet
      Caption = 'Tab'
-      ClientHeight = 326
-      ClientWidth = 549
+      ClientHeight = 319
+      ClientWidth = 528
      object Label2: TLabel
        AnchorSideTop.Control = pTabFrame
        AnchorSideTop.Side = asrCenter
@ -677,6 +679,7 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
        Width = 137
        BorderSpacing.Left = 12
        BorderSpacing.Top = 4
+        Visible = False
      end
      object pPaneBorderDark: TPanel
        AnchorSideLeft.Control = cbLinkPane
@ -821,6 +824,46 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
        OnClick = cbLinkPaneClick
        TabOrder = 8
      end
+      object cbPaneStyle: TComboBox
+        AnchorSideLeft.Control = pPaneCaptionFont
+        AnchorSideTop.Control = pPaneCaptionFont
+        AnchorSideTop.Side = asrBottom
+        AnchorSideRight.Control = pPaneCaptionFontColor
+        AnchorSideRight.Side = asrBottom
+        Left = 141
+        Height = 23
+        Top = 265
+        Width = 121
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 6
+        ItemHeight = 15
+        ItemIndex = 1
+        Items.Strings = (
+          'Rectangle flat'
+          'Rectangle etched'
+          'Rectangle raised'
+          'Divider flat'
+          'Divider etched'
+          'Divider raised'
+        )
+        OnChange = cbPaneStyleChange
+        Style = csDropDownList
+        TabOrder = 9
+        Text = 'Rectangle etched'
+      end
+      object Label12: TLabel
+        AnchorSideTop.Control = cbPaneStyle
+        AnchorSideTop.Side = asrCenter
+        AnchorSideRight.Control = LblCaptionBackground
+        AnchorSideRight.Side = asrBottom
+        Left = 68
+        Height = 15
+        Top = 269
+        Width = 53
+        Anchors = [akTop, akRight]
+        Caption = 'Pane style'
+        ParentColor = False
+      end
    end
    object TabSheet3: TTabSheet
      Caption = 'Item'
--- a/components/spktoolbar/designtime/spkte_AppearanceEditor.pas
+++ b/components/spktoolbar/designtime/spkte_AppearanceEditor.pas
@ -16,7 +16,9 @@ type
  { TfrmAppearanceEditWindow }

  TfrmAppearanceEditWindow = class(TForm)
+    cbPaneStyle: TComboBox;
    gbPreview: TGroupBox;
+    Label12: TLabel;
    SmallImages: TImageList;
    LargeImages: TImageList;
    Label18: TLabel;
@ -128,9 +130,11 @@ type
    procedure cbItemActiveGradientKindChange(Sender: TObject);
    procedure cbItemHottrackGradientKindChange(Sender: TObject);
    procedure cbItemIdleGradientKindChange(Sender: TObject);
-    procedure cbTabGradientKindChange(Sender: TObject);
    procedure cbPaneGradientKindChange(Sender: TObject);
+    procedure cbPaneStyleChange(Sender: TObject);
+    procedure cbTabGradientKindChange(Sender: TObject);

+    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);

@ -207,6 +211,9 @@ implementation

 {$R *.lfm}

+var
+  CurrPageIndex: Integer = 0;
+
 { TForm3 }

 procedure TfrmAppearanceEditWindow.SetAppearance(const Value: TSpkToolbarAppearance);
@ -362,6 +369,12 @@ begin
    Result := false;
 end;

+procedure TfrmAppearanceEditWindow.FormCloseQuery(Sender: TObject;
+  var CanClose: boolean);
+begin
+  if CanClose then CurrPageIndex := PageControl1.PageIndex;
+end;
+
 procedure TfrmAppearanceEditWindow.FormCreate(Sender: TObject);
 begin
  bOK.AutoSize := false;
@ -369,6 +382,8 @@ begin

  LargeImages.AddIcon(Application.Icon);
  SmallImages.AddIcon(Application.Icon);
+
+  PageControl1.PageIndex := CurrPageIndex;
 end;

 procedure TfrmAppearanceEditWindow.FormShow(Sender: TObject);
@ -406,6 +421,7 @@ begin
      SetPanelColor(pPaneCaptionBackground, CaptionBgColor);
      SetPanelFont(pPaneCaptionFont, CaptionFont);
      SetPanelColor(pPaneCaptionFontColor, CaptionFont.Color);
+      cbPaneStyle.ItemIndex := ord(Style);
    end;

    with Element do
@ -671,6 +687,12 @@ begin
    SetLinkedGradientKind((Sender as TComboBox).ItemIndex);
 end;

+procedure TfrmAppearanceEditWindow.cbPaneStyleChange(Sender: TObject);
+begin
+  with tbPreview.Appearance.Pane do
+    Style := TSpkPaneStyle((Sender as TCombobox).ItemIndex);
+end;
+
 procedure TfrmAppearanceEditWindow.pPaneGradientToClick(Sender: TObject);
 begin
  if ChangeColor(Sender as TPanel) then