paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 00:58:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: implement TColorDialog.Options. Currently only supported for Win32/Win64 widgetset. Issue #22717.

Browse Source 
The default value differs from Delphi (7) for backwards compatibility (CC_FULLOPEN flag was always set in Windows).

(cherry picked from commit 9077ef32a2)
This commit is contained in:
Bart 2024-12-08 13:56:18 +01:00 committed by Martin
parent c51f5f7710
commit eecc3645f1
3 changed files with 34 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lcl/dialogs.pp
View File

@ -287,12 +287,27 @@ type
constructor Create(AOwner: TComponent); override;
end;
TColorDialogOption = (
cdFullOpen, // Causes the dialog box to display the additional controls that allow the user to create custom colors.
cdPreventFullOpen, // Disables the Define Custom Color button.
cdShowHelp, // Causes the dialog box to display the Help button.
cdSolidColor, // Causes the dialog box to display only solid colors in the set of basic colors.
cdAnyColor // Causes the dialog box to display all available colors in the set of basic colors.
);
TColorDialogOptions = set of TColorDialogOption;
const
DefaultColorDialogOptions = [cdFullOpen]; //for backwards compatibility, probably not Delphi compatible
{ TColorDialog }
type
TColorDialog = class(TCommonDialog)
private
FColor: TColor;
FCustomColors: TStrings;
FOptions: TColorDialogOptions;
procedure SetCustomColors(const AValue: TStrings);
procedure AddDefaultColor(const s: AnsiString);
protected
@ -306,6 +321,7 @@ type
property Color: TColor read FColor write FColor;
// entry looks like ColorA = FFFF00 ... ColorX = C0C0C0
property CustomColors: TStrings read FCustomColors write SetCustomColors;
property Options: TColorDialogOptions read FOptions write FOptions default DefaultColorDialogOptions;
end;

1
lcl/include/lclcolordialog.inc
View File

@ -52,6 +52,7 @@ begin
// add default colors
GetColorValues(@AddDefaultColor);
fCompStyle := csColorDialog;
FOptions := DefaultColorDialogOptions;
end;
destructor TColorDialog.Destroy;

17
lcl/interfaces/win32/win32wsdialogs.pp
View File

@ -114,6 +114,8 @@ type
{ TWin32WSColorDialog }
TWin32WSColorDialog = class(TWSColorDialog)
public
class function ColorDialogOptionsToFlags(Options: TColorDialogOptions): DWORD;
published
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
@ -369,6 +371,18 @@ begin
Result := 0;
end;
class function TWin32WSColorDialog.ColorDialogOptionsToFlags(Options: TColorDialogOptions): DWORD;
const
CC_ANYCOLOR = $00000100;
begin
Result := 0;
if cdFullOpen in Options then Result := Result or CC_FULLOPEN;
if cdPreventFullOpen in Options then Result := Result or CC_PREVENTFULLOPEN;
if cdShowHelp in Options then Result := Result or CC_SHOWHELP;
if cdSolidColor in Options then Result := Result or CC_SOLIDCOLOR;
if cdAnyColor in Options then Result := Result or CC_ANYCOLOR;
end;
class function TWin32WSColorDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
var
CC: PChooseColor;
@ -398,7 +412,8 @@ begin
FillCustomColors;
lCustData := LParam(ACommonDialog);
lpfnHook := @CCHookProc;
Flags := CC_FULLOPEN or CC_RGBINIT or CC_ENABLEHOOK;
Flags := {CC_FULLOPEN or }CC_RGBINIT or CC_ENABLEHOOK;
Flags := Flags or ColorDialogOptionsToFlags(ColorDialog.Options);
end;
Result := THandle(CC);
end;