Wie erhalten Sie alle unterstützten Dateiformate von Graphics unit?

Question

Wenn ein TGraphic-Nachkomme sein eigenes Grafikdateiformat mit einer Klassenprozedur TPicture.RegisterFileFormat() registriert, werden alle in der globalen Variablen Graphics.FileFormats gespeichert.

Schade, dass FileFormats-Variable nicht in der "Schnittstelle" Abschnitt von "Graphics.pas" ist, so kann ich nicht darauf zugreifen. Ich muss diese Variable lesen, um einen speziellen Filter für mein Dateilisten-Steuerelement zu implementieren.

Kann ich diese Liste ohne manuelle Korrektur des Quellcodes von Graphics.pas bekommen?

Answer 1

Sie arbeiten mit einem Datei-List-Steuerelement, und vermutlich damit eine Liste von Dateinamen. Wenn Sie die tatsächlichen TGraphic Klassentypen, die registriert sind, nicht kennen müssen, nur ob eine bestimmte Dateierweiterung registriert ist oder nicht (z. B. um zu überprüfen, ob ein späterer Aufruf an TPicture.LoadFromFile() wahrscheinlich erfolgreich ist), können Sie die öffentliche GraphicFileMask() verwenden Funktion, um eine Liste der registrierten Dateierweiterungen zu erhalten und dann Ihre Dateinamen mit dieser Liste zu vergleichen.Zum Beispiel:

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; 

Oder könnten Sie einfach die Datei laden und sehen, was passiert:

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: wenn Sie die Erweiterungen und Beschreibungen extrahieren möchten, können Sie TStringList.DelimitedText verwenden können, analysieren das Ergebnis der GraphicFilter() Funktion:

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:, wenn Sie nur Interesse an einer Liste der registrierten Grafikdateierweiterungen sind, dann, List Annahme, daß ein bereits erstellt TStrings Nachkommen, verwenden Sie diese:

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

Answer 2

Das GlScene Projekt hat eine Einheit PictureRegisteredFormats.pas, die einen Hack dafür implementiert.

Answer 3

Hier ist ein alternativer Hack, der sicherer dann die GLScene Lösung sein könnte. Es ist immer noch ein Hack, weil die gewünschte Struktur global ist, aber in der Implementierung Abschnitt der Einheit Graphics.pas, aber meine Methode verwendet viel weniger "Maigc-Konstanten" (hart-codierte Offsets in den Code) und verwendet zwei verschiedene Methoden zu erkennen die GetFileFormats Funktion in Graphics.pas.

Mein Code nutzt die Tatsache, dass sowohl TPicture.RegisterFileFormat als auch TPicture.RegisterFileFormatRes die Graphics.GetFileFormats Funktion sofort aufrufen müssen. Der Code erkennt den relativen Offset CALL Opcode und registriert die Zieladresse für beide. Geht nur vorwärts, wenn beide Ergebnisse gleich sind, und dies fügt einen Sicherheitsfaktor hinzu. Der andere Sicherheitsfaktor ist die Erkennungsmethode selbst: Selbst wenn der vom Compiler generierte Prolog sich ändert, solange die erste aufgerufene Funktion GetFileFormats ist, findet dieser Code sie.

Ich werde nicht die "Warning: This will crash when Graphics.pas is compiled with the 'Use Debug DCUs' option." an der Spitze der Einheit setzen (wie in der GLScene Code gefunden), weil ich mit beiden debug dcu's und keine Debug-dcu getestet habe und es funktioniert. Auch getestet mit Paketen und es funktionierte immer noch.

Dieser Code funktioniert nur für 32-Bit-Ziele, daher die umfangreiche Verwendung von Integer für Zeigeroperationen. Ich werde versuchen, dies für 64-Bit-Ziele zu machen, sobald ich meinen Delphi XE2-Compiler installiert habe.

Update: Eine Version 64-Bit-Unterstützung kann hier gefunden werden: 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.