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

Question

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

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

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

Answer 1

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

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项目有一个实现hack 的单元PictureRegisteredFormats.pas。

Answer 3

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

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

我不打算将 放在"Warning: This will crash when Graphics.pas is compiled with the 'Use Debug DCUs' option."单元的顶部（如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.