Returning a result from a Windows callback in 64-bit XE6

Question

I have a code that uses EnumFontFamiliesEX to determine if a particular font is installed (using its "filename"). The code worked fine in 32-bit mode. When I compile and run it as 64-bit, it throws an exception to the callback routine all the time.

Now I got a job for both , but only if instead of passing the FindFontbyFaceName function as the 4th parameter to EnumFontFamiliesEX, I pass a local (or global) variable - MYresult in this case. (And then set the result from it). I do not understand what's going on? Can someone explain or point me to a better way. (I'm not so interested in font mechanics as the basic callback mechanics).

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

The callback function is not declared correctly. You declare the last parameter as var LPARAM , which is incorrect. The lParam parameter is passed by value, not by reference. When you call EnumFontFamiliesEx() you pass a pointer to Boolean as the value of lParam .

Your callback is trying to write sizeof(LPARAM) number of bytes to a memory address that contains only SizeOf(Boolean) bytes (and why are you trying to write -1 in Boolean ?). So you rewrite the memory. When using a pointer to a local variable as lParam you most likely just overwrite the memory in the call stack of the calling function, which does not really matter, so you don't see a failure.

You need to either:

• remove var and enter the lParam parameter in 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; 

  Or:

   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; 

• leave var , but change the parameter type to Boolean instead of 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; 

Any approach will allow you to pass @Result as lParam to EnumFontFamiliesEx() both 32-bit and 64-bit:

 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; 

For one thing, creating a TImage just to have a canvas for enumeration is wasteful. You do not need this at all:

 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; 

In doing so, you can simplify the code if you use the TScreen.Fonts property instead of directly calling EnumFontFamiliesEx() :

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