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

我有一些代码使用EnumFontFamiliesEX来确定是否安装了特定字体(使用其“facename”).代码在32位工作正常.当我编译并以64位运行它时,它在回调例程中不断抛出异常.

我现在已经让它在两个BUT下工作只有当不是将函数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,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;

解决方法

您的回调函数未正确声明.您将最后一个参数声明为var LParaM,这是错误的. lParam参数按值传递,而不是通过引用传递.调用EnumFontFamiliesEx()时,您将传递一个指向布尔值的指针作为lParam值.

你的回调试图将sizeof(LParaM)字节数写入一个只有SizeOf(布尔)字节可用的内存地址(你为什么要尝试将-1写入布尔值？).所以你要覆盖记忆.当使用指向本地变量的指针作为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;

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

function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): Boolean;
var
  lf: TLogFont;
begin
  Result := False;

  FillChar(lf,32);
  lf.lfCharSet := DEFAULT_CHARSET;

  EnumFontFamiliesEX(ACanvas.Handle,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,32);
  lf.lfCharSet := DEFAULT_CHARSET;

  DC := GetDC(0);
  EnumFontFamiliesEx(DC,0);
  ReleaseDC(0,DC);
end;

话虽这么说,如果你使用TScreen.Fonts属性而不是直接调用EnumFontFamiliesEx(),你可以简化代码：

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