从 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 参数按值传递，而不是按引用传递。当调用 EnumFontFamiliesEx() 时，您将传递一个指向 Boolean 的指针作为 lParam 值。

您的回调试图将 sizeof(LPARAM) 字节数写入只有 SizeOf(Boolean) 字节可用的内存地址（以及为什么您要尝试将 -1 写入 Boolean?)。所以你正在覆盖内存。当使用指向局部变量的指针作为 lParam 时，您可能只是覆盖调用函数的调用堆栈上的内存，这并不重要，因此您不会看到崩溃。

您需要：

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

保留 var 但将参数类型更改为 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;

这两种方法都允许您在 32 位和 64 位中将 @Result 作为 lParam 传递给 EnumFontFamiliesEx()：

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 只是为了让一个 canvas 用于枚举是一种浪费。你根本不需要它：

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 属性而不是直接调用 EnumFontFamiliesEx()，则可以简化代码：

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

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

Returning result from Windows callback in 64-bit XE6

windows

delphi

callback

delphi-xe6