在64位XE6中返回Windows回调的结果

Question

我有一些代码使用EnumFontFamiliesEX来确定是否安装了特定的字体（使用它的“facename”）。该代码在32位工作正常。当我编译并运行它为64位时，它在回调例程中不断抛出异常。

现在我已经得到了它在这两个工作，但只有当强似功能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; 

Answer 1

您的回调函数声明不正确。您宣称最后一个参数为var LPARAM，这是错误的。 lParam参数按值传递，而不是通过引用传递。当调用​​时，您传递一个指向Boolean的指针作为lParam的值。

你的回调试图写sizeof(LPARAM)字节数来，只有具有可用SizeOf(Boolean)字节的内存地址（以及为什么你想编写一个-1到Boolean？）。所以你覆盖了内存。当使用指向局部变量的指针lParam时，您可能只是在调用函数的调用堆栈上覆盖内存，这并不重要，所以您不会看到崩溃。

您需要：

1. 删除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; 
   

2. 离开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;