Question

我有一些代码使用EnumFontFamiliesEX来确定是否安装了特定字体（使用＆＃34; facename＆＃34;）。代码在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写入{{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
```

这两种方法都允许您在{32}和64位中将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：

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

话虽如此，如果您使用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()

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

1 个答案: