0

Receive Access violation when trying enumerate Fonts on Windows 64-bit Platform with EnumFontFamiliesEx.

Tried many ways to resolve my problem but strongly heed your help!!!

First chance exception at &0000000000713034. Exception class $C0000005 with message 'c0000005 ACCESS_VIOLATION'. Process Progect1.exe

Here is my program:

{ On Windows 64-bit Platform "EnumFontFamiliesEx" shows Error     }
{ On Windows 32-bit Platform "EnumFontFamiliesEx" works perfectly }
{ On Form TListBox "ListBox1" and TButton "Button1"               }

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TFontTypeObject = class (TObject)
    FtoFontType: Integer;
    FtoFlags: Cardinal;
  end;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

  function EnumFontFamExProc(var LogFont: TEnumLogFontEx; var TextMetric: TNewTextMetric; FontType: Integer; Data: Pointer): Integer; stdcall;
  var
    Strings: TStringList;
    TempFaceName: String;
    FontTypeObject: TFontTypeObject;
  begin
    Strings:= TStringList(Data);
    TempFaceName:= LogFont.elfLogFont.lfFaceName;

    if (Strings.IndexOf(TempFaceName) = -1) then      // ERROR HERE

    // First chance exception at &0000000000713034. Exception class $C0000005 with message 'c0000005 ACCESS_VIOLATION'. Process Progect1.exe

      begin
        FontTypeObject:= TFontTypeObject.Create;
        FontTypeObject.FtoFontType:= FontType;
        FontTypeObject.FtoFlags:= TextMetric.ntmFlags;
        Strings.AddObject(TempFaceName, TFontTypeObject(FontTypeObject));
       end;
     Result:= 1;
  end;

var
  DC: HDC;
  LogFont: TLogFont;
begin
  DC:= GetDC(0);
  try
    FillChar(LogFont, SizeOf(LogFont), 0);
    LogFont.lfCharSet:= DEFAULT_CHARSET;
    LogFont.lfFaceName:= '';
    LogFont.lfPitchAndFamily:= 0;
    EnumFontFamiliesEx(DC, LogFont, @EnumFontFamExProc, LPARAM(ListBox1.Items), 0);
    ListBox1.Sorted:= TRUE;
  finally
    ReleaseDC(0, DC);
  end;
end;

end.
Dharman
  • 30,962
  • 25
  • 85
  • 135
Willer
  • 3
  • 1
  • 1
    A shot in the dark: Try moving the local enumeration procedure to global scope (ie. move it outside the Button1Click event handler). There are differences in 32-bit and 64-bit calling conventions that can interfere. – HeartWare Sep 20 '21 at 08:50

1 Answers1

3

I see two problems:

  1. You shouldn't take the address of a local procedure. Make your EnumFontFamExProc a normal (non-local) procedure.

  2. The cast TStringList(Data) is incorrect. Data isn't a TStringList instance. It's a TListBoxStrings which is a TStrings, the type of the ListBox1.Items property.

Andreas Rejbrand
  • 105,602
  • 8
  • 282
  • 384