第２６章 トラックバーとプログレスバー

前章に続いて比較的小さなコモンコントロールとして、本章ではトラックバーコントロールとプログレスバーコントロールについて調べることにする。また、バディーウィンドウとして設置できるラベルウィンドウに関連して、テキストを表示するスタティックコントロールについても調べることにする。トラックバーは入力専用、プログレスバーは出力専用である。

２６−０ この章の内容

第２６章 トラックバーとプログレスバー
２６−１ トラックバーをコードでつくる
２６−２ TAPITrackBar クラス
２６−３ スタティックテキストをコードでつくる
２６−４ TAPIStaticText クラス
２６−５ プログレスバーをコードでつくる
２６−６ TAPIProgress クラス
２６−７ Colors2 プログラム
２６−８ まとめ


| arrw18c.gif 前の章へ | 総目次へ | 次の章へ arrw18d.gif ｜

２６−１ トラックバーをコードでつくる

コモンコントロールの２番目の例として、トラックバーを作ってみよう｡ ステータスバーが表示専用であるのに対し、トラックバーは入力専用であるといえる｡ トラックバーは、数値入力部品としてのスクロールバーコントロールの見かけを変えたものであるとみなすことができる｡ 事実、このコントロールが親ウィンドウに通知するメッセージは、第１４章 スクロールバー で調べたスクロールバーコントロールとほぼ同じである｡ トラックバーを作るには､ CreateWindowEx( ) または CreateWindow( ) にクラス名として TRACKBAR_CLASS を設定して作成する｡ 

const
  TRACKBAR_CLASS = 'msctls_trackbar32';

ウィンドウスタイルには、必須である WS_CHILD の他に WS_VISIBLE、WS_TABSTOP、WS_BORDER などの一般的なスタイルを設定できるほか、以下のようなスタイルを設定できる｡

const
  TBS_AUTOTICKS           = $0001;	//チックマーク（目盛）を自動的に表示する
  TBS_VERT                = $0002;  //垂直トラックバー
  TBS_HORZ                = $0000;	//水平トラックバー（デフォルト）
  TBS_TOP                 = $0004;	//チックマークを上側に表示
  TBS_BOTTOM              = $0000;	//チックマークを下側に表示(デフォルト）
  TBS_LEFT                = $0004;	//チックマークを左側に表示
  TBS_RIGHT               = $0000;	//チックマークを右側に表示（デフォルト）
  TBS_BOTH                = $0008;	//チックマークを両側に表示
  TBS_NOTICKS             = $0010;	//チックマークなし
  TBS_ENABLESELRANGE      = $0020;	//範囲選択を可能にする
  TBS_FIXEDLENGTH         = $0040;	//スライダーの長さを可変にできる
  TBS_NOTHUMB             = $0080;	//つまみなし

この中で特に便利なスタイルには TBS_AUTOTICKS があり、これをスタイルに含めるとつまみの可動範囲に応じて「目盛り」が自動的に表示される｡ トラックバーを作成した後は、他のコントロールと同様に、SendMessage( ) で特定のメッセージを送ることによりコードで遠隔操作する｡ トラックバーに送られるメッセージを以下に示す｡

const
  TBM_GETPOS              = WM_USER;	//スライダーの位置を取得
  TBM_GETRANGEMIN         = WM_USER+1;	//スライダーの位置の最小位置の取得
  TBM_GETRANGEMAX         = WM_USER+2;	//スライダーの位置の最大位置の取得
  TBM_GETTIC              = WM_USER+3;	//特定のチックマークの位置を取得
  TBM_SETTIC              = WM_USER+4;	//特定のチックマークの位置を設定
  TBM_SETPOS              = WM_USER+5;	//スライダーの位置を設定
  TBM_SETRANGE            = WM_USER+6;	//スライダー位置の可変範囲の設定
  TBM_SETRANGEMIN         = WM_USER+7;	//スライダー位置の可変範囲の最小値の設定
  TBM_SETRANGEMAX         = WM_USER+8;	//スライダー位置の可変範囲の最大値の設定
  TBM_CLEARTICS           = WM_USER+9;	//現在のチックマークを削除
  TBM_SETSEL              = WM_USER+10;	//チックマークの選択範囲の設定
  TBM_SETSELSTART         = WM_USER+11;	//チックマークの選択範囲の終了値の設定
  TBM_SETSELEND           = WM_USER+12;	//チックマークの選択範囲の開始値の設定
  TBM_GETPTICS            = WM_USER+14;	//チックマーク位置を示す配列を指すポインタの取得
  TBM_GETTICPOS           = WM_USER+15;	//チックマークの物理位置の取得
  TBM_GETNUMTICS          = WM_USER+16;	//チックマークの数の取得
  TBM_GETSELSTART         = WM_USER+17;	//選択範囲の開始位置の取得
  TBM_GETSELEND           = WM_USER+18;	//選択範囲の終了位置の取得
  TBM_CLEARSEL            = WM_USER+19;	//選択範囲の解除
  TBM_SETTICFREQ          = WM_USER+20;	//チックマークの間隔の設定
  TBM_SETPAGESIZE         = WM_USER+21;	//ページサイズの設定
  TBM_GETPAGESIZE         = WM_USER+22;	//ページサイズの取得
  TBM_SETLINESIZE         = WM_USER+23;	//ラインサイズの設定
  TBM_GETLINESIZE         = WM_USER+24;	//ラインサイズの取得
  TBM_GETTHUMBRECT        = WM_USER+25;	//つまみの境界矩形の取得
  TBM_GETCHANNELRECT      = WM_USER+26;	//スライダーが動くチャンネルの境界矩形の取得
  TBM_SETTHUMBLENGTH      = WM_USER+27;	//つまみの長さの設定
  TBM_GETTHUMBLENGTH      = WM_USER+28;	//つまみの長さの取得

この中でよく使われるものを、Delphi に付属する Win32.hlp で調べよう｡

TBM_SETRANGE 
  wParam = (WPARAM) (BOOL) fRedraw; 
  lParam = (LPARAM) MAKELONG(lMinimum, lMaximum);

つまみの可動範囲を設定する。wParam には、ゼロ以外を設定すると再描画する。lParam に最大値、最小値を MakeLong( ) を使って設定する。以下のメッセージを使えば最大値と最小値を個別に設定することもできる｡ デフォルトは、０ から １００までである。

TBM_SETRANGEMIN 
  wParam = (WPARAM) fRedraw; 
  lParam = (LPARAM) lMinimum; 

TBM_SETRANGEMAX 
  wParam = (WPARAM) fRedraw; 
  lParam = (LPARAM) lMaximum;

可動範囲を取得するには次のメッセージを送る。

TBM_GETRANGEMIN 
  wParam = 0; 
  lParam = 0; 

TBM_GETRANGEMAX 
  wParam = 0; 
  lParam = 0;

これらのメッセージ送出の戻り値として、値を取得できる｡ 

TBM_SETPOS 
  wParam = (WPARAM) (BOOL) fPosition; 
  lParam = (LPARAM) (LONG) lPosition;

コードでつまみの位置を設定する。wParam にはゼロ以外の値を設定すると lParam の値をつまみの位置に反映させることができる｡ wParam のゼロを指定してこのメッセージを送ると、現在の可動範囲に収まるようにつまみを適切に配置する｡

TBM_GETPOS 
  wParam = 0; 
  lParam = 0;

つまみの位置を取得する｡ 戻り値として現在のつまみの位置が取得できる｡

TBM_SETPAGESIZE
  wParam = 0; 
  lParam = (LONG) lPageSize; 

TBM_GETPAGESIZE
  wParam = 0; 
  lParam = 0;

スクロールバーと同じように、ユーザーが [PageUp/Down] キーを押したり、つまみの上下をマウスでクリックすると、つまみが大きく移動する。その移動量をページサイズと言い、これらのメッセージで設定・取得する｡ デフォルトでは、可動範囲の１／５である｡ 

TBM_SETLINESIZE
  wParam = 0; 
  lParam = (LONG) lLineSize; 

TBM_GETLINESIZE
  wParam = 0; 
  lParam = 0;

やはりスクロールバーと同じように、ユーザーが矢印キーを押すと、つまみが小さく移動する。その移動量をラインサイズと言い、これらのメッセージで設定・取得する｡ デフォルトでは １である｡

多くのコモンコントロールでは、通知メッセージは WM_NOTIFY で親ウィンドウに送られるのに対し、トラックバーの状態に変化が起きるとトラックバーは親ウィンドウに水平トラックバーのときは WM_HSCROLL、垂直のときは WM_VSCROLL メッセージを送る｡ このとき、lParam にはこのメッセージを送ったトラックバーのハンドルが設定されている｡ wParam の下位ワードには以下の通知メッセージが設定されている。

const
  TB_LINEUP               = 0;	//ラインアップ
  TB_LINEDOWN             = 1;	//ラインダウン
  TB_PAGEUP               = 2;	//ページアップ
  TB_PAGEDOWN             = 3;	//ページダウン
  TB_THUMBPOSITION        = 4;	//マウスでスライダーを移動した
  TB_THUMBTRACK           = 5;	//マウスでスライダーをドラグしている
  TB_TOP                  = 6;	//[Home]キーによる最大値への移動
  TB_BOTTOM               = 7;	//[End]キーによる最小値への移動
  TB_ENDTRACK             = 8;	//スライダーの移動が完了した

wParam の上位ワードには、TB_THUMBPOSITION と TB_THUMBTRACK のときは現在のつまみ位置が設定されているが、他の通知のときはゼロになっている。スクロールバーコントロールのときは、マウスでつまみをドラグしてもボタンをはなすと元の位置に戻ってしまい、コードで位置を設定してやらなければならなかった｡ これに対して､ トラックバーの場合は、つまみの位置は自動的に変化し、プログラマが関与する必要はない。ただ、通知メッセージに対して適切な処理をするだけでよいのである｡

ここまでの知識を使って、トラックバーをコードで作成し、テストするプログラムを作ろう｡

  1. エクスプローラを使って、新しいフォルダを 2601TrackBar01 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2506MenuHelp02 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas と CmCtrl.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで TrackBar01.dpr という名前で保存する｡
  5. [プロジェクト] メニューから [プロジェクトに追加...] を選んで表示されるダイアログから CmCtrl を選ぶ｡
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する。

以下に TrackBar01.dpr の全リストをしめす。

program TrackBar01;

uses
  windows,
  messages,
  commctrl,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas',
  CmCtrl in 'CmCtrl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
const
  TBM_SETBUDDY = WM_USER+32;
  TBM_GETBUDDY = WM_USER+33;

var
  MainWnd: TSDIMainWindow;

  hTR: HWND;
  SB: TAPIStatusBar;
  ED: TAPIEdit;
  BG: TBtnGroup;

  SelRangeFlag,NoThumbFlag,BorderFlag,VerticalFlag: Boolean;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function CreateTrackBar(x,y,dx,dy:integer;OptionStyle:DWORD):HWND;
var
  Style:DWORD;
begin
  Style := WS_CHILD or WS_VISIBLE or WS_TABSTOP;
  Style := Style or OptionStyle;
  result := CreateWindow(TRACKBAR_CLASS,
                         'APITrackbar',
                         Style,
                         x,y,dx,dy,
                         MainWnd.Handle,
                         12345,
                         hInstance,
                         nil);
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainHScroll(var Msg:TMessage);
var
  Pos: integer;
  hTB: HWND;
begin
  hTB := Msg.LParam;
  Pos := SendMessage(hTB,TBM_GETPOS,0,0);
  SB.Text[0] := 'HorPos : '+AIntToStr(Pos);
  ED.Text := AIntToStr(Pos);
end;

procedure MainVScroll(var Msg:TMessage);
var
  Pos: integer;
  hTB: HWND;
begin
  hTB := Msg.LParam;
  Pos := SendMessage(hTB,TBM_GETPOS,0,0);
  SB.Text[0] := 'VertPos : '+AIntToStr(Pos);
  ED.Text := AIntToStr(Pos);
end;

procedure EDChange(var Msg:TMessage);
var
  TRPos,EDVal,Code:integer;
begin
  TRPos := SendMessage(hTR,TBM_GETPOS,0,0);
  Val(Ed.Text,EDVal,Code);
  if Code <> 0 then Exit;
  if TRPos <> EDVal then
    SendMessage(hTR,TBM_SETPOS,1,EDVal);
end;

procedure BGClick(var MSG:TMessage);
var
  Style:DWORD;
  r:Trect;
begin
  Style := GetWindowLong(hTR,GWL_STYLE);
  case Msg.WParam of
    0: begin
      Style := (Style and $FFFFFFF3) or TBS_BOTH;
      SetWindowLong(hTR,GWL_STYLE,Style);
    end;
    1: begin
      Style := (Style and $FFFFFFF3) or TBS_TOP;
      SetWindowLong(hTR,GWL_STYLE,Style);
    end;
    2: begin
      if SelRangeFlag then
        Style := Style and (not TBS_ENABLESELRANGE)
      else
        Style := Style or TBS_ENABLESELRANGE;
      SetWindowLong(hTR,GWL_STYLE,Style);
      SelrangeFlag := not SelRangeFlag;
    end;
    3: begin
      if NoThumbFlag then
        Style := Style and (not TBS_NOTHUMB)
      else
        Style := Style or TBS_NOTHUMB;
      SetWindowLong(hTR,GWL_STYLE,Style);
      NoThumbFlag := not NoThumbFlag;
    end;
    4: begin
      if BorderFlag then
        Style := Style and (not WS_BORDER)
      else
        Style := Style or WS_BORDER;
      SetWindowLong(hTR,GWL_STYLE,Style);
      GetWindowRect(hTR,r);
      ChangeWindowSize(hTR,0,0);
      ChangeWindowSize(hTR,r.Right-r.Left,r.Bottom-r.Top);
      BorderFlag := not BorderFlag;
    end;
    5: begin
      if VerticalFlag then
        Style := Style and (not TBS_VERT)
      else
        Style := Style or TBS_VERT;
      SetWindowLong(hTR,GWL_STYLE,Style);
      GetWindowRect(hTR,r);
      ChangeWindowSize(hTR,r.Bottom-r.Top,r.Right-r.Left);
      VerticalFlag := not VerticalFlag;
    end;
    6: SendMessage(hTR,TBM_SETPOS,1,50);
  end;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  InitCommonControls;

  hTR := CreateTrackbar(10,20,300,45,TBS_AUTOTICKS);
  SendMessage(hTR,TBM_SETTICFREQ,10,0);
  SendMessage(hTR,TBM_SETPAGESIZE,0,10);

  SB := CreateStatusBar(hWindow,false);

  ED := createEdit(hWindow,280,80,40,27,'',EDChange);

  BG := CreateBtnGroup(hWindow,true,70,80,200,250,7,BGClick);
  BG.Captions[0] := 'TBS_BOTH';
  BG.Captions[1] := 'TBS_TOP';
  BG.Captions[2] := 'TBS_ENABLESELRANGE';
  BG.Captions[3] := 'TBS_NOTHUMB';
  BG.Captions[4] := 'WS_BORDER';
  BG.Captions[5] := 'TBS_VERT';
  BG.Captions[6] := 'TBM_SETPOS';

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 380;
    Center;
    Trap(WM_HSCROLL,MainHScroll);
    Trap(WM_VSCROLL,MainVScroll);
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  SendMessage(hTR,TBM_SETBUDDY,0,ED.Handle);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifTrackBar01.zip(28.889kB)
TrackBar01.gif

実行すると右図のように、水平トラックバーとボタングループとステータスバーとエディットが一つずつ作られる｡ マウスやキーボードを使ってつまみを動かすと、ステータスバーにその位置が表示される｡ ボタングループの各ボタンを押すとトラックバーのスタイルが変更される。

コードを調べよう｡ トラックバーをつくった後、メモリの間隔とページサイズを変更している。

  hTR := CreateTrackbar(10,20,300,45,TBS_AUTOTICKS);
  SendMessage(hTR,TBM_SETTICFREQ,10,0);
  SendMessage(hTR,TBM_SETPAGESIZE,0,10);

つまみの可動範囲は設定していないのでデフォルトのゼロから１００までである｡ 表示するメモリの間隔を設定するには、以下のメッセージを送る。

TBM_SETTICFREQ 
  wParam = (WPARAM) wFreq; 
  lParam = 0;

wParam には表示間隔を設定する。デフォルトの設定は１である。MainWnd では WM_HSCROLL と WM_VSCROLL メッセージをトラップして、ステータスバーとエディットにつまみの位置を表示している｡

procedure MainHScroll(var Msg:TMessage);
var
  Pos: integer;
  hTB: HWND;
begin
  hTB := Msg.LParam;
  Pos := SendMessage(hTB,TBM_GETPOS,0,0);
  SB.Text[0] := 'HorPos : '+AIntToStr(Pos);
  ED.Text := AIntToStr(Pos);
end;

また、エディットの OnChange イベントハンドラでは、入力された数値が反映されるようにトラックバーのつまみの位置を変更している｡

procedure EDChange(var Msg:TMessage);
var
  TRPos,EDVal,Code:integer;
begin
  TRPos := SendMessage(hTR,TBM_GETPOS,0,0);
  Val(Ed.Text,EDVal,Code);
  if Code <> 0 then Exit;
  if TRPos <> EDVal then
    SendMessage(hTR,TBM_SETPOS,1,EDVal);
end;

TBM_SETPOS メッセージを送って「つまみ」の位置を変更すると、WM_HSCROLL や WM_VSCROLL メッセージが発行されず、ステータスバーの表示が変化しないことが分かる｡ 'TBS_BOTH' のボタンを押すと目盛りが上下に付き、'TBS_TOP' では上だけに付く。'TBS_ENABLESELRANGE' ボタンを押すと、「選択範囲」を表示するために、つまみの軸が通過する矩形の幅が大きくなる。もう一度押すと、元に戻る｡ 'TBS_NOTHUMB' ボタンでは、つまみの表示の On/Off ができる。 'WS_BORDER' ボタンでは、このコントロールのしめる矩形領域の枠線描画の On/Off ができる。'TBS_VERT' では、トラックバーを水平/垂直の切り替えができる｡

Test! メニューを選択するとエディットがトラックバーの右側に配置される。この後、'TBS_VERT' でトラックバーを水平/垂直の切り替えても自動的にエディットの配置が追随する。このようにコントロールによって自動的に制御されるウィンドウは、バディーウィンドウと呼ばれている｡ Test! メニューでは、

rocedure OnTest(hWindow: HWND);
begin
  SendMessage(hTR,TBM_SETBUDDY,0,ED.Handle);
end;

のように、TBM_SETBUDDY メッセージを送ってバディーウィンドウを設定する。このメッセージは、私のバージョンの CommCtrl.pas には載っていないので、const として冒頭で定義している。

TBM_SETBUDDY
  wParam = (WPARAM)(BOOL) fLocation;// ゼロだと右/下、ゼロ以外だと左/上
  lParam = (LPARAM)(HWND) hwndBuddy;// バディーウィンドウのウィンドウハンドル

現在設定されているバディーウィンドウのハンドルは、

TBM_GETBUDDY
  wParam = (WPARAM)(BOOL) fLocation;// ゼロだと右/下、ゼロ以外だと左/上
  lParam = 0;

メッセージを送って、その戻り値として取得できる｡

redball.gifこの章の目次へ戻る

２６−２ TAPITrackBar クラス

この節では、前節で調べたトラックバーコントロールのラッパークラスを TCmCtrl クラスから派生して CmCtrl.pas に作ろう｡ トラックバーが認識するメッセージのうち、ごく基本的なものだけを実装することにする｡

  1. エクスプローラを使って、新しいフォルダを 2602TrackBar02 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2601TrackBar01 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas と CmCtrl.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで TrackBar02.dpr という名前で保存する｡
  5. [プロジェクト] メニューから [プロジェクトに追加...] を選んで表示されるダイアログから CmCtrl を選ぶ｡
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する。

最初に TAPITrackBar クラスを CmCtrl.pas に実装しよう｡ まず定義されていないメッセージをこのユニットファイルの冒頭の定数定義に追加する。

  TBM_SETBUDDY = WM_USER+32;
  TBM_GETBUDDY = WM_USER+33;

宣言部を以下に示す。

//------------ TAPITrackBar ------------------------------------------
TTickDisplay = (BottomOrRight,TopOrLeft,Both, None);
TBuddyLocation = (RightOrBelow,LeftOrAbove);

TAPITrackBar = class(TCmCtrl)
private
  FDim: TRect;
  FRect: TRect;
  FVertical: Boolean;
  FTickDisplay: TTickDisplay;
  FTickFreq:integer;
  FDrawFrame: Boolean;
  FOnChange: TNotifyMessage;
  procedure SetDimension(val: TRect);
  function GetPos:integer;
  procedure SetPos(val: integer);
  function GetRangeMin: integer;
  procedure SetRangeMin(val: integer);
  function GetRangeMax: integer;
  procedure SetRangeMax(val: integer);
  function GetLine: integer;
  procedure SetLine(val: integer);
  function GetPage: integer;
  procedure SetPage(val: integer);
  procedure SetTickDisplay(val: TTickDisplay);
  procedure SetTickFreq(value:integer);
  function GetChannelRect:TRect;
  procedure SetDrawFrame(val:Boolean);
protected
  procedure CreateControl;override;
public
  constructor Create(hParent:HWND); override;
  procedure DefaultHandler(var Message);override;
  procedure SetVertical(val: Boolean);
  procedure SetBuddy(hBuddy:HWND;Position:TBuddyLocation);
  function GetBuddy(Position:TBuddyLocation):HWND;
  property Dimension : TRect read FDim write SetDimension;
  property ThumbPos: integer read GetPos write SetPos;
  property RangeMin: integer read GetRangeMin write setRangeMin;
  property RangeMax: integer read GetRangeMax write setRangeMax;
  property LineChange: integer read GetLine write SetLine;
  property PageChange: integer read GetPage write SetPage;
  property TickDisplay: TTickDisplay read FTickDisplay write SetTickDisplay;
  property TickFreq: integer read FTickFreq write SetTickFreq;
  property ChannelRect: TRect read GetChannelRect;
  property DrawFrame:Boolean read FDrawFrame write SetDrawFrame;
  property OnChange: TNotifyMessage read FOnChange write FOnChange;
end;

function CreateTrackBar(hParent:HWND;Vertical:Boolean;
           x,y,cx,cy,cRangeMin,cRangeMax,cTickFreq:integer;
           sOnChange:TNotifyMessage):TAPITrackBar;

この宣言部の public 部のメソッドやプロパティーの大半は、その名前から機能が想像できるだろう｡ ChannelRect は、「つまみ」の軸部分が可動する矩形領域を TRect 型レコードとして取得できる｡ 今回の実装では、選択範囲に関するものと、自前で「目盛り」を描く機能を省略した。実装部を以下に示す｡

//------------ TAPITrackBar ------------------------------------------
constructor TAPITrackBar.Create(hParent:HWND);
begin
  inherited Create(hParent);

  CreateControl;
  FVertical := false;
  FTickDisplay := BottomOrRight;
  FTickFreq := 1;
  FDrawFrame := false;
  Dispatcher.TrapMessage(WM_HSCROLL,self);
  Dispatcher.TrapMessage(WM_VSCROLL,self);
end;

procedure TAPITrackBar.CreateControl;
begin

  FHandle := CreateWindow(TRACKBAR_CLASS,
                          'APITrackbar',
                          WS_CHILD or WS_VISIBLE or WS_TABSTOP or
                          TBS_AUTOTICKS,
                          20,20,200,40,
                          Parent,
                          ID_CmCtrl,
                          hInstance,
                          nil);

  FID := ID_CmCtrl;
  inc(ID_CmCtrl);

  Dimension := SetDim(20,20,200,40);
end;

procedure TAPITrackBar.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin
  AMsg := TMessage(Message);

  if AMsg.LParam <> FHandle then exit; //自分を確認する

  case AMsg.Msg of

    WM_HSCROLL, WM_VSCROLL: begin
      AMsg.Msg := UINT(self);  // sender
      if Assigned(FOnChange) then OnCHange(AMsg);
    end;

  end;
end;

procedure TAPITrackBar.SetVertical(val: Boolean);
var
  st: integer;
begin
  FVertical := val;
  st := GetWindowLong(FHandle,GWL_STYLE);
  if val then
    st := st or TBS_VERT
  else
    st := st and (not TBS_VERT);
  SetWindowLong(FHandle,GWL_STYLE,st);
end;

procedure TAPITrackBar.SetDimension(val: TRect);
begin
  FDim := val;// xPos,yPos,width,height
  FRect := val;
  FRect.Right := FDim.Left+FDim.Right; // right from width
  FRect.Bottom := FDim.Top+FDim.Bottom; // Bottom from height
  MoveWindow(FHandle,val.left, val.top,val.right, val.bottom, true);
end;


function TAPITrackBar.GetPos:integer;
begin
  result := SendMessage(FHandle,TBM_GETPOS,0,0);
end;

procedure TAPITrackBar.SetPos(val: integer);
var
  Msg: TMessage;
begin
  SendMessage(FHandle,TBM_SETPOS,1,val);
  Msg.Msg := WM_HSCROLL;
  Msg.LParam := FHandle;
  Dispatch(Msg);
end;

function TAPITrackBar.GetRangeMin: integer;
begin
  result := SendMessage(FHandle,TBM_GETRANGEMIN,0,0);
end;

procedure TAPITrackBar.SetRangeMin(val: integer);
begin
  SendMessage(FHandle,TBM_SETRANGEMIN,1,val);
end;

function TAPITrackBar.GetRangeMax: integer;
begin
  result := SendMessage(FHandle,TBM_GETRANGEMAX,0,0);
end;

procedure TAPITrackBar.SetRangeMax(val: integer);
begin
  SendMessage(FHandle,TBM_SETRANGEMAX,1,val);
end;

function TAPITrackBar.GetLine: integer;
begin
  result := SendMessage(FHandle,TBM_GETLINESIZE,0,0);
end;

procedure TAPITrackBar.SetLine(val: integer);
begin
  SendMessage(FHandle,TBM_SETLINESIZE,0,val);
end;

function TAPITrackBar.GetPage: integer;
begin
  result := SendMessage(FHandle,TBM_GETPAGESIZE,0,0);
end;

procedure TAPITrackBar.SetPage(val: integer);
begin
  SendMessage(FHandle,TBM_SETPAGESIZE,0,val);
end;

procedure TAPITrackBar.SetTickDisplay(val: TTickDisplay);
var
  td,st,flag: integer;
begin
  case val of
    TopOrLeft: td := TBS_TOP;
    Both:      td := TBS_BOTH;
    None:      td := TBS_NOTICKS;
  else
    td := TBS_BOTTOM;
  end;
  flag := $1C;
  st := GetWindowLong(FHandle,GWL_STYLE);
  st := st and (not flag) or td;
  SetWindowLong(FHandle,GWL_STYLE,st);
  FTickDisplay := val;
end;

function TAPITrackBar.GetChannelRect:TRect;
var
  r:TRect;
begin
  SendMessage(FHandle,TBM_GETCHANNELRECT,0,LPARAM(@r));
  if not FVertical then
    result := r
  else begin
    result.Left := FDim.Right-r.Bottom;
    result.Top := r.Left;
    result.Right := FDim.Right-r.Top;
    result.Bottom := r.Right;
  end;
end;

procedure TAPITrackBar.SetTickFreq(value:integer);
begin
  FTickFreq := value;
  SendMessage(FHandle,TBM_SETTICFREQ,value,0);
end;

procedure TAPITrackBar.SetBuddy(hBuddy:HWND;Position:TBuddyLocation);
begin
  case Position of
    RightOrBelow: SendMessage(FHandle,TBM_SETBUDDY,0,hBuddy);
    LeftOrAbove: SendMessage(FHandle,TBM_SETBUDDY,1,hBuddy);
  end;
end;

function TAPITrackBar.GetBuddy(Position:TBuddyLocation):HWND;
begin
  result := 0;
  case Position of
    RightOrBelow: result := SendMessage(FHandle,TBM_SETBUDDY,0,0);
    LeftOrAbove: result := SendMessage(FHandle,TBM_SETBUDDY,1,0);
  end;
end;

procedure TAPITrackBar.SetDrawFrame(val:Boolean);
var
  Style:DWORD;
  r:TRect;
begin
  Style := GetWindowLong(FHandle,GWL_STYLE);
  if val then
    Style := Style or WS_BORDER
  else
    Style := Style and (not WS_BORDER);
  SetWindowLong(FHandle,GWL_STYLE,Style);
  GetWindowRect(FHandle,r);
  ChangeWindowSize(FHandle,0,0);
  ChangeWindowSize(FHandle,r.Right-r.Left,r.Bottom-r.Top);
  FDrawFrame := val;
end;

function CreateTrackBar(hParent:HWND;Vertical:Boolean;
           x,y,cx,cy,cRangeMin,cRangeMax,cTickFreq:integer;
           sOnChange:TNotifyMessage):TAPITrackBar;
begin
  result := TAPITrackBar.Create(hParent);
  with result do begin
    if Vertical then SetVertical(true);
    Dimension := SetDim(x,y,cx,cy);
    RangeMin := cRangeMin;
    RangeMax := cRangeMax;
    TickFreq := cTickFreq;
    OnChange := sOnChange;
  end;
end;

実装コードについてはほとんど説明の必要はないだろう｡ SetPos( ) メソッドを見てみよう。

procedure TAPITrackBar.SetPos(val: integer);
var
  Msg: TMessage;
begin
  SendMessage(FHandle,TBM_SETPOS,1,val);
  Msg.Msg := WM_HSCROLL;
  Msg.LParam := FHandle;
  Dispatch(Msg);
end;

前節で示したように TBM_SETPOS メッセージを送ってつまみの位置を変更したときは WM_HSCROLL や WM_VSCROLL メッセージは発行されないので、コード内でメッセージを自分のクラスに Dispatch( ) している｡ DefaultHandler( ) を見てみよう。

procedure TAPITrackBar.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin
  AMsg := TMessage(Message);

  if AMsg.LParam <> FHandle then exit; //自分を確認する

  case AMsg.Msg of

    WM_HSCROLL, WM_VSCROLL: begin
      AMsg.Msg := UINT(self);  // sender
      if Assigned(FOnChange) then OnCHange(AMsg);
    end;

  end;
end;

ここでは、WM_HSCROLL と WM_VSCROLL メッセージを捕まえてイベントを呼んでいるだけである｡

このクラスをテストするプログラムを TrackBar02.dpr につくろう。以下に全リストを示す｡

program TrackBar02;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas',
  CmCtrl in 'CmCtrl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  TR: TAPITrackBar;
  SB: TAPIStatusBar;
  ED: TAPIEdit;
  BG: TBtnGroup;

  VerticalFlag:Boolean;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure TRChange(var Msg:TMessage);
begin
  SB.Text[0] := 'Pos : '+AIntToStr(TR.ThumbPos);
  ED.Text := AIntToStr(TR.ThumbPos);
end;

procedure EDChange(var Msg:TMessage);
var
  EDVal,Code:integer;
begin
  Val(Ed.Text,EDVal,Code);
  if Code <> 0 then Exit;
  if TR.ThumbPos <> EDVal then TR.ThumbPos := EDVal;
end;

procedure BGClick(var MSG:TMessage);
var
  r:Trect;
begin
  case Msg.WParam of
    0: case TR.TickDisplay of
         BottomOrRight: TR.TickDisplay := TopOrLeft;
         TopOrLeft: TR.TickDisplay := Both;
         Both: TR.TickDisplay := None;
         None: TR.TickDisplay := BottomOrRight;
       end;
    1: begin
      if VerticalFlag then
        TR.SetVertical(false)
      else
        TR.SetVertical(true);
      GetWindowRect(TR.Handle,r);;
      ChangeWindowSize(TR.Handle,r.Bottom-r.Top,r.Right-r.Left);
      VerticalFlag := not VerticalFlag;
    end;
    2: TR.DrawFrame := not TR.DrawFrame;
    3: TR.ThumbPos := 125;
    4: TR.SetBuddy(ED.Handle,RightOrBelow);
    5: TR.TickFreq := 10;
  end;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  TR := CreateTrackBar(hWindow,false,10,20,300,45,
                       0,200,20,TRChange);
  TR.PageChange := 10;

  SB := CreateStatusBar(hWindow,false);

  ED := createEdit(hWindow,280,80,40,27,'0',EDChange);

  BG := CreateBtnGroup(hWindow,true,70,80,200,250,7,BGClick);
  BG.Captions[0] := 'TickDisplay';
  BG.Captions[1] := 'Vertical';
  BG.Captions[2] := 'DrawFrame';
  BG.Captions[3] := 'SetPos = 125';
  BG.Captions[4] := 'SetBuddy';
  BG.Captions[5] := 'TickFreq = 10';
  BG.Captions[6] := '';

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 380;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MessageBeep($FFFFFFFF);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifTrackBar02.zip(29.180kB)
TrackBar02.gif

実行すると右図のようになり、前節のプログラムと同様の動作をすることを確かめることができる。

redball.gifこの章の目次へ戻る

２６−３ スタティックテキストをコードでつくる

前節までで試したように、トラックバーコントロールには TBM_SETBUDDY メッセージを送ってバディーウィンドウを設置できる｡ 前節ではエディットコントロールをバディウィンドウとしたが、ユーザからの入力を受け付けたくないときもあるだろう｡ エディットを読み出し専用にすることもできるが、ここではこのバディウィンドウに関連して、文字列を表示するスタティックコントロールについて調べてみよう｡ スタティックコントロールは、コモンコントロールではなく標準コントロールである。すでに第６章から第１４章にかけて標準コントロールについて調べたが、そこではスタティックコントロールについて触れなかった。２３−１ モーダルダイアログボックスをつくる において、ダイアログリソースを使ってモーダルダイアログをつくったときに､ ラベルとしてスタティックコントロールを使った。

スタティックコントロールは、他の標準コントロールと同様、定義済みの子コントロールであり、ラベルとして文字列を表示したり、ビットマップやアイコン、メタファイルを保持して表示したり、ＶＣＬの TBevel のように枠線を描いたりする多機能なコントロールである。しかし、入力フォーカスを持たず、キーボードメッセージには応答しない｡ この節では、文字列を表示するスタティックコントロールについて調べることにする｡ 本稿で作った TAPILabel クラスも、Delphi のＶＣＬの TLabel クラスも､ どちらもＧＤＩ関数を用いて文字列を描画する機能をカプセル化したものであり、ウィンドウではない。ＶＣＬには、似たクラスとして TStaticText があり、これは TWinControl から派生したウィンドウコントロールである｡ 文字列を保持して表示するスタティックコントロールは、クラス名を 'STATIC' として CreateWindow( ) または CtreateWindowEx( ) で作成する｡ このとき設定できるウィンドウスタイルとして以下のものがある。

const
  SS_LEFT = 0;            // 左寄せテキスト、ワードラップ（デフォルト）
  SS_CENTER = 1;          // 中央寄せテキスト、ワードラップ
  SS_RIGHT = 2;           // 右寄せテキスト、ワードラップ
  SS_LEFTNOWORDWRAP = 12; // 左寄せテキスト、ワードラップなし、タブ展開
  SS_NOPREFIX = $80;      // & に続く文字に下線を引かない
  SS_NOTIFY = $100;       // マウスイベントに応答する
  SS_SUNKEN = $1000;      // 周囲をくぼんだ線で描画する

ここで０から１２までのスタイルはビットフラグではないので、それぞれ１つだけ選んで指定するものだ｡ コントロールを作成した後、文字列を設定するには WM_SETTEXT メッセージを送るか、SetWindowText( ) を実行する。保持している文字列を取得するには WM_GETTEXT メッセージを送るか、GetWindowText( ) を実行する。スタティックコントロールは、自分の背景を描画するとき親ウィンドウに WM_CTLCOLORSTATIC メッセージを送る。

WM_CTLCOLORSTATIC 
  hdcStatic = (HDC) wParam;   // ディスプレイデバイスコンテキストのハンドル 
  hwndStatic = (HWND) lParam; // スタティックコントロールのハンドル

このメッセージを処理したアプリケーションは、戻り値として背景を描くブラシのハンドルを返さなければならない｡

SS_NOTIFY スタイルを設定して作成したスタティックコントロールは、以下の通知メッセージを WM_COMMAND につけて( wParamHi として )親ウィンドウに送る。

const
  STN_CLICKED = 0; // クリックされた
  STN_DBLCLK = 1;  // ダブルクリックされた
  STN_ENABLE = 2;  // 使用可になった
  STN_DISABLE = 3; // 使用不可になった

以上の知識に基づいてコードでスタティックコントロールを作って、テストしてみよう｡

  1. エクスプローラを使って、新しいフォルダを 2603StaticText01 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2602TrackBar02 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas と CmCtrl.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで StaticText01.dpr という名前で保存する｡
  5. コードエディタで以下のように編集する｡
  6. [F.9]でコンパイルして実行する。

以下に StaticText01.dpr の全リストを示す｡

program StaticText01;

uses
  windows,
  messages,
  CommCtrl,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  hST:HWND;
  BG: TBtnGroup;

  TextColor,BkColor:COLORREF;
  hBkBrush: HBRUSH;
  BorderFlag,EdgeFlag:Boolean;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function CreateStaticText:HWND;
begin
  result := CreateWindowEx(0,
                           'STATIC',
                           'Static Control',
                           WS_CHILD or WS_VISIBLE or SS_CENTER or SS_NOTIFY,
                           10,10,150,35,
                           MainWnd.Handle,
                           12345,
                           hInstance,
                           nil);
end;                  

procedure SetBkColor(val:COLORREF);
begin
  BkColor := val;
  DeleteObject(hBkBrush);
  hBkBrush := CreateSolidBrush(val);
end;

function STGetText:string;
var
  Len:integer;
  PC:PChar;
begin
  Len := GetWindowTextLength(hST)+1;
  GetMem(PC,Len);
  GetWindowText(hST,PC,Len);
  SetString(result,PC,Len-1);
  FreeMem(PC);
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainCtlColorStatic(var Msg: TMessage);
begin
  if Msg.LParam = hST then begin
    Windows.SetBkColor(Msg.WParam,BkColor);
    SetTextColor(Msg.WParam,TextColor);
    Msg.Result := hBKBrush;
  end;
end;

procedure BGClick(var MSG:TMessage);
var
  Style:DWORD;
  r:Trect;
begin
  Style := GetWindowLong(hST,GWL_STYLE);
  case Msg.WParam of
    0: begin
      Style := (Style and $FFFFFFFC) or SS_LEFT;
      SetWindowLong(hST,GWL_STYLE,Style);
      InvalidateRect(hST,nil,true);
    end;
    1: begin
      Style := (Style and $FFFFFFFC) or SS_RIGHT;
      SetWindowLong(hST,GWL_STYLE,Style);
      InvalidateRect(hST,nil,true);
    end;
    2: begin
      Style := (Style and $FFFFFFFC) or SS_CENTER;
      SetWindowLong(hST,GWL_STYLE,Style);
      InvalidateRect(hST,nil,true);
    end;
    3: begin
      Style := GetWindowLong(hST,GWL_EXSTYLE);
      if EdgeFlag then
        Style := 0
      else
        Style := Style or WS_EX_STATICEDGE;
      EdgeFlag := not EdgeFlag;
      SetWindowLong(hST,GWL_EXSTYLE,Style);
      GetWindowRect(hST,r);
      ChangeWindowSize(hST,0,0);
      ChangeWindowSize(hST,r.Right-r.Left,r.Bottom-r.Top);
    end;
    4: SetWindowText(hST,PChar(STGetText+'+'));
    5: begin
      if BorderFlag then
        Style := Style and (not WS_BORDER)
      else
        Style := Style or WS_BORDER;
      BorderFlag := not BorderFlag;
      SetWindowLong(hST,GWL_STYLE,Style);
      GetWindowRect(hST,r);
      ChangeWindowSize(hST,0,0);
      ChangeWindowSize(hST,r.Right-r.Left,r.Bottom-r.Top);
    end;
    6: begin
      BkColor := RGB(Random(256),Random(256),Random(256));
      TextColor := not BkColor;
      SetBkColor(BkColor);
      InvalidateRect(hST,nil,true);
    end;
  end;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  TextColor := clrBlack;
  SetBkColor(clrWhite);

  hST := CreateStaticText;

  BG := CreateBtnGroup(hWindow,true,70,50,200,250,7,BGClick);
  BG.Captions[0] := 'SS_LEFT';
  BG.Captions[1] := 'SS_RIGHT';
  BG.Captions[2] := 'SS_CENTER';
  BG.Captions[3] := 'Change EdgeStyle';
  BG.Captions[4] := 'Text = Text+';
  BG.Captions[5] := 'Border On/Off';
  BG.Captions[6] := 'Change Color';

  Randomize;

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 310;
    Trap(WM_CTLCOLORSTATIC,MainCtlColorStatic);
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MessageBeep($FFFFFFFF);
end;

procedure MainCommand(var Msg: TMessage);
begin
  if (Msg.LParam = hST) and (Msg.WParamHi = STN_CLICKED) then
    MessageBeep($FFFFFFFF);
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  DeleteObject(hBkBrush);
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifStaticText01.zip(26.774kB)
StaticText01.gif

実行すると右図のようになる。ボタングループのボタンを押すと各タイトル通りの変更が起こることを確かめられる。
StaticText をマウスでクリックするとシステムブザーが鳴る。これは、MainCommand( ) ハンドラの中で

  if (Msg.LParam = hST) and (Msg.WParamHi = STN_CLICKED) then
    MessageBeep($FFFFFFFF);

として、WM_COMMAND を捕まえて､ STN_CLICKED 通知を処理しているからである｡

redball.gifこの章の目次へ戻る

２６−４ TAPIStaticText クラス

前節で調べた文字列を保持して表示するスタティックコントロールをカプセル化して、TAPIStaticText クラスを作成しよう｡ スタティックコントロールは標準コントロールなので、APIControl.pas に TAPIControl クラスから派生して作ることにしよう。早速取りかかることにする。

  1. エクスプローラを使って、新しいフォルダを 2604StaticText02 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2603StaticText01 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas と CmCtrl.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで StaticText02.dpr という名前で保存する｡
  5. [CTRL] + F12 を押して表示されるダイアログから､ APIControl を選んでコードエディタに表示させる。
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する。

最初に APIControl.pas に TAPIStaticText クラスを作成しよう｡ 宣言部を以下に示す｡

//---------- TAPIStaticText ----------------------------------------------
TTextAlign = (taLeft,taCenter,taRight);

TAPIStaticText = class(TAPIControl)
private
  FBorder: Boolean;
  FTextAlign: TTextAlign;
  FTextColor: COLORREF;
  FBkColor: COLORREF;
  FhBkBrush:HBRUSH;
  FSunkenBorder: Boolean;
  FOnTextChange: TNotifyMessage;
  FOnClick: TNotifyMessage;
  function GetText:string;
  procedure SetText(val:string);
  procedure SetTextAlign(val: TTextAlign);
  procedure SetTextColor(val:COLORREF);
  procedure SetBkColor(val:COLORREF);
  procedure SetBorder(val:Boolean);
  procedure SetSunkenBorder(val:Boolean);
protected
  procedure APICreateParams(var Params: TAPICreateParams); override;
  procedure Initialize; override;
public
  destructor Destroy; override;
  procedure DefaultHandler(var Message); override;
  property Text:string read GetText write SetText;
  property TextAlign: TTextAlign read FTextAlign write SetTextAlign;
  property TextColor: COLORREF read FTextColor write SetTextColor;
  property BkColor:COLORREF read FBkColor write SetBkColor;
  property Border: Boolean read FBorder write SetBorder;
  property SunkenBorder: Boolean read FSunkenBorder write SetSunkenBorder;
  property OnTextChange: TNotifyMessage read FOnTextChange write FOnTextChange;
  property OnClick: TNotifyMessage read FOnClick write FOnClick;
end;

この宣言部を見ると分かるように、前節で試したスタティックコントロールの属性を全てプロパティーに装備している。OnTextChange イベントは、SetText アクセスメソッドの中から呼ばれている｡ 通知メッセージに対応するイベントは OnClick (STN_CLICKED) だけである。実装部を以下に示す｡

//---------- TAPIStaticText ----------------------------------------------
procedure TAPIStaticText.APICreateParams(var Params: TAPICreateParams);
begin
  with Params do begin
    Caption := 'Static Text';
    Style := WS_CHILD or WS_VISIBLE or SS_NOTIFY;
    ExStyle := 0;
    X := 0;
    Y := 0;
    Width := 0;
    Height := 0;
    WinClassName := 'STATIC';
  end;
end;

procedure TAPIStaticText.Initialize;
begin
  inherited Initialize;
  Dispatcher.TrapMessage(WM_CTLCOLORSTATIC,self);
  FBorder := false;
  FTextAlign := taLeft;
  FTextColor := clrBlack;
  FBkColor := clrBtnFace;
  FhBkBrush := CreateSolidBrush(FBkColor);
  FSunkenBorder := false;
end;

destructor TAPIStaticText.Destroy;
begin
  DeleteObject(FhBkBrush);
  inherited Destroy;
end;

procedure TAPIStaticText.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin
  AMsg := TMessage(message);
  case AMsg.Msg of
    WM_COMMAND:
      if (AMsg.LParam = FHandle) and (AMsg.WParamHi = STN_CLICKED) then
         if Assigned(FOnClick) then begin
           AMsg.Msg := UINT(self); // Sender
           OnClick(AMsg);
         end;
    WM_CTLCOLORSTATIC: if AMsg.LParam = FHandle then begin
        Windows.SetBkColor(AMsg.WParam,FBkColor);
        Windows.SetTextColor(AMsg.WParam,FTextColor);
        TMessage(message).Result := FhBkBrush;
      end;
  end; // case
end;

function TAPIStaticText.GetText:string;
var
  Len:integer;
  PC:PChar;
begin
  Len := GetWindowTextLength(FHandle)+1;
  GetMem(PC,Len);
  GetWindowText(FHandle,PC,Len);
  SetString(result,PC,Len-1);
  FreeMem(PC);
end;

procedure TAPIStaticText.SetText(val:string);
var
  AMsg:TMessage;
begin
  SetWindowText(FHandle, PChar(Val));
  if Assigned(FOnTextChange) then begin
    AMsg.Msg := UINT(self); // Sender
    FOnTextChange(AMsg);
  end;
end;

procedure TAPIStaticText.SetTextAlign(val: TTextAlign);
var
  Style:DWORD;
begin
  FTextAlign := val;
  Style := GetWindowLong(FHandle,GWL_STYLE);
  case val of
    taLeft:Style := (Style and $FFFFFFFC) or SS_LEFT;
    taCenter:Style := (Style and $FFFFFFFC) or SS_CENTER;
    taRight:Style := (Style and $FFFFFFFC) or SS_RIGHT;
  end;
  SetWindowLong(FHandle,GWL_STYLE,Style);
  InvalidateRect(FHandle,nil,True);
end;

procedure TAPIStaticText.SetTextColor(val:COLORREF);
begin
  FTextColor := val;
  InvalidateRect(FHandle,nil,true);
end;

procedure TAPIStaticText.SetBkColor(val:COLORREF);
begin
  FBkColor := val;
  DeleteObject(FhBkBrush);
  FhBkBrush := CreateSolidBrush(FBkColor);
  InvalidateRect(FHandle,nil,true);
end;

procedure TAPIStaticText.SetBorder(val:Boolean);
var
  Style:DWORD;
  W,H: integer;
begin
  Style := GetWindowLong(FHandle,GWL_STYLE);
  FBorder := val;
  if val then
    Style := Style or WS_BORDER
  else
    Style := Style and (not WS_BORDER);
  SetWindowLong(FHandle,GWL_STYLE,Style);
  W := Width; H := Height;
  Width := 0; Height := 0;
  Width := W; Height := H;
end;

procedure TAPIStaticText.SetSunkenBorder(val:Boolean);
var
  Style:DWORD;
  W,H: integer;
begin
  if FSunkenBorder = val then exit;
  if val then
    Style := WS_EX_STATICEDGE
  else
    Style := 0;
  FSunkenBorder := val;
  SetWindowLong(FHandle,GWL_EXSTYLE,Style);
  W := Width; H := Height;
  Width := 0; Height := 0;
  Width := W; Height := H;
end;

これらのコードは、前節のテストコードをアクセスメソッドに書き換えているだけである｡ 最後にインスタンス生成関数を作る。宣言部は、

function CreateStaticText(hParent: HWND; x,y,cx,cy: integer;
                      sOnTextChange:TNotifyMessage): TAPIStaticText;

であり、実装部は以下のようになる｡

function CreateStaticText(hParent: HWND; x,y,cx,cy: integer;
                      sOnTextChange:TNotifyMessage): TAPIStaticText;
begin
  result := TAPIStaticText.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    OnTextChange := sOnTextChange;
  end;
end;

これで TAPIStaticText クラスができたので、これをテストするプログラムを StaticText02.dpr に書こう。以下に全リストを示す｡

program StaticText02;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  ST1: TAPIStaticText;
  BG: TBtnGroup;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure ST1TextChange(var Msg: TMessage);
begin
  MessageBeep($FFFFFFFF);
end;

procedure BGClick(var MSG:TMessage);
begin
  case Msg.WParam of
    0: ST1.TextAlign := taRight;
    1: ST1.TextAlign := taCenter;
    2: ST1.TextAlign := taLeft;
    3: ST1.SunkenBorder := not ST1.SunkenBorder;
    4: ST1.Text := ST1.Text + '+';
    5: ST1.Border := not ST1.Border;
    6: begin
      ST1.BkColor := RGB(Random(256),Random(256),Random(256));
      ST1.TextColor := not ST1.BkColor;
    end;
  end;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  ST1 := CreateStaticText(hWindow,10,10,250,40,ST1TextChange);
  ST1.OnClick := ST1TextChange;

  BG := CreateBtnGroup(hWindow,true,70,60,200,250,7,BGClick);
  BG.Captions[0] := 'SS_RIGHT';
  BG.Captions[1] := 'SS_CENTER';
  BG.Captions[2] := 'SS_LEFT';
  BG.Captions[3] := 'Change EdgeStyle';
  BG.Captions[4] := 'Text = Text+';
  BG.Captions[5] := 'Border On/Off';
  BG.Captions[6] := 'Change Color';

  Randomize;

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 320;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MessageBeep($FFFFFFFF);
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifStaticText02.zip(16.239kB)
StaticText02.gif

実行すると右図のようになる。前節のプログラムと全く同じく動作するのが確かめられる。これを使って、トラックバーのバディーウィンドウに設定する例は、この後でつくる Colors2 プログラムで示すことにする｡

redball.gifこの章の目次へ戻る

２６−５ プログレスバーをコードでつくる

プログレスバーは、単純な表示専用のコントロールである｡ 作成して表示範囲を設定し、表示位置を指定するだけで動作する｡ プログレスバーは、CreateWindowEx( ) または CreateWindow( ) にウィンドウスタイルとして PROGRESS_CLASS を指定して作成する｡

const
  PROGRESS_CLASS = 'msctls_progress32';

作成時に設定できるプログレスバー特有のウィンドウスタイルには以下のものがある。

const
  PBS_SMOOTH = 1;   //スムース表示
  PBS_VERTICAL = 4; //垂直プログレスバー

例によって、作成後は以下のメッセージを SendMessage( ) を使って送ることにより遠隔操作する｡

const
  PBM_SETRANGE            = WM_USER+1;  // 最小値と最大値の設定
  PBM_SETPOS              = WM_USER+2;  // 現在位置の設定
  PBM_DELTAPOS            = WM_USER+3;  // 現在位置の相対設定
  PBM_SETSTEP             = WM_USER+4;  // PBM_STEPITメッセージ受信時の増分を設定
  PBM_STEPIT              = WM_USER+5;  // ステップ増分だけ現在位置を変更する
  PBM_SETRANGE32          = WM_USER+6;  // 最小値と最大値の設定（３２ビット値使用時）
  PBM_GETRANGE            = WM_USER+7;  // 最小値と最大値の取得
  PBM_GETPOS              = WM_USER+8;  // 現在位置の取得
  
  PBM_SETBARCOLOR         = WM_USER+9;  // バー色の設定
  PBM_SETBKCOLOR          = $2001;      // 背景色の設定

主なメッセージを調べよう｡

PBM_SETRANGE 
  wParam = 0; 
  lParam = MakeLong(nMinRange, nMaxRange);

表示範囲の最小値(nMinRange)と最大値(nMaxRange)を設定する｡ デフォルトは 0 から 100 である。

PBM_GETRANGE
  wParam = (WPARAM)(BOOL) fLowHigh;
  lParam = 0;

wParam にゼロ以外を設定すると最小値、ゼロを設定すると最大値が戻される｡

PBM_SETPOS 
  wParam = (WPARAM) nNewPos; 
  lParam = 0;

現在の表示位置を設定する。

PBM_GETPOS 
  wParam = 0; 
  lParam = 0;

現在位置が戻される｡ 

PBM_DELTAPOS 
  wParam = (WPARAM) nIncrement 
  lParam = 0;

現在位置から wParam の分だけ表示位置を変更する｡

PBM_SETSTEP 
  wParam = (WPARAM) nStepInc; 
  lParam = 0;

ステップ増分を設定する。デフォルトは +10 である。

PBM_STEPIT 
  wParam = 0; 
  lParam = 0;

ステップ増分だけ表示位置を変更する。

PBM_SETBARCOLOR
  wParam = 0;
  lParam = (LPARAM)(COLORREF)clrBar;

バー部分の色を設定する。デフォルトの色に設定するには

const
  CLR_DEFAULT = $FF000000;

を設定する。

PBM_SETBKCOLOR
  wParam = 0;
  lParam = (LPARAM)(COLORREF)clrBk;

背景色を設定する｡

プログレスバーには通知メッセージがない｡ 表示専用である｡ 表示位置の変更は PBM_SETPOS、PBM_STEPIT、PBM_DELTAPOS メッセージを受信したときだけなので、このメッセージを送り出すときにイベントを発生するようにコードを書くことはできる｡

ここまでの知識の使って、プログラスバーをコードで作成して試してみよう。

  1. エクスプローラを使って、新しいフォルダを 2605Progress01 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2604StaticText02 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas と CmCtrl.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで Progress01.dpr という名前で保存する｡
  5. [プロジェクト] メニューから [プロジェクトに追加...] を選んで表示されるダイアログから CmCtrl を選ぶ｡
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する。

以下に Progress01.dpr の全リストを示す。

program Progress01;

uses
  windows,
  messages,
  commctrl,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas',
  CmCtrl in 'CmCtrl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
const
  PBS_SMOOTH = 1;
  PBS_VERTICAL = 4;
  PBM_SETBARCOLOR = WM_USER+9;
  PBM_SETBKCOLOR = $2001;
  CLR_DEFAULT = $FF000000;

var
  MainWnd: TSDIMainWindow;

  hPG1,hPG2,hPG3,hPG4: HWND;
  ProgID:Integer = 1234;

  TM:TAPITimer;
  SB:TAPIStatusBar;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function CreateProgressBar(x,y,dx,dy:integer;OptionStyle:DWORD):HWND;
var
  Style:DWORD;
begin
  Style := WS_CHILD or WS_VISIBLE or OptionStyle;
  result := CreateWindowEx(WS_EX_STATICEDGE,
                            PROGRESS_CLASS,
                           'ProgressBar',
                           Style,
                           x,y,dx,dy,
                           MainWnd.Handle,
                           ProgID,
                           hInstance,
                           nil);
  Inc(ProgID);
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure OnTimer(var Msg:TMessage);
begin
  SendMessage(hPG1,PBM_STEPIT,0,0);
  SendMessage(hPG2,PBM_STEPIT,0,0);
  SendMessage(hPG3,PBM_STEPIT,0,0);
  SendMessage(hPG4,PBM_STEPIT,0,0);
  SB.Text[0] := AIntToStr(SendMessage(hPG1,PBM_GETPOS,0,0));
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  InitCommonControls;

  hPG1 := CreateProgressBar(10,10,300,20,0);
  SendMessage(hPG1,PBM_SETPOS,50,0);

  hPG2 := CreateProgressBar(10,40,300,20,0);
  SendMessage(hPG2,PBM_SETBKCOLOR,0,clrPurple);
  SendMessage(hPG2,PBM_SETBARCOLOR,0,clrYellow);
  SendMessage(hPG2,PBM_SETPOS,50,0);

  hPG3 := CreateProgressBar(10,70,300,20,WS_BORDER or PBS_SMOOTH);
  SendMessage(hPG3,PBM_SETPOS,50,0);

  hPG4 := CreateProgressBar(330,10,20,240,PBS_VERTICAL or PBS_SMOOTH);
  SendMessage(hPG4,PBM_SETBKCOLOR,0,clrTeal);
  SendMessage(hPG4,PBM_SETBARCOLOR,0,RGB(255,80,0));
  SendMessage(hPG4,PBM_SETPOS,50,0);

  TM := CreateTimer(hWindow,300,OnTimer);

  SB := CreateStatusBar(HWindow,false);

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 280;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  if TM.IsOn then TM.Off else TM.On;
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifProgress01.zip(26.320kB)
Progress01.gif

実行すると右図のように４つのプログレスバーが作られる。最初のひとつはデフォルトのプログラスバーであり、二番目のものは背景色とバーの色を変更したもの、三番目のものは枠を描画し、PBS_SMOOTH スタイルを設定したもの、四番目のものは、背景色とバーの色を変更し、PBS_VERTICAL or PBS_SMOOTH スタイルを設定したものである。Test! メニューをクリックすると Timer を On/Off できて、On のときには、PBM_STEPIT メッセージを各プログレスバーに送るとともに、その位置をスタータスバーに表示する｡

筆者の D3.1 では、以下のスタイルとメッセージが CommCtrl.pas に定義されていないので、このプログラムの冒頭で定数定義をしている。

const
  PBS_SMOOTH = 1;
  PBS_VERTICAL = 4;
  PBM_SETBARCOLOR = WM_USER+9;
  PBM_SETBKCOLOR = $2001;
  CLR_DEFAULT = $FF000000;

以上､ 本節ではプログレスバーをコードで作ってテストした｡

redball.gifこの章の目次へ戻る

２６−６ TAPIProgress クラス

前節で試したプログレスバーの機能を包み込んだ TAPIProgress クラスを TCmCtrl クラスから派生して作成し、テストしてみよう｡

  1. エクスプローラを使って、新しいフォルダを 2606Progress02 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2605Progress01 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas と CmCtrl.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで Progress02.dpr という名前で保存する｡
  5. [プロジェクト] メニューから [プロジェクトに追加...] を選んで表示されるダイアログから CmCtrl を選ぶ｡
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する。

最初に CmCtrl.pas に TAPIProgress クラスを作成しよう。最初に冒頭部分に定数定義を追加する。

  PBS_SMOOTH = 1;
  PBS_VERTICAL = 4;
  PBM_SETBARCOLOR = WM_USER+9;
  PBM_SETBKCOLOR = $2001;
  CLR_DEFAULT = $FF000000;

D3.1 より上のバージョンではこの追加は必要ないかもしれない｡ TAPIProgress の宣言部を以下にしめす。

//--------------- TAPIProgress --------------------------------------
type
TAPIProgress = class(TCmCtrl)
private
  FDim: TRect;
  FStep: integer;
  FSmooth: Boolean;
  FVertical: Boolean;
  FBarColor:COLORREF;
  FBkColor:COLORREF;
  FDrawFrame: Boolean;
  FOnChange: TNotifyMessage;
  procedure SetDimension(val: TRect);
  function GetPos: integer;
  procedure SetPos(val: integer);
  function GetRangeMin: integer;
  procedure SetRangeMin(val: integer);
  function GetRangeMax: integer;
  procedure SetRangeMax(val: integer);
  procedure SetStep(val: integer);
  procedure SetSmooth(value: Boolean);
  procedure SetVertical(value: Boolean);
  procedure SetBarColor(value:COLORREF);
  procedure SetBkColor(value:COLORREF);
  procedure SetDrawFrame(val:Boolean);
protected
  procedure CreateControl;override;
public
  constructor Create(hParent:HWND); override;
  procedure DefaultHandler(var Message);override;
  procedure StepIt;
  procedure DeltaPos(val: integer);
  property Dimension : TRect read FDim write SetDimension;
  property Pos: integer read GetPos write SetPos;
  property RangeMin: integer read GetRangeMin write SetRangeMin;
  property RangeMax: integer read GetRangeMax write SetRangeMax;
  property Step: integer read FSTep write SetStep;
  property BarColor: COLORREF read FBarColor write SetBarColor;
  property BkColor: COLORREF read FBkColor write SetBkColor;
  property Smooth: Boolean read FSmooth write SetSmooth;
  property Vertical: Boolean read FVertical write SetVertical;
  property DrawFrame:Boolean read FDrawFrame write SetDrawFrame;
  property OnChange: TNotifyMessage read FOnChange write FOnChange;
end;

function CreateProgressBar(hParent:HWND;x,y,cx,cy,cRangeMin,cRangeMax:integer;
            cVertical,cSmooth:Boolean;sOnChange:TNotifyMessage):TAPIProgress;

このクラスのメソッドやプロパティーはその名前から機能が類推できるだろう｡ 実装部を以下に示す｡

//--------------- TAPIProgress --------------------------------------
const
  PBM_EVENT = WM_USER+100;

constructor TAPIProgress.Create(hParent:HWND);
begin
  inherited Create(hParent);

  CreateControl;
  FStep := 10;
  FBarColor := CLR_DEFAULT;
  FBkColor := CLR_DEFAULT;
end;

procedure TAPIProgress.CreateControl;
var
  Style:DWORD;
begin
  Style := WS_CHILD or WS_VISIBLE;
  if FSmooth then Style := Style or PBS_SMOOTH;
  if FVertical then Style := Style or PBS_VERTICAL;
  FHandle := CreateWindowEx(WS_EX_STATICEDGE,
                            PROGRESS_CLASS,
                           'ProgressBar',
                           Style,
                           20,20,300,20,
                           Parent,
                           ID_CmCtrl,
                           hInstance,
                           nil);
  FID := ID_CmCtrl;
  inc(ID_CmCtrl);

  Dimension := SetDim(20,20,300,20);
end;

procedure TAPIProgress.DefaultHandler(var Message);
var
  AMsg:TMessage;
begin
  AMsg := TMessage(Message);

  if AMsg.LParam <> FHandle then exit; //自分を確認する

  case AMsg.Msg of

    PBM_EVENT: begin
      AMsg.Msg := UINT(self);  // sender
      if Assigned(FOnChange) then FOnCHange(AMsg);
    end;

  end;
end;

procedure TAPIProgress.StepIt;
var
  Msg: TMessage;
begin
  SendMessage(FHandle,PBM_STEPIT,0,0);
  Msg.Msg := PBM_EVENT;
  Msg.LParam := FHandle;
  Dispatch(Msg);
end;

procedure TAPIProgress.DeltaPos(val: integer);
var
  Msg: TMessage;
begin
  SendMessage(FHandle,PBM_DELTAPOS,val,0);
  Msg.Msg := PBM_EVENT;
  Msg.LParam := FHandle;
  Dispatch(Msg);
end;

function TAPIProgress.GetPos: integer;
begin
  result := SendMessage(FHandle,PBM_GETPOS,0, 0);
end;

procedure TAPIProgress.SetPos(val: integer);
var
  Msg: TMessage;
begin
  SendMessage(FHandle,PBM_SETPOS,val,0);
  Msg.Msg := PBM_EVENT;
  Msg.LParam := FHandle;
  Dispatch(Msg);
end;

procedure TAPIProgress.SetDimension(val: TRect);
begin
  FDim := val;// xPos,yPos,width,height
  MoveWindow(FHandle,val.left, val.top,val.right, val.bottom, true);
end;

function TAPIProgress.GetRangeMin: integer;
begin
  result := SendMessage(FHandle,PBM_GETRANGE,1,0);
end;

procedure TAPIProgress.SetRangeMin(val: integer);
begin
  SendMessage(FHandle,PBM_SETRANGE,0,MakeLong(val,RangeMax));
end;

function TAPIProgress.GetRangeMax: integer;
begin
  result := SendMessage(FHandle,PBM_GETRANGE,0,0);
end;

procedure TAPIProgress.SetRangeMax(val: integer);
begin
  SendMessage(FHandle,PBM_SETRANGE,0,MakeLong(RangeMin,val));
end;

procedure TAPIProgress.SetStep(val :integer);
begin
  FStep := val;
  SendMessage(FHandle,PBM_SETSTEP,val,0);
end;

procedure TAPIProgress.SetBarColor(value:COLORREF);
begin
  FBarColor := value;
  SendMessage(FHandle,PBM_SETBARCOLOR,0,value);
end;

procedure TAPIProgress.SetBkColor(value:COLORREF);
begin
  FBkColor := value;
  SendMessage(FHandle,PBM_SETBKCOLOR,0,value);
end;

procedure TAPIProgress.SetSmooth(value: Boolean);
var
  iMin,iMax,iPos:integer;
  Dim: TRect;
begin
  if FSmooth = value then exit;
  FSmooth := value;
  Dim := FDim;
  iMin := RangeMin;
  iMax := RangeMax;
  iPos := Pos;
  DestroyWindow(FHandle);
  CreateControl;
  Dimension := Dim;
  RangeMin := iMin;
  RangeMax := iMax;
  Pos := iPos;
  Step := FStep;
  BarColor := FBarColor;
  BkColor := FBkColor;
end;

procedure TAPIProgress.SetVertical(value: Boolean);
var
  iMin,iMax,iPos:integer;
  Dim: TRect;
begin
  if FVertical = value then exit;
  FVertical := value;
  Dim := FDim;
  iMin := RangeMin;
  iMax := RangeMax;
  iPos := Pos;
  DestroyWindow(FHandle);
  CreateControl;
  Dimension := Dim;
  RangeMin := iMin;
  RangeMax := iMax;
  Pos := iPos;
  Step := FStep;
  BarColor := FBarColor;
  BkColor := FBkColor;
end;

procedure TAPIProgress.SetDrawFrame(val:Boolean);
var
  Style:DWORD;
  r:TRect;
begin
  Style := GetWindowLong(FHandle,GWL_STYLE);
  if val then
    Style := Style or WS_BORDER
  else
    Style := Style and (not WS_BORDER);
  SetWindowLong(FHandle,GWL_STYLE,Style);
  GetWindowRect(FHandle,r);
  ChangeWindowSize(FHandle,0,0);
  ChangeWindowSize(FHandle,r.Right-r.Left,r.Bottom-r.Top);
  FDrawFrame := val;
end;

function CreateProgressBar(hParent:HWND;x,y,cx,cy,cRangeMin,cRangeMax:integer;
            cVertical,cSmooth:Boolean;sOnChange:TNotifyMessage):TAPIProgress;
begin
  result := TAPIProgress.Create(hParent);
  with Result do begin
    Dimension := SetDim(x,y,cx,cy);
    RangeMin := cRangeMin;
    RangeMax := cRangeMax;
    Vertical := cVertical;
    Smooth := cSmooth;
    OnChange := sOnChange;
  end;
end;

ほとんど説明の必要はないと思うが、Smooth プロパティーの設定メソッドを見てみよう｡

procedure TAPIProgress.SetSmooth(value: Boolean);
var
  iMin,iMax,iPos:integer;
  Dim: TRect;
begin
  if FSmooth = value then exit;
  FSmooth := value;
  Dim := FDim;
  iMin := RangeMin;
  iMax := RangeMax;
  iPos := Pos;
  DestroyWindow(FHandle);
  CreateControl;
  Dimension := Dim;
  RangeMin := iMin;
  RangeMax := iMax;
  Pos := iPos;
  Step := FStep;
  BarColor := FBarColor;
  BkColor := FBkColor;
end;

実は PBS_SMOOTH スタイルの設定はこのコントロールを作成するときだけ有効であるので、Smooth プロパティーの変更にともなってコントロールを作り直している。そして、各プロパティーの値を反映させている訳である。同様に、PBS_VERTICAL スタイルについてもウィンドウコントロールを作成し直している｡

TAPIProgress クラスをテストするプログラムを Progress02.dpr につくろう。 以下に全リストを示す｡

program Progress02;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas',
  CmCtrl in 'CmCtrl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  PG1,PG2,PG3,PG4: TAPIProgress;
  SB: TAPIStatusBar;
  TM:TAPITimer;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure OnTimer(var Msg:TMessage);
begin
  PG1.StepIt;
  PG2.StepIt;
  PG3.StepIt;
  PG4.StepIt;
end;

procedure PG1Change(var Msg:TMessage);
begin
  SB.Text[0] := AIntToStr(PG1.Pos);
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  SB := CreateStatusBar(HWindow,false);

  PG1 := CreateProgressBar(hWindow,10,10,300,20,0,200,false,false,PG1Change);
  PG1.Pos := 50;

  PG2 := CreateProgressbar(hWindow,10,40,300,20,0,200,false,false,nil);
  PG2.Pos := 50;
  PG2.BarColor := clrYellow;
  PG2.BkColor := clrPurple;

  PG3 := CreateProgressBar(hWindow,10,70,300,20,0,200,false,true,nil);
  PG3.Pos := 50;
  PG3.DrawFrame := true;

  PG4 := CreateProgressBar(hWindow,330,10,20,240,0,200,true,true,nil);
  PG4.Pos := 50;
  PG4.BarColor := RGB(255,80,0);
  PG4.BkColor := clrTeal;

  TM := CreateTimer(hWindow,300,OnTimer);

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 280;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  if TM.IsOn then TM.Off else TM.On;
end;

procedure MainCommand(var Msg: TMessage);
begin
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
    OnCommand := MainCommand;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifProgress02.zip(26.998kB)
Progress02.gif

実行すると右図のようになり、前節のプログラムと同じように動作する｡

redball.gifこの章の目次へ戻る

２６−７ Colors2 プログラム

この節では、本章であつかったトラックバー、スタティックテキスト、プログレスバーを組み合わせて、１４−６ Colors プログラム と同様の色入力用の小さなアプリケーションを作ろう｡

  1. エクスプローラを使って、新しいフォルダを 2607Colors2 という名前でつくる。
  2. 作ったフォルダに、エクスプローラを使って 2606Progress02 フォルダの Skeleton03.dpr と UtilFunc.pas と GDIObject.pas と UtilClass.pas と APIControl.pas と APIWindow.pas と CmCtrl.pas をコピーする｡
  3. コピーした Skeleton03.dpr をダブルクリックして Delphi を立ち上げる｡
  4. コードエディタに Skeleton03.dpr のコードがあることを確認してから、[ファイル]メニューから[プロジェクトに名前を付けて保存]を選んで Colors2.dpr という名前で保存する｡
  5. [プロジェクト] メニューから [プロジェクトに追加...] を選んで表示されるダイアログから CmCtrl を選ぶ｡
  6. コードエディタで以下のように編集する｡
  7. [F.9]でコンパイルして実行する。

以下に Colors2.dpr の全リストを示す｡

program Colors2;

uses
  windows,
  messages,
  UtilFunc in 'UtilFunc.pas',
  UtilClass in 'UtilClass.pas',
  GDIObject in 'GDIObject.pas',
  APIWindow in 'APIWindow.pas',
  APIControl in 'APIControl.pas',
  CmCtrl in 'CmCtrl.pas';

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  MainWnd: TSDIMainWindow;

  PG1,PG2,PG3: TAPIProgress;
  TR1,TR2,TR3: TAPITrackBar;
  ST1,ST2,ST3: TAPIStaticText;

  L1: TAPILabel;
  Btn1,Btn2,Btn3: TAPISpeedBtn;
  Ed1,Ed2,Ed3: TAPIEdit;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure DisplayColor;
var
  r,g,b: integer;
begin
  r := TR1.ThumbPos;
  g := TR2.ThumbPos;
  b := TR3.ThumbPos;
  L1.Color := RGB(r,g,b);
  Ed1.Text := 'RGB('+AIntToStr(r)+','+AIntToStr(g)+','+AIntToStr(b)+')';
  Ed2.Text := '$'+AIntToHex(b,2)+AIntToHex(g,2)+AIntToHex(r,2);
  Ed3.Text := '#'+AIntToHex(r,2)+AIntToHex(g,2)+AIntToHex(b,2);
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure TR1Change(var Msg:TMessage);
begin
  PG1.Pos := TR1.ThumbPos;
  ST1.Text := AIntToStr(TR1.ThumbPos);
  DisplayColor;
end;

procedure TR2Change(var Msg:TMessage);
begin
  PG2.Pos := TR2.ThumbPos;
  ST2.Text := AIntToStr(TR2.ThumbPos);
  DisplayColor;
end;

procedure TR3Change(var Msg:TMessage);
begin
  PG3.Pos := TR3.ThumbPos;
  ST3.Text := AIntToStr(TR3.ThumbPos);
  DisplayColor;
end;

procedure Btn1Click(var Msg:TMessage);
begin
  Ed1.SelectAll;
  Ed1.Copy;
end;

procedure Btn2Click(var Msg:TMessage);
begin
  Ed2.SelectAll;
  Ed2.Copy;
end;

procedure Btn3Click(var Msg:TMessage);
begin
  Ed3.SelectAll;
  Ed3.Copy;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
  r, TRd:Trect;
begin
  hWindow := MainWnd.Handle;

  TR1 := CreateTrackBar(hWindow,false,10,10,330,35,0,255,20,TR1Change);

  PG1 := CreateProgressBar(hWindow,0,0,0,0,0,255,false,true,nil);
  TRd := TR1.Dimension;
  r := TR1.ChannelRect;
  PG1.Dimension := SetDim(TRd.Left+r.Left,47,r.Right-r.Left,15);
  PG1.BarColor := clrRed;

  ST1 := CreateStaticText(hWindow,10,10,45,25,nil);
  ST1.Text := '0';
  ST1.SunkenBorder := true;
  ST1.TextAlign := taCenter;
  ST1.BkColor := clrRed;
  ST1.TextColor := clrWhite;
  TR1.SetBuddy(ST1.Handle,RightOrBelow);

  TR2 := CreateTrackBar(hWindow,false,10,70,330,35,0,255,20,TR2Change);

  PG2 := CreateProgressBar(hWindow,0,0,0,0,0,255,false,true,nil);
  TRd := TR2.Dimension;
  r := TR2.ChannelRect;
  PG2.Dimension := SetDim(TRd.Left+r.Left,107,r.Right-r.Left,15);
  PG2.BarColor := clrGreen;

  ST2 := CreateStaticText(hWindow,10,10,45,25,nil);
  ST2.Text := '0';
  ST2.SunkenBorder := true;
  ST2.TextAlign := taCenter;
  ST2.BkColor := clrGreen;
  ST2.TextColor := clrWhite;
  TR2.SetBuddy(ST2.Handle,RightOrBelow);

  TR3 := CreateTrackBar(hWindow,false,10,130,330,35,0,255,20,TR3Change);

  PG3 := CreateProgressBar(hWindow,0,0,0,0,0,255,false,true,nil);
  TRd := TR3.Dimension;
  r := TR3.ChannelRect;
  PG3.Dimension := SetDim(TRd.Left+r.Left,167,r.Right-r.Left,15);
  PG3.BarColor := clrBlue;

  ST3 := CreateStaticText(hWindow,10,10,45,25,nil);
  ST3.Text := '0';
  ST3.SunkenBorder := true;
  ST3.TextAlign := taCenter;
  ST3.BkColor := clrBlue;
  ST3.TextColor := clrWhite;
  TR3.SetBuddy(ST3.Handle,RightOrBelow);

  L1 := CreateLabel(hWindow,10,190,150,150,'');
  L1.Color := clrBlack;
  L1.DrawFrame := true;

  Ed1 := CreateEdit(hWindow,170,210,150,30,'RGB(0,0,0)',nil);
  Ed2 := CreateEdit(hWindow,170,250,150,30,'$000000',nil);
  Ed3 := CreateEdit(hWindow,170,290,150,30,'#000000',nil);

  Btn1 := CreateSpeedBtn(hWindow,330,210,80,30,'Copy',Btn1Click);
  Btn2 := CreateSpeedBtn(hWindow,330,250,80,30,'Copy',Btn2Click);
  Btn3 := CreateSpeedBtn(hWindow,330,290,80,30,'Copy',Btn3Click);

  with MainWnd do begin
    ClientWidth := 420;
    ClientHeight := 350;
    Center;
  end;
end;

procedure MainDestroy(var Msg: TMessage);
begin
  PostQuitMessage(0);
end;

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
begin

  MainWnd := TSDIMainWindow.Create(0,GetExeName);
  with MainWnd do begin
    OnCreate := MainCreate;
    OnDestroy := MainDestroy;
  end;
  MainWnd.DoCreate;

  Halt(MessageLoopNormal);

end.

DownloadExe.gifColors2.zip(30.909kB)
Colors2.gif

実行すると右図のようにになる。前作と同様に、三つのエディットに、それぞれ RGB( )関数と COLORREF 型と ＨＴＭＬの色指定方式のテキスト表示があり、その横のスピードボタンを押すとクリップボード経由でコードエディタなどに貼り付けることができる｡ 三つのスタティックテキストは、トラックバーの SetBuddy( ) メソッドにより、右側に配置されている。

redball.gifこの章の目次へ戻る

２６−８ まとめ

本章では、比較的小規模なコモンコントロールであるトラックバーとプログレスバーについて調べた｡ トラックバーにバディーウィンドウを設置する話題に関連して、標準コントロールであるスタティックのテキスト表示機能の部分だけを調べて、ラッパークラスを作成した。

redball.gifこの章の目次へ戻る

ここまでのプログラムファイル

  1. Skeleton03.dpr (2 kB)
  2. UtilFunc.pas (19 kB)
  3. UtilClass.pas (74 kB)
  4. GDIObject.pas (21 kB)
  5. APIControl.pas (69 kB)
  6. APIWindow.pas (35 kB)
  7. CmCtrl.pas (27 kB)


redball.gifこの章の目次へ戻る