高見知英のかいはつにっし(β)

高見知英のアプリケーション開発日誌 のほか、地域活動などの活動報告ブログ。

TPanelの中にTPaintBox

 TPanelの上にTShapeなど、描画系のコンポーネントを置き、頻繁に再描画させると、当然ながらちらつきます。背景描画が先に来るためです(特に、ビジュアルスタイルを有効にしたときは、ちらつきがひどくなるようです)。
そして、やっかいなことに、パネルのDoubleBufferedをTrueにしても、ちらつきは収まらないです。TPanelはDoubleBufferedに対応してないということでしょうか?
 …と言うことで、サブクラス化するしか方法がなさそうです。おんぷ村の裏にある"MiniClasses"より、"TSubClass"を使用します。いちいちクラスとして作ると面倒ですし、再描画を押さえたい部分の位置を取得する処理が面倒になるので、イベントとして処理できるように、継承してクラスを作ります。

  TExWndMethod   = procedure(var Inherit: Boolean; var Message: TMessage) of object;
  TEventSubClass = class(TSubClass)
  private
    { Private 宣言 }
    FWndMethod            : TExWndMethod;
  protected
    { Protected 宣言 }
    procedure   WndProc   (var Message: TMessage); override;
  public
    { Public 宣言 }
    constructor Create    (AOwner: TWinControl; WndMethod: TExWndMethod = nil); reintroduce;
    property    WndMethod : TExWndMethod read FWndMethod;
  end;

 TWndMethodでなく、わざわざTExWndMethodを作った理由は後述、実現部は…まあ、すぐあちらに公開するので、そちらを参照 ということで(^_^;)

で、これをMainPanelSubClass := TEventSubClass.Create(MainPanel, MainPanelWndMethod);などとして生成し、MainPanelをサブクラス化。MainPanelWndMethodで

var rc: TRect;
begin // メインパネルのColorViewの部分だけを、描画しないようにする
  if Message.Msg = WM_ERASEBKGND then begin
    rc              := MainPanel.BoundsRect;
    rc.Left         := ComplementColor.BoundsRect.Right;
    FillRect(TWMEraseBkGnd(Message).DC, rc, Canvas.Brush.Handle);
    inherit         := False;
  end;
end;

とやれば、完成です。WM_ERASEBKGNDでは、ちらつかせたくない部分(ここではComplementColorの右端より左)を描画せず、ちらつきは収まるというわけです。


 最後に、引数inheritがなぜあるかということ。最初はMessage.Result := 1; と入れてみたんですが、どうしてもそれではデフォルトの処理(全体の背景塗りつぶし)が呼び出されてしまいます。なぜかは知りませんが。TPanelが独自に何かやってるのかな。
ということで、inherited――つまりは、PrevWndProc自体を呼び出さないようにする仕組みが必要。それで、inheritがFalseの時はInheritedを呼び出さない というようにしたのです。
まあ、このクラスはMiniClasses.pasにつけて、すぐにおんぷ村の裏にアップしますので、よければ使ってください。


たったこれだけにこんなことになるとは。まあ、成果物もできたし、まあいいか(^^ゞ