- お知らせ -
  • 当wikiのプログラムコードの表示を直してみました(ついでに長い行があると全体が下にぶっ飛ぶのも修正)。不具合があればBBSまでご連絡下さい。

ここのソースは致命的なバグを含みます。そのまま使ってはいけません。

修正したものがありますので、そちらを参照してください

使い方の例 Edit

自分の場合は、Canvasの生成コストを考え、使うときだけ生成するのではなく、
Surface生成時に生成しています。

DirectDraw管理クラス内で、

TDirectDrawEngine = class
private
  :
 FBackBufferCanvas: TDirectDrawCanvas;
property
 property BackBufferCanvas: TDirectDrawCanvas read FBackBufferCanvas;
end.

Surface生成ルーチンの後あたりで、

FBackBufferCanvas := TDirectDrawCanvas.Create(FBackBuffer);

Surface開放時に一緒に開放するのも忘れずに。

実際に使うとき

with DirectDrawEngine.BackBufferCanvas do
  if Enabled then try
    Brush.Style := bsSolid;
    Brush.Color := clBlue
    FillRect(MogeMogeRect);
  finally
    Release;
  end;

ソース Edit

interface
uses
  Windows, Graphics, DirectX;
type
  TDirectDrawCanvas = class(TCanvas)
  private
    FSurface: IDirectDrawSurface;
    FDeviceContext: HDC;
    FEnabled: Boolean;

    procedure CreateHandle; override;
  public
    constructor Create(ASurface: IDirectDrawSurface);
    destructor Destroy; override;
    procedure Release;
    property Enabled: Boolean read FEnabled;
  end;

implementation

{ TDirectDrawCanvas }

constructor TDirectDrawCanvas.Create(ASurface: IDirectDrawSurface);
begin
  inherited Create;
  FSurface := ASurface;
  FDeviceContext := 0;
  FEnabled := ASurface.IsLost = DD_OK;
end;

destructor TDirectDrawCanvas.Destroy;
begin
  Release;
  inherited;
end;

procedure TDirectDrawCanvas.CreateHandle;
begin
  if FDeviceContext = 0 then begin
    FEnabled := FSurface.GetDC(FDeviceContext) = DD_OK;
    if FEnabled then
      Handle := FDeviceContext
    else begin
      Handle := 0;
      FDeviceContext := 0;
    end;
  end;
end;

procedure TDirectDrawCanvas.Release;
begin
  if FDeviceContext <> 0 then begin
    Handle := 0;
    FSurface.ReleaseDC(FDeviceContext);
    FDeviceContext := 0;
  end;
end;

「Canvasに対する描画ができません」の問題 Edit

問題点 Edit

上のソースを使っていると、「Canvasに対する描画ができません」という例外のメッセージが出ることがあります。

原因 Edit

実は、この問題の原因は、Graphics.TCanvas のソース見るとすぐに気づきます。(すみません。今までそこそこ動いていたので、まともに見てませんでした。何でもそうですが、挙動を理解せず使うと必ず失敗します(´д⊂))

まず、TCanvas.CreateHandleは、TCanvas.CopyRect や TCanvas.Draw の内などで、WindowsAPIにHandleを渡す直前によばれます。
そして、CreateHandle後、Handleが0だと「Canvasに対する描画ができません」の例外が発生します。
つまり、今回のソースではCreateHandleで、GetDCが失敗した時にHandle = 0にしているのが問題なのです。また、GetDCの失敗成功を表わす Enabled もほとんど意味をなしていないことになります。

GetDCが失敗しても、とりあえずは無視してでも動いてもらわなくてはなりません。
(失敗の要因であろう、surfaceのロストからの復帰は別のタイミングでやるので)

問題の再現 Edit

GetDCが失敗する状態をシミュレートするようにします

procedure TDirectDrawCanvas.CreateHandle;
begin
  if FDeviceContext = 0 then begin
    // 必ず失敗 :p
    FEnabled := False; // FSurface.GetDC(FDeviceContext) = DD_OK;
    if FEnabled then
      Handle := FDeviceContext
    else begin
      Handle := 0;
      FDeviceContext := 0;
    end;
  end;
end;

改善案 Edit

  • 例外を許容し、try 〜 except で捕らえる
  • CreateHandle で GetDCしない(Handle = 0となる状況を作らない)

1番目の例外の許容ですが、はっきり言って面倒です。

with DirectDraw.BackBufferCanvas do
  if Enabled then try
    :
  finally
    Release;
  end;

↑これが、↓こうなります、

with DirectDrawEngine.BackBufferCanvas do
  if Enabled then try try
    :
  except end;
  finally
    Release;
  end;

なにかアホっぽいですね。それに単調です。(C#のようにまとめられればいいのに)

そこで、2番目の方法です。
まず、CreateHandle から GetDCをはずします。
そして、Enabled で GetDC して、成功したらHandle を設定しておき、失敗したら False を返すようにます。CreateHandleでは何もしません。
こうすれば、GetDCに失敗してもそのまま通り過ぎるだけで何もおきません。
しかも、今までの使い方そのままで利用できます。

以下は、その実装例です。

type
  TDirectDrawCanvas = class(TCanvas)
  private
     :  // FEnabled, CrateHandle はなくします
    function GetEnabled: Boolean;
  public
     :
    procedure Release;
    property Enabled: Boolean read GetEnabled;
  end;

 :

function TDirectDrawCanvas.GetEnabled;
begin
  if FDeviceContext = 0 then begin
    Result := FSurface.GetDC(FDeviceContext) = DD_OK;
    if Result then
      Handle := FDeviceContext
    else begin
      Handle := 0;
      FDeviceContext := 0;
    end;
  end
  else
    Result := False;
end;

使用法は一緒です。で、テスト法ですが、

Result := FSurface.GetDC(FDeviceContext) = DD_OK;
 ↓
Result := False;

としてみて、例外がおきなければOKです。

また、もし Enabled を使用し忘れていた場合は、Handle = 0 のままなので例外がおき、すぐわかります。実行しないと検知できないのは問題ではありますが。


Releaseし忘れると、長い間 SurfaceをLockしてしまう(GetDC = SurfaceのLock)問題 Edit

問題点 Edit

Releaseをし忘れると、GetDCしたSurfaceをReleaseDCしないので、Lockしっぱなしになります。大抵は、その後に呼び出した Blt や BltFast などでエラーを(返却値 = DDERR_SURFACEBUSY)を引き起こします。

原因 Edit

GetDCしたのに、ReleaseDCしていない。

問題の再現 Edit

Release をはずす。

改善案 Edit

エラーが出るからわかるじゃん。別にいいや(ぉぃ)

使うときだけCanvasを生成し、try .. finally .. end; でくくって必ずFreeするようにして、Destroy内でReleaseさせる方法がありますが、
結局、finally で Free し忘れるという問題がありますので、根本的に解決になりません。
(どうしてもやりたいなら、Interface化して勝手に開放されるようにするとか……それでも、自動で解放される前に、BltやBltFast使うと同じだしなあ)


入れ子にした場合のことを考えていない問題 Edit

問題点 Edit

Enabled と Releaseの組の間で、またEnabled, Releaseが出た場合が問題です。
実際には、外のReleaseで、「Canvasに対する…」のエラーが出ます。
「問題の再現」の例を見たほうが理解が早いです。

原因 Edit

最初のRelease で Handle が0になっている。

問題の再現 Edit

with DirectDrawEngine.BackBufferCanvas do
  if Enabled then try
    if Enabled then try
       Brush.Style := bsSolid;
    finally
      Release;              // ←Handle = 0になる
    end;
    FillRect(DrawingRect);  // ←ここで例外発生
  finally
    Release;
  end; 

改善案 Edit

参照カウンタを使います。Enabled = True(GetDC成功)でカウンタを増加、Releaseでカウンタを減少させます。また、Canvasの開放時にカウンタが0であるかどうか確認することで、Enabled と Release の対応が正しくとれているかチェックできます(ということは、1つ上の問題も解決か?)

TDirectDrawCanvas = class(TCanvas)
private
  FCountForEnabled: Integer;   // ←追加
 :
end; 

procedure TDirectDrawCanvas.Release;
begin
  Dec(FCountForEnabled);                // ←追加
  if FCountForEnabled = 0 then begin    // ←変更
    Handle := 0;
    FSurface.ReleaseDC(FDeviceContext);
    FDeviceContext := 0;
  end;
end;

function TDirectDrawCanvas.GetEnabled: Boolean;
begin
  if FCountForEnabled = 0 then begin    // ←変更
    Result := FSurface.GetDC(FDeviceContext) = DD_OK;
    if Result then
      Handle := FDeviceContext
    else begin
      Handle := 0;
      FDeviceContext := 0;
    end;
  end
  else
    Result := True;
  Inc(FCountForEnabled);                // ←追加
end;

destructor TDirectDrawCanvas.Destroy;
begin
  // ↓追加
  Assert(FCountForEnabled = 0, 
    'TDirectDrawCanvas で Enabled と Release との対応が取れていません');
  inherited;
end;

参考 Edit

  • インプレス『Delphi2.0J 32bitパワープログラミング』(Charles Calvert著)

Front page   Edit Freeze Diff Backup Upload Copy Rename Reload   New Pages Search Recent changes   Help   RSS of recent changes
Last-modified: 2007-05-12 Sat 13:30:07 JST (4595d)