在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;