如何从图形单元获取所有支持的文件格式？

Question

当任何 TGraphic 后代使用类过程 TPicture.RegisterFileFormat() 注册其自己的图形文件格式时，它们都存储在 Graphics.FileFormats 全局变量中。

可惜 FileFormats 变量不在“Graphics.pas”的“界面”部分中，所以我无法访问它。我需要读取这个变量来为我的文件列表控件实现一个特殊的过滤器。

我可以在不手动修复 Graphics.pas 源代码的情况下获得该列表吗？

Answer 1

您正在使用文件列表控件，因此可能是文件名列表。如果您不需要知道已注册的实际 TGraphic 类类型，只需知道给定的文件扩展名是否已注册（例如检查稍后是否调用 TPicture.LoadFromFile () 很可能会成功），您可以使用公共 GraphicFileMask() 函数来获取已注册文件扩展名的列表，然后将您的文件名与该列表进行比较。例如：

uses
  SysUtils, Classes, Graphics, Masks;

function IsGraphicClassRegistered(const FileName: String): Boolean;
var
  Ext: String;
  List: TStringList;
  I: Integer;
begin
  Result := False;
  Ext := ExtractFileExt(FileName);
  List := TStringList.Create;
  try
    List.Delimiter := ';';
    List.StrictDelimiter := True;
    List.DelimitedText := GraphicFileMask(TGraphic);
    for I := 0 to List.Count-1 do
    begin
      if MatchesMask(FileName, List[I]) then
      begin
        Result := True;
        Exit;
      end;
    end;
  finally
    List.Free;
  end;
end;

或者，您可以简单地加载文件并查看会发生什么：

uses
  Graphics;

function GetRegisteredGraphicClass(const FileName: String): TGraphicClass;
var
  Picture: TPicture;
begin
  Result := nil;
  try
    Picture := TPicture.Create;
    try
      Picture.LoadFromFile(FileName);
      Result := TGraphicClass(Picture.Graphic.ClassType);
    finally
      Picture.Free;
    end;
  except
  end;
end;

更新：如果您想提取扩展名和描述，可以使用TStringList.DelimitedText来解析GraphicFilter() 函数的结果：

uses
  SysUtils, Classes, Graphics;

function RPos(const ASub, AIn: String; AStart: Integer = -1): Integer;
var
  i: Integer;
  LStartPos: Integer;
  LTokenLen: Integer;
begin
  Result := 0;
  LTokenLen := Length(ASub);
  // Get starting position
  if AStart < 0 then begin
    AStart := Length(AIn);
  end;
  if AStart < (Length(AIn) - LTokenLen + 1) then begin
    LStartPos := AStart;
  end else begin
    LStartPos := (Length(AIn) - LTokenLen + 1);
  end;
  // Search for the string
  for i := LStartPos downto 1 do begin
    if Copy(AIn, i, LTokenLen) = ASub then begin
      Result := i;
      Break;
    end;
  end;
end;

procedure GetRegisteredGraphicFormats(AFormats: TStrings);
var
  List: TStringList;
  i, j: Integer;
  desc, ext: string;
begin
  List := TStringList.Create;
  try
    List.Delimiter := '|';
    List.StrictDelimiter := True;
    List.DelimitedText := GraphicFilter(TGraphic);
    i := 0;
    if List.Count > 2 then
      Inc(i, 2); // skip the "All" filter ...
    while i <= List.Count-1 do
    begin
      desc := List[i];
      ext := List[i+1];
      j := RPos('(', desc);
      if j > 0 then
        desc := TrimRight(Copy(desc, 1, j-1)); // remove extension mask from description
      AFormats.Add(ext + '=' + desc);
      Inc(i, 2);
    end;
  finally
    List.Free;
  end;
end;

更新 2： 如果您只对注册的图形文件扩展名列表感兴趣，则假设 List 是一个已经创建的 TStrings 后代，使用这个：

ExtractStrings([';'], ['*', '.'], PChar(GraphicFileMask(TGraphic)), List);

Answer 2

GlScene 项目有一个单元 PictureRegisteredFormats.pas 实现了这一点。

Answer 3

这是一种替代方法，它可能比 GLScene 解决方案更安全。 这仍然是一个黑客，因为所需的结构是全局的，但在Graphics.pas单元的实现部分中，但我的方法使用了少得多的“maigc常量”（很难-编码到代码中的偏移量）并使用两种不同的方法来检测 Graphics.pas 中的 GetFileFormats 函数。

我的代码利用了 TPicture.RegisterFileFormat 和 TPicture.RegisterFileFormatRes 都需要立即调用 Graphics.GetFileFormats 函数这一事实。该代码检测相对偏移CALL操作码并注册两者的目标地址。仅当两个结果相同时才继续前进，这增加了安全系数。另一个安全因素是检测方法本身：即使编译器生成的序言发生变化，只要调用的第一个函数是GetFileFormats，该代码就会找到它。

我不会将“警告：当使用“使用调试 DCU”选项编译 Graphics.pas 时，这将崩溃。” 位于单元顶部（如 >GLScene 代码），因为我已经使用调试 dcu 和无调试 dcu 进行了测试，并且它有效。还用包进行了测试，它仍然有效。

此代码仅适用于 32 位目标，因此广泛使用Integer 进行指针操作。一旦我安装了 Delphi XE2 编译器，我将尝试使其适用于 64 位目标。

更新：支持 64 位的版本可以在这里找到：https://stackoverflow.com/a/35817804 /505088

unit FindReigsteredPictureFileFormats;

interface

uses Classes, Contnrs;

// Extracts the file extension + the description; Returns True if the hack was successful,
// False if unsuccesful.
function GetListOfRegisteredPictureFileFormats(const List: TStrings): Boolean;

// This returns the list of TGraphicClass registered; True for successful hack, false
// for unsuccesful hach
function GetListOfRegisteredPictureTypes(const List:TClassList): Boolean;

implementation

uses Graphics;

type
  TRelativeCallOpcode = packed record
    OpCode: Byte;
    Offset: Integer;
  end;
  PRelativeCallOpcode = ^TRelativeCallOpcode;

  TLongAbsoluteJumpOpcode = packed record
    OpCode: array[0..1] of Byte;
    Destination: PInteger;
  end;
  PLongAbsoluteJumpOpcode = ^TLongAbsoluteJumpOpcode;

  TMaxByteArray = array[0..System.MaxInt-1] of Byte;
  PMaxByteArray = ^TMaxByteArray;

  TReturnTList = function: TList;

  // Structure copied from Graphics unit.
  PFileFormat = ^TFileFormat;
  TFileFormat = record
    GraphicClass: TGraphicClass;
    Extension: string;
    Description: string;
    DescResID: Integer;
  end;

function FindFirstRelativeCallOpcode(const StartOffset:Integer): Integer;
var Ram: PMaxByteArray;
    i: Integer;
    PLongJump: PLongAbsoluteJumpOpcode;
begin
  Ram := nil;

  PLongJump := PLongAbsoluteJumpOpcode(@Ram[StartOffset]);
  if (PLongJump^.OpCode[0] = $FF) and (PLongJump^.OpCode[1] = $25) then
    Result := FindFirstRelativeCallOpcode(PLongJump^.Destination^)
  else
    begin
      for i:=0 to 64 do
        if PRelativeCallOpcode(@Ram[StartOffset+i])^.OpCode = $E8 then
          Exit(StartOffset + i + PRelativeCallOpcode(@Ram[StartOffset+i])^.Offset + 5);
      Result := 0;
    end;
end;

procedure FindGetFileFormatsFunc(out ProcAddr: TReturnTList);
var Offset_from_RegisterFileFormat: Integer;
    Offset_from_RegisterFileFormatRes: Integer;
begin
  Offset_from_RegisterFileFormat := FindFirstRelativeCallOpcode(Integer(@TPicture.RegisterFileFormat));
  Offset_from_RegisterFileFormatRes := FindFirstRelativeCallOpcode(Integer(@TPicture.RegisterFileFormatRes));

  if (Offset_from_RegisterFileFormat = Offset_from_RegisterFileFormatRes) then
    ProcAddr := TReturnTList(Pointer(Offset_from_RegisterFileFormat))
  else
    ProcAddr := nil;
end;

function GetListOfRegisteredPictureFileFormats(const List: TStrings): Boolean;
var GetListProc:TReturnTList;
    L: TList;
    i: Integer;
begin
  FindGetFileFormatsFunc(GetListProc);
  if Assigned(GetListProc) then
    begin
      Result := True;
      L := GetListProc;
      for i:=0 to L.Count-1 do
        List.Add(PFileFormat(L[i])^.Extension + '=' + PFileFormat(L[i])^.Description);
    end
  else
    Result := False;
end;

function GetListOfRegisteredPictureTypes(const List:TClassList): Boolean;
var GetListProc:TReturnTList;
    L: TList;
    i: Integer;
begin
  FindGetFileFormatsFunc(GetListProc);
  if Assigned(GetListProc) then
    begin
      Result := True;
      L := GetListProc;
      for i:=0 to L.Count-1 do
        List.Add(PFileFormat(L[i])^.GraphicClass);
    end
  else
    Result := False;
end;

end.