tipos texto soportados son por mas los formatos formato cuáles comunes archivos delphi file graphics delphi-2010 formats

delphi - texto - ¿Cómo obtener todos los formatos de archivo admitidos desde la unidad de gráficos?



tipos de archivos de texto (3)

El proyecto GlScene tiene una unidad PictureRegisteredFormats.pas que implementa un hack para eso.

Cuando un descendiente de TGraphic registra su propio formato de archivo gráfico con un procedimiento de clase TPicture.RegisterFileFormat (), todos se almacenan en la variable global Graphics.FileFormats.

Lástima que la variable FileFormats no se encuentre en la sección "interfaz" de "Graphics.pas", por lo que no puedo acceder a ella. Necesito leer esta variable para implementar un filtro especial para mi control de lista de archivos.

¿Puedo obtener esa lista sin una reparación manual del código fuente de Graphics.pas?


Está trabajando con un control de lista de archivos y, presumiblemente, una lista de nombres de archivos. Si no necesita conocer los tipos reales de clase TGraphic que están registrados, solo si una extensión de archivo determinada está registrada o no (por ejemplo, para verificar si una llamada posterior a TPicture.LoadFromFile() es probable que tenga éxito), puede use la función pública GraphicFileMask() para obtener una lista de extensiones de archivos registradas y luego compare sus nombres de archivo con esa lista. Por ejemplo:

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;

O bien, simplemente puede cargar el archivo y ver qué sucede:

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;

Actualización: si desea extraer las extensiones y descripciones, puede usar TStringList.DelimitedText para analizar el resultado de la función 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;

Actualización 2: si solo está interesado en una lista de extensiones de archivos gráficos registrados, suponiendo que List es un descendiente TStrings ya creado, use esto:

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


Aquí hay un truco alternativo que podría ser más seguro que la solución GLScene . Todavía es un truco , porque la estructura deseada es global, pero en la sección de implementación de la unidad Graphics.pas , pero mi método utiliza muchas menos "constantes maigc" (desplazamientos codificados en el código) y utiliza dos métodos distintos para detectar la función GetFileFormats en Graphics.pas .

Mi código explota el hecho de que tanto TPicture.RegisterFileFormat como TPicture.RegisterFileFormatRes necesitan llamar inmediatamente a la función Graphics.GetFileFormats . El código detecta el código de operación CALL desplazamiento relativo y registra la dirección de destino para ambos . Solo avanza si ambos resultados son iguales y esto agrega un factor de seguridad. El otro factor de seguridad es el método de detección en sí mismo: incluso si el prólogo generado por el compilador cambiara, siempre que la primera función llamada sea GetFileFormats , este código la encuentre.

No voy a poner la "Warning: This will crash when Graphics.pas is compiled with the ''Use Debug DCUs'' option." en la parte superior de la unidad (como se encuentra en el código GLScene ), porque probé con depuración de dcu y sin depuración y funcionó. También probado con paquetes y todavía funcionó.

Este código solo funciona para objetivos de 32 bits, de ahí el uso extensivo de Integer para operaciones de puntero. Intentaré hacer que esto funcione para objetivos de 64 bits tan pronto como tenga mi compilador Delphi XE2 instalado.

Actualización: una versión que admite 64 bits se puede encontrar aquí: https://.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.