色変更が可能なプログレスバー

Delphi5のProgressBarコンポーネントでは，OrientaionプロパティやSmoothプロパティが 用意されている． これらのプロパティはIE4.0以降でプログレスバーに追加されたPBS_VERTICALスタイル およびPBS_SMOOTHスタイルに対応するものである．

さらに，IE4.0以降ではバーの色および背景色を設定するための メッセージであるPBM_SETBARCOLORおよびPBM_SETBKCOLORも追加されている． しかしながら，これらのメッセージに対応するプロパティはない． 今回は色変更のためのプロパティを実装したコンポーネントを作ってみた．

バーの色を変更するにはプログレスバーにPBM_SETBARCOLORメッセージを送り，LPARAMに 変更したい色を指定する．

FBarColor := clRed;
SendMessage( Handle, PBM_SETBARCOLOR, 0, LPARAM( FBarColor ) );

という感じである． PBM_SETBARCOLORはcommctrl.pasで宣言されているので，これをuses節に追加する． このユニットはWin32コモンコントロールで使われる構造体，メッセージおよび マクロ（Delphiではマクロの概念はないので，マクロは全て関数に置き換えられている）が定義されている． commctrl.pasはフォームにProgressBarをドロップしただけでは追加されない．

よく似たユニットにcomctrls.pasがあるが， こちらはTListViewやTRichEditなどのWin32コモンコントロールのラッパーコンポーネントが定義されており， それらのコンポーネントをフォームにドロップすれば自動的にuses節に追加される．

なお，メッセージを送る場合は必ずSendMessageを使わなければならない． Performメソッドを使って

Perform( PBM_SETBARCOLOR, 0, LPARAM( FBarColor ) );

などとしてもバーの色は変化しない． ProgressBarに限らずすべてのラッパーコンポーネントでは， ウィンドウに送るメッセージはそのウィンドウのウィンドウプロシージャを通過させなければならないからである．

背景色を変更する場合も，

FBackColor := clBlue;
SendMessage( Handle, PBM_SETBKCOLOR, 0, LPARAM( FBackColor ) );

などとすれば良さそうだが，こちらはうまくいかない． 背景色は何ら変化しない． SDKのドキュメントを読む限りは，上のように単純にPBM_SETBKCOLORメッセージを送るだけで いいようなので，VCLの構造に起因するものだろう．

ではどうすれば背景色を変えられるかというと，実は，Colorプロパティに 変更したい色を設定してやるだけでよい． ただし，ProgressBarのColorプロパティはprotectedなので，継承コンポーネントでpublishedに再定義する．

以上でバーの色と背景色を変更することは可能になった． が，あともう一つ問題が残っている． 設計時にOrientaionプロパティやSmoothプロパティの値を変更すると，バーの色がデフォルトに 戻ってしまうのである．

これは，OrientaionプロパティやSmoothプロパティの値が変更されるとRecreateWndメソッドが呼ばれ プログレスバーが再生成されてしまうためである． RecreateWndメソッドはTWinControlで定義されているが， virtualでもdynamicでもないので，継承コンポーネントでオーバーライドすることはできない．

ところが，TWinControlのRecreateWndメソッドのソースを見ると，単にCM_RECREATEWNDメッセージを 自分自身に送っているだけである． したがって，このメッセージのハンドラを継承コンポーネントでオーバーライドすればよいのである． 具体的には，まず継承元のハンドラを呼び出した後，再びPBM_SETBARCOLORメッセージを送ればよい．

以下にソースコード全体を示す．

unit ColorPrgbar;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Commctrl;

type
  TColorProgressBar = class(TProgressBar)
  private
    FBarColor: TColor;
    procedure SetBarColor( AColor: TColor );
  protected
    procedure CMRecreateWnd( var Message: TMessage ); message CM_RECREATEWND;
  public
    constructor Create( AOwner: TComponent ); override;
  published
    property BarColor: TColor read FBarColor write SetBarColor;
    property Color;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyVCL', [TColorProgressBar]);
end;

constructor TColorProgressBar.Create( AOwner: TComponent );
begin
   inherited Create( AOwner );
   FBarColor := clNavy;
end;

procedure TColorProgressBar.SetBarColor( AColor: TColor );
begin
   if AColor <> FBarColor then
   begin
      FBarColor := AColor;
      SendMessage( Handle, PBM_SETBARCOLOR, 0, LPARAM( FBarColor ) );
   end;
end;

procedure TColorProgressBar.CMRecreateWnd( var Message: TMessage );
begin
   inherited;
   SendMessage( Handle, PBM_SETBARCOLOR, 0, LPARAM( FBarColor ) );
end;


end.

戻る

SEO		[PR] 爆速!無料ブログ 無料ホームページ開設 無料ライブ放送