戻る ホーム 上へ 進む

2.10 グラフィッククラスの作り方

TMetafile, TBitmap, TIcon, TJPEGImage クラス は TGraphic から継承するクラスです。TGraphic は VCL で定義されているグラフィック用のクラスの抽象ベースクラスで、グラフィッククラスが備えるべきインターフェース(メソッドやプロパティ)を規定しています。TGraphic のインターフェースに沿ったクラスを実装すれば、Delphiで扱える画像データ形式が拡張され、新たなグラフィックデータを TImage や TDBImage コンポーネントにグラフィックを表示したり、Canvas の Draw, StretchDraw メソッドを使ってグラフィックを Canvas 上に描画したりできます。

例えば、Web でポピュラーな GIF や PNG に対応した TGif や TPng などのクラスを TGraphic のインターフェースに沿って作成すれば、GIF で書いた絵を張り込んだスピードボタンを作ったり、PNG をイメージコンポーネントに表示できるようになります。

以下に TGraphic の詳細を記述しますが、このクラスは抽象ベースクラスなので、継承クラスをどのように実装するのかが説明の中心となり、単にだらだらと説明すると抽象的で退屈な説明になってしまいます。そこで、簡単なグラフィッククラス TEllipse の各メソッドの実装を説明し、グラフィッククラスの実装の仕方をより具体的に説明することにしました。

尚、説明の便宜のため、TGraphic からの継承クラスをグラフィッククラス、グラフィッククラスのインスタンス内の画像データをグラフィックと呼ぶことにします。

2.10.1 TEllipse(楕円)クラス

まず最初に、ここで実装するグラフィッククラス TEllipseを紹介します。TEllipse はグラフィックとして1個の楕円を保持するだけの非常に非実用的かつ単純なクラスです (^^。TEllipse をイメージコントロールで表示した時の様子を以下に示します。

Figure 2.10-1 Figure 2.10-2
図2.10-1 TEpllipse を設計時にイメージコントロールで表示している様子 図2.10-2 TEpllipse を実行時にイメージコントロールで表示している様子

TEllipse が持っているグラフィックデータは、「楕円の幅」、「楕円の高さ」と「楕円の色」だけです。TEllipse の実装のために、TEllipse が使うファイル(ストリームデータ)形式とクリップボード形式を以下に示します。尚、ファイルの拡張子は elp とします。

Figure 2.10-3

TEllipse のファイル(ストリームデータ)とクリップボード形式

2.10.2 TGraphic のインターフェース

次に、TGraphic のインターフェースを紹介します。以下は TGraphic クラスの宣言をそのまま抜き出したものです(Delphi 6 の最新のソース)。

  TGraphic = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FOnProgress: TProgressEvent;   
    FModified: Boolean;
    FTransparent: Boolean;         
    FPaletteModified: Boolean;     
    procedure SetModified(Value: Boolean);  
  protected
    procedure Changed(Sender: TObject); virtual;
    procedure DefineProperties(Filer: TFiler); override;
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); virtual; abstract;
    function Equals(Graphic: TGraphic): Boolean; virtual;
    function GetEmpty: Boolean; virtual; abstract;
    function GetHeight: Integer; virtual; abstract;
    function GetPalette: HPALETTE; virtual;  
    function GetTransparent: Boolean; virtual;       
    function GetWidth: Integer; virtual; abstract;
    procedure Progress(Sender: TObject;              
                       Stage: TProgressStage; 
                       PercentDone: Byte;  
                       RedrawNow: Boolean; 
                       const R: TRect; 
                       const Msg: string); dynamic;
    procedure ReadData(Stream: TStream); virtual;
    procedure SetHeight(Value: Integer); virtual; abstract;
    procedure SetPalette(Value: HPALETTE); virtual;
    procedure SetTransparent(Value: Boolean); virtual; 
    procedure SetWidth(Value: Integer); virtual; abstract;
    procedure WriteData(Stream: TStream); virtual;
  public
    constructor Create; virtual;
    procedure LoadFromFile(const Filename: string); virtual;
    procedure SaveToFile(const Filename: string); virtual;
    procedure LoadFromStream(Stream: TStream); virtual; abstract;
    procedure SaveToStream(Stream: TStream); virtual; abstract;
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
      APalette: HPALETTE); virtual; abstract;
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
      var APalette: HPALETTE); virtual; abstract;
    property Empty: Boolean read GetEmpty;
    property Height: Integer read GetHeight write SetHeight;
    property Modified: Boolean read FModified write SetModified;
    property Palette: HPALETTE read GetPalette              
                               write SetPalette;
    property PaletteModified: Boolean read FPaletteModified 
                                      write FPaletteModified;
    property Transparent: Boolean read GetTransparent       
                                  write SetTransparent;
    property Width: Integer read GetWidth write SetWidth;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnProgress: TProgressEvent read FOnProgress   
                                        write FOnProgress;
  end;

全部で10個の abstract で virtual なメソッドがあることが判ると思います。これが継承クラスで絶対に実装しなければならないメソッドです。残りの virtual だけが付いているメソッドはデフォルトの動作が実装済みのメソッドで、余程の事情が無い限り override する必要はありません(Assignメソッドは例外です)。

これから実装する TEllipse の宣言を以下に示します。

type
  TEllipse = class(TGraphic)
  private
    FWidth, FHeight: Integer;
    FColor: TColor;
    procedure SetColor(Value: TColor);
  protected
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
    function GetEmpty: Boolean; override;
    function GetHeight: Integer; override;
    function GetWidth: Integer; override;
    function GetTransparent: Boolean; override;
    procedure SetHeight(Value: Integer); override;
    procedure SetWidth(Value: Integer); override;
  public
    constructor Create; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
                                      APalette: HPALETTE); override;
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
                                    var APalette: HPALETTE); override;
    procedure Assign(Source: TPersistent); override;

    property Color: TColor read FColor write SetColor;
  end;

  TEllipseClipboarddata = record
    Width, Height: Integer;
    Color: TColor;
  end;


TGraphic の abstract なメソッドの他に、TPersistent から継承する Assign メソッドを Override していることに注意してください。理由は後述します。

2.10.3 グラフィックの表示

グラフィックの表示には

procedure Draw(ACanvas: TCanvas; const Rect: TRect); 

が使われます。グラフィッククラスはグラフィックデータを解釈して表示できなければ話になりません。このメソッド Draw は、protected なのでアプリケーションから直接呼ばれることはありません。その代わりに、TCanvas の

procedure Draw(X, Y: Integer; Graphic: TGraphic);
procedure StretchDraw(const Rect: TRect; Graphic: TGraphic);

メソッドにグラフィッククラスのインスタンスを渡すと、TCanvasが呼び出します。この仕組みの面白いところは、TCanvas は グラフィッククラスの詳細を知ること無しに描画を行うことです。TCanvas の Draw や StretchDraw はグラフィックの描画をグラフィッククラスの Draw メソッドに委託します。インスタンスの多態性を利用して、何のグラフィッククラスか知ること無しに描画を委託してくるわけです。

TCanvas.Draw から呼び出された場合は、TCanvas.Draw の (x, y) パラメータとグラフィッククラスの Width/Height プロパティ(グラフィックの大きさ) から、描画先の矩形(Rect)が作られ、グラフィッククラスの Draw メソッドに渡されます。TCanvas.StrechDraw から呼び出された場合は StretchDraw の Rect パラメータがそのまま、グラフィッククラスの Draw メソッドに渡されます。

パレットをサポートする場合、グラフィッククラスの Draw メソッドは グラフィックのパレットを描画先の Canvas のデバイスコンテキストに「BG実体化」しなければなりません。

TEllipse の Draw メソッドの実装を以下に示します。

procedure TEllipse.Draw(ACanvas: TCanvas; const Rect: TRect);
var SavedPenColor: TColor;
    SavedBrushStyle: TBrushStyle;
begin
  SavedPenColor := ACanvas.Pen.Color; 
  SavedBrushStyle := ACanvas.Brush.Style;
  ACanvas.Pen.Color := FColor; 
  ACanvas.Brush.Style := bsClear;

  ACanvas.Ellipse(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);

  ACanvas.Pen.Color := SavedPenColor;
  ACanvas.Brush.Style := SavedBrushStyle;
end;

この実装では、まず、描画先の Canvas の属性をセーブし、楕円を指定された枠 の大きさで書きます。後で説明する Width や Height プロパティ を特に意識する必要は有りません。 Width と Height プロパティ を使って図形の大きさを決めるのは Canvas の Draw や StretchDraw メソッドの仕事だからです。

2.10.4 Width, Height プロパティ

Width/Height プロパティ はグラフィックのピクセル単位大きさを表わします。必ずしもグラフィックが決まった大きさを持っているわけでは有りませんが、何らかの大きさを与える必要があります。この大きさが Canvas.Draw や Canvas.StretchDraw でグラフィックを描画する時にグラフィッククラスの Draw メソッドに渡されるグラフィッククラスのの大きさになります。例えばメタファイルには決まった大きさは有りませんが、2.8 TMetafileで説明したように、TMetafile はメタファイルの境界ボックスのデフォルト描画サイズを Width/Height プロパティ にしています。

Width、Height プロパティ の実装である

function GetHeight: Integer;
function GetWidth: Integer;
procedure SetHeight(Value: Integer);
procedure SetWidth(Value: Integer);

メソッドは必ず実装しなければなりません。SetWidth/SetHeight でグラフィックのピクセル単位の大きさの変更を許さない場合は例外をあげる必要があります。変更を許す場合は、グラフィックを大きさを変更するロジックを実装しなければなりません。例えば、TBitmap は新しい大きさで無地のビットマップを新たに作成し、旧画像をその上にコピーします。

TEllpse の GetWidth/getHeight/SetWidth/SetHeight の実装を以下に示します。

function TEllipse.GetHeight: Integer;
begin Result := FHeight; end;

function TEllipse.GetWidth: Integer;
begin Result := FWidth; end;

procedure TEllipse.SetHeight(Value: Integer);
begin FHeight := Value; Changed(Self); end;

procedure TEllipse.SetWidth(Value: Integer);
begin FWidth := Value; Changed(Self); end;

処理内容は一目瞭然ですが、SetWidth と SetHeight メソッドで Changed メソッドを呼び出していることに注意してください。Changed メソッドは TEllipse OnChange を起こします。OnChangeイベントは通常、グラフィッククラスを表示しているコントロール(イメージコントロールなど)に接続されていて、OnChangeイベントは再描画を促します。

Changedメソッドを呼び出す代わりに

Modified := True; 

としてもかまいません。Changed メソッドは Modified プロパティを True にします。また Modified プロパティに True を代入すると OnChange イベントが起こります。どちらの手法を使っても結果は同じです。尚、Modified プロパティは明示的に False が代入されるまで、True のままになります。これはグラフィッククラスを表示するコントロールなどが、グラフィッククラスの変化を処理したかどうかの判断に用いられます。

TEllipse の表示に影響するプロパティとして、TEllipse独自の Color プロパティがありますが、 これの実装も示しておきます。

procedure TEllipse.SetColor(Value: TColor);
begin
  FColor := Value;
  Changed(Self);
end;

Changed を呼んでいる理由は説明不要でしょう。

2.10.5 Palette プロパティ と PaletteModified プロパティ

Palette プロパティと PaletteModified プロパティはグラフィッククラスを表示するイメージコンポーネントなどにグラフィックの論理パレットを伝えるためのものです。

Palette プロパティ を実装するため、TGraphic には SetPaletteGetPalette メソッドが用意されました。これを Override することで Palette プロパティ を読み書きできます。デフォルトでは GetPalette は 0を返し、SetPalette は何もしません。必要に応じて override して下さい。また、パレットを使う場合は、GetPalette が返すパレットを描画先のデバイスコンテキストに選択し、バックグラウンド実体化をしてから描画を行うようにして下さい。

例:
procedure TXXXXXX.Draw(ACanvas: TCanvas; const Rect: TRect);
var OldPalette: HPALETTE;
begin
  OldPalette := SelectPalette(ACanvas.Handle, GetPalette, True);
  RealizePalette(ACanvas.Handle);
  //  ..  いろいろな描画
  SelectPalette(ACanvas.handle, oldPalette, True);
end;

こんな具合です。

PaletteModified プロパティはグラフィッククラスで特に実装する必要は有りません。グラフィッククラスで行うべきことはグラフィックを描画するためのパレットが変化したら、それをChanged メソッドで OnChange イベントでグラフィックコントロールに知らせる「前」に PaletteModified プロパティ に True をセットすることです。つまり

  パレットを変更する処理;
  PaletteModified := True;
  Changed(Self);

こんな感じになります。グラフィッククラスを表示するコントロール等は、OnChange イベント発生時等に、PaletteModified プロパティを見てパレットが変更されたかを判断し、必要な処置を行います。TEllipse ではパレットを使いませんから何も実装せず、デフォルトの動作に任せています。

尚、PaletteModified プロパティは明示的に False が代入されるまで True のままになります。理由は Modified プロパティと同じです。

2.10.6 Transparent プロパティ

この プロパティ は、 Draw メソッドが、 Rect (描画先枠)で示される描画先の領域を完全に描画し尽くすかどうかを指定します。言い換えると描画されるイメージが描画先矩形を完全に覆い尽くすかを表わす プロパティ です。

ここで注意すべきことは Transparent プロパティ は描画の方式を指示するプロパティ であって、グラフィックの性質を示す プロパティ では無いということです。例えば TBitmap は Transparent が True になると TransparentColor プロパティ の指定に従ってビットマップの一部が透明になるように描画します。

つまり、Transparent が False の場合、Draw メソッドは描画先矩形を完全に描画し尽くさなければなりません。それが出来ない場合は、常にTransparent が True を返すように GetTransparent メソッドを override する必要があります。TEllipse の場合、楕円が描画先を常に完全には覆い尽くさないので、以下の様にするのが適切です。

function TEllipse.GetTransparent: Boolean;
begin Result := True; end;

2.10.7 ストリーム/ファイルとの入出力

procedure LoadFromStream(Stream: TStream);
procedure SaveToStream(Stream: TStream);

上の2つのメソッドはグラフィッククラスがストリームにグラフィックデータを書いたり、ストリームからグラフィックデータを読み込むためのメソッドです。LoadFromFile/SaveToFile メソッドはグラフィックをファイルと入出力するためのメソッドです。

このメソッドは、グラフィッククラスのメソッドとして

var el: TEllipse;
  :
  el := TEllipse.Create;
  el.LoadFromStream(........

という具合に明示的に呼び出されることもありますが、TPicture から間接的に呼び出されることもあります。この時、TPicture は グラフィッククラスの多態性を利用してグラフィックの種類を知らずにグラフィッククラスに処理を依頼することもありますし、LoadFromFile の場合はファイルの拡張子から適切なグラフィッククラスを生成してから処理を依頼します。ファイルの拡張子とグラフィッククラスとの対応を登録する方法は後述します。

デフォルトでは LoadFromFile/SaveToFile はファイルストリームを作成して LoadFromStream/SaveToStream を呼び出すようになっていますので SaceToFile/LoadFromFileを実装する必要は通常ありません。LoadFromStreamメソッドはグラフィックデータをロードしたら Changed メソッドと呼び出し、グラフィッククラスの OnChange イベントを起こすのが適切でしょう。

LoadFromFile/SaveToFile の実装を LoadFromStream/SaveToStream とは別にすることがあります。例えば TMetafile の場合 SaveToFile はファイル名の拡張子によってセーブするメタファイルの種類が変わります。

TEllipse の LoadFromStream/SaveToStream の実装を以下に示します。

procedure TEllipse.LoadFromStream(Stream: TStream);
begin
  Stream.ReadBuffer(FWidth, SizeOf(Integer));
  Stream.ReadBuffer(FHeight, SizeOf(Integer));
  Stream.ReadBuffer(FColor, SizeOf(TColor));
  Changed(Self);
end;

procedure TEllipse.SaveToStream(Stream: TStream);
begin
  Stream.WriteBuffer(FWidth, SizeOf(Integer));
  Stream.WriteBuffer(FHeight, SizeOf(Integer));
  Stream.WriteBuffer(FColor, SizeOf(TColor));
end;

実装を見れば一目瞭然ですが、ファイル(ストリームデータ)形式に従ってストリームと入出力を行っているだけです。

2.10.8 フォームファイルとの入出力

グラフィッククラスには設計時にグラフィックデータをファイルから読み込むことが出来ます。例えば、スピードボタンをフォームに貼り付け、オブジェクトインスペクタで Glyph プロパティ をダブルクリックすると、グラフィック(TBitmap)をファイルから読むためのダイアログが表示されます。そして読み込んだグラフィックはフォームとともにプロジェクトのフォームファイルに保存することが出来、プロジェクトをいったん閉じて再び開いた時はフォームファイルにセーブされたグラフィックが自動的に読み込まれます。また、実行時にはフォームファイルの内容はリソースとして実行ファイルにバインドされるため、実行時にもグラフィックが自動的に読み込まれ表示されます。つまり設計時に読み込んだグラフィックは実行時にも自動的に使われるわけです。

procedure DefineProperties(Filer: TFiler);

メソッドはこのグラフィックデータをフォームファイルにセーブしたりフォームファイルからロードしたりするための偽プロパティ 'Data' を定義します。通常このメソッドを override する必要はありません。デフォルトではフォームファイルとの入出力は

procedure ReadData(Stream: TStream);
procedure WriteData(Stream: TStream);

メソッドで行います。デフォルトで ReadData/WriteData メソッドは LoadFromStream/WriteFromStream メソッドを使うのでそれで良ければ ReadData/WriteData を Override する必要はありません。ReadData を override した場合は、ReadData が Changed メソッドを呼び出し、OnChange エベントを発生させなくてはなりません。

2.10.9 Equalsメソッドと Emptyプロパティ

function Equals(Graphic: TGraphic): Boolean;
function GetEmpty: Boolean;

この2個のメソッドはフォームファイルとの入出力に利用される補助メソッドです。

GetEmpty メソッドは Empty プロパティ の実装でもありますが、グラフィッククラスのインスタンス内にグラフィックが有るか無いかを判定します。無い場合はグラフィックはフォームファイルにセーブされません。

TEllipse の GetEmpty の実装を以下に示します。

function TEllipse.GetEmpty: Boolean;
begin Result := False; end;

TEllipse は決して空にはならないので、常に False を返します。

Equals メソッドは2つの グラフィッククラスのインスタンス内のグラフィックを比較し、同じグラフィックが格納されているかを判定します。このメソッドは継承フォームをフォームファイルにセーブする際、親フォームと継承フォームで同じグラフィックを重複してセーブしてしまうことを防ぐのに用いられます。

Equals メソッドはデフォルトではまずクラス名が一致するかを検査し、クラス名が一致していた場合は両方のグラフィックを SaveToStream メソッドを使ってメモリストリームに書き出し比較します。もしもっと効率の良い比較法があれば override しても構いません。VCL では TBitmap, TMetafile, TIcon のいずれも Equals メソッドを override していません。

2.10.10 グラフィックのコピー

TGraphic は TPersistent から Assign メソッドを継承しています。グラフィッククラスは必ず Assign メソッドを override して少なくとも同じクラス間でのコピーの方法を定義しなければなりません。この定義をしておかないと、グラフィッククラスの使い勝手が悪くなるばかりか、イメージコントロールにグラフィッククラスのインスタンスをセットすることができなくなってしまうのです。overrideは必須です。以下に TEllipse の Assign メソッドの実装を示します。

procedure TEllipse.Assign(Source: TPersistent);
var
  Clip: TClipboard;
  AData: THandle;
begin
  if Source is TEllipse then begin
    FWidth := (Source as TEllipse).Width;
    FHeight := (Source as TEllipse).Height;
    FColor := (Source as TEllipse).Color;
    Changed(Self);
  end
  // 代入元がクリップボード
  else if Source is TClipBoard then begin
    Clip := Source as TClipBoard;
    Clip.Open;
    // アイコンファイルイメージを引き取る
    try
      // クリップボードから ClipboardFormat 型のデータを取得
      AData := Clip.GetAsHandle(EllipseClipboardFormatID);

      // ここで、データが取得できたかのチェックはしない。
      // ADataのチェックは LoadFromClipboardFormat が行う。

      // データを押し込む
      LoadFromClipboardFormat(EllipseClipboardFormatID, AData, 0);
    finally
      Clip.Close;
    end;
  end
  else if Source = Nil then begin
    Width := 0;
    Height := 0;
  end
  else
    inherited Assign(Source);
end;

実装上注意すべき点は2点有ります。まず Source の型が Assign メソッドで処理できる型ではなかった場合、TPersistent の Assign メソッドを呼び出してなんとかしてもらうようにすることです。TPersistent の Assign は Source の AssignTo メソッドを呼び出し、それでも駄目なら例外をあげます。代入先で Changed メソッドを呼び出すことを忘れないでください。

2点目は、Nil の代入のサポートです。これはサポートしなくても支障はありませんが、多くのグラフィッククラスでは、データを破棄するなどなんらかのリアクションを取ることが多いので、実装しておいたほうが親切でしょう。

グラフィッククラスがクリップボードからのデータの読み込みをサポートする場合は、必ず、Assign メソッドに Source が TClipboard だった場合の処理を記述してください。そうすると

グラフィッククラスのインスタンスへの参照.Assign(Clipboard);
(例: Bitmap.Assign(Clipboard); // クリップボードからビットマップを取り込む

という具合にかけるようになります。

処理内容は決まりきっていて、LoadFromClipboardFormat メソッドを使ってクリップボード上のデータのハンドル(多くの場合メモリハンドルですが、ビットマップや Windows Metafile などでは専用のハンドル)を受け取りグラフィッククラスに押し込むだけです。ちなみに EllipseClipboardFormatID は TEllipse が扱う楕円データのクリップボード識別子です。これをどのように取得するかは後述します。

2.10.11 LoadFromClipboardFormat、 SaveToClipboardFormat メソッド

procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE);
procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; var APalette: HPALETTE);

この2つのメソッドは グラフィッククラスのインスタンスと Clipboard 変数との間でクリップボードデータを入出力する時に呼び出されるメソッドです。これらのメソッドはDraw メソッドと同様、直接使うことはほとんど有りません。

Clipboard.Assign(グラフィッククラスのインスタンス);

というふうに Assign メソッドで代入が行われる時や、TPicture 型のインスタンスと Clipboard 変数との間で

Clipboard.Assign(TPicture のインスタンス);
TPicture のインスタンス.Assign(Clipboard);

というふうに代入が行われる時、グラフィッククラスの LoadFromClipboardFormat と SaveToClipBoardFormat が Clipborad の Assign や AssignTo メソッドを介して呼び出されます。

グラフィッククラスのインスタンス.Assign(Clipboard); 

とすれば特定のデータ形式のクリップボードデータを取り込むことができます。例えば TBitmap の場合、クリップボード上に CF_BITMAP 形式のデータがあればそれを選択して受け取れます。

LoadFromClipboardFormat メソッドはパラメータ AData, APalette クリップボードデータをで受け取りますが、この内容を壊さずにクリップボードデータからグラフィックを新たに作成してグラフィッククラスのインスタンス内に取り込まなければなりません。グラフィックデータの取り込みに成功したなら Changed メソッドの呼び出しが必要です。AFormat と AData のチェックをお忘れなく。

逆に SaveToClipboardFormat メソッドはグラフィックデータから、クリップボード形式のデータを作成し、AData, APalette にセットしなければなりません。

グラフィッククラスがクリップボードをサポートしていない場合は、 LoadFromClipboardFormat と SaveToClipboardFormat メソッドで例外をあげるようにします。

以下に TEllipse の LoadFromClipboardFormat と SaveToClipboardFormat の実装を示します。

var EllipseClipboardFormatID: Cardinal;


procedure TEllipse.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
                                           APalette: HPALETTE);
var p: ^TEllipseClipboardData;
begin
  if AFormat <> EllipseClipboardFormatID then
    raise EInvalidGraphic.Create('TEllipse.LoadFromClipboardFormat');

  if AData = 0 then
    raise EInvalidGraphic.Create('TEllipse.LoadFromClipboardFormat');

  p := GlobalLock(AData);

  FWidth  := p^.Width;
  FHeight := p^.Height;
  FColor  := p^.Color;

  GlobalUnlock(AData);

  Changed(Self);
end;

procedure TEllipse.SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
                                var APalette: HPALETTE);
var h: Thandle;
    p: ^TEllipseClipboardData;
begin
  h := GlobalAlloc(GHND, SizeOf(TEllipseClipboardData));
  p := GlobalLock(h);
  p^.Width := FWidth; p^.Height := FHeight; p^.Color := FColor;
  GlobalUnlock(h);
  AFormat := EllipseClipboardFormatID;
  AData := h;
  APalette := 0;
end;

EllipseClipboardFormatID は TEllipse のクリップボードデータの識別子です。どのようにして取得するかは後述します。行っていることはソースを読めば一目瞭然とは思いますが、LoadFromClipboardFormat でクリップボード識別子をチェックしているのは、実装の誤りで間違ったデータが来た時のデバッグコーディングです。また、TEllipse はパレットをサポートしていないので SaveToClipboardFormat では APalette に0を渡しています。

2.10.12 初期化

グラフィッククラスを実装する上で初期化(ユニットの Initialization 部)は非常に重要です。説明の前に TEllipse の実装を以下に示します。

Initialization
  // 拡張子 elp のファイルと TEllipse を対応させる。
  TPicture.RegisterFileFormat('elp', 'Ellipse', TEllipse);
  // Clipborad Format 'CF_ELLIPSE' を TEllipse に対応させる。
  EllipseClipboardFormatID :=
    Windows.RegisterClipboardFormat(PChar('CF_ELLIPSE'));
  TPicture.RegisterClipBoardFormat(EllipseClipboardFormatID, TEllipse);

1行目では TEllipse のグラフィックデータが入ったファイルの拡張子を登録しています。TPicture が LoadFromFile メソッドでグラフィックファイルを読む時、この登録されたデータを使って、ファイルの拡張子から TPicture の Graphic プロパティ に適切なグラフィッククラスのインスタンスを作成し、そのグラフィッククラスの LoadFromFile メソッドでグラフィックファイルを読み込みます。この登録データは実行時だけでなく、設計時に画像データを読み込む時にも使われます。例えば、イメージコントロールに設計時にグラフィックファイルを読み込む時、TEllipse がインストール済みであれば、コンポーネントエディタの画面は以下のようになります。

Figure 2.10-4

図2.10-4 イメージコントロールの画像の設定ダイアログ

2行目はクリップボード形式を登録し、その識別子を取得しています。

3行目はクリップボード形式の識別子とグラフィッククラスの対応を登録しています。Clipboard 変数や TPicture はこの登録データを使って、クリップボードデータを入出力します。

TEllipse は コンポーネントでは有りませんが、上記の初期化は設計時にも必要です。なぜなら、設計時のグラフィックファイルの読み込みでファイルの拡張子の情報が必要だからです。従って、 TEllipse を実装したユニット Ellipse は 適当な設計時パッケージにリンクすると便利です。そうすると設計時に TEllipse 型の プロパティ や イメージコントロールにTEllipse のグラフィックファイル(*.elp)からグラフィックを読み込むことが可能になります。

2.10.13 終了処理

TPicture に UnRegisterGraphicClass というメソッドがあります。これは TPicture.RegisterFileFormat と TPicture.RegisterClipboardFormat で登録された、グラフィッククラスのファイルの拡張子とクリップボードフォーマット識別しを削除するためのメソッドです。

このメソッドが必要な理由はDelphi 3 以降で使われているパッケージのためです。TEllipse のようなユーザ定義のカスタムグラフィッククラスを登録する場合、RegisterFileFormat/RegisterClipboardFormat で登録を行う必要があるわけですが、カスタムグラフィッククラスは Graphics ユニットとは別のパッケージにリンクされます。しかし、RegisterFileFormat/RegisterClipboardFormat は カスタムグラフィッククラスの クラス参照を登録するので、カスタムグラフィックスを含むパッケージが Graphic ユニットを含むパッケージより先にメモリからアンロードされると Graphic ユニットの中に不正なクラス参照が残ることになります。したがって、RegisterFileFormat/RegisterClipboardFormat でクラスの登録を行った場合は、必ず UnRegisterGrahicClass で登録されたクラスを削除しなければなりません。TEllipse の場合は以下の様に finalization を付け加える必要があります。

finalization
  TPicture.UnRegisterGraphicClass(TEllipse);

end.

2.10.14 OnProgress Event

グラフィッククラスが時間のかかる処理を行うときはこのイベントを起こすことで処理の進行状況をグラフィッククラスの利用者に通知することが出来ます。OnProgress イベントは VCL の中では TImage が使用しています。TImage の中に格納されたグラフィッククラスのインスタンスが OnProgress イベントを起こすと TImage の OnProgress イベントが起こります。 OnProgress イベントは

TProgressEvent = procedure (Sender: TObject; 
                            Stage: TProgressStage; 
                            PercentDone: Byte; 
                            RedrawNow: Boolean; 
                            const R: TRect; 
                            const Msg: string) of object;

という形式です。OnProgress イベントは処理の進行状況にしたがって何回かに分けて起こります。まず Stage = psStating のイベントが起こり、Statge = psRunning のイベントが続きます。最後に Stage = psEnding のイベントが起こります。

PercentDone は作業の進行状況を表わし、単位は % です。Stage = psStarting では 0% Stage = psEnding では 100 % になると思います(たぶん)。

RedrawNow はイベント発生時に再描画が可能になっていることを示します。R は再描画が必要な領域を表わします。

Msg は進行状況や処理の内容を表わす文字列です。

グラフィッククラスが時間のかかる処理を行うときに OnProgress イベントを起こすには TGraphic の Progress メソッドを呼び出します。

TGraphic の progress メソッドは 以下の様に定義されています。

procedure Progress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;

これを呼ぶと OnProgress イベントが起こります。見て判る通りパラメータは OnProgress イベントそのものです。これがそのまま OnProgress イベントに渡ります。

2.10.15 TEllipse の全ソースコード

最後に TEllipse の全ソースを掲載します

unit Ellipse;

interface
uses Windows, Classes, Graphics;

type
  TEllipse = class(TGraphic)
  private
    FWidth, FHeight: Integer;
    FColor: TColor;
    procedure SetColor(Value: TColor);
  protected
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
    function GetEmpty: Boolean; override;
    function GetHeight: Integer; override;
    function GetWidth: Integer; override;
    function GetTransparent: Boolean; override;
    procedure SetHeight(Value: Integer); override;
    procedure SetWidth(Value: Integer); override;
  public
    constructor Create; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
                                      APalette: HPALETTE); override;
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
                                    var APalette: HPALETTE); override;
    procedure Assign(Source: TPersistent); override;

    property Color: TColor read FColor write SetColor;
  end;

  TEllipseClipboarddata = record
    Width, Height: Integer;
    Color: TColor;
  end;

implementation

uses Clipbrd;

var
  EllipseClipboardFormatID: Cardinal;

constructor  TEllipse.Create;
begin
  inherited Create;
  FWidth := 10; FHeight := 10; FColor := clBlack;
end;

procedure TEllipse.Draw(ACanvas: TCanvas; const Rect: TRect);
var SavedPenColor: TColor;
    SavedBrushStyle: TBrushStyle;
begin
  SavedPenColor := ACanvas.Pen.Color;
  SavedBrushStyle := ACanvas.Brush.Style;
  ACanvas.Pen.Color := FColor;
  ACanvas.Brush.Style := bsClear;
  ACanvas.Ellipse(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
  ACanvas.Pen.Color := SavedPenColor;
  ACanvas.Brush.Style := SavedBrushStyle;
end;

function TEllipse.GetEmpty: Boolean;
begin Result := False; end;

function TEllipse.GetHeight: Integer;
begin Result := FHeight; end;

function TEllipse.GetWidth: Integer;
begin Result := FWidth; end;


function TEllipse.GetTransparent: Boolean;
begin Result := True; end;


procedure TEllipse.SetHeight(Value: Integer);
begin FHeight := Value; Changed(Self); end;

procedure TEllipse.SetWidth(Value: Integer);
begin FWidth := Value; Changed(Self); end;

procedure TEllipse.SetColor(Value: TColor);
begin
  FColor := Value;
  Changed(Self);
end;

procedure TEllipse.LoadFromStream(Stream: TStream);
begin
  Stream.ReadBuffer(FWidth, SizeOf(Integer));
  Stream.ReadBuffer(FHeight, SizeOf(Integer));
  Stream.ReadBuffer(FColor, SizeOf(TColor));
  Changed(Self);
end;

procedure TEllipse.SaveToStream(Stream: TStream);
begin
  Stream.WriteBuffer(FWidth, SizeOf(Integer));
  Stream.WriteBuffer(FHeight, SizeOf(Integer));
  Stream.WriteBuffer(FColor, SizeOf(TColor));
end;

procedure TEllipse.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
                                           APalette: HPALETTE);
var p: ^TEllipseClipboardData;
begin
  if AFormat <> EllipseClipboardFormatID then
    raise EInvalidGraphic.Create('TEllipse.LoadFromClipboardFormat');

  if AData = 0 then
    raise EInvalidGraphic.Create('TEllipse.LoadFromClipboardFormat');

  p := GlobalLock(AData);

  FWidth  := p^.Width;
  FHeight := p^.Height;
  FColor  := p^.Color;

  GlobalUnlock(AData);

  Changed(Self);
end;

procedure TEllipse.SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
                                var APalette: HPALETTE);
var h: Thandle;
    p: ^TEllipseClipboardData;
begin
  h := GlobalAlloc(GHND, SizeOf(TEllipseClipboardData));
  p := GlobalLock(h);
  p^.Width := FWidth; p^.Height := FHeight; p^.Color := FColor;
  GlobalUnlock(h);
  AFormat := EllipseClipboardFormatID;
  AData := h;
  APalette := 0;
end;

procedure TEllipse.Assign(Source: TPersistent);
var
  Clip: TClipboard;
  AData: THandle;
begin
  if Source is TEllipse then begin
    FWidth := (Source as TEllipse).Width;
    FHeight := (Source as TEllipse).Height;
    FColor := (Source as TEllipse).Color;
    Changed(Self);
  end
  // 代入元がクリップボード
  else if Source is TClipBoard then begin
    Clip := Source as TClipBoard;
    Clip.Open;
    // アイコンファイルイメージを引き取る
    try
      // クリップボードから ClipboardFormat 型のデータを取得
      AData := Clip.GetAsHandle(EllipseClipboardFormatID);

      // ここで、データが取得できたかのチェックはしない。
      // ADataのチェックは LoadFromClipboardFormat が行う。

      // データを押し込む
      LoadFromClipboardFormat(EllipseClipboardFormatID, AData, 0);
    finally
      Clip.Close;
    end;
  end
  else if Source = Nil then begin
    Width := 0;
    Height := 0;
  end
  else
    inherited Assign(Source);
end;


Initialization
  // 拡張子 elp のファイルと TEllipse を対応させる。
  TPicture.RegisterFileFormat('elp', 'Ellipse', TEllipse);
  // Clipborad Format CF_ELLIPSE を TEllipse に対応させる。
  EllipseClipboardFormatID :=
    Windows.RegisterClipboardFormat(PChar('CF_ELLIPSE'));
  TPicture.RegisterClipBoardFormat(EllipseClipboardFormatID, TEllipse);

finalization
  TPicture.UnRegisterGraphicClass(TEllipse);

end.

このユニットをコンポーネントとしてインストールしアプリケーションのユニットの uses 句に Ellipse を加えれば、TEllipse は新しいグラフィッククラスとして動作します。

2.10.16 まとめ

TGraphic はグラフィッククラスのベースクラスで、VCL でグラフィックデータを扱うためのグラフィッククラスを定義するための雛形です。これに従ってグラフィッククラスを作成することにより、グラフィッククラスを Canvas に描画したり、コンポーネントのプロパティにしたり、イメージコントロールで表示したりすることが出来ます。
グラフィッククラスを作成するには少なくとも TGraphic から継承する抽象メソッド10個を実装しなければなりません。また TPersistent から継承する Assign メソッドをoverride しなければなりません。
多くの abstract ではないメソッドは、ストリームとの入出力メソッド LoadFromStream/SaveToStream を実装すれば、自動的に実装されるように TGraphic にデフォルトの処理があらかじめ組み込まれています。このため。あまり凝った実装をしない限り、グラフィッククラスの実装が楽になるようになっています。

これで、TGraphic の説明は終わりですが、以上の説明だけではまだ TGraphic の詳細を把握するのは難しいと思います。もしソースコードをお持ちなら、Graphics.pas の TBitmap や TMetafile の実装を参考にしてください。また、もしソースコードをお持ちでないなら、ダウンロードエリアにある TNkDIB のソースコードが参考になると思います。

戻る ホーム 上へ 進む inserted by FC2 system