Returning result from Windows callback in 64-bit XE6

Question

I have some code which uses EnumFontFamiliesEX to determine whether a particular font (using its "facename") is installed. The code was working fine in 32-bit. When I compile and run it as 64-bit, it kept throwing an exception in the callback routine.

I have now gotten it to work under both BUT only if instead of passing the function FindFontbyFaceName's result as the 4th parameter to EnumFontFamiliesEX, I pass a local (or global) variable - MYresult in this case. (And then set result from it). I don't understand what is going on? Can anyone explain or point me to a better way. (I'm not so much interested in the mechanics of the fonts, 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

Your callback function is not declared correctly. You are declaring the last parameter as a var LPARAM, which is wrong. The lParam parameter is passed by value, not by reference. When calling EnumFontFamiliesEx() you are passing a pointer to a Boolean as the lParam value.

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

You need to either:

1. remove the var and typecast the lParam parameter to a 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;
   

2. leave the 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;
   

Either approach will allow you to pass @Result as the lParam to EnumFontFamiliesEx() in both 32bit and 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;

On a side note, creating a TImage just to have a canvas to enumerate with is wasteful. You don't need it 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;

That being said, you can simplify the code if you use the TScreen.Fonts property instead of calling EnumFontFamiliesEx() directly:

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