pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

spktoolbar: Add checkbox support to SpkPopupMenu.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8727 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-02-21 23:18:12 +00:00
parent 100404da41
commit b97dbe66dd
2 changed files with 172 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

69
components/spktoolbar/SpkPopupMenu/spkpopup.pas
View File

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

106
components/spktoolbar/SpkToolbar/spkt_Appearance.pas
View File

@ -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;