mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-06 00:20:13 +02:00
win32: initial support for fonts with national names (issue #0013141)
git-svn-id: trunk@19131 -
This commit is contained in:
paul
parent
5bf4723e5c
commit
ea305d04d4
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user