在64位XE6中返回Windows回调的结果
我有一些代码使用EnumFontFamiliesEX来确定是否安装了特定的字体(使用它的“facename”)。该代码在32位工作正常。当我编译并运行它为64位时,它在回调例程中不断抛出异常。在64位XE6中返回Windows回调的结果
现在我已经得到了它在这两个工作,但只有当强似功能FindFontbyFaceName的结果作为第四个参数来EnumFontFamiliesEX,我通过本地(或全局)变量 - 在这种情况下MYresult。(然后从中设置结果)。我不明白发生了什么事?任何人都可以解释或指出我更好的方式。 (我对这些字体的机制并没有太多兴趣,因为它是基本的回调机制)。
// single font find callback
function FindFontFace( {$IFDEF CPUX86} lpelf: PLogFont; {$ENDIF}
{$IFDEF CPUX64} lpelf: PEnumLogFontEx; {$ENDIF}
lpntm: PNewTextMetricEx;
AFontType: DWORD; var Aresult: lparam): integer ; stdcall;
begin
result := 0; // 1 shot only please - not interested in any variations in style etc
if (lpelf <> nil) then
Aresult := -1 // TRUE
else
Aresult := 0;
end;
function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): boolean;
var
lf: TLogFont;
Myresult: boolean;
begin
MYresult := false;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
// this works in both 32 and 64 bit
EnumFontFamiliesEX(ACanvas.Handle, lf, @FindFontFace, lparam(@MYresult), 0);
result := MYresult;
// this works in 32 bit but throws exception in callback in 64 bit
// EnumFontFamiliesEX(ACanvas.Handle, lf, @FindFontFace, lparam(@result), 0);
end;
function FindFont(const AFacename: string): boolean;
var
AImage: TImage;
begin
AImage := Timage.Create(nil);
try
result := FindFontbyFaceName(AImage.Canvas, Afacename);
finally
Aimage.Free;
end;
end;
您的回调函数声明不正确。您宣称最后一个参数为var LPARAM
,这是错误的。 lParam
参数按值传递,而不是通过引用传递。当调用时,您传递一个指向Boolean
的指针作为lParam
的值。
你的回调试图写sizeof(LPARAM)
字节数来,只有具有可用SizeOf(Boolean)
字节的内存地址(以及为什么你想编写一个-1
到Boolean
?)。所以你覆盖了内存。当使用指向局部变量的指针lParam
时,您可能只是在调用函数的调用堆栈上覆盖内存,这并不重要,所以您不会看到崩溃。
您需要:
-
删除
var
和类型转换lParam
参数为PBoolean
:function FindFontFace( lpelf: PLogFont; lpntm: PTextMetric; FontType: DWORD; lParam: LPARAM): Integer ; stdcall; begin PBoolean(lParam)^ := True; Result := 0; // 1 shot only please - not interested in any variations in style etc end;
或者:
function FindFontFace( lpelf: PLogFont; lpntm: PTextMetric; FontType: DWORD; lParam: PBoolean): Integer ; stdcall; begin lParam^ := True; Result := 0; // 1 shot only please - not interested in any variations in style etc end;
-
离开
var
但变化参数ETER类型的Boolean
代替LPARAM
:function FindFontFace( var lpelf: TLogFont; var lpntm: TTextMetric; FontType: DWORD; var lParam: Boolean): Integer ; stdcall; begin lParam := True; Result := 0; // 1 shot only please - not interested in any variations in style etc end;
这两种方法都可以让你通过@Result
为lParam
到在32位和64位:
function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): Boolean;
var
lf: TLogFont;
begin
Result := False;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
EnumFontFamiliesEX(ACanvas.Handle, lf, @FindFontFace, LPARAM(@Result), 0);
end;
在一个侧面说明,创建一个TImage
只是有一个画布来枚举是浪费。你不需要它了:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: LPARAM): integer ; stdcall;
begin
PBoolean(lParam)^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
function FindFont(const AFacename: string): Boolean;
var
lf: TLogFont;
DC: HDC;
begin
Result := False;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
DC := GetDC(0);
EnumFontFamiliesEx(DC, lf, @FindFontFace, LPARAM(@Result), 0);
ReleaseDC(0, DC);
end;
话虽这么说,你可以,如果你使用TScreen.Fonts
属性而不是调用直接的简化代码:在Win32中
function FindFont(const AFacename: string): Boolean;
begin
Result := (Screen.Fonts.IndexOf(AFacename) <> -1);
end;
感谢您的详细解答。这是有道理的。 (画布不过是使用画布的真实代码的遗物。)我查看了Screen.fonts,但是在细版中,一些字体未包含在内,并且感兴趣的字体可能(仅)是打印机字体。谢谢一堆。 – TomB
LPARAMs有不同的大小和Win64平台。最简单的就是制作MyResult:LPARAM,然后让Result:=(MyResult = -1)。 – FredS
@FredS谢谢。关键问题在于为什么我需要这个本地/全局变量呢?为什么我不能直接使用结果? – TomB
@TomB:你的回调是垃圾回忆。看到我的答案。 –