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

LCL/TColorDialog: Show Title property. Issue #39155, based on code submitted by jamie in https://forum.lazarus.freepascal.org/index.php/topic,55236.msg410713.html#msg410713

Browse Source 
git-svn-id: trunk@65375 -
This commit is contained in:
wp 2021-07-05 16:19:16 +00:00
parent 912b44ef09
commit 9d94d9e7e3
1 changed files with 15 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -345,6 +345,18 @@ end;
{ TWin32WSColorDialog }
Function CCHookProc(H: THandle; msg: Cardinal; W: WParam; L: LParam): UintPtr; StdCall;
var
ws: WideString;
begin
if (H <> 0) and (Msg = WM_InitDialog) then
begin
ws := TColorDialog(PChooseColor(L)^.lCustData).Title;
SetWindowTextW(H, PWideChar(ws));
end;
Result := 0;
end;
class function TWin32WSColorDialog.CreateHandle(const ACommonDialog: TCommonDialog): THandle;
var
CC: PChooseColor;
@ -372,7 +384,9 @@ begin
RGBResult := ColorToRGB(ColorDialog.Color);
LPCustColors := AllocMem(16 * SizeOf(DWord));
FillCustomColors;
Flags := CC_FULLOPEN or CC_RGBINIT;
lCustData := LParam(ACommonDialog);
lpfnHook := @CCHookProc;
Flags := CC_FULLOPEN or CC_RGBINIT or CC_ENABLEHOOK;
end;
Result := THandle(CC);
end;