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

当任何TGraphic子体使用类过程TPicture.RegisterFileFormat（）注册自己的图形文件格式时，它们都存储在Graphics.FileFormats全局变量中

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

---

无需手动修复Graphics.pas的源代码，我就可以获得该列表吗？

该项目有一个单元PictureRegisteredFormats.pas，它实现了一个黑客攻击。

这里有一个比

GLScene

解决方案更安全的替代黑客攻击这仍然是一个难题，因为所需的结构是全局的，但在

Graphics.pas

单元的实现部分，但是我的方法使用的“maigc常量”（硬编码到代码中的偏移量）要少得多，并且使用两种不同的方法来检测

Graphics.pas

中的

GetFileFormats

函数

我的代码利用了这样一个事实，即

TPicture.RegisterFileFormat

和

TPicture.RegisterFileFormatRes

都需要立即调用

Graphics.GetFileFormats

函数。代码检测相对偏移量

调用

操作码，并为两者注册目标地址。只有在两个结果相同的情况下才会向前移动，这会增加一个安全系数。另一个安全因素是检测方法本身：即使编译器生成的序言会改变，只要调用的第一个函数是

GetFileFormats

，此代码就会找到它

我不打算把

“警告：当使用'Use Debug dcu'选项编译Graphics.pas时，这将崩溃。”

放在单元的顶部（如

GLScene

代码中所示），因为我已经使用调试dcu和未使用调试dcu进行了测试，它工作正常。还使用软件包进行了测试，但仍然有效

此代码仅适用于32位目标，因此广泛使用

Integer

进行指针操作。一旦安装了Delphi XE2编译器，我将尝试为64位目标执行此操作

更新：可在此处找到支持64位的版本：

---

您使用的是一个文件列表控件，大概是一个文件名列表。如果不需要知道注册的实际

TGraphic

类类型，只需要知道是否注册了给定的文件扩展名（例如检查以后调用

TPicture.LoadFromFile（）

是否可能成功），可以使用public

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;

伟大的非常感谢你，乌维。您认为，如果我在这里为社区发布GIScene的解决方案是否正确？不管怎么说，它是开源的。我没有自己在这里发布它的原因是我不想考虑这个问题…@Andrew，Uwe:谷歌搜索文件名。这应该足够了。我有一个64位的版本。要我为您粘贴吗？
GetListOfRegisteredPictureFileFormats（）
函数可以通过使用
TStringList.DelimitedText
解析公共函数的结果以不同的方式实现。这与
TOpenPictureDialog
用于创建其
过滤器的函数相同。不需要低级黑客。只有在访问
TFileFormat.GraphicClass
字段时，才需要进行低级黑客攻击，注册的描述和扩展可以公开访问，只是不能直接访问。好吧，这两种新解决方案都是可以接受的。我两个都投了赞成票）我没有检查Uwe的答案，直到悬赏超时结束。@Andrew，如果只需要注册的文件扩展名和描述，Remy的解决方案非常好。我的解决方案只有在需要
TGraphicClass
列表时才有意义，但我认为这不是很有价值。至少我无法想象我需要
tgraphicsclass
的场景。当你想从流中加载时，你需要
tgraphicsclass
，请参见：和。你可能应该在这里说，以及你对@Cosmin的评论，可以解析
graphicsfilter
以获得描述和掩码。+1哇！非常感谢您为我们指出这两个非常有用的
Graphics.pas
例程。OP真的与文件列表控件一起工作吗？我在剩下的评论中看不到任何关于这一点的内容。还有相关的值得投票的内容
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;

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