第７章 チェックボックス、ラジオボタン、グループボックス

前章で実装した TAPIControl から派生して、'BUTTON' クラスのコントロールのチェックボックス、ラジオボタン、グループボックスのラッパークラスを作ろう。 TAPIControl でほとんどのプロパティーが装備されているので、それぞれのラッパークラスは簡単につくることができる。これらのラッパークラスの作成を通して Win32 の標準コントロールの仕組みについての理解を深めよう。

7−0 この章の内容

第７章 チェックボックス、ラジオボタン、グループボックス
７−１ チェックボックス
７−２ ラジオボタン
７−３ グループボックス
７−４ まとめ


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

７−１ チェックボックス

'Button' クラスをコードでつくることは、すでに６−２節の BtnLook.dpr で試したので、ここではラッパークラスを作ることから始めよう。 ここでカプセル化するのは BS_3STATE スタイルの「ボタン」、つまり、チェック状態・アンチェック状態・不定状態の三つの状態を表示できるチェックボックスである。 イベントはプッシュボタンと同じ OnClick のみだが、プロパティーはチェック状態の設定・取得のためや不定状態にするために少し多くなる。 それでは早速、実装してテストするプログラムを作ろう。

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

まず APIControl.pas に TAPICheckBox クラスを定義する。

//---------- TAPICheckBox ----------------------------------------------
TCBTextStyle = (cbtRight,cbtLeft);

TAPICheckBox = class(TAPIControl)
private
  FChecked: Boolean;
  FTextStyle: TCBTextStyle;
  FReadOnly: Boolean;
  FIndeterminate: Boolean;
  FOnClick: TNotifyMessage;
  procedure SetChecked(value:Boolean);
  procedure SetTextStyle(value:TCBTextStyle);
  procedure SetIndeterminate(value: Boolean);
protected
  procedure APICreateParams(var Params: TAPICreateParams); override;
  procedure Initialize; override;
public
  procedure DefaultHandler(var Message); override;
  property Checked: Boolean read FChecked write SetChecked;
  property TextStyle: TCBTextStyle read FTextStyle write SetTextStyle;
  property DoIndeterminate: Boolean read FIndeterminate write SetIndeterminate;
  property ReadOnly: Boolean read FReadOnly write FReadOnly;
  property OnClick: TNotifyMessage read FOnClick write FOnClick;
end;

ここでは、TAPIControl から派生し、APICreateParams( )、Initialize、DefaultHandler( ) の三つのメソッドを override している。 TextStyle プロパティーはチェックマークボックスに対してテキストの表示される位置を指定するものでデフォルトは cbtRight である。ReadOnly プロパティーを true にするとクリックイベントを発生せず、 状態の表示だけに用いられるチェックボックスになる。 不定状態は DoIndeterminate を true にすることで設定できる。 実装コードを以下に示す。

//---------- TAPICheckBox ----------------------------------------------
procedure TAPICheckBox.Initialize;
begin
  inherited Initialize;

  FChecked := false;
  FTextStyle := cbtRight;
  FReadOnly := false;
  FIndeterminate := false;
end;

procedure TAPICheckBox.APICreateParams(var Params: TAPICreateParams);
begin
  with Params do begin
    Caption := 'APICheckBox';
    Style := WS_CHILD or WS_VISIBLE or WS_TABSTOP or
             WS_CLIPSIBLINGS or BS_3STATE;
    ExStyle := 0;
    X := 50;
    Y := 50;
    Width := 150;
    Height := 32;
    WinClassName := 'BUTTON';
  end;
end;

procedure TAPICheckBox.DefaultHandler(var Message);
var
  AMsg: TMessage;
begin
  if FReadOnly then Exit;
  AMsg := TMessage(message);
  case AMsg.Msg of
    WM_COMMAND:
      if (AMsg.LParam = LPARAM(FHandle)) and (AMsg.WParamHi = BN_CLICKED) then begin
        Checked := not Checked;
        AMsg.Msg := UINT(self); // Sender
        if Assigned(FOnClick)then OnClick(AMsg);
      end;
  end; // case
end;

procedure TAPICheckBox.SetChecked(value:Boolean);
begin
  FChecked := value;
  if value then
    SendMessage(FHandle,BM_SETCHECK,BST_CHECKED,0)
  else
    SendMessage(FHandle,BM_SETCHECK,BST_UNCHECKED,0);
end;

procedure TAPICheckBox.SetTextStyle(value:TCBTextStyle);
var
  Style: LongInt;
begin
  if FTextStyle = value then exit;
  FTextStyle := value;
  Style := GetWindowLong(FHandle,GWL_STYLE);
  if value = cbtLeft then
    SetWindowLong(FHandle,GWL_STYLE,(Style or BS_LEFTTEXT))
  else
    SetWindowLong(FHandle,GWL_STYLE,(Style and (not BS_LEFTTEXT)));
  InvalidateRect(FHandle,nil,true);
end;

procedure TAPICheckBox.SetIndeterminate(value: Boolean);
begin
  if value then
    SendMessage(FHandle,BM_SETCHECK,BST_INDETERMINATE,0)
  else
    if FChecked then Checked := true else Checked := false;
  FIndeterminate := value;
end;

チェック状態の設定は、ウィンドウオブジェクトに SendMessage( ) ＡＰＩで BM_SETCHECK メッセージを送ることで設定できる。 wParam が BST_CHECKED ならチェック、BST_UNCHECKED ならアンチェックの状態にできる。 また、BST_INDETERMINATE にすると不定状態にすることができる。 最後に、 インスタンス作成のための関数を作ろう。宣言部は、

function CreateCheckBox(hParent: HWND; x,y,cx,cy: integer;sCaption: string;
                      sOnClick:TNotifyMessage): TAPICheckBox;

であり、実装部は

function CreateCheckBox(hParent: HWND; x,y,cx,cy: integer;sCaption: string;
                      sOnClick:TNotifyMessage): TAPICheckBox;
begin
  result := TAPICheckBox.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Caption := sCaption;
    OnClick := sOnClick;
  end;
end;

である。CheckBox.dpr にこのクラスのテストプログラムを書こう。 

program CheckBox;

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

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  Clr: COLORREF;

  Ck: array[1..4] of TAPICheckBox;
  L1, L2: TAPILabel;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure CkClick(var Msg:TMessage);
var
  s: string;
  i: integer;
begin
  s := 'You Clicked '+ TAPICheckBox(Msg.Msg).Caption + #13#13;
  for i := 1 to 4 do
    if Ck[i].Checked then
      s := s + 'CheckBox '+ AIntToStr(i) + ' is   Checked'#13
    else
      s := s + 'CheckBox '+ AIntToStr(i) + ' is UnChecked'#13;
  L2.Text := s;
end;

//------------------------------------------------------------
//             Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
  hWindow: HWND;
  i: integer;
begin
  hWindow := Msg.Msg;
  Clr := clrBtnFace;
  MakeInitMenu(hWindow);
  ChangeWindowSize(hWindow,520,450);
  CenterWindow(hWindow);

  L1 := CreateLabel(hWindow,20,20,220,250,'');
  with L1 do begin
    DrawFrame := true;
    Margin := 5;
  end;

  L2 := CreateLabel(hWindow,250,20,220,250,'');
  with L2 do begin
    DrawFrame := true;
    Margin := 5;
  end;

  for i := 1 to 4 do 
    Ck[i] := CreateCheckBox(hWindow,70,250+30*i,120,25,
                            'CheckBox '+AIntToStr(i),CkClick);
  Ck[1].Checked := true;
  Ck[4].TextStyle := cbtLeft;
  Ck[2].ReadOnly := true;
end;

procedure OnTest(hWindow: HWND);
begin
  L1.Text := WindowInfo(Ck[1].Caption,Ck[1].Handle);
  L2.Text := ClassInfo(Ck[1].Handle);
  Ck[4].DoIndeterminate := not Ck[4].DoIndeterminate;
end;

procedure OnCommand(var Msg: TMessage);
begin
  InitMenuCommand(Msg,OnTest);
end;

procedure OnEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;

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

//------------------------------------------------------------
//             Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                      LParam: LPARAM): LRESULT; stdcall;
var
  AMsg: TMessage;
begin
  Result := 0;

  AMsg.Msg := hWindow;
  AMsg.WParam := WParam;
  AMsg.LParam := LParam;
  AMsg.Result := 0;

  case Msg of

//-------------  WM_CREATE  -----------------------------------

     WM_CREATE: OnCreate(AMsg);

//-------------  WM_COMMAND  ----------------------------------

     WM_COMMAND: OnCommand(AMsg);

//-------------  WM_ERASEBKGND  -------------------------------

     WM_ERASEBKGND: begin
       OnEraseBkgnd(AMsg);
       result := AMsg.Result;
     end;

//-------------  WM_DESTROY  ----------------------------------

     WM_DESTROY: OnDestroy(AMsg);

//-------- そのほかのメッセージの処理 ------
  else begin
    result := DefWindowProc( hWindow, Msg, wParam, lParam );
    end;

  end; // case
end;

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

  MakeMainWindow(@MainWndProc);

  Halt(MessageLoopNormal);

end.

DownloadExe.gifCheckBox.zip(17.221kB)
CheckBox.gif

以上で完成である。 実行時の様子を上図に示す。 チェックボックスをクリックするたびに４つのチェックボックスのチェック状態が L2 ラベルに表示される。 Ck[2] は ReadOnly なのでクリックイベントを起こさない。 Test! メニューを選択すると Ck[1] のウィンドウ情報とクラス情報が表示される。 同時に、Ck[4] の DoIndeterminate プロパティーが反転する。

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

７−２ ラジオボタン

ラジオボタンはチェックボックスより少々複雑なコントロールだ。それは、同じグループのラジオボタンと相互排他的にマークを付けなければならないからだ。ここでは、ＶＣＬと同じように GroupIndex というプロパティーを導入し、このプロパティーにゼロ以外の値を設定することでグループ化を行うことにしよう。

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

APIControl.pas に TAPIRadioButton クラスを以下のように定義する。

//---------- TAPIRadioButton --------------------------------------------
TAPIRadioButton = class(TAPIControl)
private
  FTextStyle: TCBTextStyle;
  FGroupIndex: Integer;
  FOnClick: TNotifyMessage;
  function GetChecked:Boolean;
  procedure SetChecked(value:Boolean);
  procedure SetTextStyle(value:TCBTextStyle);
protected
  procedure APICreateParams(var Params: TAPICreateParams); override;
  procedure Initialize; override;
public
  procedure DefaultHandler(var Message); override;
  property Checked: Boolean read GetChecked write SetChecked;
  property TextStyle: TCBTextStyle read FTextStyle write SetTextStyle;
  property GroupIndex: integer read FGroupIndex write FGroupIndex;
  property OnClick: TNotifyMessage read FOnClick write FOnClick;
end;

//---------- APIPushRadio --------------------------------------------
TAPIPushRadio = class(TAPIRadioButton)
protected
  procedure APICreateParams(var Params: TAPICreateParams); override;
end;

ここでは、さらに TAPIRadioButton から派生して TAPIPushRadio クラスもつくる。このクラスは、 APICreateParams( ) をオーバーライドして、ウィンドウスタイルに BS_PUSHLIKE を加えているだけである。 実装コードは、以下のようになる。

//---------- TAPIRadioButton --------------------------------------------
procedure TAPIRadioButton.Initialize;
begin
  inherited Initialize;

  FTextStyle := cbtRight;
  FGroupIndex := 0;
end;

procedure TAPIRadioButton.APICreateParams(var Params: TAPICreateParams);
begin
  with Params do begin
    Caption := 'APIRadioButton';
    Style := WS_CHILD or WS_VISIBLE or WS_TABSTOP or
             WS_CLIPSIBLINGS or BS_RADIOBUTTON;
    ExStyle := 0;
    X := 50;
    Y := 50;
    Width := 150;
    Height := 32;
    WinClassName := 'BUTTON';
  end;
end;

function UnCheckSameRadioGroup(hWindow: HWND; Data:LParam): Boolean; stdcall;
var
  sobject: TObject;
begin
  result := true;
  if GetProp(hWindow,'OBJECT') <> 0 then begin
    sobject := TObject(GetProp(hWindow,'OBJECT'));
    if (sobject is TAPIRadioButton) and
          (TAPIRadioButton(sobject).GroupIndex = Data) then
       TAPIRadioButton(sobject).Checked := false;
  end;
end;

procedure UnCheckSameGroup(hParent: HWND; GroupIndex:Integer);
begin
  EnumChildWindows(hParent,@UnCheckSameRadioGroup,GroupIndex);
end;

procedure TAPIRadioButton.DefaultHandler(var Message);
var
  AMsg: TMessage;
begin
  AMsg := TMessage(message);
  case AMsg.Msg of
    WM_COMMAND:
      if (AMsg.LParam = LPARAM(FHandle)) and (AMsg.WParamHi = BN_CLICKED) then begin
        if FGroupIndex = 0 then begin
          Checked := not Checked;
        end else begin // グループ化されている
          UnCheckSameGroup(Parent,FGroupIndex);
          Checked := true;
        end;
        AMsg.Msg := UINT(self);
        if Assigned(FOnClick)then OnClick(AMsg);
      end;
  end; // case
end;

function TAPIRadioButton.GetChecked:Boolean;
begin
  result := Boolean(SendMessage(FHandle,BM_GETCHECK,0,0));
end;

procedure TAPIRadioButton.SetChecked(value:Boolean);
begin
  if value then
    SendMessage(FHandle,BM_SETCHECK,1,0)
  else
    SendMessage(FHandle,BM_SETCHECK,0,0);
end;

procedure TAPIRadioButton.SetTextStyle(value:TCBTextStyle);
var
  Style: LongInt;
begin
  if FTextStyle = value then exit;
  FTextStyle := value;
  Style := GetWindowLong(FHandle,GWL_STYLE);
  if value = cbtLeft then
    SetWindowLong(FHandle,GWL_STYLE,(Style or BS_LEFTTEXT))
  else
    SetWindowLong(FHandle,GWL_STYLE,(Style and (not BS_LEFTTEXT)));
  InvalidateRect(FHandle,nil,true);
end;

//---------- TAPIPushRadio --------------------------------------------
procedure TAPIPushRadio.APICreateParams(var Params: TAPICreateParams);
begin
  inherited APICreateParams(Params);
  with Params do begin
    Caption := 'APIPushRadio';
    Style := Style or BS_PUSHLIKE;
  end;
end;

Checked プロパティーのアクセスメソッド GetChecked( ) と SetChecked( ) に注目してほしい。 プログラムコードとウィンドウオブジェクトとの間の情報のやりとりに SendMessage( ) ＡＰＩを使うときのサンプルコードになっている。 同じグループに属するラジオボタンを探し出して、チェックマークをはずす UnCheckSameGroup( ) 手続きは、DefaultHandler( ) から呼ばれるが、このクラスのメソッドではなく単独の関数である。 この中では、EnumChildWindows( ) ＡＰＩを呼び出して、同じ親ウィンドウの子ウィンドウを走査している。 同じグループに属するラジオボタンは共通の親ウィンドウを持っていると期待できるからである。

  function EnumChildWindows(hWndParent: HWND; 
                            lpEnumFunc: TFNWndEnumProc;
                                lParam: LPARAM): BOOL; stdcall;

このＡＰＩは、hWndParent で指定されるウィンドウの子ウィンドウを検索して見つかるたびに lpEnumFunc で指定されるコールバック関数を呼び出す。 lParam には integer 型の任意のデータを指定でき、これはコールバック関数に渡される。 もちろん、型キャストすればオブジェクト参照やレコードのポインタも渡せる。 この関数は最後の子ウィンドウが見つかるか、コールバック関数が false を返すまで実行が続く。 windows.pas には、TFNWndEnumProc は

type
  TFarProc = Pointer;
  TFNWndEnumProc = TFarProc;

と単なるポインタとして定義されているが、 Delphi 付属の Win32.hlp を読むと、コールバック関数は以下の形をとる必要があることが分かる。

  function EnumChildProc(hwnd: HWND; lParam: LPARAM):Boolean; stdcall;

第一パラメータ hwnd は、見つかった子ウィンドウのハンドルである。UnCheckSameGroup( ) では、コールバック関数に UnCheckSameRadioGroup( ) を、lParam には GroupIndex の値を指定している。 UnCheckSameRadioGroup( ) では、子ウィンドウのハンドルからパスカルオブジェクトを取得して、それが TAPIRadioButton クラス（またはその派生クラス）のオブジェクトであるか確認し、そうであるなら、GroupIndex が渡されたそれと同じであるかどうかの判断し、 同じである場合はチェック状態を解除している。 これで同じグループのラジオボタンのチェックマークがすべてはずされるわけだ。 そのあと DefaultHandler( ) では、クリックされた自分自身のチェックマークをセットしている。最後に、 これらのクラスのインスタンス作成関数を作ろう。宣言部は、

function CreateRadioButton(hParent: HWND; x,y,cx,cy: integer;sCaption: string;
            Group: integer; sOnClick:TNotifyMessage): TAPIRadioButton;

function CreatePushRadio(hParent: HWND; x,y,cx,cy: integer;sCaption: string;
            Group: integer; sOnClick:TNotifyMessage): TAPIPushRadio;

であり、実装部は以下に示すとおりである。

function CreateRadioButton(hParent: HWND; x,y,cx,cy: integer;sCaption: string;
            Group: integer; sOnClick:TNotifyMessage): TAPIRadioButton;
begin
  result := TAPIRadioButton.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Caption := sCaption;
    GroupIndex := Group;
    OnClick := sOnClick;
  end;
end;

function CreatePushRadio(hParent: HWND; x,y,cx,cy: integer;sCaption: string;
            Group: integer; sOnClick:TNotifyMessage): TAPIPushRadio;
begin
  result := TAPIPushRadio.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Caption := sCaption;
    GroupIndex := Group;
    OnClick := sOnClick;
  end;
end;

TAPIRadioButton と TAPIPushRadio クラスのテストコードを RadioButton.dpr に書く。 以下に全リストを示す。 

program RadioButton;

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

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  Clr: COLORREF;

  RB: array[1..4] of TAPIRadioButton;
  PR: array[1..4] of TAPIPushRadio;
  L1, L2: TAPILabel;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure RBClick(var Msg:TMessage);
var
  s: string;
  i: integer;
begin
  s := 'You Clicked '+ TAPIRadioButton(Msg.Msg).Caption + #13#13;
  for i := 1 to 4 do
    if RB[i].Checked then
      s := s + 'RadioButton '+ AIntToStr(i) + ' is   Checked'#13
    else
      s := s + 'RadioButton '+ AIntToStr(i) + ' is UnChecked'#13;
  L2.Text := s;
end;

procedure PRClick(var Msg:TMessage);
var
  s: string;
  i: integer;
begin
  s := 'You Clicked '+ TAPIPushRadio(Msg.Msg).Caption + #13#13;
  for i := 1 to 4 do
    if PR[i].Checked then
      s := s + 'PushRadio '+ AIntToStr(i) + ' is   Checked'#13
    else
      s := s + 'PushRadio '+ AIntToStr(i) + ' is UnChecked'#13;
  L2.Text := s;
end;

//------------------------------------------------------------
//             Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
  hWindow: HWND;
  i: integer;
begin
  hWindow := Msg.Msg;
  Clr := clrBtnFace;
  MakeInitMenu(hWindow);
  ChangeWindowSize(hWindow,520,450);
  CenterWindow(hWindow);

  L1 := CreateLabel(hWindow,20,20,220,250,'');
  with L1 do begin
    DrawFrame := true;
    Margin := 5;
  end;

  L2 := CreateLabel(hWindow,250,20,220,250,'');
  with L2 do begin
    DrawFrame := true;
    Margin := 5;
  end;

  for i := 1 to 4 do
    RB[i] := CreateRadioButton(hWindow,70,250+30*i,120,25,
                               'RadioButton '+AIntToStr(i),1,RBClick);
  RB[1].Checked := true;
  RB[4].TextStyle := cbtLeft;
  RB[4].GroupIndex := 0; // RB[4] is not in Group

  for i := 1 to 4 do
    PR[i] := CreatePushRadio(hWindow,300,250+30*i,120,25,
                             'PushRadio '+AIntToStr(i),2,PRClick);
  PR[1].Checked := true;
  PR[4].TextStyle := cbtLeft; //not effective!!
  PR[4].GroupIndex := 0; // PR[4] is not in Group
end;

procedure OnTest(hWindow: HWND);
begin
  L1.Text := WindowInfo(RB[1].Caption,RB[1].Handle);
  L2.Text := ClassInfo(RB[1].Handle);
end;

procedure OnCommand(var Msg: TMessage);
begin
  InitMenuCommand(Msg,OnTest);
end;

procedure OnEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;

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

//------------------------------------------------------------
//             Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                      LParam: LPARAM): LRESULT; stdcall;
var
  AMsg: TMessage;
begin
  Result := 0;

  AMsg.Msg := hWindow;
  AMsg.WParam := WParam;
  AMsg.LParam := LParam;
  AMsg.Result := 0;

  case Msg of

//-------------  WM_CREATE  -----------------------------------

     WM_CREATE: OnCreate(AMsg);

//-------------  WM_COMMAND  ----------------------------------

     WM_COMMAND: OnCommand(AMsg);

//-------------  WM_ERASEBKGND  -------------------------------

     WM_ERASEBKGND: begin
       OnEraseBkgnd(AMsg);
       result := AMsg.Result;
     end;

//-------------  WM_DESTROY  ----------------------------------

     WM_DESTROY: OnDestroy(AMsg);

//-------- そのほかのメッセージの処理 ------
  else begin
    result := DefWindowProc( hWindow, Msg, wParam, lParam );
    end;

  end; // case
end;

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

  MakeMainWindow(@MainWndProc);

  Halt(MessageLoopNormal);

end.

DownloadExe.gifRadioButton.zip(17.622kB)
RadioButton.gif

以上で完成だ。実行すると上図のようになる。 一番下のボタンは、グループに属していないので単独でチェックマークが付けられることが分かる。

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

７−３ グループボックス

グループボックスは、イベントを発生しないコントロールであり、コントロールを囲む矩形を描画しテキストを表示するだけの、ただ単に視覚上の効果をあらわすものだ。これは、TGDIObject から派生したクラスとして、自前でもコードを書けるだろう。 しかし、その場合は、他のコントロールのコンテナになることは出来ない。ここでは、BS_GROUPBOX スタイルをもつ 'BUTTON' クラスのラッパークラスを TAPIControl から派生して作る。 グループボックスはウィンドウなので、他のコントロールのコンテナになれる。

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

最初に APIControl.pas に TAPIGroupBox クラスを定義する。 宣言部を以下に示す。

//---------- APIGroupBox ---------------------------------------------
TGBTextAlign = (gbtLeft, gbtCenter, gbtRight);// TextAlign of APIGroupBox

TAPIGroupBox = class(TAPIControl)
private
  FTextAlign: TGBTextAlign;
  procedure SetTextAlign(value:TGBTextAlign);
protected
  procedure APICreateParams(var Params: TAPICreateParams); override;
  procedure Initialize; override;
public
  property TextAlign: TGBTextAlign read FTextAlign write SetTextAlign;
end;

実装部に以下のコードを書く。

//---------- APIGroupBox ---------------------------------------------
procedure TAPIGroupBox.Initialize;
begin
  inherited Initialize;
  FTextAlign := gbtLeft;
end;

procedure TAPIGroupBox.APICreateParams(var Params: TAPICreateParams);
begin
  with Params do begin
    Caption := 'APIGroupBox';
    Style := WS_CHILD or WS_VISIBLE or  WS_CLIPSIBLINGS or
             BS_GROUPBOX or BS_LEFT;
    ExStyle := 0;
    X := 50;
    Y := 50;
    Width := 150;
    Height := 32;
    WinClassName := 'BUTTON';
  end;
end;

procedure TAPIGroupBox.SetTextAlign(value:TGBTextAlign);
var
  Style,SetStyle: LongInt;
  r: TRect;
begin
  if FTextAlign = value then Exit;
  FTextAlign := value;
  Style := GetWindowLong(FHandle,GWL_STYLE);
  SetStyle := Style and (not BS_CENTER);
  case value of
    gbtLeft: SetStyle := SetStyle or BS_LEFT;
    gbtCenter: SetStyle := SetStyle or BS_CENTER;
    gbtRight: SetStyle := SetStyle or BS_RIGHT;
  end;
  SetWindowLong(FHandle,GWL_STYLE,SetStyle);
  r := SetDim(XPos,YPos,XPos+Width,YPos+Height);
  InvalidateRect(Parent,@r,true);
end;

これで TAPIGroupBox クラスは完成だ。 このクラスはメッセージを処理しないので、DefaultHandler はオーバーライドしない。 最後に、例によってこのクラスのインスタンスを作成する関数を作ろう。 宣言部は、

function CreateGroupBox(hParent: HWND; x,y,cx,cy: integer;
                       sCaption: string): TAPIGroupBox;

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

function CreateGroupBox(hParent: HWND; x,y,cx,cy: integer;
                       sCaption: string): TAPIGroupBox;
begin
  result := TAPIGroupBox.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    Caption := sCaption;
  end;
end;

このクラスをテストするプログラムを GroupBox.dpr に書こう。 以下に全リストを示す。

program GroupBox;

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

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
var
  Clr: COLORREF;

  GB1, GB2: TAPIGroupBox;
  RB: array[1..6] of TAPIRadioButton;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure RBClick(var Msg:TMessage);
begin
  if TAPIRadioButton(Msg.Msg).Caption = 'Left' then
    GB1.TextAlign := gbtLeft
  else if TAPIRadioButton(Msg.Msg).Caption = 'Center' then
    GB1.TextAlign := gbtCenter
  else if TAPIRadioButton(Msg.Msg).Caption = 'Right' then
    GB1.TextAlign := gbtRight;
end;

procedure RB4Click(var Msg:TMessage);
var
  c: COLORREF;
begin
  c := clrLtGray;
  if TAPIRadioButton(Msg.Msg).Caption = 'White' then
    c := clrWhite
  else if TAPIRadioButton(Msg.Msg).Caption = 'Green' then
    c := clrGreen;
  Clr := c;
  InvalidateRect(GB1.Parent,nil,true);
end;

//------------------------------------------------------------
//             Event Handlers
//------------------------------------------------------------
procedure OnCreate(var Msg: TMessage);
var
  hWindow: HWND;
  i: integer;
begin
  hWindow := Msg.Msg;
  Clr := clrBtnFace;
  MakeInitMenu(hWindow);
  ChangeWindowSize(hWindow,380,230);
  CenterWindow(hWindow);

  GB1 := CreateGroupBox(hWindow,10,20,160,130,'TextAlign');
  GB2 := CreateGroupBox(hWindow,190,20,160,130,'Window Color');

  for i := 1 to 3 do
    RB[i] := CreateRadioButton(GB1.Handle,30,30*i,120,25,'',1,RBClick);
  RB[1].Caption := 'Left';
  RB[2].Caption := 'Center';
  RB[3].Caption := 'Right';
  RB[1].Checked := true;

  for i := 4 to 6 do
    RB[i] := CreateRadioButton(GB2.Handle,30,30*(i-3),120,25,'',2,RB4Click);
  RB[4].Caption := 'LtGray';
  RB[5].Caption := 'White';
  RB[6].Caption := 'Green';
  RB[4].Checked := true;
end;

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

procedure OnCommand(var Msg: TMessage);
begin
  InitMenuCommand(Msg,OnTest);
end;

procedure OnEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := EraseBkGnd(Msg.Msg,Clr,Msg.WParam);
end;

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

//------------------------------------------------------------
//             Main Window Procedure
//------------------------------------------------------------
function MainWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                      LParam: LPARAM): LRESULT; stdcall;
var
  AMsg: TMessage;
begin
  Result := 0;

  AMsg.Msg := hWindow;
  AMsg.WParam := WParam;
  AMsg.LParam := LParam;
  AMsg.Result := 0;

  case Msg of

//-------------  WM_CREATE  -----------------------------------

     WM_CREATE: OnCreate(AMsg);

//-------------  WM_COMMAND  ----------------------------------

     WM_COMMAND: OnCommand(AMsg);

//-------------  WM_ERASEBKGND  -------------------------------

     WM_ERASEBKGND: begin
       OnEraseBkgnd(AMsg);
       result := AMsg.Result;
     end;

//-------------  WM_DESTROY  ----------------------------------

     WM_DESTROY: OnDestroy(AMsg);

//-------- そのほかのメッセージの処理 ------
  else begin
    result := DefWindowProc( hWindow, Msg, wParam, lParam );
    end;

  end; // case
end;

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

  MakeMainWindow(@MainWndProc);

  Halt(MessageLoopNormal);

end.

DownloadExe.gifGroupBox.zip(15.585kB)
GroupBox.gif

以上でこのプログラムは完成だ。実行すると右図のようになる。

グループボックスは単純なコントロールであるが、本稿で扱う最初のコンテナオブジェクトでもある。 OnCreate( ) ハンドラでは、最初に二つのグループボックスをつくってから、その「上」に配置するラジオボタンをグループボックスの子ウィンドウとして作っている。 ＶＣＬを使い慣れた読者にはこの方法は普通であるし、これが正しい生成方法だろう。 このとき、ラジオボタンの Dimension は当然ながら親であるグループボックスの中の相対座標で指定することになる。 ウィンドウが描画されるとき、ＯＳはどんな順序で WM_PAINT メッセージを渡すのだろうか。 一般に、親ウィンドウは子ウィンドウに先立って受け取る。したがって、最下層の子ウィンドウが最も手前側、つまり「上」に描画されることになる。 では、同格の子ウィンドウが複数あるときはどんな順序で描画されるのだろうか。 結論を言えば、生成された順序と逆の順序で描画されるのだ。 上のプログラムで、 ラジオボタンの親にメインウィンドウを指定して Dimension を適当に調整すると、どうなるか試してほしい。 ラジオボタンはグループボックスの「下」に表示されるのが分かるだろう。 これを避けるためには、 まず最初にラジオボタンを生成してから、グループボックスを生成すると、ラジオボタンの方が「上」に描画されるのを確かめられる。 しかし、上のコードのようにグループボックスの子ウィンドウとしてラジオボタンを作るのが正当だろう。

右側のラジオボタンをクリックするとメインウィンドウの背景色が変更される。 RB4Click( ) では、FillRect( ) ＡＰＩではなく、WM_ERASEBKGND メッセージの背景ブラシの色を指定することで背景色を変更している。 注目してほしいのは、グループボックスの枠とテキスト表示部分以外の領域が、親の背景ブラシと同じ色で描画されることだ。 グループボックスのウィンドウ関数では、WM_PAINT を処理するとき自分自身の枠とテキストを描画しているだけで、背景はグループボックスの親のままで残されるのだろう。

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

７−４ まとめ

本章では、前章で実装した TAPIContol クラスから派生して、チェックボックス、ラジオボタン、グループボックスのラッパークラスを作成し、テストした。 TAPIContol がコントロールに必要な大部分のプロパティーとメソッドを装備しているので、これらの小さな「ボタン」類は簡単に実装することができる。

ここまでで、「ボタン」クラスは終わりである。 次章では、 筆者が偏愛する LISTBOX コントロールである。 このコントロールはボタン類とは比較にならないほど大きなコードで実装されている（らしい）ので、機能は複雑であるが実装方法自体はこれまでと同じである。

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

  1. Skeleton02.dpr (3 kB)
  2. UtilFunc.pas (8 kB)
  3. UtilClass.pas (13 kB)
  4. GDIObject.pas (16 kB)
  5. APIControl.pas (18 kB)


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