From ea305d04d4793974f82cae7b45367a028107ccf4 Mon Sep 17 00:00:00 2001 From: paul Date: Fri, 27 Mar 2009 08:15:34 +0000 Subject: [PATCH] win32: initial support for fonts with national names (issue #0013141) git-svn-id: trunk@19131 - --- lcl/forms.pp | 8 +- lcl/include/screen.inc | 2 +- lcl/interfaces/win32/win32winapi.inc | 117 +++++++++++++++++++++++-- lcl/interfaces/win32/win32winapih.inc | 2 +- lcl/interfaces/win32/win32wsdialogs.pp | 80 +++++++++++++---- 5 files changed, 176 insertions(+), 33 deletions(-) diff --git a/lcl/forms.pp b/lcl/forms.pp index cf77cba646..893a3c2408 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -877,10 +877,10 @@ type property DataModuleCount: Integer read GetDataModuleCount; property DataModules[Index: Integer]: TDataModule read GetDataModules; - property Fonts : TStrings read GetFonts; - property Height : Integer read Getheight; - property HintFont : TFont read GetHintFont; - property Width : Integer read GetWidth; + property Fonts: TStrings read GetFonts; + property Height: Integer read Getheight; + property HintFont: TFont read GetHintFont; + property Width: Integer read GetWidth; property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange write FOnActiveControlChange; property OnActiveFormChange: TNotifyEvent read FOnActiveFormChange diff --git a/lcl/include/screen.inc b/lcl/include/screen.inc index 7c29aafff9..f264e8877b 100644 --- a/lcl/include/screen.inc +++ b/lcl/include/screen.inc @@ -326,7 +326,7 @@ begin lf.lfPitchAndFamily := 0; DC := GetDC(0); try - EnumFontFamiliesEX(DC, @lf, @EnumFontsNoDups, PtrInt(FontList), 0); + EnumFontFamiliesEx(DC, @lf, @EnumFontsNoDups, PtrInt(FontList), 0); finally ReleaseDC(0, DC); end; diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index fd5c4598dd..58f9acc6e5 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -938,18 +938,49 @@ end; Creates a logical font that has the characteristics specified in the specified record. ------------------------------------------------------------------------------} -function TWin32WidgetSet.CreateFontIndirect(Const LogFont: TLogFont): HFONT; +function TWin32WidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT; var +{$ifdef WindowsUnicodeSupport} + TempLogFontW: TLogFontW; + TempLogFont: TLogFontA absolute TempLogFontW; +{$else} TempLogFont: TLogFont; +{$endif} + FontName: String; begin + FontName := LogFont.lfFaceName; + TempLogFont := LogFont; - if String(TempLogFont.lfFaceName) = DefFontData.Name then + if FontName = DefFontData.Name then begin + {$ifdef WindowsUnicodeSupport} + if UnicodeEnabledOS then + TempLogFontW.lfFaceName := UTF8ToUTF16(FMetrics.lfMessageFont.lfFaceName) // FMetrics must be UTF16 + else + Move(FMetrics.lfMessageFont.lfFaceName, TempLogFont.lfFaceName, LF_FACESIZE); + {$else} Move(FMetrics.lfMessageFont.lfFaceName, TempLogFont.lfFaceName, LF_FACESIZE); + {$endif} if TempLogFont.lfHeight = 0 then TempLogFont.lfHeight := FMetrics.lfMessageFont.lfHeight; + end + else + begin + {$ifdef WindowsUnicodeSupport} + if UnicodeEnabledOS then + TempLogFontW.lfFaceName := UTF8ToUTF16(FontName) + else + TempLogFontW.lfFaceName := Utf8ToAnsi(FontName); + {$endif} end; + {$ifdef WindowsUnicodeSupport} + if UnicodeEnabledOS then + Result := Windows.CreateFontIndirectW(@TempLogFontW) + else + Result := Windows.CreateFontIndirectA(@TempLogFont) + {$else} Result := Windows.CreateFontIndirect(@TempLogFont); + {$endif} end; {------------------------------------------------------------------------------ @@ -1310,18 +1341,86 @@ begin end; function TWin32WidgetSet.EnumFontFamilies(DC: HDC; Family: Pchar; - EnumFontFamProc: FontEnumProc; LParam:Lparam):longint; + EnumFontFamProc: FontEnumProc; LParam: Lparam): longint; begin - result := Windows.EnumFontFamilies(DC,Family, - Windows.FontEnumProc(EnumFontFamProc), Lparam); + // TODO: do as EnumFontFamiliesEx + Result := Windows.EnumFontFamilies(DC, Family, + Windows.FontEnumProc(EnumFontFamProc), LParam); end; -function TWin32WidgetSet.EnumFontFamiliesEx(DC:HDC; lpLogFont:PLogFont; - Callback: FontEnumExProc; LParam:Lparam; flags:dword):longint; +{$ifdef WindowsUnicodeSupport} +type + TProcRedirRec = record + LParam: LParam; + CallBack: FontEnumExProc; + end; + PProcRedirRec = ^TProcRedirRec; + +function EnumExProcRedirW(var ELogFont: TEnumLogFontExW; var Metric: TNewTextMetricEx; + FontType: Longint; Data: LParam): Longint; stdcall; +var + Rec: PProcRedirRec absolute Data; + ALogFont: TEnumLogFontExA; begin - result := Windows.EnumFontFamiliesEx(DC, + Move(ELogFont.elfLogFont, ALogFont.elfLogFont, SizeOf(ALogFont.elfLogFont) - SizeOf(ALogFont.elfLogFont.lfFaceName)); + ALogFont.elfLogFont.lfFaceName := UTF16ToUTF8(ELogFont.elfLogFont.lfFaceName); + ALogFont.elfFullName := UTF16ToUTF8(ELogFont.elfFullName); + ALogFont.elfStyle := UTF16ToUTF8(ELogFont.elfStyle); + ALogFont.elfScript := UTF16ToUTF8(ELogFont.elfScript); + + Result := Rec^.CallBack(ALogFont, Metric, FontType, Rec^.LParam); +end; + +function EnumExProcRedirA(var ELogFont: TEnumLogFontExA; var Metric: TNewTextMetricEx; + FontType: Longint; Data: LParam): Longint; stdcall; +var + Rec: PProcRedirRec absolute Data; + ALogFont: TEnumLogFontExA; +begin + ALogFont := ELogFont; + ALogFont.elfLogFont.lfFaceName := AnsiToUtf8(ELogFont.elfLogFont.lfFaceName); + ALogFont.elfFullName := AnsiToUtf8(ELogFont.elfFullName); + ALogFont.elfStyle := AnsiToUtf8(ELogFont.elfStyle); + ALogFont.elfScript := AnsiToUtf8(ELogFont.elfScript); + + Result := Rec^.CallBack(ALogFont, Metric, FontType, Rec^.LParam); +end; +{$endif} + +function TWin32WidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; + Callback: FontEnumExProc; LParam: Lparam; flags: DWord): longint; +{$ifdef WindowsUnicodeSupport} +var + FontName: String; + LFW: LogFontW; + LFA: LogFontA absolute LFW; + Rec: TProcRedirRec; +{$endif} +begin +{$ifdef WindowsUnicodeSupport} + FontName := lpLogFont^.lfFaceName; + ZeroMemory(@LFW, SizeOf(LFW)); + LFW.lfCharSet := lpLogFont^.lfCharSet; + LFW.lfPitchAndFamily := lpLogFont^.lfPitchAndFamily; + Rec.LParam := LParam; + Rec.CallBack := CallBack; + if UnicodeEnabledOS then + begin + LFW.lfFaceName := UTF8ToUTF16(FontName); + Result := LongInt(Windows.EnumFontFamiliesExW(DC, + LFW, windows.FontEnumExProc(@EnumExProcRedirW), Windows.LParam(@Rec), Flags)); + end + else + begin + LFA.lfFaceName := Utf8ToAnsi(FontName); + Result := LongInt(Windows.EnumFontFamiliesExA(DC, + LFA, windows.FontEnumExProc(@EnumExProcRedirA), Windows.LParam(@Rec), Flags)); + end; +{$else} + Result := Windows.EnumFontFamiliesEx(DC, windows.LPLOGFONT(lpLogFont), - windows.FontEnumExProc(Callback), Lparam, Flags); + windows.FontEnumExProc(Callback), LParam, Flags); +{$endif} end; {------------------------------------------------------------------------------ diff --git a/lcl/interfaces/win32/win32winapih.inc b/lcl/interfaces/win32/win32winapih.inc index 9161813390..0b5558a765 100644 --- a/lcl/interfaces/win32/win32winapih.inc +++ b/lcl/interfaces/win32/win32winapih.inc @@ -47,7 +47,7 @@ function ClipboardRegisterFormat(const AMimeType: String): TClipboardFormat; ove function CombineRgn(Dest, Src1, Src2 : HRGN; fnCombineMode : Longint) : Longint; override; function ComboBoxDropDown(Handle: HWND; DropDown: boolean): boolean; override; function CreateBitmap(Width, Height: Integer; Planes, BitCount: LongInt; BitmapBits: Pointer): HBITMAP; override; -function CreateBrushIndirect(Const LogBrush: TLogBrush): HBRUSH; override; +function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; override; function CreateCaret(Handle: HWND; Bitmap: HBITMAP; Width, Height: Integer): Boolean; override; function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; override; function CreateCompatibleDC(DC: HDC): HDC; override; diff --git a/lcl/interfaces/win32/win32wsdialogs.pp b/lcl/interfaces/win32/win32wsdialogs.pp index b1875bae2c..8ec27286e7 100644 --- a/lcl/interfaces/win32/win32wsdialogs.pp +++ b/lcl/interfaces/win32/win32wsdialogs.pp @@ -28,16 +28,6 @@ unit Win32WSDialogs; interface uses -{$IF FPC_VERSION < 2} - {$DEFINE OLD_PLACE} -{$IFEND} -{$IF (FPC_VERSION = 2) AND (FPC_RELEASE < 2)} - {$DEFINE OLD_PLACE} -{$IFEND} -{$IF (FPC_VERSION = 2) AND (FPC_RELEASE = 2) AND (FPC_PATCH = 0)} - {$DEFINE OLD_PLACE} -{$IFEND} - //////////////////////////////////////////////////// // I M P O R T A N T //////////////////////////////////////////////////// @@ -46,9 +36,7 @@ uses //////////////////////////////////////////////////// // rtl Windows, shlobj, ShellApi, ActiveX, SysUtils, Classes, -{$IFNDEF OLD_PLACE} CommDlg, -{$ENDIF} // lcl LCLProc, LCLType, Dialogs, Controls, Graphics, Forms, FileUtil, // ws @@ -768,12 +756,71 @@ class function TWin32WSFontDialog.CreateHandle(const ACommonDialog: TCommonDialo end; var +{$ifdef WindowsUnicodeSupport} + CFW: TChooseFontW; + LFW: LogFontW; + CF: TChooseFontA absolute CFW; + LF: LogFontA absolute LFW; +{$else} CF: TChooseFont; - LF: LCLType.LOGFONT; + LF: LogFont; +{$endif} UserResult: WINBOOL; begin with TFontDialog(ACommonDialog) do begin + {$ifdef WindowsUnicodeSupport} + ZeroMemory(@CFW, sizeof(TChooseFontW)); + ZeroMemory(@LFW, sizeof(LogFontW)); + if UnicodeEnabledOS then + begin + with LFW do + begin + LFHeight := Font.Height; + LFFaceName := UTF8ToUTF16(Font.Name); + if (fsBold in Font.Style) then LFWeight:= FW_BOLD; + LFItalic := byte(fsItalic in Font.Style); + LFStrikeOut := byte(fsStrikeOut in Font.Style); + LFUnderline := byte(fsUnderline in Font.Style); + LFCharSet := Font.CharSet; + end; + with CFW do + begin + LStructSize := sizeof(TChooseFont); + HWndOwner := GetOwnerHandle(ACommonDialog); + LPLogFont := commdlg.PLOGFONTW(@LFW); + Flags := GetFlagsFromOptions(Options); + Flags := Flags or CF_INITTOLOGFONTSTRUCT or CF_BOTH; + RGBColors := DWORD(Font.Color); + end; + UserResult := ChooseFontW(@CFW); + // we need to update LF now + LF.lfFaceName := UTF16ToUTF8(LFW.lfFaceName); + end + else + begin + with LF do + begin + LFHeight := Font.Height; + LFFaceName := Utf8ToAnsi(Font.Name); + if (fsBold in Font.Style) then LFWeight:= FW_BOLD; + LFItalic := byte(fsItalic in Font.Style); + LFStrikeOut := byte(fsStrikeOut in Font.Style); + LFUnderline := byte(fsUnderline in Font.Style); + LFCharSet := Font.CharSet; + end; + with CF do + begin + LStructSize := sizeof(TChooseFont); + HWndOwner := GetOwnerHandle(ACommonDialog); + LPLogFont := commdlg.PLOGFONTA(@LF); + Flags := GetFlagsFromOptions(Options); + Flags := Flags or CF_INITTOLOGFONTSTRUCT or CF_BOTH; + RGBColors := DWORD(Font.Color); + end; + UserResult := ChooseFontA(@CF); + end + {$else} ZeroMemory(@CF, sizeof(TChooseFont)); ZeroMemory(@LF, sizeof(LogFont)); with LF do @@ -790,18 +837,15 @@ begin begin LStructSize := sizeof(TChooseFont); HWndOwner := GetOwnerHandle(ACommonDialog); -{$ifndef OLD_PLACE} LPLogFont := commdlg.PLOGFONT(@LF); -{$else} - LPLogFont := windows.PLOGFONT(@LF); -{$endif} Flags := GetFlagsFromOptions(Options); Flags := Flags or CF_INITTOLOGFONTSTRUCT or CF_BOTH; RGBColors := DWORD(Font.Color); end; + UserResult := ChooseFont(@CF); + {$endif} end; - UserResult := ChooseFont(@CF); SetDialogResult(ACommonDialog, UserResult); if UserResult then begin