How to get all of the supported file formats from Graphics unit?

Question

When any TGraphic descendant registering its own graphic file format with a class procedure TPicture.RegisterFileFormat(), they're all stored in Graphics.FileFormats global variable.

Too bad that FileFormats variable is not in the "interface" section of "Graphics.pas", so I can't access it. I need to read this variable to implement a special filter for my file-list control.

Can I get that list without manual fixing the Graphics.pas's source code?

Chowchow

There is also related QC report #11837 worth to vote – Broaden

Answer 1

You are working with a file-list control, and presumably thus a list of filenames. If you don't need to know the actual TGraphic class types that are registered, only whether a given file extension is registered or not (such as to check if a later call to TPicture.LoadFromFile() is likely to succeed), you can use the public GraphicFileMask() function to get a list of registered file extensions and then compare your filenames to that list. For example:

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;

Or, you could simply load the file and see what happens:

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;

Update: if you want to extract the extensions and descriptions, you can use TStringList.DelimitedText to parse the result of the GraphicFilter() function:

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;

Update 2: if you are just interested in a list of registered graphic file extensions, then, assuming List is an already created TStrings descendant, use this:

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

Shrink

You should probably say here, as well as your comment to @Cosmin, that GraphicFilter can be parsed to get descriptions as well as masks. – Visconti

+1 Wow! Thanks very much for pointing us at these two véry usefull Graphics.pas routines. – Selassie

Does OP really work with file list control? I don't see anything about that in remaining comments. – Greywacke

Answer 2

The GlScene project has a unit PictureRegisteredFormats.pas that implements a hack for that.

Lenette

Great! Thank you very much, Uwe. How do you think, will it be correct if I'll publish the solution of GIScene here for community? It's open source anyway – Chowchow

The reason I didn't post it here by myself was that I didn't want to think about exactly that question... – Lenette

@Andrew, Uwe: Googling for the filename yields koders.com/delphi/…. This should be enough. – Veroniqueverras

Answer 3

Here's an alternative hack that might be safer then the GLScene solution. It's still a hack, because the desired structure is global but in the implementation section of the Graphics.pas unit, but my method uses a lot less "maigc constants" (hard-coded offsets into the code) and uses two distinct methods to detect the GetFileFormats function in Graphics.pas.

My code exploits the fact that both TPicture.RegisterFileFormat and TPicture.RegisterFileFormatRes need to call the Graphics.GetFileFormats function immediately. The code detects the relative-offset CALL opcode and registers the destination address for both. Only moves forward if both results are the same, and this adds a safety-factor. The other safety-factor is the detection method itself: even if the prologue generated by the compiler would change, as long as the first function called is GetFileFormats, this code finds it.

I'm not going to put the "Warning: This will crash when Graphics.pas is compiled with the 'Use Debug DCUs' option." at the top of the unit (as found in the GLScene code), because I've tested with both debug dcu's and no debug dcu's and it worked. Also tested with packages and it still worked.

This code only works for 32bit targets, hence the extensive use of Integer for pointer operations. I will attempt making this work for 64bit targets as soon as I'll get my Delphi XE2 compiler installed.

Update: A version supporting 64 bit can be found here: https://mcmap.net/q/662596/-how-to-get-all-of-the-registered-file-formats-from-vcl-graphics-but-64bit

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.

Backslide

I have a version that works for 64 bit. Would you like me to pastebin it for you? – Visconti

The GetListOfRegisteredPictureFileFormats() function can be implemented differently by using TStringList.DelimitedText to parse the result of the public Graphics.GraphicFilter() function. This is the same function that TOpenPictureDialog uses to create its Filter. No low-level hack needed. A low-level hack would only be needed when accessing the TFileFormat.GraphicClass field, the registered descriptions and extensions are publically accessible, just not stright-forward. – Shrink

Well, both new solutions are acceptable. I voted for both ) I unchecked the Uwe's answer until the bounty timeout will end. – Chowchow

@Andrew, Remy's solution is very good if one only needs the registered file extensions and descriptions. My solution is only interesting if one needs the TGraphicClass list - but I don't think that's very valuable. At least I can't imagine a scenario where I'd need the TGraphicClass. – Backslide

You would need the TGraphicClass when you want to load from a stream, see: QC6669 and QC57402. – Selassie