第２０章 コントロールグループ

Delphi のコンポーネントパレットの Standard ページのうち、本稿でこれまでに扱ってこなかったのは TMainMenu ､ TPopupMenu と TRadioGroup である｡ メニュー関連のクラスについては、次章で調べることにしているので、本章では､ 親ウィンドウの任意の矩形領域を格子状に区切り、複数のコントロールを作成して配置し、メッセージを一括して処理することを考えることにしよう｡ このようなグループ化は、ラジオボタンだけではなく、プッシュボタンやチェックボックスについても行う｡ グループ化すると、複数のコントロールを配置する視覚上の効果の他に、簡単に多数のコントロールのインスタンスを作る事ができること、メッセージ処理を一元化できることなどメリットは大きい｡

２０−０ この章の内容

第２０章 コントロールグループ
２０−１ ボタングループをコードでつくる
２０−２ プッシュボタングループクラス
２０−３ チェックグループクラス
２０−４ ラジオグループクラス
２０−５ まとめ


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

２０−１ ボタングループをコードでつくる

本稿のようなコードベースのプログラミングでは、プッシュボタンを五個作るときでも、作成関数を五回、メッセージハンドラを五個書かなければならない｡ また、ウィンドウに整列配置するためにも、頭の中で配置座標を暗算で計算しなければならない｡ もし、ボタングループのようなコントロールがあれば、インスタンスを作って、ボタンの個数を指定し、メッセージハンドラを一つ作るだけで良いことになるだろう｡ 複数のボタンの配置は、クラスがプロパティーを参照して自動的に行ってくれる｡ すでに、第１１章 パネルとアレンジャー では、グリッドアレンジャーとボーダーアレンジャーを作成して、パネルやコントロールの配置を自動化した｡ このアレンジャークラスは、もっぱら親ウィンドウの WM_SIZE メッセージを捕まえて配置を自動化していた｡ ここでは、クライアント領域の任意の矩形領域を縦に区切って複数のプッシュボタンを作成して配置し、これらのボタンが発行する WM_COMMAND メッセージを一括して処理することを試みる｡ それでは早速コードを書いてみよう｡

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

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

program BtnGroup01;

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;

  Dimension : TRect;
  Interval:integer;
  Handles:TIntegerList;
  ID_GROUPBTN: integer = 10000;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function CreateBtn:HWND;
begin
  result := CreateWindow('BUTTON',
                         'GroupBtn',
                         WS_CHILD or WS_VISIBLE or
                         BS_PUSHBUTTON,
                         0,0,0,0,
                         MainWnd.Handle,
                         ID_GROUPBTN,
                         hInstance,nil);
  inc(ID_GROUPBTN);
end;

procedure ArrangeBtn;
var
  i: integer;
  x,y,w,h: integer;
begin
  if Handles.Count = 0 then exit;
  x := Dimension.Left;
  w := Dimension.Right;
  h := (Dimension.Bottom - Interval*(Handles.Count-1)) div Handles.Count;
  for i := 0 to Handles.Count-1 do begin
    y := Dimension.Top + (h+Interval)*i;
    MoveWindow(Handles[i],x,y,w,h,true);
  end;
end;

procedure SetCaptions(indx:integer;cp:string);
begin
  if (indx > -1) and (indx < Handles.Count) then
    SetWindowText(Handles[indx],PChar(cp));
end;

procedure AddBtn;
begin
  Handles.Add(CreateBtn);
  ArrangeBtn;
end;

procedure RemoveBtn;
var
  FH: TIntegerList;
  i:integer;
begin
  FH := TIntegerList.Create(0,10);
  for i := 0 to Handles.Count-2 do FH.Add(Handles[i]);
  DestroyWindow(Handles[Handles.Count-1]);
  FH.CopyTo(Handles);
  FH.Free;
end;
//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure BtnCommand(Msg:TMessage);
var
  BtnNo:integer;
begin
  if (Msg.WParamHi = BN_CLICKED) then begin
    BtnNo := Handles.Search(Msg.LParam);
    case BtnNo of
      0:begin
        Dimension.Left := Dimension.Left +10;
        ArrangeBtn;
      end;
      1:begin
        Dimension.Top := Dimension.Top +10;
        ArrangeBtn;
      end;
      2:begin
        Dimension.Right := Dimension.Right +10;
        ArrangeBtn;
      end;
      3:begin
        Dimension.Bottom := Dimension.Bottom +10;
        ArrangeBtn;
      end;
      4:begin
        AddBtn;
        SetCaptions(Handles.Count-1,'Added Btn');
        ArrangeBtn;
      end;
      5:begin
        RemoveBtn;
        ArrangeBtn;
      end;
    end;
  end;
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  Dimension := SetDim(100,10,120,200);
  Interval := 2;
  Handles := TIntegerList.Create(0,10);

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

procedure OnTest(hWindow: HWND);
var
  i:integer;
begin
  for i := 0 to 5 do
    Handles.Add(CreateBtn);
  SetCaptions(0,'Move X');
  SetCaptions(1,'Move Y');
  SetCaptions(2,'Inc W');
  SetCaptions(3,'Inc H');
  SetCaptions(4,'Add a Btn');
  SetCaptions(5,'Remove a Btn');
  ArrangeBtn;
end;

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

procedure MainDestroy(var Msg: TMessage);
begin
  Handles.Free;
  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.gifBtnGroup01.zip(13.266kB)
BtnGroup01.gif

実行して､ Test! メニューをクリックすると右図のように６個のボタンが作られる。一番上の 'Move X' のボタンを押すと左に１０ピクセル、'Move Y' ボタンでは下に１０ピクセル移動する。'Inc W' では幅が、'Inc H' では高さが１０ピクセル増加する。'Add a Btn' ではボタンが一つ追加され、'Remove a Btn' ではボタンが一つ削除される。

コードを見てみよう｡ グローバル変数として以下のものが宣言されている｡

  Dimension : TRect;
  Interval:integer;
  Handles:TIntegerList;
  ID_GROUPBTN: integer = 10000;

このうち、Dimension はボタングループ全体が占める矩形領域を、左上の点の座標(Left,Top)と幅と高さ(Right,Bottom)で保持する TRect 型の変数である｡ Interval は、配置されるボタンの間隔を保持する｡ TIntegerList 型の Handles は、作成されたボタンのハンドルを保持する。その Count プロパティーから個数が分かる｡ ID_GROUPBTN は、作成されるボタンのコントロールＩＤの初期値である｡ これらの値は､ MainCreate( ) ハンドラで初期化される。

  Dimension := SetDim(100,10,120,200);
  Interval := 2;
  Handles := TIntegerList.Create(0,10);

実際にボタンを作っている OnTest( ) ハンドラを見てみよう｡ 

procedure OnTest(hWindow: HWND);
var
  i:integer;
begin
  for i := 0 to 5 do
    Handles.Add(CreateBtn);
  SetCaptions(0,'Move X');
  SetCaptions(1,'Move Y');
  SetCaptions(2,'Inc W');
  SetCaptions(3,'Inc H');
  SetCaptions(4,'Add a Btn');
  SetCaptions(5,'Remove a Btn');
  ArrangeBtn;
end;

ここでは、CreateBtn 手続きでボタンを作りそのハンドルを Handles に格納している｡ そして、キャプションを設定し、実際にボタンを配置している｡ CreateBtn 手続きを見てみよう｡

function CreateBtn:HWND;
begin
  result := CreateWindow('BUTTON',
                         'GroupBtn',
                         WS_CHILD or WS_VISIBLE or
                         BS_PUSHBUTTON,
                         0,0,0,0,
                         MainWnd.Handle,
                         ID_GROUPBTN,
                         hInstance,nil);
  inc(ID_GROUPBTN);
end;

ここでは、６−１ ボタンコントロールを使ってみる 節と同じ方法でボタンを CreateWindow( ) ＡＰＩで作っている｡ TAPIButton クラスも使用できるが、メッセージを一括処理したいのでここでは、裸のボタンコントロールを作成している｡ キャプションを設定する SetCaption( ) 手続きは、SetWindowText( ) ＡＰＩ を使っているだけだ。作ったボタンを配置する ArrangeBtn 手続きを見てみよう｡

procedure ArrangeBtn;
var
  i: integer;
  x,y,w,h: integer;
begin
  if Handles.Count = 0 then exit;
  x := Dimension.Left;
  w := Dimension.Right;
  h := (Dimension.Bottom - Interval*(Handles.Count-1)) div Handles.Count;
  for i := 0 to Handles.Count-1 do begin
    y := Dimension.Top + (h+Interval)*i;
    MoveWindow(Handles[i],x,y,w,h,true);
  end;
end;

ここでは、Dimension と Interval と Handles.Count を参照して矩形領域を縦に格子状に区切り MoveWindow( ) ＡＰＩを使ってボタンを配置している｡

  function MoveWindow(hWnd: HWND; 
                      X, Y, 
           nWidth, nHeight: Integer;  
                  bRepaint: BOOL): BOOL; stdcall;

この関数は、左上の点の座標と幅と高さを指定して、ウィンドウを移動する。bRepaint に true を指定すると移動後に再描画する。これで、ボタングループができあがる｡ ボタンが押されると 第６章 で示したように､親ウィンドウに WM_COMMAND が発行される｡ ここでは、MainCommand( ) ハンドラから BtnCommand( ) にこのメッセージを転送してもらっている。

procedure BtnCommand(Msg:TMessage);
var
  BtnNo:integer;
begin
  if (Msg.WParamHi = BN_CLICKED) then begin
    BtnNo := Handles.Search(Msg.LParam);
    case BtnNo of
      0:begin
        Dimension.Left := Dimension.Left +10;
        ArrangeBtn;
      end;
      1:begin
        Dimension.Top := Dimension.Top +10;
        ArrangeBtn;
      end;
      2:begin
        Dimension.Right := Dimension.Right +10;
        ArrangeBtn;
      end;
      3:begin
        Dimension.Bottom := Dimension.Bottom +10;
        ArrangeBtn;
      end;
      4:begin
        AddBtn;
        SetCaptions(Handles.Count-1,'Added Btn');
        ArrangeBtn;
      end;
      5:begin
        RemoveBtn;
        ArrangeBtn;
      end;
    end;
  end;
end;

このように、Msg.LParam には、このメッセージを生成したボタンのウィンドウハンドルが設定されているので､ Handles の Search( ) メソッドをつかって何番目のボタンであるかすぐに分かる。このようにして６個のボタンすべてのメッセージをこのハンドラで処理できる。

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

２０−２ プッシュボタングループクラス

前節のコードで示した、ウィンドウの任意のクライアント領域の矩形領域を格子状に区切ってプッシュボタンを作って配置し、メッセージを一括処理するクラスを作成しよう。これは、単に前節のコードをクラスにまとめれば良いのですぐに作ることができるが、その前に、次節以降でチェックボックスやラジオボタンもグループ化したいので､ これらのコントロールをグループ化するだけのクラスを作り、それから派生して、実際にコントロールグループのクラスを作成しよう｡ このシナリオにしたがって、この節では､ TControlGroup クラスを作成し、これから派生して TBtnGroup クラスを作成しよう｡ 前節のコードでは、WM_COMMAND メッセージを MainCreate( ) から転送してもらっていたが､ このメッセージを自前で捕まえるために、TControlGroup は TSubClass から派生することにしよう｡ そうすると、WM_COMMAND は Dispatcher から自動的に送られ、パスカルオブジェクトは親の廃棄のタイミングで自動的に削除される｡

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

最初に UtilClass.pas に TControlGroup と TBtnGroup クラスを作成しよう｡ 宣言部を以下に示す｡

//------------------  TControlGroup ---------------------------------------
TControlGroup = class(TSubClass)
private
  FVertical: Boolean;
  FDim: TRect;
  FCtrlCount: integer;
  FHandles: TIntegerList;
  FInterval: integer;
  FFontHandle: HFONT;
  procedure SetVertical(value:Boolean);
  procedure SetInterval(value:integer);
  procedure SetCtrlCount(count: integer);virtual;
  function GetHandles(i:integer):HWND;
  procedure SetDimension(value: TRect);
  function GetXPos: integer;
  procedure SetXPos(value: integer);
  function GetYPos: integer;
  procedure SetYPos(value: integer);
  function GetWidth: integer;
  procedure SetWidth(value: integer);
  function GetHeight: integer;
  procedure SetHeight(value: integer);
  function GetEnable: Boolean;
  procedure SetEnable(value:Boolean);
  function GetVisible: Boolean;
  procedure SetVisible(value: Boolean);
  procedure SetFontHandle(fth:HFONT);
protected
  function CreateCtrl:HWND;virtual;
  procedure ArrangeCtrl;virtual;
public
  constructor Create(hParent: HWND); override;
  destructor Destroy; override;
  property Vertical: Boolean read FVertical write SetVertical;
  property Dimension : TRect read FDim write SetDimension;
  property Interval:integer read FInterval write SetInterval;
  property CtrlCount: integer read FCtrlCount write SetCtrlCount;
  property Handles[i:integer]:HWND read GetHandles;
  property XPos: integer read GetXPos write SetXPos;
  property YPos: integer read GetYPos write SetYPos;
  property Width: integer read GetWidth write SetWidth;
  property Height: integer read GetHeight write SetHeight;
  property Enable: Boolean read GetEnable write SetEnable;
  property Visible: Boolean read GetVisible write SetVisible;
  property FontHandle: HFONT read FFontHandle write SetFontHandle;
end;

//------------------ TBtnGroup ------------------------------------
TBtnGroup = class(TControlGroup)
private
  FOnClick: TNotifyMessage;
  function GetCaptions(indx:integer):string;
  procedure SetCaptions(indx:integer;cp:string);
protected
  function CreateCtrl:HWND;override;
public
  procedure DefaultHandler(var AMessage); override;
  property Captions[i:integer]:string read GetCaptions write SetCaptions;
  property OnClick: TNotifyMessage read FOnClick write FOnClick;
end;

TControlGroup クラスでは、矩形領域を保持する Dimension プロパティーと、その個別のプロパティーとして XPos、YPos、Width、Height をもっている。Handles と Interval プロパティーは前節のコードと同じである｡ Verical はデフォルトで true であり、矩形領域に縦にコントロールが配置される｡ false にすると横に並んで配置される｡ TBtnGroup クラスでは、メッセージを受け取る DefaultHandler( ) とキャプションとイベント OnClick が追加されている｡ CreateCtrl メソッドをオーバーライドして実際にプッシュボタンコントロールを作成する｡ 実装部を以下に示す｡

 //------------------  TControlGroup ---------------------------------------
var
  ID_GROUPCTRL: integer = 10000;

constructor TControlGroup.Create(hParent: HWND);
begin
  inherited Create(hParent);
  Dispatcher.TrapMessage(WM_COMMAND,self);

  FVertical := true;
  FCtrlCount := 0;
  FInterval := 2;
  FHandles := TIntegerList.Create(0,10);
end;

destructor TControlGroup.Destroy;
begin
  CtrlCount := 0;
  FHandles.Free;
  inherited Destroy;
end;

function TControlGroup.CreateCtrl:HWND;
begin
  result := 0;
end;

procedure TControlGroup.ArrangeCtrl;
var
  i: integer;
  x,y,w,h: integer;
begin
  if FCtrlCount = 0 then exit;
  if FVertical then begin
    x := FDim.Left;
    w := FDim.Right;
    h := (FDim.Bottom - FInterval*(FCtrlCount-1)) div FCtrlCount;
    for i := 0 to FCtrlCount-1 do begin
      y := FDim.Top + (h+FInterval)*i;
      MoveWindow(FHandles[i],x,y,w,h,true);
    end;
  end else begin
    y := FDim.Top;
    h := FDim.Bottom;
    w := (FDim.Right - FInterval*(FCtrlCount-1)) div FCtrlCount;
    for i := 0 to FCtrlCount-1 do begin
      x := FDim.Left + (w+FInterval)*i;
      MoveWindow(FHandles[i],x,y,w,h,true);
    end;
  end;
end;

procedure TControlGroup.SetVertical(value:Boolean);
begin
  FVertical := value;
  ArrangeCtrl;
end;

procedure TControlGroup.SetInterval(value:integer);
begin
  FInterval := value;
  ArrangeCtrl;
end;

procedure TControlGroup.SetCtrlCount(count: integer);
var
  i:integer;
  FH: TIntegerList;
begin
  if count = FCtrlCount then exit;
  if count > FCtrlCount then begin
    for i := 1 to count-FCtrlCount do FHandles.Add(CreateCtrl);
    FCtrlCount := count;
    ArrangeCtrl;
  end else
    if count > 0 then begin
      FH := TIntegerList.Create(0,10);
      for i := 0 to count-1 do FH.Add(FHandles[i]);
      for i := count to CtrlCount-1 do DestroyWindow(FHandles[i]);
      FH.CopyTo(FHandles);
      FH.Free;
      FCtrlCount := count;
      ArrangeCtrl;
    end else begin // count = 0 or minus
      for i := 0 to FCtrlCount-1 do DestroyWindow(FHandles[i]);
      FHandles.Clear;
      FCtrlCount := 0;
    end;
end;

function TControlGroup.GetHandles(i:integer):HWND;
begin
  if i > FHandles.Count-1 then
    result := 0
  else
    result := FHandles[i];
end;

procedure TControlGroup.SetDimension(value: TRect);
begin
  FDim := value;
  ArrangeCtrl;
end;

function TControlGroup.GetXPos: integer;
begin
  result := FDim.Left;
end;

procedure TControlGroup.SetXPos(value: integer);
begin
  FDim.Left := value;
  ArrangeCtrl;
end;

function TControlGroup.GetYPos: integer;
begin
  result := FDim.Top;
end;

procedure TControlGroup.SetYPos(value: integer);
begin
  FDim.Top := value;
  ArrangeCtrl;
end;

function TControlGroup.GetWidth: integer;
begin
  result := FDim.Right;
end;

procedure TControlGroup.SetWidth(value: integer);
begin
  FDim.Right := value;
  ArrangeCtrl;
end;

function TControlGroup.GetHeight: integer;
begin
  result := FDim.Bottom;
end;

procedure TControlGroup.SetHeight(value: integer);
begin
  FDim.Bottom := value;
  ArrangeCtrl;
end;

function TControlGroup.GetEnable: Boolean;
begin
  result := Boolean(IsWindowEnabled(FHandles[0]));
end;

procedure TControlGroup.SetEnable(value:Boolean);
var
  i:integer;
begin
  for i := 0 to FCtrlCount-1 do EnableWindow(FHandles[i],value);
end;

function TControlGroup.GetVisible: Boolean;
begin
  result := Boolean(IsWindowVisible(FHandles[0]));
end;

procedure TControlGroup.SetVisible(value: Boolean);
var
  i:integer;
begin
  if value then
    for i := 0 to FCtrlCount-1 do ShowWindow(FHandles[i],SW_SHOWNORMAL)
  else
    for i := 0 to FCtrlCount-1 do ShowWindow(FHandles[i],SW_HIDE);
end;

procedure TControlGroup.SetFontHandle(fth:HFONT);
var
  i:integer;
begin
  FFontHandle := fth;
  if FCtrlCount > 0  then
    for i := 0 to FCtrlCount-1 do

      SendMessage(FHandles[i],WM_SETFONT,fth,1);
end;

//------------------ TBtnGroup ------------------------------------
procedure TBtnGroup.DefaultHandler(var AMessage);
var
  AMsg:TMessage;
  BtnNo:integer;
begin
  AMsg := TMessage(AMessage);
  case AMsg.Msg of
    WM_COMMAND:
      if (AMsg.WParamHi = BN_CLICKED) then begin
        BtnNo := FHandles.Search(AMsg.LParam);
        if BtnNo <> -1 then
           if Assigned(FOnClick) then begin
             AMsg.Msg := UINT(self); // Sender
             AMsg.WParam := BtnNo;
             OnClick(AMsg);
           end;
      end;
  end; // case
end;

function TBtnGroup.CreateCtrl:HWND;
begin
  result := CreateWindow('BUTTON',
                         'GroupBtn',
                         WS_CHILD or WS_VISIBLE or
                         BS_PUSHBUTTON,
                         0,0,100,30,
                         Parent,
                         ID_GROUPCTRL,
                         hInstance,nil);

  if FFontHandle <> 0 then
    SendMessage(result,WM_SETFONT,FFontHandle,1);
  inc(ID_GROUPCTRL);
end;

function TBtnGroup.GetCaptions(indx:integer):string;
var
  s: string;
begin
  if (indx > -1) and (indx < FCtrlCount) then begin
    SetLength(s,50);
    SetString(result,PChar(s),GetWindowText(FHandles[indx],PChar(s),50));
  end else
    result := 'No Index';
end;

procedure TBtnGroup.SetCaptions(indx:integer;cp:string);
begin
  if (indx > -1) and (indx < FCtrlCount) then
    SetWindowText(FHandles[indx],PChar(cp));
end;

TControlGroup のコンストラクタでは、WM_COMMAND メッセージを送ってくれるよう Dispatcher に依頼している｡ 実際にコントロールを作成しているのは、個数を設定する SetCtrlCount( ) アクセスメソッドで CreateCtrl メソッドを呼び出して作成している。したがって、個数を指定して動的にコントロールの個数を変更できる｡ TBtnGroup クラスの DefaultHandler( ) では WM_COMMAND を処理して、何番目のボタンが押されたかを WParam に設定して OnClick イベントを呼び出している｡ これでクラスが完成したので、このクラスの作成関数を作ろう｡ 宣言部を示す｡

function CreateBtnGroup(hParent:HWND;Vert:Boolean; x,y,cx,cy: integer;
               Btns:integer;sOnClick:TNotifyMessage): TBtnGroup;

実装部を以下に示す｡

function CreateBtnGroup(hParent:HWND;Vert:Boolean; x,y,cx,cy: integer;
               Btns:integer;sOnClick:TNotifyMessage): TBtnGroup;
begin
  result := TBtnGroup.Create(hParent);
  with result do begin
    FVertical := Vert;
    FDim := SetDim(x,y,cx,cy);
    OnClick := sOnClick;
    CtrlCount := Btns;
  end;
end;

それでは、BtnGroup02.dpr にこのクラスをテストするプログラムを書こう｡ 以下に全リストを示す｡

program BtnGroup02;

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;

  BG1,BG2: TBtnGroup;

  ft: TAPICFont;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure BG1Click(var Msg: TMessage);
begin
  case Msg.WParam of
    0: BG1.XPos := BG1.XPos + 10;
    1: BG1.YPos := BG1.YPos + 10;
    2: BG1.Width := BG1.Width + 10;
    3: BG1.Height := BG1.Height + 10;
    4: BG1.Interval := BG1.Interval + 2;
    5: BG1.CtrlCount := BG1.CtrlCount + 1;
    6: BG1.CtrlCount := BG1.CtrlCount - 1;
    7: BG1.FontHandle := ft.Handle;
    8: BG1.Free;
  end;
end;

procedure BG2Click(var Msg: TMessage);
begin
  case Msg.WParam of
    0: MainWnd.Color := clrBtnFace;
    1: MainWnd.Color := clrRed;
    2: MainWnd.Color := clrGreen;
    3: MainWnd.Color := clrBlue;
  end;
end;

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

  BG1 := CreateBtnGroup(hWindow,true,10,50,150,300,9,BG1Click);
  BG1.Captions[0] := 'Change XPos';
  BG1.Captions[1] := 'Change YPos';
  BG1.Captions[2] := 'Change Width';
  BG1.Captions[3] := 'Change Height';
  BG1.Captions[4] := 'Change Interval';
  BG1.Captions[5] := 'Add a Button';
  BG1.Captions[6] := 'Remove a Button';
  BG1.Captions[7] := 'SetFont';
  BG1.Captions[8] := 'SelfDestroy';

  BG2 := CreateBtnGroup(hWindow,false,10,5,350,30,4,BG2Click);
  BG2.Captions[0] := 'BtnFace';
  BG2.Captions[1] := 'Red';
  BG2.Captions[2] := 'Green';
  BG2.Captions[3] := 'Blue';

  ft := TAPICFont.Create;
  with ft do begin
    Name := 'ＭＳ Ｐ明朝';
    Size := 11;
    GetHandle;
  end;

  with MainWnd do begin
    ClientWidth := 400;
    ClientHeight := 450;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  BG1.Enable := not BG1.Enable;
  BG2.Visible := not BG2.Visible;
end;

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

procedure MainDestroy(var Msg: TMessage);
begin
  ft.free;
  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.gifBtnGroup02.zip(15.537kB)
BtnGroup02.gif

実行して､ 'SetFont' ボタンを押したときの様子を右図に示す｡ 縦配置の BG1 では、キャプション通りの動作を確認できるだろう｡ 横配置の BG2 では、ウィンドウの背景色を変更している｡ Test! では、BG1 の有効性と BG2 の可視性を反転している。この例のように、多数のボタンを簡単に作成でき、メッセージを一括処理できることは、特にコードベースのプログラミングでは非常にありがたい事である｡

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

２０−３ チェックグループクラス

この節では、チェックボックスグループのクラス TCheckGroup を TControlGroup から派生して作成しよう｡ チェックボックスは、プッシュボタンと同じく OnClick イベントを発生するが、チェック状態の有無を保持している事だけがプッシュボタンとの相違点である｡ そこで、チェック状態を取得・設定するプロパティー Checked が追加されることだけが前節との違いである｡ それでは早速 TCheckGroup クラスを作成しよう｡

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

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

//------------------ TCheckGroup ------------------------------------
TCheckGroup = class(TControlGroup)
private
  FOnClick: TNotifyMessage;
  function GetChecked(indx:integer):Boolean;
  procedure SetChecked(indx:integer;value:Boolean);
  function GetCaptions(indx:integer):string;
  procedure SetCaptions(indx:integer;cp:string);
protected
  function CreateCtrl:HWND;override;
public
  procedure DefaultHandler(var AMessage); override;
  property Checked[i:integer]:Boolean read GetChecked write SetChecked;
  property Captions[i:integer]:string read GetCaptions write SetCaptions;
  property OnClick: TNotifyMessage read FOnClick write FOnClick;
end;

ここでは、先述のように TBtnGroup クラスに Checked プロパティーが加わっているだけである｡ 実装部を以下に示す｡

//------------------ TCheckGroup ------------------------------------
procedure TCheckGroup.DefaultHandler(var AMessage);
var
  AMsg:TMessage;
  BtnNo:integer;
begin
  AMsg := TMessage(AMessage);
  case AMsg.Msg of
    WM_COMMAND:
      if (AMsg.WParamHi = BN_CLICKED) then begin
        BtnNo := FHandles.Search(AMsg.LParam);
        if BtnNo <> -1 then
           if Assigned(FOnClick) then begin
             AMsg.Msg := UINT(self); // Sender
             AMsg.WParam := BtnNo;
             OnClick(AMsg);
           end;
      end;
  end; // case
end;

function TCheckGroup.CreateCtrl:HWND;
begin
  result := CreateWindow('BUTTON',
                         'GroupCheck',
                         WS_CHILD or WS_VISIBLE or
                         BS_AUTOCHECKBOX,
                         0,0,100,30,
                         Parent,
                         ID_GROUPCTRL,
                         hInstance,nil);
  if FFontHandle <> 0 then
    SendMessage(result,WM_SETFONT,FFontHandle,1);
  inc(ID_GROUPCTRL);
end;

function TCheckGroup.GetChecked(indx:integer):Boolean;
begin
  if (indx > -1) and (indx < FCtrlCount) then
    result := Boolean(SendMessage(FHandles[indx],BM_GETCHECK,0,0)=1)
  else
    result := false;
end;

procedure TCheckGroup.SetChecked(indx:integer;value:Boolean);
begin
  if (indx > -1) and (indx < FCtrlCount) then
    if value then
      SendMessage(FHandles[indx],BM_SETCHECK,BST_CHECKED,0)
    else
      SendMessage(FHandles[indx],BM_SETCHECK,BST_UNCHECKED,0);
end;

function TCheckGroup.GetCaptions(indx:integer):string;

var
  s: string;
begin
  if (indx > -1) and (indx < FCtrlCount) then begin
    SetLength(s,50);
    SetString(result,PChar(s),GetWindowText(FHandles[indx],PChar(s),50));
  end else
    result := 'No Index';
end;

procedure TCheckGroup.SetCaptions(indx:integer;cp:string);
begin
  if (indx > -1) and (indx < FCtrlCount) then
    SetWindowText(FHandles[indx],PChar(cp));
end;

ここでは、Checked プロパティーのアクセスメソッドで BM_GETCHECK と BM_SETCHECK メッセージを SendMessage( ) で送って取得・設定している｡ これでクラスが完成したのでインスタンス作成関数を作ろう｡ 宣言部を以下に示す｡

function CreateCheckGroup(hParent:HWND;Vert:Boolean; x,y,cx,cy: integer;
               Chcks:integer;sOnClick:TNotifyMessage): TCheckGroup;

実装部を以下に示す｡

function CreateCheckGroup(hParent:HWND;Vert:Boolean; x,y,cx,cy: integer;
               Chcks:integer;sOnClick:TNotifyMessage): TCheckGroup;
begin
  result := TCheckGroup.Create(hParent);
  with result do begin
    FVertical := Vert;
    FDim := SetDim(x,y,cx,cy);
    OnClick := sOnClick;
    CtrlCount := Chcks;
  end;
end;

それでは、このクラスをテストするプログラムを CheckGroup.dpr に作成しよう。以下に全リストを示す｡

program CheckGroup;

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;

  L1:TAPILabel;

  CG1,CG2: TCheckGroup;
  GB: TAPIGroupBox;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure CheckState;
var
  s:string;
  i:integer;
begin
  s := ' Check State '+#13#13;
  for i := 0 to 4 do

    if CG1.Checked[i] then
      s := s+' '+AIntToStr(i)+' : Yes'+#13
    else
      s := s+' '+AIntToStr(i)+' : No'+#13;
  L1.Text := s;
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure CG1Click(var Msg: TMessage);
begin
  CheckState;
end;

procedure CG2Click(var Msg: TMessage);
var
  i:integer;
begin
  for i := 0 to 4 do CG1.Checked[i] := CG2.Checked[i];
  CheckState;
end;

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

  L1 := Createlabel(hWindow,10,5,120,160,'');

  CG1 := CreateCheckGroup(hWindow,true,160,30,80,120,5,CG1Click);
  for i := 0 to 4 do CG1.Captions[i] := 'Check '+AIntToStr(i);

  GB := CreateGroupBox(hWindow,260,5,120,160,'Check Group');

  CG2 := CreateCheckGroup(GB.Handle,true,15,25,80,120,5,CG2Click);
  for i := 0 to 4 do CG2.Captions[i] := 'Check '+AIntToStr(i);

  with MainWnd do begin
    ClientWidth := 400;
    ClientHeight := 180;
    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.gifCheckGroup.zip(17.159kB)
CheckGroup.gif

実行すると、右図のようにメインウィンドウとグループボックスを親とした二つのチェックグループが作成される｡ マウスでクリックするたびに真ん中のチェックグループのチェック状態がラベルに表示される｡ 右側のチェックグループをクリックするとチェック状態が真ん中のチェックグループにコピーされる｡

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

２０−４ ラジオグループクラス

ラジオボタンのグループは、相互排他的にチェックマークを付けられるので、チェックボックスよりは幾分複雑なコントロールである｡ ７−２ ラジオボタン 節では、EnumChildWindows( ) ＡＰＩを使って同じグループに属するラジオボタンを検索していたが､ ここでは、Handles プロパティーで同じグループに属するすべてのハンドルを管理しているので、コードで相互排他的にチェックマークを付けるのは簡単である｡ それでは早速作成しよう｡

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

最初に、通常のラジオボタンをグループ化した TRadioGroup クラスと、それから派生してプッシュライクなラジオボタンをグループ化した TPushRadioGroup クラスを UtilClass.pas に作成する｡ 宣言部を以下に示す｡

//------------------ TRadioGroup ------------------------------------
TRadioGroup = class(TControlGroup)
private
  FCheckIndex:integer;
  FOnClick: TNotifyMessage;
  function GetCaptions(indx:integer):string;
  procedure SetCaptions(indx:integer;cp:string);
protected
  function CreateCtrl:HWND;override;
  procedure UnCheckAll;
public
  procedure DefaultHandler(var AMessage); override;
  procedure SetCheck(indx:integer);
  property CheckIndex:integer read FCheckIndex;
  property Captions[i:integer]:string read GetCaptions write SetCaptions;
  property OnClick: TNotifyMessage read FOnClick write FOnClick;
end;

//------------------ TPushRadioGroup --------------------------------
TPushRadioGroup = class(TRadioGroup)
protected
  function CreateCtrl:HWND;override;
end;

SetCheck メソッドは、特定のインデックスのラジオボタンをチェックする。CheckIndex プロパティーは、グループの中で現在チェックされているボタンのインデックスを保持している｡ 実装部を以下に示す｡

//------------------ TRadioGroup ------------------------------------
procedure TRadioGroup.DefaultHandler(var AMessage);
var
  AMsg:TMessage;
  BtnNo:integer;
begin
  AMsg := TMessage(AMessage);
  case AMsg.Msg of
    WM_COMMAND:
      if (AMsg.WParamHi = BN_CLICKED) then begin
        BtnNo := FHandles.Search(AMsg.LParam);
        if BtnNo <> -1 then begin
           SetCheck(BtnNo);
           if Assigned(FOnClick) then begin
             AMsg.Msg := UINT(self); // Sender
             AMsg.WParam := BtnNo;
             OnClick(AMsg);
           end;
        end;
      end;
  end; // case
end;

function TRadioGroup.CreateCtrl:HWND;
begin
  result := CreateWindow('BUTTON',
                         'GroupRadio',
                         WS_CHILD or WS_VISIBLE or
                         BS_RADIOBUTTON,
                         0,0,100,30,
                         Parent,
                         ID_GROUPCTRL,
                         hInstance,nil);
  if FFontHandle <> 0 then
    SendMessage(result,WM_SETFONT,FFontHandle,1);
  inc(ID_GROUPCTRL);
end;

procedure TRadioGroup.UnCheckAll;
var
  i:integer;
begin
  for i := 0 to CtrlCount-1 do
    SendMessage(FHandles[i],BM_SETCHECK,0,0);
end;

procedure TRadioGroup.SetCheck(indx:integer);
begin
  if (indx > -1) and (indx < FCtrlCount) then begin
    UnCheckAll;
    SendMessage(FHandles[indx],BM_SETCHECK,1,0);
    FCheckIndex := indx;
  end;
end;

function TRadioGroup.GetCaptions(indx:integer):string;
var
  s: string;
begin
  if (indx > -1) and (indx < FCtrlCount) then begin
    SetLength(s,50);
    SetString(result,PChar(s),GetWindowText(FHandles[indx],PChar(s),50));
  end else
    result := 'No Index';
end;

procedure TRadioGroup.SetCaptions(indx:integer;cp:string);
begin
  if (indx > -1) and (indx < FCtrlCount) then
    SetWindowText(FHandles[indx],PChar(cp));
end;

//------------------ TPushRadioGroup --------------------------------
function TPushRadioGroup.CreateCtrl:HWND;
begin
  result := CreateWindow('BUTTON',
                         'GroupRadio',
                         WS_CHILD or WS_VISIBLE or
                         BS_RADIOBUTTON or BS_PUSHLIKE,
                         0,0,100,30,
                         Parent,
                         ID_GROUPCTRL,
                         hInstance,nil);
  if FFontHandle <> 0 then
    SendMessage(result,WM_SETFONT,FFontHandle,1);
  inc(ID_GROUPCTRL);
end;

ここでは、UnCheckAll で全てのチェックをはずし､ SetCheck( ) で特定のラジオボタンのみチェックマークを付けている｡ TPushRadioGroup クラスでは、CreateCtrl をオーバーライドしてコントロールスタイルに BS_PUSHLIKE を追加しているだけである｡ 両クラスのインスタンス生成関数を作ろう｡ 宣言を以下に示す｡

function CreateRadioGroup(hParent:HWND;Vert:Boolean; x,y,cx,cy: integer;
               Radios:integer;sOnClick:TNotifyMessage): TRadioGroup;

function CreatePushRadioGroup(hParent:HWND;Vert:Boolean; x,y,cx,cy: integer;
               Radios:integer;sOnClick:TNotifyMessage): TPushRadioGroup;

実装部を以下に示す｡

function CreateRadioGroup(hParent:HWND;Vert:Boolean; x,y,cx,cy: integer;
               Radios:integer;sOnClick:TNotifyMessage): TRadioGroup;
begin
  result := TRadioGroup.Create(hParent);
  with result do begin
    FVertical := Vert;
    FDim := SetDim(x,y,cx,cy);
    OnClick := sOnClick;
    CtrlCount := Radios;
  end;
end;

function CreatePushRadioGroup(hParent:HWND;Vert:Boolean; x,y,cx,cy: integer;
               Radios:integer;sOnClick:TNotifyMessage): TPushRadioGroup;
begin
  result := TPushRadioGroup.Create(hParent);
  with result do begin
    FVertical := Vert;
    FDim := SetDim(x,y,cx,cy);
    OnClick := sOnClick;
    CtrlCount := Radios;
  end;
end;

それでは、RadioGroup.dpr にこれらのクラスをテストするプログラムを作ろう｡ 以下に全リストを示す｡

program RadioGroup;

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;

  L1:TAPILabel;

  RG1: TRadioGroup;
  GB: TAPIGroupBox;
  PR1: TPushRadioGroup;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure CheckState;
var
  s:string;
begin
  s := ' Check State '+#13#13;
  s := s+' CheckIndex = '+AIntToStr(RG1.CheckIndex);
  L1.Text := s;
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure RG1Click(var Msg: TMessage);
begin
  PR1.setCheck(Msg.WParam);
  CheckState;
end;

procedure PR1Click(var Msg: TMessage);
begin
  RG1.setCheck(Msg.WParam);
  CheckState;
end;

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

  L1 := Createlabel(hWindow,10,70,170,100,'');

  GB := CreateGroupBox(hWindow,200,50,120,160,'Radio Group');

  RG1 := CreateRadioGroup(GB.Handle,true,15,25,80,120,5,RG1Click);
  for i := 0 to 4 do RG1.Captions[i] := 'Radio '+AIntToStr(i);
  RG1.SetCheck(1);

  PR1 := CreatePushRadioGroup(hWindow,false,5,5,430,30,5,PR1Click);
  PR1.interval := 2;
  for i := 0 to 4 do PR1.Captions[i] := 'PushR '+AIntToStr(i);
  RG1.SetCheck(1);

  with MainWnd do begin
    ClientWidth := 450;
    ClientHeight := 250;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  //MessageBeep($FFFFFFFF);
  RG1.SetCheck(2);
  CheckState;
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.gifRadioGroup.zip(17.255kB)
RadioGroup.gif

実行すると、右図のように縦配置の通常ラジオボタングループと横配置のプッシュラジオグループが作成される｡ どちらをクリックしても他方にチェック状態がコピーされ、そのときのチェックインデックスがラベルに表示される｡

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

２０−５ まとめ

本章では､ プッシュボタン、チェックボックス、ラジオボタンをグループ化して生成・配置するクラスを TSubClass から派生して作成した｡ グループ化する事により、メッセージ処理が一括して行えるようになった。この他に、エディットやエディットとラベルの組み合わせなどをグループ化したクラスも有益だろう｡ これらの作成は､読者にお任せする｡

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

  1. Skeleton03.dpr (2 kB)
  2. UtilFunc.pas (12 kB)
  3. UtilClass.pas (62 kB)
  4. GDIObject.pas (21 kB)
  5. APIControl.pas (61 kB)
  6. APIWindow.pas (19 kB)


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