paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-05 01:20:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32: fix GetObject to support fonts with national names

Browse Source 
git-svn-id: trunk@19132 -
This commit is contained in:
paul 2009-03-27 08:30:09 +00:00
parent ea305d04d4
commit 5027651b45
1 changed files with 24 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
lcl/interfaces/win32/win32winapi.inc
View File

@ -1960,8 +1960,32 @@ end;
Gets information about a specified graphics object.
------------------------------------------------------------------------------}
function TWin32WidgetSet.GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer;
{$ifdef WindowsUnicodeSupport}
var
LF: PLogFontA absolute Buf;
LFW: TLogFontW;
{$endif}
begin
Assert(False, 'Trace:[TWin32WidgetSet.GetObject]');
{$ifdef WindowsUnicodeSupport}
if GetObjectType(GDIObj) = OBJ_FONT then
begin
if (UnicodeEnabledOS) and (BufSize = Sizeof(LOGFONTA)) then
begin
BufSize := SizeOf(LogFontW);
Result := Windows.GetObjectW(GDIObj, BufSize, @LFW);
Move(LFW, LF^, SizeOf(LogFontA) - SizeOf(LOGFONTA.lfFaceName));
LF^.lfFaceName := UTF16ToUTF8(LFW.lfFaceName);
end
else
begin
Result := Windows.GetObject(GDIObj, BufSize, Buf);
if (BufSize >= Sizeof(LOGFONTA)) and (Result <= BufSize) then
LF^.lfFaceName := AnsiToUtf8(LF^.lfFaceName);
end;
end
else
{$endif}
Result := Windows.GetObject(GDIObj, BufSize, Buf);
end;