From b97dbe66dd3f10d7cc985bb9a9631f8c9ed8460c Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 21 Feb 2023 23:18:12 +0000 Subject: [PATCH] spktoolbar: Add checkbox support to SpkPopupMenu. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8727 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../spktoolbar/SpkPopupMenu/spkpopup.pas | 69 +++++++++++- .../spktoolbar/SpkToolbar/spkt_Appearance.pas | 106 +++++++++++++++++- 2 files changed, 172 insertions(+), 3 deletions(-) diff --git a/components/spktoolbar/SpkPopupMenu/spkpopup.pas b/components/spktoolbar/SpkPopupMenu/spkpopup.pas index 1c370efcc..70db910de 100644 --- a/components/spktoolbar/SpkPopupMenu/spkpopup.pas +++ b/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 diff --git a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas index d9aa2a2f6..8283311bc 100644 --- a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas +++ b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas @@ -342,7 +342,11 @@ type private FDispatch: TSpkBaseAppearanceDispatch; FCaptionFont: TFont; - FDisabledCaptionColor : TColor; + 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;