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

LCL: Win32: Font dialog initializing for default values. Issue #32894. Patch by C Western

Browse Source 
git-svn-id: trunk@56879 -
This commit is contained in:
michl 2017-12-30 18:43:08 +00:00
parent a69353463f
commit f7f4950c33
2 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/interfaces/win32/win32int.pp
View File

@ -207,6 +207,8 @@ type
property CommonControlsVersion: DWord read FCommonControlsVersion;
property OnAsyncSocketMsg: TSocketEvent read FOnAsyncSocketMsg write FOnAsyncSocketMsg;
property DotsPatternBitmap: HBitmap read GetDotsPatternBitmap;
property Metrics: TNonClientMetrics read FMetrics;
property MetricsFailed: Boolean read FMetricsFailed;
end;
{$I win32listslh.inc}

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

@ -1198,6 +1198,13 @@ begin
LFUnderline := byte(fsUnderline in Font.Style);
LFCharSet := Font.CharSet;
end;
// Duplicate logic in CreateFontIndirect
if not Win32WidgetSet.MetricsFailed and SameText(Font.Name, DefFontData.Name) then
begin
LFW.lfFaceName := UTF8ToUTF16(Win32WidgetSet.Metrics.lfMessageFont.lfFaceName);
if LFW.lfHeight = 0 then
LFW.lfHeight := Win32WidgetSet.Metrics.lfMessageFont.lfHeight;
end;
with CFW do
begin
LStructSize := sizeof(TChooseFont);
@ -1215,7 +1222,7 @@ begin
lpfnHook := @FontDialogCallBack;
lCustData := PtrInt(@ACommonDialog);
end;
RGBColors := DWORD(Font.Color);
RGBColors := ColorToRGB(Font.Color);
if fdLimitSize in Options then
begin
nSizeMin := MinFontSize;