Powracający wynik z wywołania zwrotnego Windows w 64-bitowym XE6

Question

Mam trochę kodu, który używa EnumFontFamiliesEX, aby ustalić, czy konkretna czcionka (używając jej "nazwy użytkownika") jest zainstalowana. Kod działał poprawnie w wersji 32-bitowej. Kiedy skompilowałem i uruchomiłem go jako 64-bitowy, wciąż zgłaszano wyjątek w procedurze wywołania zwrotnego.

Mam teraz to działa zarówno pod , ale tylko wtedy, gdy zamiast podania wyniku FindFontbyFaceName jako czwartego parametru do EnumFontFamiliesEX, przekazuję lokalną (lub globalną) zmienną - MYresult w tym przypadku. (A następnie ustaw wynik z tego). Nie rozumiem, co się dzieje? Czy ktoś może mi wytłumaczyć lub wskazać lepszy sposób? (Nie jestem tak bardzo zainteresowany mechaniką czcionek, jak podstawową mechaniką zwrotną).

// 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

Twoja funkcja zwrotna nie jest zadeklarowana poprawnie. Deklarujesz ostatni parametr jako var LPARAM, który jest nieprawidłowy. Parametr lParam jest przekazywany przez wartość, a nie przez odniesienie. Podczas wywoływania EnumFontFamiliesEx() podajesz wskaźnik do wartości Boolean jako wartość lParam.

Twój zwrotna próbuje napisać sizeof(LPARAM) liczbę bajtów do adresu pamięci, który ma tylko SizeOf(Boolean) bajtów dostępnych (i dlaczego starasz się napisać -1 Do Boolean?). Nadpisujesz pamięć. Gdy używasz wskaźnika do zmiennej lokalnej jako lParam, prawdopodobnie po prostu nadpisujesz pamięć na stosie wywołań funkcji wywołania, która tak naprawdę nie ma znaczenia, więc nie widzisz awarii.

Musisz albo:

1. usunąć var i typecast parametr lParam do 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; 
   

   Lub:

   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. opuścić zmianę var ale param Eter typem Boolean zamiast 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; 
   

Albo podejście pozwoli Ci zdać @Result jako lParam do EnumFontFamiliesEx() zarówno 32bit i 64bit:

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; 

Na marginesie, tworząc a TImage tylko po to, by mieć płótno do wyliczenia, jest marnotrawstwem. Nie trzeba go wcale:

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; 

Mając na uwadze powyższe, można uprościć kod, jeśli użyć właściwości TScreen.Fonts zamiast dzwonić EnumFontFamiliesEx() bezpośrednio:

function FindFont(const AFacename: string): Boolean; 
begin 
    Result := (Screen.Fonts.IndexOf(AFacename) <> -1); 
end;