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につけて、すぐにおんぷ村の裏にアップしますので、よければ使ってください。
たったこれだけにこんなことになるとは。まあ、成果物もできたし、まあいいか(^^ゞ