19

TGraphicの子孫が独自のグラフィックファイル形式をクラスプロシージャTPicture.RegisterFileFormat（）に登録すると、それらはすべてGraphics.FileFormatsグローバル変数に格納されます。

FileFormats変数が「Graphics.pas」の「interface」セクションにないので、アクセスできません。ファイルリストコントロール用の特別なフィルターを実装するには、この変数を読み取る必要があります。

Graphics.pasのソースコードを手動で修正せずにそのリストを取得できますか？

4

3 に答える 3

21

あなたはファイル リスト コントロールを操作しており、おそらくファイル名のリストを操作しています。登録されている実際のクラス タイプを知る必要がなく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);
于 2013-02-03T22:22:50.600 に答える
11

GlSceneプロジェクトには、そのためのハックを実装するユニットPictureRegisteredFormats.pasがあります。

于 2010-12-13T16:01:02.973 に答える
9

これは、ソリューションよりも安全な代替ハックです。目的の構造はグローバルですが、ユニットの実装セクションにあるため、これはまだハックですが、私の方法では「maigc 定数」(コードにハードコードされたオフセット) を使用することがはるかに少なく、関数を検出するために 2 つの異なる方法を使用しています。 .GLSceneGraphics.pasGetFileFormatsGraphics.pas

TPicture.RegisterFileFormat私のコードは、との両方が関数をすぐTPicture.RegisterFileFormatResに呼び出す必要があるという事実を利用しています。Graphics.GetFileFormatsこのコードは、相対オフセット オペコードを検出し、両方CALLの宛先アドレスを登録します。両方の結果が同じ場合にのみ前進し、これにより安全係数が追加されます。もう 1 つの安全要因は、検出方法自体です。コンパイラによって生成されたプロローグが変更されたとしても、呼び出される最初の関数が である限り、このコードはそれを検出します。GetFileFormats

デバッグ DCU を使用する場合とデバッグ DCU を使用しない場合の両方でテストした"Warning: This will crash when Graphics.pas is compiled with the 'Use Debug DCUs' option."ところ、動作したため、(コードにあるように) をユニットの先頭に置くつもりはありません。GLSceneパッケージでもテストしましたが、それでも機能しました。

このコードは 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.
于 2013-02-03T21:31:50.420 に答える