spktoolbar: Add checkbox support to SpkPopupMenu.

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

components/spktoolbar/SpkPopupMenu/spkpopup.pas

@@ -5,7 +5,7 @@ unit SpkPopup;
 interface
 
 uses
-  LCLType, Types, Classes, Controls, SysUtils, Graphics, Menus,
+  LCLIntf, LCLType, Types, SysUtils, Classes, Controls, Graphics, Menus, StdCtrls,
   spkt_Const, SpkGUITools, SpkMath, SpkGraphTools, spkt_Appearance;
 
 type
@@ -30,8 +30,13 @@ type
 
 implementation
 
+uses
+  Themes;
+
 procedure TSpkPopupMenu.DrawItemHandler(Sender: TObject; ACanvas: TCanvas;
   ARect: TRect; AState: TOwnerDrawState);
+const
+  CHECKBOX_STYLES: array[boolean] of TSpkCheckboxStyle = (cbsCheckbox, cbsRadioButton);
 var
   menuItem: TMenuItem;
   FrameColor: TColor = clNone;
@@ -40,11 +45,13 @@ var
   TextColor: TColor;
   GradientType: TBackgroundKind;
   P: T2DIntPoint;
-  R, Rgutter: T2DIntRect;
+  R, Rgutter, Rcheck: T2DIntRect;
   Radius: Integer;
   x, y, wGutter, hText: Integer;
   iconSize: TSize;
+  checkboxSize: TSize;
   isHot: Boolean;
+  te: TThemedElementDetails;
 begin
   if FAppearance = nil then
     exit;
@@ -114,6 +121,64 @@ begin
         TGUITools.DrawVLine(ACanvas, Rgutter.Right+1, R.Top, R.Bottom, FrameColor);
     end;
 
+    // Checkbox
+    if menuItem.Checked then
+    begin
+      {$IFDEF EnhancedRecordSupport}
+      Rcheck := T2DIntRect.Create(
+      {$ELSE}
+      Rcheck := Create2DIntRect(
+      {$ENDIF}
+        ARect.Left,
+        ARect.Top,
+        ARect.Left + wGutter,
+        ARect.Bottom// - 1
+      );
+      FrameColor := FAppearance.Popup.CheckedFrameColor;
+      ColorFrom := FAppearance.Popup.CheckedGradientFromColor;
+      ColorTo := FAppearance.Popup.CheckedGradientToColor;
+      GradientType := FAppearance.Popup.CheckedGradientType;
+      TGUITools.DrawPopupItemRect(ACanvas, Rcheck, Radius, ColorFrom, ColorTo, GradientType);
+      TGUITools.DrawHLine(ACanvas, Rcheck.Left, Rcheck.Right-1, Rcheck.Top, FrameColor);
+      TGUITools.DrawHLine(ACanvas, Rcheck.Left, Rcheck.Right-1, Rcheck.Bottom-1, FrameColor);
+      TGUITools.DrawVLine(ACanvas, Rcheck.Left, Rcheck.Top, Rcheck.Bottom-1, FrameColor);
+      TGUITools.DrawVLine(ACanvas, Rcheck.Right-1, Rcheck.Top, Rcheck.Bottom-1, FrameColor);
+
+      if not Assigned(Images) or (menuItem.ImageIndex = -1) then
+      begin
+        if ThemeServices.ThemesEnabled then
+        begin
+          if menuItem.Enabled then
+          begin
+            if menuItem.RadioItem then
+              te := ThemeServices.GetElementDetails(tmPopupBulletNormal)
+            else
+              te := ThemeServices.GetElementDetails(tmPopupCheckmarkNormal);
+          end else
+          begin
+            if menuItem.RadioItem then
+              te := ThemeServices.GetElementDetails(tmPopupBulletDisabled)
+            else
+              te := ThemeServices.GetElementDetails(tmPopupCheckmarkDisabled);
+          end;
+          ThemeServices.DrawElement(ACanvas.Handle, te, Rect(Rcheck.Left, Rcheck.Top, Rcheck.Right, Rcheck.Bottom));
+        end else
+        begin
+          checkboxSize.CX := GetSystemMetrics(SM_CYMENUCHECK);
+          checkboxSize.CY := GetSystemMetrics(SM_CXMENUCHECK);
+          x := (Rcheck.Left + Rcheck.Right - checkboxSize.CX) div 2;
+          y := (Rcheck.Top + Rcheck.Bottom - checkboxSize.CY) div 2;
+          TGUITools.DrawCheckbox(
+            ACanvas,
+            x, y,
+            cbChecked,
+            bsIdle,
+            CHECKBOX_STYLES[menuItem.RadioItem]
+          );
+        end;
+      end;
+    end;
+
     // Draw icon
     if Assigned(Images) and (menuItem.ImageIndex > -1) then
     begin

components/spktoolbar/SpkToolbar/spkt_Appearance.pas

@@ -343,6 +343,10 @@ type
     FDispatch: TSpkBaseAppearanceDispatch;
     FCaptionFont: TFont;
     FDisabledCaptionColor: TColor;
+    FCheckedFrameColor: TColor;
+    FCheckedGradientFromColor: TColor;
+    FCheckedGradientToColor: TColor;
+    FCheckedGradientType: TBackgroundKind;
     FGutterGradientFromColor: TColor;
     FGutterGradientToColor: TColor;
     FGutterGradientType: TBackgroundKind;
@@ -358,6 +362,10 @@ type
     FIdleGradientType: TBackgroundKind;
     FStyle: TSpkPopupStyle;
     procedure SetCaptionFont(const Value: TFont);
+    procedure SetCheckedFrameColor(const Value: TColor);
+    procedure SetCheckedGradientFromColor(const Value: TColor);
+    procedure SetCheckedGradientToColor(const Value: TColor);
+    procedure SetCheckedGradientType(const Value: TBackgroundKind);
     procedure SetDisabledCaptionColor(const Value: TColor);
     procedure SetGutterGradientFromColor(const Value: TColor);
     procedure SetGutterGradientToColor(const Value: TColor);
@@ -385,6 +393,10 @@ type
     procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue);
   published
     property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
+    property CheckedFrameColor: TColor read FCheckedFrameColor write SetCheckedFrameColor;
+    property CheckedGradientFromColor: TColor read FCheckedGradientFromColor write SetCheckedGradientFromColor;
+    property CheckedGradientToColor: TColor read FCheckedGradientToColor write SetCheckedGradientToColor;
+    property CheckedGradientType: TBackgroundKind read FCheckedGradientType write SetCheckedGradientType;
     property DisabledCaptionColor: TColor read FDisabledCaptionColor write SetDisabledCaptionColor;
     property GutterGradientFromColor: TColor read FGutterGradientFromColor write SetGutterGradientFromColor;
     property GutterGradientToColor: TColor read FGutterGradientToColor write SetGutterGradientToColor;
@@ -1806,6 +1818,24 @@ begin
   if Assigned(Subnode) then
     TSpkXMLTools.Load(Subnode, FCaptionFont);
 
+  // Checkbox rectangle
+  Subnode := Node['CheckedFrameColor', false];
+  if Assigned(Subnode) then
+    FCheckedFrameColor := Subnode.TextAsColor;
+
+  Subnode := Node['CheckedGradientFromColor', false];
+  if Assigned(Subnode) then
+    FCheckedGradientFromColor := Subnode.TextAsColor;
+
+  Subnode := Node['CheckedGradientToColor', false];
+  if Assigned(Subnode) then
+    FCheckedGradientToColor := Subnode.TextAsColor;
+
+  Subnode := Node['CheckedGradientType', false];
+  if Assigned(Subnode) then
+    FCheckedGradientType := TBackgroundKind(Subnode.TextAsInteger);
+
+
   // Disabled text
   Subnode := Node['DisabledCaptionColor', false];
   if Assigned(SubNode) then
@@ -1908,6 +1938,10 @@ begin
       begin
         FCaptionFont.Style := [];
         FDisabledCaptionColor := rgb(192, 192, 192);
+        FCheckedFrameColor := rgb(242, 149, 54);
+        FCheckedGradientFromColor := rgb(255, 227, 149);
+        FCheckedGradientToColor := FCheckedGradientFromColor;
+        FCheckedGradientType := bkSolid;
         {
         FIdleFrameColor := rgb(155, 183, 224);
         }
@@ -1942,6 +1976,17 @@ begin
         FCaptionFont.Style := [];
         FCaptionFont.Color := $008B4215;
         FDisabledCaptionColor := rgb(192, 192, 192);
+        FCheckedGradientType := bkSolid;
+        if AStyle = spkOffice2007SilverTurquoise then
+        begin
+          FCheckedFrameColor := $009E7D0E;
+          FCheckedGradientFromColor := $00FBF1D0;
+        end else
+        begin
+          FCheckedFrameColor := rgb(242, 149, 54);
+          FCheckedGradientFromColor := rgb(255, 227, 149);
+        end;
+        FCheckedGradientToColor := FCheckedGradientFromColor;
         {
         FIdleFrameColor := $00B8B1A9;
         }
@@ -1984,6 +2029,11 @@ begin
       begin
         FCaptionFont.Style := [];
         FCaptionFont.Color := $003F3F3F;
+        FCheckedFrameColor := $00F9CEA4;
+        FCheckedGradientFromColor := $00F7EFE8;
+        FCheckedGradientToColor := FCheckedGradientFromColor;
+        FCheckedGradientType := bkSolid;
+
         FDisabledCaptionColor := rgb(192, 192, 192);
         FGutterGradientFromColor := rgb(239, 239, 239);
         FGutterGradientToColor := rgb(239, 239, 239);
@@ -2021,6 +2071,10 @@ begin
       begin
         FCaptionFont.Style := [];
         FCaptionFont.Color := $003F3F3F;
+        FCheckedFrameColor := $00C4793C;
+        FCheckedGradientFromColor := $00805B3D;
+        FCheckedGradientToColor := FCheckedGradientFromColor;
+        FCheckedGradientType := bkSolid;
         FDisabledCaptionColor := $787878;
         FGutterGradientFromColor := clBlack;
         FGutterGradientToColor := clBlack;
@@ -2058,6 +2112,11 @@ begin
     Add('  with Popup do begin');
     SaveFontToPascal(AList, FCaptionFont, '    CaptionFont');
 
+    Add('    CheckedFrameColor := $' + IntToHex(FCheckedFrameColor, 8) + ';');
+    Add('    CheckedGradientFromColor := $' + IntToHex(FCheckedGradientFromColor, 8) + ';');
+    Add('    CheckedGradientToColor := $' + IntToHex(FCheckedGradientToColor, 8) + ';');
+    Add('    CheckedGradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FCheckedGradientType)) + ';');
+
     Add('    IdleCaptionColor := $' + IntToHex(FIdleCaptionColor, 8) + ';');
 //    Add('    IdleFrameColor := $' + IntToHex(FIdleFrameColor, 8) + ';');
     Add('    IdleGradientFromColor := $' + IntToHex(FIdleGradientFromColor, 8) + ';');
@@ -2095,6 +2154,19 @@ begin
   Subnode := Node['CaptionFont', true];
   TSpkXMLTools.Save(Subnode, FCaptionFont);
 
+  // Checkbox rectangles
+  Subnode := Node['CheckedFrameColor', true];
+  Subnode.TextAsColor := FCheckedFrameColor;
+
+  Subnode := Node['CheckedGradientFromColor', true];
+  Subnode.TextAsColor := FCheckedGradientFromColor;
+
+  Subnode := Node['CheckedGradientToColor', true];
+  Subnode.TextAsColor := FCheckedGradientToColor;
+
+  Subnode := Node['IdleGradientType', true];
+  Subnode.TextAsInteger := integer(FIdleGradientType);
+
   // Idle
   Subnode := Node['IdleCaptionColor', true];
   Subnode.TextAsColor := FIdleCaptionColor;
@@ -2170,6 +2242,38 @@ begin
     FDispatch.NotifyAppearanceChanged;
 end;
 
+procedure TSpkPopupMenuAppearance.SetCheckedFrameColor(const Value: TColor);
+begin
+  FCheckedFrameColor := Value;
+  if FDispatch <> nil then
+    FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkPopupMenuAppearance.SetCheckedGradientFromColor(const Value: TColor);
+begin
+  FCheckedGradientFromColor := Value;
+  if FDispatch <> nil then
+    FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkPopupMenuAppearance.SetCheckedGradientToColor(const Value: TColor);
+begin
+  FCheckedGradientToColor := Value;
+  if FDispatch <> nil then
+    FDispatch.NotifyAppearanceChanged;
+end;
+
+procedure TSpkPopupMenuAppearance.SetCheckedGradientType(const Value: TBackgroundKind);
+begin
+  FCheckedGradientType := Value;
+  if FDispatch <> nil then
+    FDispatch.NotifyAppearanceChanged;
+end;
+
+
+
+
+
 procedure TSpkPopupMenuAppearance.SetDisabledCaptionColor(const Value: TColor);
 begin
   FDisabledCaptionColor := Value;