spktoolbar: Option to draw selection in TSpkToolbar with rounded corners.

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

components/spktoolbar/SpkGUITools/SpkGUITools.pas

@@ -247,6 +247,11 @@ type
                                  LeftBottomRound : boolean = true;
                                  RightBottomRound : boolean = true); overload;
 
+    class procedure DrawRoundRectBorder(ACanvas: TCanvas;
+                                        ARect: T2DIntRect;
+                                        ARadius: Integer;
+                                        AColor: TColor);
+
     class procedure DrawPopupItemRect(ACanvas: TCanvas;
                                       ARect: T2DIntRect;
                                       ARadius: Integer;
@@ -2265,6 +2270,84 @@ begin
   DeleteObject(ClipRgn);
 end;
 
+class procedure TGUITools.DrawRoundRectBorder(ACanvas: TCanvas; ARect: T2DIntRect;
+  ARadius: Integer; AColor: TColor);
+var
+  x1, x2, y1, y2: Integer;
+begin
+  // *** Straight edges ***
+  // Top
+  x1 := ARect.Left + ARadius ;
+  x2 := ARect.Right - ARadius - 1;
+  y1 := ARect.Top;
+  TGuiTools.DrawHLine(ACanvas, x1, x2, y1, AColor);
+
+  // Bottom
+  y1 := ARect.Bottom;
+  TGuiTools.DrawHLine(ACanvas, x1, x2, y1, AColor);
+
+  // Left
+  y1 := ARect.Top + ARadius;
+  y2 := ARect.Bottom - ARadius;
+  x1 := ARect.Left;
+  TGuiTools.DrawVLine(ACanvas, x1, y1, y2, AColor);
+
+  // Right
+  x1 := ARect.Right - 1;
+  TGuiTools.DrawVLine(ACanvas, x1, y1, y2, AColor);
+
+  // *** Rounded corners ***
+  // top/left
+  TGuiTools.DrawAARoundCorner(
+    ACanvas,
+    {$IFDEF EnhancedRecordSupport}
+    T2DIntPoint.Create(ARect.Left, ARect.Top),
+    {$ELSE}
+    Create2DIntPoint(ARect.Left, ARect.Top),
+    {$ENDIF}
+    ARadius,
+    cpLeftTop,
+    AColor
+  );
+  // top/right
+  TGuiTools.DrawAARoundCorner(
+    ACanvas,
+    {$IFDEF EnhancedRecordSupport}
+    T2DIntPoint.Create(ARect.Right - ARadius - 1, ARect.Top),
+    {$ELSE}
+    Create2DIntPoint(ARect.Right - ARadius - 1, ARect.Top),
+    {$ENDIF}
+    ARadius,
+    cpRightTop,
+    AColor
+  );
+  // bottom/left
+  TGuiTools.DrawAARoundCorner(
+    ACanvas,
+    {$IFDEF EnhancedRecordSupport}
+    T2DIntPoint.Create(ARect.Left, ARect.Bottom - ARadius),
+    {$ELSE}
+    Create2DIntPoint(ARect.Left, ARect.Bottom - ARadius),
+    {$ENDIF}
+    ARadius,
+    cpLeftBottom,
+    AColor
+  );
+  // bottom/right
+  TGuiTools.DrawAARoundCorner(
+    ACanvas,
+    {$IFDEF EnhancedRecordSupport}
+    T2DIntPoint.Create(ARect.Right - ARadius - 1, ARect.Bottom - ARadius),
+    {$ELSE}
+    Create2DIntPoint(ARect.Right - ARadius - 1, ARect.Bottom - ARadius),
+    {$ENDIF}
+    ARadius,
+    cpRightBottom,
+    AColor
+  );
+end;
+
+
 class procedure TGUITools.DrawText(ACanvas: TCanvas; x, y: integer;
   const AText: string; TextColor: TColor);
 begin

components/spktoolbar/SpkPopupMenu/spkpopup.pas

@@ -63,7 +63,7 @@ var
   GradientType: TBackgroundKind;
   P: T2DIntPoint;
   R, Rgutter, Rcheck: T2DIntRect;
-  Radius: Integer;
+  Radius: Integer = 0;
   x, y, wGutter, hText, wText: Integer;
   iconSize: TSize;
   checkboxSize: TSize;
@@ -98,22 +98,27 @@ begin
       ColorFrom := FAppearance.Popup.HotTrackGradientFromColor;
       ColorTo := FAppearance.Popup.HotTrackGradientToColor;
       GradientType := FAppearance.Popup.HotTrackGradientType;
-      Radius := 0;  // maybe to be changed...
+      if FAppearance.Popup.SelectionShape = ssRounded then
+        Radius := DropdownSelectionRadius
     end else
     begin
       ColorFrom := FAppearance.Popup.IdleGradientFromColor;
       ColorTo := FAppearance.Popup.IdleGradientToColor;
       GradientType := FAppearance.Popup.IdleGradientType;
-      Radius := 0;
     end;
     TGUITools.DrawPopupItemRect(ACanvas, R, Radius, ColorFrom, ColorTo, GradientType);
     if isHot and (FrameColor <> clNone) then
+    begin
+      if FAppearance.Popup.SelectionShape = ssRounded then
+        TGUITools.DrawRoundRectBorder(ACanvas, R, Radius, FrameColor)
+      else
       begin
         TGUITools.DrawHLine(ACanvas, R.Left, R.Right-1, R.Top, FrameColor);
         TGUITools.DrawHLine(ACanvas, R.Left, R.Right-1, R.Bottom-1, FrameColor);
         TGUITools.DrawVLine(ACanvas, R.Left, R.Top, R.Bottom-1, FrameColor);
         TGUITools.DrawVLine(ACanvas, R.Right-1, R.Top, R.Bottom-1, FrameColor);
       end;
+    end;
 
     // Gutter
 

components/spktoolbar/SpkToolbar/SpkToolbar.pas

@@ -2472,6 +2472,9 @@ begin
   if SmallButtonRadius > 1 then
     SmallButtonRadius := round(SmallButtonRadius * AXProportion);
 
+  if DropDownSelectionRadius > 0 then
+    DropdownSelectionRadius := round(DROPDOWN_SELECTION_RADIUS * AXProportion);
+
   if PaneCornerRadius > 1 then
     PaneCornerRadius := round(PaneCornerRadius * AXProportion);
 

components/spktoolbar/SpkToolbar/spkt_Appearance.pas

@@ -27,10 +27,10 @@ type
   );
 
   TSpkElementStyle = (esRounded, esRectangle);
+  TSpkMenuButtonShapeStyle = (mbssRounded, mbssRectangle);
 
   TSpkPopupStyle = (psDefault, psGutter);
-
+  TSpkPopupSelectionShape = (ssRounded, ssRectangle);
-  TSpkMenuButtonShapeStyle = (mbssRounded, mbssRectangle);
 
   TSpkStyle = (
     spkOffice2007Blue,
@@ -362,6 +362,7 @@ type
     FIdleGradientToColor: TColor;
     FIdleGradientType: TBackgroundKind;
     FStyle: TSpkPopupStyle;
+    FSelShape: TSpkPopupSelectionShape;
     procedure SetCaptionFont(const Value: TFont);
     procedure SetCheckedFrameColor(const Value: TColor);
     procedure SetCheckedGradientFromColor(const Value: TColor);
@@ -382,6 +383,7 @@ type
     procedure SetIdleGradientFromColor(const Value: TColor);
     procedure SetIdleGradientToColor(const Value: TColor);
     procedure SetIdleGradientType(const Value: TBackgroundKind);
+    procedure SetSelShape(const Value: TSpkPopupSelectionShape);
     procedure SetStyle(const Value: TSpkPopupStyle);
   protected
     procedure CaptionFontChange(Sender: TObject);
@@ -414,6 +416,7 @@ type
     property IdleGradientFromColor: TColor read FIdleGradientFromColor write SetIdleGradientFromColor;
     property IdleGradientToColor: TColor read FIdleGradientToColor write SetIdleGradientToColor;
     property IdleGradientType: TBackgroundKind read FHotTrackGradientType write SetHotTrackGradientType;
+    property SelectionShape: TSpkPopupSelectionShape read FSelShape write SetSelShape;
     property Style: TSpkPopupStyle read FStyle write SetStyle;
   end;
 
@@ -1798,7 +1801,9 @@ begin
     FHotTrackGradientToColor := SrcAppearance.HotTrackGradientToColor;
     FHotTrackGradientType := SrcAppearance.HotTrackGradientType;
 
+    FSelShape := SrcAppearance.SelectionShape;
     FStyle := SrcAppearance.Style;
+
     if FDispatch <> nil then
       FDispatch.NotifyAppearanceChanged;
   end else
@@ -1853,11 +1858,7 @@ begin
   Subnode := Node['IdleCaptionColor', false];
   if Assigned(Subnode) then
     FIdleCaptionColor := Subnode.TextAsColor;
-  {
+
-  Subnode := Node['IdleFrameColor', false];
-  if Assigned(Subnode) then
-    FIdleFrameColor := Subnode.TextAsColor;
-  }
   Subnode := Node['IdleGradientFromColor', false];
   if Assigned(Subnode) then
     FIdleGradientFromColor := Subnode.TextAsColor;
@@ -1870,16 +1871,6 @@ begin
   if Assigned(Subnode) then
     FIdleGradientType := TBackgroundKind(Subnode.TextAsInteger);
 
-  {
-  Subnode := Node['IdleInnerLightColor', false];
-  if Assigned(Subnode) then
-    FIdleInnerLightColor := Subnode.TextAsColor;
-
-  Subnode := Node['IdleInnerDarkColor', false];
-  if Assigned(Subnode) then
-    FIdleInnerDarkColor := Subnode.TextAsColor;
-  }
-
   // Gutter
   Subnode := Node['GutterFrameColor', false];
   if Assigned(Subnode) then
@@ -1897,7 +1888,6 @@ begin
   if Assigned(Subnode) then
     FGutterGradientType := TBackgroundKind(Subnode.TextAsInteger);
 
-
   // HotTrack
   Subnode := Node['HottrackCaptionColor', false];
   if Assigned(Subnode) then
@@ -1918,21 +1908,12 @@ begin
   Subnode := Node['HottrackGradientType', false];
   if Assigned(Subnode) then
     FHottrackGradientType := TBackgroundKind(Subnode.TextAsInteger);
-  {
-  Subnode := Node['HottrackInnerLightColor', false];
-  if Assigned(Subnode) then
-    FHottrackInnerLightColor := Subnode.TextAsColor;
-
-  Subnode := Node['HottrackInnerDarkColor', false];
-  if Assigned(Subnode) then
-    FHottrackInnerDarkColor := Subnode.TextAsColor;
-
-  Subnode := Node['HottrackBrightnessChange', false];
-  if Assigned(Subnode) then
-    FHottrackBrightnessChange := Subnode.TextAsInteger;
-    }
 
   // Other
+  Subnode := Node['SelectionShape', false];
+  if Assigned(Subnode) then
+    FSelShape := TSpkPopupSelectionShape(Subnode.TextAsInteger);
+
   Subnode := Node['Style', false];
   if Assigned(SubNode) then
     FStyle := TSpkPopupStyle(Subnode.TextAsInteger);
@@ -1977,6 +1958,7 @@ begin
         FIdleGradientToColor := rgb(250, 250, 250);
         FIdleGradientType := bkSolid;
         FStyle := psGutter;
+        FSelShape := ssRectangle;
       end;
 
     spkOffice2007Silver,
@@ -2031,6 +2013,7 @@ begin
           FHotTrackGradientToColor := $004DD7FF;
         end;
         FStyle := psGutter;
+        FSelShape := ssRectangle;
       end;
 
     spkMetroLight:
@@ -2074,6 +2057,7 @@ begin
         }
 
         FStyle := psDefault;
+        FSelShape := ssRectangle;
       end;
 
     spkMetroDark:
@@ -2112,6 +2096,7 @@ begin
         FIdleInnerLightColor := $00444444;
         }
         FStyle := psDefault;
+        FSelShape := ssRectangle;
       end;
   end;
 end;
@@ -2146,6 +2131,7 @@ begin
     Add('    HotTrackGradientToColor := $%.8x;', [FHotTrackGradientToColor]);
     Add('    HotTrackGradientType := %s;', [GradientTypeName(FHotTrackGradientType)]);
 
+    Add('    SelectionShape := %s;', [GetEnumName(TypeInfo(TSpkPopupSelectionShape), ord(FSelShape))]);
     Add('    Style := %s;', [GetEnumName(TypeInfo(TSpkPopupStyle), ord(FStyle))]);
     Add('  end;');
   end;
@@ -2244,6 +2230,9 @@ begin
 }
 
   // Other
+  Subnode := Node['SelectionShape', true];
+  Subnode.TextAsInteger := integer(FSelShape);
+
   Subnode := Node['Style', true];
   Subnode.TextAsInteger := integer(FStyle);
 end;
@@ -2388,6 +2377,13 @@ begin
     FDispatch.NotifyAppearanceChanged;
 end;
 
+procedure TSpkPopupMenuAppearance.SetSelShape(const Value: TSpkPopupSelectionShape);
+begin
+  FSelShape := Value;
+  if FDispatch <> nil then
+    FDispatch.NotifyAppearanceChanged;
+end;
+
 procedure TSpkPopupMenuAppearance.SetStyle(const Value: TSpkPopupStyle);
 begin
   FStyle := Value;

components/spktoolbar/SpkToolbar/spkt_Const.pas

@@ -28,7 +28,6 @@ const
   // ****************
   // *** Elements ***
   // ****************
-
   LARGEBUTTON_DROPDOWN_FIELD_SIZE = 29;
   LARGEBUTTON_GLYPH_MARGIN = 2;
   LARGEBUTTON_CAPTION_HMARGIN = 3;
@@ -58,7 +57,6 @@ const
   // ***********************
   // *** Tab page layout ***
   // ***********************
-
   /// <summary>Maximum area height that can be used by an element</summary>
   MAX_ELEMENT_HEIGHT = 67;
 
@@ -96,7 +94,6 @@ const
   // *******************
   // *** Pane layout ***
   // *******************
-
   /// <summary>Pane caption height</summary>
   PANE_CAPTION_HEIGHT = 15;
   /// <summary>Pane corner radius</summary>
@@ -115,7 +112,6 @@ const
   // ************
   // *** Tabs ***
   // ************
-
   /// <summary>Tab corner radius</summary>
   TAB_CORNER_RADIUS = 4;
   /// <summary>Tab page left margin</summary>
@@ -135,7 +131,6 @@ const
   // *******************
   // *** Menu button ***
   // *******************
-
   /// <summary>Menu button corner radius</summary>
   MENUBUTTON_CORNER_RADIUS = 4;
   /// <summary>Menu button minimum width</summary>
@@ -145,7 +140,6 @@ const
   // ***************
   // *** Toolbar ***
   // ***************
-
   /// <summary>Pane padding?</summary>
   TOOLBAR_BORDER_WIDTH = 1;
   TOOLBAR_CORNER_RADIUS = 0;  //was: 3;
@@ -160,8 +154,8 @@ const
   // *********************
   // *** Dropdown menu ***
   // *********************
-
   DROPDOWN_MENU_MARGIN = 3;
+  DROPDOWN_SELECTION_RADIUS = 4;
 
 var
   // ****************
@@ -200,6 +194,7 @@ var
   // *********************
 
   DropDownMenuMargin: Integer;
+  DropDownSelectionRadius: Integer;
 
 
   // ***********************
@@ -358,6 +353,7 @@ begin
   DropdownArrowHeight := SpkScaleY(DROPDOWN_ARROW_HEIGHT, FromDPI, ToDPI);
 
   DropdownMenuMargin := SpkScaleX(DROPDOWN_MENU_MARGIN, FromDPI, ToDpi);
+  DropdownSelectionRadius := DROPDOWN_SELECTION_RADIUS;
 
   MaxElementHeight := SpkScaleY(MAX_ELEMENT_HEIGHT, FromDPI, ToDPI);
   PaneRowHeight := SpkScaleY(PANE_ROW_HEIGHT, FromDPI, ToDPI);
@@ -411,6 +407,9 @@ begin
   if SmallButtonRadius > 1 then
     SmallButtonRadius := SpkScaleX(SmallButtonRadius, FromDPI, ToDPI);
 
+  if DropDownSelectionRadius > 1 then
+    DropDownSelectionRadius := SpkScaleX(DropDownSelectionRadius, FromDPI, ToDPI);
+
   if PaneCornerRadius > 1 then
     PaneCornerRadius := SpkScaleX(PaneCornerRadius, FromDPI, ToDPI);
 

components/spktoolbar/designtime/spkte_AppearanceEditor.lfm

@@ -3946,6 +3946,39 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
         TabOrder = 19
         Text = 'None'
       end
+      object cbPopupHotSelectionShape: TComboBox
+        AnchorSideLeft.Control = pPopupHotTrackGradientToColor
+        AnchorSideTop.Control = pPopupDividerLineColor
+        AnchorSideTop.Side = asrCenter
+        AnchorSideRight.Control = pPopupHotTrackGradientToColor
+        AnchorSideRight.Side = asrBottom
+        Left = 281
+        Height = 23
+        Top = 251
+        Width = 100
+        Anchors = [akTop, akLeft, akRight]
+        BorderSpacing.Top = 2
+        ItemHeight = 15
+        ItemIndex = 0
+        Items.Strings = (
+          'rounded'
+          'rectangle'
+        )
+        OnChange = cbPopupHotSelectionShapeChange
+        Style = csDropDownList
+        TabOrder = 20
+        Text = 'rounded'
+      end
+      object lblPopupHotSelectionShape: TLabel
+        AnchorSideLeft.Control = cbPopupHotSelectionShape
+        AnchorSideBottom.Control = cbPopupHotSelectionShape
+        Left = 281
+        Height = 15
+        Top = 234
+        Width = 82
+        Anchors = [akLeft, akBottom]
+        Caption = 'Selection shape'
+      end
     end
     object TabSheet4: TTabSheet
       Caption = 'Import / Export'

components/spktoolbar/designtime/spkte_AppearanceEditor.pas

@@ -49,6 +49,7 @@ type
     bvPaneVertSpacer: TBevel;
     cbPopupGutterGradientKind: TComboBox;
     cbPopupCheckedGradientKind: TComboBox;
+    cbPopupHotSelectionShape: TComboBox;
     cbPopupIdleGradientKind: TComboBox;
     cbMenuButtonActiveGradientKind: TComboBox;
     cbMenuButtonHottrackGradientKind: TComboBox;
@@ -58,6 +59,7 @@ type
     edMenuButtonHotTrackBrightnessChange: TSpinEdit;
 
     edTabCaptionHeight: TSpinEdit;
+    lblPopupHotSelectionShape: TLabel;
     lblPopupFont: TLabel;
     lblPopupDisabledCaptionColor: TLabel;
     lblPopupCaption: TLabel;
@@ -350,6 +352,7 @@ type
     procedure cbPaneStyleChange(Sender: TObject);
     procedure cbPopupCheckedGradientKindChange(Sender: TObject);
     procedure cbPopupGutterGradientKindChange(Sender: TObject);
+    procedure cbPopupHotSelectionShapeChange(Sender: TObject);
     procedure cbPopupHotTrackGradientKindChange(Sender: TObject);
     procedure cbPopupIdleGradientKindChange(Sender: TObject);
     procedure cbTabGradientKindChange(Sender: TObject);
@@ -1301,6 +1304,8 @@ begin
 
     with Popup do
     begin
+      cbPopupHotSelectionShape.ItemIndex := ord(SelectionShape);
+
       SetPanelFont(pPopupFont, CaptionFont);
       SetPanelColor(pPopupDisabledCaptionColor, DisabledCaptionColor);
       SetPanelColor(pPopupIdleGradientFromColor, IdleGradientFromColor);
@@ -1575,6 +1580,13 @@ begin
     GutterGradientType := TBackgroundKind((Sender as TCombobox).ItemIndex);
 end;
 
+procedure TfrmAppearanceEditWindow.cbPopupHotSelectionShapeChange(
+  Sender: TObject);
+begin
+  with tbPreview.Appearance.Popup do
+    SelectionShape := TSpkPopupSelectionShape((Sender as TCombobox).ItemIndex);
+end;
+
 procedure TfrmAppearanceEditWindow.cbPopupHotTrackGradientKindChange(
   Sender: TObject);
 begin
@@ -2004,7 +2016,6 @@ begin
      PageControl.Constraints.MinWidth
    );
 
-
    AutoSize := false;
    FAutoSized := true;