4

私は次の子孫の例を持っていますTBitmap：

TMyBitmap = class(TBitmap)
public
    constructor Create; override;
end;

constructor TMyBitmap.Create;
begin
   inherited;
   Beep;
end;

実行時に、これらのTMyBitmapオブジェクトの1つを作成し、それに画像をロードしてTImage、フォーム上のに配置します。

procedure TForm1.Button1Click(Sender: TObject);
var
   g1: TGraphic;
begin
   g1 := TMyBitmap.Create;
   g1.LoadFromFile('C:\...\example.bmp');

   Image1.Picture.Graphic := g1;
end;

内部では、新しいグラフィックを作成し、新しく作成されたクローンTPicture.SetGraphicを呼び出すことで、グラフィックのコピーを作成していることがわかります。.Assign

procedure TPicture.SetGraphic(Value: TGraphic);
var
   NewGraphic: TGraphic;
begin
   ...
   NewGraphic := TGraphicClass(Value.ClassType).Create;
   NewGraphic.Assign(Value);
   ...
end;

新しいグラフィッククラスが構築される行：

NewGraphic := TGraphicClass(Value.ClassType).Create;

コンストラクターを正しく呼び出し、すべてが順調です。

私は似たようなことをしたい、私はクローンを作りたいTGraphic：

procedure TForm1.Button1Click(Sender: TObject);
var
   g1: TGraphic;
   g2: TGraphic;
begin
   g1 := TMyBitmap.Create;
   g1.LoadFromFile('C:\...\example.bmp');

   //Image1.Picture.Graphic := g1;
   g2 := TGraphicClass(g1.ClassType).Create;
end;

これが私のコンストラクターを呼び出すことも、コンストラクターを呼び出すこともないことを除いてTBitmap。コンストラクターを呼び出すだけTObjectです。建設後：

g2.ClassName: 'TMyBitmap'
g2.ClassType: TMyBitmap

タイプは正しいですが、コンストラクターを呼び出しませんが、他の場所で同じコードを呼び出します。

なんで？

この架空の考案された例でも、のコンストラクターTBitmapが呼び出されていないため、まだ問題があります。内部状態変数が有効な値に初期化されていません：

constructor TBitmap.Create;
begin
  inherited Create;
  FTransparentColor := clDefault;
  FImage := TBitmapImage.Create;
  FImage.Reference;
  if DDBsOnly then HandleType := bmDDB;
end;

TPictureのバージョン：

NewGraphic := TGraphicClass(Value.ClassType).Create;

次のように逆コンパイルします。

mov eax,[ebp-$08]
call TObject.ClassType
mov dl,$01
call dword ptr [eax+$0c]
mov [ebp-$0c],eax

私のバージョン：

g2 := TGraphicClass(g1.ClassType).Create;

次のように逆コンパイルします。

mov eax,ebx
call TObject.ClassType
mov dl,$01
call TObject.Create
mov ebx,eax

アップデートワン

「クローン作成」を別の機能にプッシュする：

function CloneGraphic(Value: TGraphic): TGraphic;
var
    NewGraphic: TGraphic;
begin
   NewGraphic := TGraphicClass(Value.ClassType).Create;
   Result := NewGraphic;
end;

助けにはなりません。

アップデート2

明らかに、私は明確なコードの明確なスクリーンショットを明確に提供しています。これは、明確なコードが明確にすべて存在することを明確に示しています。明らかに：

ここに画像の説明を入力してください

アップデート3

OutputDebugStringsを使用した明確なバージョンは次のとおりです。

{ TMyGraphic }

constructor TMyBitmap.Create;
begin
  inherited Create;
    OutputDebugStringA('Inside TMyBitmap.Create');
end;

function CloneGraphic(Value: TGraphic): TGraphic;
var
    NewGraphic: TGraphic;
begin
    NewGraphic := TGraphicClass(Value.ClassType).Create;
    Result := NewGraphic;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    g1: TGraphic;
    g2: TGraphic;
begin
    OutputDebugString('Creating g1');
    g1 := TMyBitmap.Create;
    g1.LoadFromFile('C:\Archive\-=Images=-\ChessvDanCheckmateIn38.bmp');
    OutputDebugString(PChar('g1.ClassName: '+g1.ClassName));

    OutputDebugStringA('Assigning g1 to Image.Picture.Graphic');
    Image1.Picture.Graphic := g1;

    OutputDebugString('Creating g2');
    g2 := Graphics.TGraphicClass(g1.ClassType).Create;
    OutputDebugString(PChar('g2.ClassName: '+g2.ClassName));

    OutputDebugString(PChar('Cloning g1 into g2'));
    g2 := CloneGraphic(g1);
    OutputDebugString(PChar('g2.ClassName: '+g2.ClassName));
end;

そして生の結果：

ODS: Creating g1 Process Project2.exe ($1138)
ODS: Inside TMyBitmap.Create Process Project2.exe ($1138)
ODS: g1.ClassName: TMyBitmap Process Project2.exe ($1138)
ODS: Assigning g1 to Image.Picture.Graphic Process Project2.exe ($1138)
ODS: Inside TMyBitmap.Create Process Project2.exe ($1138)
ODS: Creating g2 Process Project2.exe ($1138)
ODS: g2.ClassName: TMyBitmap Process Project2.exe ($1138)
ODS: Cloning g1 into g2 Process Project2.exe ($1138)
ODS: g2.ClassName: TMyBitmap Process Project2.exe ($1138)
ODS: g1.ClassName: TMyBitmap Process Project2.exe ($1138)

そしてフォーマットされた結果：

Creating g1
   Inside TMyBitmap.Create
g1.ClassName: TMyBitmap

Assigning g1 to Image.Picture.Graphic
   Inside TMyBitmap.Create

Creating g2
g2.ClassName: TMyBitmap

Cloning g1 into g2
g2.ClassName: TMyBitmap

g1.ClassName: TMyBitmap

アップデート4

私は私ができるすべてのコンパイラオプションをオフにしてみました：

ここに画像の説明を入力してください

注：オフにしないでくださいExtended syntax。Resultこれがないと、関数のを割り当てることができません（宣言されていない識別子の結果）。

アップデートファイブ

@Davidの提案に従って、他のいくつかのマシン（すべてDelphi 5）でコードをコンパイルしてみました。

  • Ian Boyd（me）：失敗（Windows 7 64ビット）
  • デール：失敗（Windows 7 64ビット）
  • デイブ：失敗（Windows 7 64ビット）
  • クリス：失敗（Windows 7 64ビット）
  • ジェイミー：失敗（Windows 7 64ビット）
  • ジェイ：失敗（Windows XP 32ビット）
  • カスタマービルドサーバー：失敗（Windows 7 32ビット）

これがソースです。

4

2 に答える 2

7

これはスコーピングの問題のようです（以下はD5 Graphics.pasからのものです）：

TGraphic = class(TPersistent)
...
protected
  constructor Create; virtual;
...
end;

TGraphicClass = class of TGraphic;

Graphics.pasユニット内から呼び出された場合、オーバーライドCreateに問題はなく、問題もありません。TGraphicClass(Value.ClassType).Create;

ただし、別のユニットでは、のTGraphicClass(Value.ClassType).Create;保護されたメンバーにアクセスできませんTGraphic。したがって、最終TObject.Create;的には（仮想ではない）呼び出しを行うことになります。

可能な解決策

  • Graphics.pasを編集して再コンパイルします
  • クローンメソッドのサブクラスが階層の下位にあることを確認してください。（例：TBitmap.Createはパブリックです）

編集：追加の解決策

これは、クラスの保護されたメンバーにアクセスするための手法のバリエーションです。
ソリューションの堅牢性は保証されませんが、機能しているようです。:)
私が恐れているのはあなた自身の広範なテストをしなければならないでしょう。

type
  TGraphicCracker = class(TGraphic)
  end;

  TGraphicCrackerClass = class of TGraphicCracker;

procedure TForm1.Button1Click(Sender: TObject);
var
  a: TGraphic;
  b: TGraphic;
begin
  a := TMyBitmap.Create;
  b := TGraphicCrackerClass(a.ClassType).Create;
  b.Free;
  a.Free;
end;
于 2011-03-17T16:29:16.243 に答える
3

価値があるのは、あなたのソース (ZIP ファイル) をダウンロードして実行CannotCloneGraphics.exeしたところ、「無効」というメッセージが表示されたことです。エラーメッセージ。次に、プロジェクト (DPR ファイル) を Delphi 2009 で開き、コンパイルして実行しました。その後、エラー メッセージは表示されず、カスタム コンストラクターは 4 回実行されました。

したがって、これは Delphi 5 のインストールに問題があるように思われます。実際、すべてのマシンに Delphi 5 が搭載されていました (アップグレードの時期?!)。Delphi 5 に何らかの問題があるか、すべてのマシンが同じように「改ざん」されています。

私は古いDelphi 4を持っていると確信しています個人的どこか。私はそれをインストールして、そこで何が起こるか見てみましょう...

アップデート

Delphi 4 Standard を仮想 Windows 95 システムにインストールしました。私はこのコードを試しました：

  TMyBitmap = class(TBitmap)
  public
    constructor Create; override;
  end;

  ...

  constructor TMyBitmap.Create;
  begin
    inherited;
    ShowMessage('Constructor constructing!');
  end;

  ...

  procedure TForm1.Button1Click(Sender: TObject);
  var
    g, g2: TGraphic;
  begin
    g := TMyBitmap.Create;
    g2 := TGraphicClass(g.ClassType).Create;
    g.Free;
    g2.Free;
  end;

メッセージボックスは1つしかありません！したがって、結局のところ、これはDelphi 4 (および 5) の問題です。（ごめんなさい、デビッド！）

于 2011-03-17T15:18:41.540 に答える