第１１章 パネルとアレンジャー

Delphi のコンポーネントパレットの Standard ページで最も頻繁に使われるコンポーネントの一つに TPanel クラスがある。 前章では、本稿ではじめて汎用ウィンドウクラスとして TSDIMainWindow クラスを作成した。 パネルは、ＶＣＬでは幾つかのイベントハンドラが装備されているが、本来、他のコントロールを配置するためのコンテナウィンドウである。ここでは、メッセージを処理するイベントハンドラを持たない、本来のコンテナウィンドウとしてのパネルを汎用子ウィンドウとして作成し、そのラッパークラスを作成する。また、メインウィンドウなどの親ウィンドウのサイズがユーザによって変更されたときに、パネルや他のコントロールを自動的に配置し直すクラスを作成してみよう。

１１−０ この章の内容

第１１章 パネルとアレンジャー
１１−１ パネルをコードでつくる
１１−２ パネルのラッパークラス
１１−３ パネルの配置
１１−４ グリッドアレンジャークラス
１１−５ ボーダーアレンジャークラス
１１−６ メッセージトラッパ
１１−７ まとめ


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

１１−１ パネルをコードでつくる

パネルを汎用の子ウィンドウとして作成しよう。 子ウィンドウであるから、ウィンドウオブジェクトは親ウィンドウが破棄されるときに自動的に破棄される。したがって、第１章で説明した Generic プログラムでは必須だった WM_DESTROY メッセージも処理する必要がないので、ウィンドウ関数ははじめから DefWindowProc( ) を指定して作ろう。 それでは早速作り始めよう。

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

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

program APIPanel01;

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;

  hPanel: HWND;
  Btn1: TAPIButton;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function CreatePanel(hParent:HWND):HWND;
var
  wc: TWndClass;
begin
  wc.lpszClassName   := 'APIPanel';
  wc.lpfnWndProc     := @DefWindowProc;
  wc.style           := CS_VREDRAW or CS_HREDRAW;
  wc.hInstance       := hInstance;
  wc.hIcon           := 0;
  wc.hCursor         := LoadCursor(0,IDC_ARROW);
  wc.hbrBackground   := (COLOR_BTNFACE+1);
  wc.lpszMenuName    := nil;
  wc.cbClsExtra      := 0;
  wc.cbWndExtra      := 0;

  RegisterClass( wc );

  result := CreateWindowEx(WS_EX_CONTROLPARENT,
                           'APIPanel',
                           'APIPanel',
                           WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS,
                           50,50,120,100,
                           hParent,
                           0,
                           hInstance,
                           nil);
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure Btn1Click(var Msg: TMessage);
begin
  ChangeWindowPos(hPanel,10,10);
  ChangeWindowSize(hPanel,200,200);
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  hPanel := CreatePanel(MainWnd.Handle);

  Btn1 := CreateButton(hPanel,10,10,100,40,'Button 1',Btn1Click);

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Color := clrWhite;
    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.gifAPIPanel01.zip(15.539kB)
APIPanel01.gif

実行すると、パネルとその上にボタンがつくられる。見やすいように、メインウィンドウの背景色を白にしている。ボタンをクリックするとパネルの位置とサイズが変更される。このときの様子を右図に示した。
コードを見てみよう。パネルは、ヘルパ関数 CreatePanel( ) をつかって作成される。 ここでは、クラス属性としてウィンドウ関数を DefWindowProc( ) 、背景色をシステムカラー BtnFace としている。 また、ウィンドウ属性として、拡張スタイルに WS_EX_CONTROLPARENT 、スタイルに WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS を指定している。 これで、パネルの原型がつくられた。次節では、このようなパネルのラッパークラスを作成しよう。

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

１１−２ パネルのラッパークラス

前節でコードでつくったパネルは、ウィンドウ関数に DefWindowProc( ) を設定した汎用子ウィンドウであった。このラッパークラスを前章で作成した汎用ウィンドウの基本属性をもつ TAPIWindow3 から派生して APIWindow.pas に作ろう。

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

最初に、APIWindow.pas に TAPIPanel クラスを作成しよう。宣言部を以下に示す。

//---------- TAPIPanel ----------------------------------------------
TEdgeStyle = (esNone,esRaised,esSunken);

TAPIPanel = class(TAPIWindow3)
private
  FOuterEdge: TEdgeStyle;
  FInnerEdge: TEdgeStyle;
  FEdgeWidth: integer;
  function GetDimension: TRect;
  procedure SetDimension(value: TRect);
  function GetXPos: integer;
  procedure SetXPos(value: integer);
  function GetYPos: integer;
  procedure SetYPos(value: integer);
  procedure SetOuterEdge(value: TEdgeStyle);
  procedure SetInnerEdge(value: TEdgeStyle);
  procedure SetEdgeWidth(value: integer);
protected
  procedure APIClassParams(var WC:TWndClass); override;
  procedure APICreateParams(var CP:TCreateParamsEx); override;
public
  procedure DefaultHandler(var Message); override;
  property Dimension : TRect read GetDimension write SetDimension;
  property XPos: integer read GetXPos write SetXPos;
  property YPos: integer read GetYPos write SetYPos;
  property OuterEdge: TEdgeStyle read FOuterEdge write SetOuterEdge;
  property InnerEdge: TEdgeStyle read FInnerEdge write SetInnerEdge;
  property EdgeWidth: integer read FEdgeWidth write SetEdgeWidth;
end;

function CreatePanel(hParent:HWND;x,y,cx,cy:integer):TAPIPanel;

ここでは APIClassParams( ) と APICreateParams( ) をオーバーライドして、クラス属性とウィンドウ属性を書き換える。 位置とサイズのプロパティーとして Dimension 、XPos 、YPos を設けている。ＶＣＬの TPanel のエッジスタイルをまねるために OuterEdge 、InnerEdge 、EdgeWidth のプロパティーを設けた。 実装部を以下に示す。

//--------------- TAPIPanel ----------------------------------------------
function PanelWndProc(hWindow: HWND; Msg: UINT; WParam: WPARAM;
                            LParam: LPARAM): LRESULT; stdcall;
var
  WPMsg: TMessage;
  Wnd: TAPIPanel;
  pCS: PCreateStruct;
begin
   Result := 0;
   
   if Msg = WM_CREATE then begin
     pCS := Pointer(LParam);
     SetProp(hWindow,'OBJECT',integer(pCS^.lpCreateParams));
     TAPIPanel(pCS^.lpCreateParams).FHandle := hWindow;
   end;

   Wnd := TAPIPanel(GetProp(hWindow,'OBJECT'));

   case Msg of

{------------------  WM_PAINT,WMERASEBKGND  ---------------------}

     WM_PAINT,WM_ERASEBKGND: begin
       WPMsg.Msg := Msg;
       WPMsg.WParam := WParam;
       WPMsg.LParam := LParam;
       WPMsg.Result := Result;
       if Assigned(Wnd) then begin
         Wnd.Dispatch(WPMsg);
         if WPMsg.result <> 0 then Result := WPMsg.result;
       end;
     end;

{------------------  WM_DESTROY  --------------------------------}

     WM_DESTROY: begin
       if Assigned(Wnd) then begin
         Wnd.Free;
       end;
     end;

   else Result := DefWindowProc( hWindow, Msg, wParam, lParam );

   end; //case

end;

procedure TAPIPanel.APIClassParams(var WC:TWndClass);
begin
  WC.lpszClassName   := 'APIPanel';
  WC.lpfnWndProc     := @PanelWndProc;
  WC.style           := CS_VREDRAW or CS_HREDRAW;
  WC.hInstance       := hInstance;
  WC.hIcon           := 0;
  WC.hCursor         := LoadCursor(0,IDC_ARROW);
  WC.hbrBackground   := ( COLOR_BTNFACE+1 );
  WC.lpszMenuName    := nil;
  WC.cbClsExtra      := 0;
  WC.cbWndExtra      := 0;

  FOuterEdge := esRaised;
  FInnerEdge := esNone;
  FEdgeWidth := 2;

  If Assigned(FOnClassParams) then FOnClassParams(WC);
end;

procedure TAPIPanel.APICreateParams(var CP:TCreateParamsEx);
begin
  CP.dwExStyle           := WS_EX_CONTROLPARENT;
  CP.lpClassName         := 'APIPanel';
  CP.lpWindowName        := 'APIPanel';
  CP.dwStyle             := WS_CHILD or WS_VISIBLE or WS_CLIPSIBLINGS;
  CP.X                   := 0;
  CP.Y                   := 0;
  CP.nWidth              := 0;
  CP.nHeight             := 0;
  CP.hWndParent          := FParent;
  CP.hMenu               := 0;
  CP.hInstance           := hInstance;
  CP.lpParam             := self;
  If Assigned(FOnWindowParams) then FOnWindowParams(CP);
end;

procedure TAPIPanel.DefaultHandler(var Message);
var
  AMsg:TMessage;
  r: TRect;
  DC: HDC;
  ps: TPaintStruct;
begin
  AMsg := TMessage(message);
  case AMsg.Msg of
    WM_PAINT:begin
      DC := BeginPaint(FHandle,ps);
        GetClientRect(FHandle,r);
        case FOuterEdge of
          esRaised:DrawEdge(DC,r,BDR_RAISEDOUTER or BDR_RAISEDINNER,
                 BF_RECT);
          esSunken:DrawEdge(DC,r,BDR_SUNKENOUTER or BDR_SUNKENINNER,
                 BF_RECT);
        end;
        InflateRect(r,-FEdgeWidth,-FEdgeWidth);
        case FInnerEdge of
          esRaised:DrawEdge(DC,r,BDR_RAISEDOUTER or BDR_RAISEDINNER,
                 BF_RECT);
          esSunken:DrawEdge(DC,r,BDR_SUNKENOUTER or BDR_SUNKENINNER,
                 BF_RECT);
        end;
      EndPaint(FHandle,ps);
    end;
    WM_ERASEBKGND:TMessage(message).Result := EraseBkgnd(FHandle,
                   FColor,AMsg.WParam);
  end; // case
end;

function TAPIPanel.GetDimension: TRect;
begin
  result := SetDim(XPos,YPos,Width,Height);
end;

procedure TAPIPanel.SetDimension(value: TRect);
begin
  MoveWindow(FHandle,value.left, value.top,
                   value.right, value.bottom, true);
end;

function TAPIPanel.GetXPos: integer;
var
  r: TRect;
  p: TPoint;
begin
  GetWindowRect(FHandle,r);
  p.x := r.Left; p.y := r.Top;
  ScreenToClient(FParent,p);
  result := p.x;
end;

procedure TAPIPanel.SetXPos(value: integer);
begin
  ChangeWindowPos(FHandle,value,YPos);
end;

function TAPIPanel.GetYPos: integer;
var
  r: TRect;
  p: TPoint;
begin
  GetWindowRect(FHandle,r);
  p.x := r.Left; p.y := r.Top;
  ScreenToClient(FParent,p);
  result := p.y;
end;

procedure TAPIPanel.SetYPos(value: integer);
begin
  ChangeWindowPos(FHandle,XPos,value);
end;
        
procedure TAPIPanel.SetOuterEdge(value: TEdgeStyle);
begin
  FOuterEdge := value;
  InvalidateRect(FHandle,nil,true);
end;

procedure TAPIPanel.SetInnerEdge(value: TEdgeStyle);
begin
  FInnerEdge := value;
  InvalidateRect(FHandle,nil,true);
end;

procedure TAPIPanel.SetEdgeWidth(value: integer);
begin
  FEdgeWidth := value;
  InvalidateRect(FHandle,nil,true);
end;

function CreatePanel(hParent:HWND;x,y,cx,cy:integer):TAPIPanel;
begin
  result := TAPIPanel.Create(hParent,'');
  result.DoCreate;
  result.Dimension := SetDim(x,y,cx,cy);
end;

APIClassParams( ) では、ウィンドウ関数に PanelWndProc( ) を指定した他は前節でコードで作ったパネルと同じクラス属性を設定している。 敬称メソッドを呼び出さずに、完全に書き換えている。 APICreateParams( ) も前節と同じ設定である。 PanelWndProc( ) では、WM_CREATE のときにウィンドウオブジェクトにプロパティーを設定し、ハンドルプロパティーを初期化している。 また WM_PAINT と WM_ERASEBKGND メッセージのときだけパスカルオブジェクトに配送している。 そして、WM_DESTROY のときにパスカルオブジェクトを破棄している。

DefaultHandler( ) では、WM_PAINT の処理として５−２節でスピードボタンの外観を描くために使った DrawEdge( ) ＡＰＩを使って、３Ｄ的な表示をしている。 WM_ERASEBKGND の処理では、 Color プロパティーを使って背景色を描画している。

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

program APIPanel02;

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;

  PL1, PL2, PL3, PL4, PL5: TAPIPanel;
  Btn1: TAPIButton;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure Btn1Click(var Msg: TMessage);
begin
  DestroyWindow(PL4.Handle);
end;

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

  PL1 := CreatePanel(hWindow,10,10,100,100);
  PL2 := CreatePanel(hWindow,120,10,100,100);
  PL3 := CreatePanel(hWindow,230,10,100,100);
  PL4 := CreatePanel(hWindow,10,120,200,120);
  PL5 := CreatePanel(PL4.Handle,10,10,150,100);
  Btn1 := CreateButton(PL5.Handle,20,20,100,40,'APIButton',Btn1Click);

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

procedure OnTest(hWindow: HWND);
begin
  PL1.OuterEdge := esSunken;
  PL2.InnerEdge := esSunken;
  PL3.OuterEdge := esSunken;
  PL3.EdgeWidth := 3;
  PL3.InnerEdge := esRaised;
  PL4.Color := clrPurple;
  PL5.EdgeWidth := 5;
  PL5.InnerEdge := esSunken;
  PL5.Color := clrGreen;
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.gifAPIPanel02.zip(16.145kB)
APIPanel02.gif

実行すると、五枚のパネルとボタンが一つ作られる。 Test! メニューを選択すると、 右図のようにエッジスタイルと色が変更される。 ボタンを押すと、 自分がのっているパネルの下の方が削除される。

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

１１−３ パネルの配置

パネルは、 コントロールを配置するウィンドウである。 もし、ユーザーがメインウィンドウのサイズを変更したとしても、 それに追随してコントロールを配置できることが望ましい。ＶＣＬの TPanel には、パネル自身を親ウィンドウに対してどのように配置するのかを決定する TControl から継承した Align プロパティーがある。 この節では、 メインウィンドウの WM_SIZE メッセージを処理して、コードでパネルの配置を処理することを試みる。

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

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

program Arranger01;

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;

  PL: array[0..3] of TAPIPanel;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainSize(var Msg: TMessage);
var
  w,h: integer;
begin
  w := Msg.LParamLo div 3;
  h := Msg.LParamHi div 2;
  PL[0].Dimension := SetDim(0,0,w,h);
  PL[1].Dimension := SetDim(w,0,w*2,h);
  PL[2].Dimension := SetDim(0,h,w*2,h);
  PL[3].Dimension := SetDim(w*2,h,w,h);
end;

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

  for i := 0 to 3 do PL[i] := CreatePanel(hWindow,0,0,0,0);

  with MainWnd do begin
    Trap(WM_SIZE,MainSize);
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
  end;
  Randomize;
end;

procedure OnTest(hWindow: HWND);
var
  i: integer;
begin
  for i := 0 to 3 do
    PL[i].Color := RGB(Random(256),Random(256),Random(256));
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.gifArranger01.zip(14.221kB)

Arranger011.gif Arranger012.gif

実行すると、左上図のように４枚のパネルが配置される。メインウィンドウのサイズを変更しても相対的な配置は保たれる。Test! メニューを選択するとパネルの色がランダムに変更される。このときの様子を右上図に示した。

MainCreate( ) ハンドラで４枚のパネルが作られている。 Trap( ) メソッドで WM_SIZE メッセージを MainSize( ) ハンドラで処理することを依頼する。 MainSize( ) ハンドラを見てみよう。

procedure MainSize(var Msg: TMessage);
var
  w,h: integer;
begin
  w := Msg.LParamLo div 3;
  h := Msg.LParamHi div 2;
  PL[0].Dimension := SetDim(0,0,w,h);
  PL[1].Dimension := SetDim(w,0,w*2,h);
  PL[2].Dimension := SetDim(0,h,w*2,h);
  PL[3].Dimension := SetDim(w*2,h,w,h);
end;

WM_SIZE の Msg.LParamLo と Msg.LParamHi からクライアント領域の幅と高さを取り出し、幅を三等分、高さを二等分したものを単位として、各パネルの位置とサイズを決定している。 このような配置方法は JAVA に見られるものでグリッドレイアウトと呼ばれている。 ここでは、レイアウトのかわりにアレンジャーと言うことにしよう。 これで、サイズ変更に追随することができるわけだ。

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

１１−４ グリッドアレンジャークラス

前節のグリッドアレンジャーの機能を包み込んだクラスを作成してみよう。 親ウィンドウの WM_SIZE メッセージを捕獲してイベントを公開できればよいので、TSubClass から直接派生して、UtilClass.pas に作成することにしよう。

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

最初に、UTilClass.pas に TGridArranger クラスを作成しよう。 宣言部を以下に示す。

//------------- TGridArranger ----------------------------------------------
TGridArranger = class(TSubClass)
private
  FNumCol: integer;
  FNumRow: integer;
  FXMargin: integer;
  FYMargin: integer;
  FXSep: integer;
  FYSep: integer;
  FOnSize: TNotifyMessage;
public
  constructor Create(hParent: HWND); override;
  procedure DefaultHandler(var Message);override;
  function Arrange(Row,Col: integer): TRect;
  function CenterArrange(Row,Col:integer;Dim: TRect): TRect;
  property NumCol: integer read FNumCol write FNumCol;
  property NumRow: integer read FNumRow write FNumRow;
  property XMargin: integer read FXMargin write FXMargin;
  property YMargin: integer read FYMargin write FYMargin;
  property XSep: integer read FXSep write FXSep;
  property YSep: integer read FYSep write FYSep;
  property OnSize: TNotifyMessage read FOnSize write FOnSize;
end;

NumRow と NumCol プロパティーは、格子状に分割するときの行と列の数である。 XMargin と YMargin は、親ウィンドウの左右と上下の余白の値、XSep と YSep は、配置されるコントロール同士の隙間の幅と高さである。 Arrange( ) メソッドは、行と列を指定するとその Dimension を返してくれる。 CenterArrange( ) メソッドは、コントロールのサイズを変えずに位置だけを格子の中心に揃えるような Dimension を返してくれる。 これらのメソッドは、OnSize イベントハンドラの中で使われる。
実装部を以下に示す。

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

  Dispatcher.TrapMessage(WM_SIZE,self);
  FNumCol := 2;
  FNumRow := 2;
  FXMargin := 0;
  FYMargin := 0;
  FXSep := 1;
  FYSep := 1;
end;

procedure TGridArranger.DefaultHandler(var Message);
var
  AMsg: TMessage;
begin
  AMsg := TMessage(Message);
  case AMsg.Msg of
    WM_SIZE:begin
      if Assigned(FOnSize) then begin
        AMsg.Msg := UINT(self); // sender
        OnSize(AMsg);
      end;
    end;
  end; // case
end;

function TGridArranger.Arrange(Row,Col: integer): TRect;
var
  CR: TRect;
begin
  GetClientRect(FParent,CR);
  result.Right := (CR.Right-2*FXMargin-FXSep*(FNumCol-1)) div FNumCol;
  result.Bottom := (CR.Bottom-2*FYMargin-FYSep*(FNumRow-1)) div FNumRow;
  result.Left := FXMargin+(result.Right+FXSep)*Row;
  result.Top := FYMargin+(result.Bottom+FYSep)*Col;
end;

function TGridArranger.CenterArrange(Row,Col:integer;Dim: TRect): TRect;
var
  CR: TRect;
begin
  CR := Arrange(Row,Col);
  result := Dim;
  if CR.Right < Dim.Right then
    result.Left := CR.Left
  else
    result.Left := (CR.Right-Dim.Right) div 2 + CR.Left;

  if CR.Bottom < Dim.Bottom then
    result.Top := CR.Top
  else
    result.Top := (CR.Bottom-Dim.Bottom) div 2 + CR.Top;
end;

コンストラクタでは、Dispatcher に WM_SIZE メッセージを送ってくれるよう依頼している。 DefaultHandler ではこのメッセージを捕まえて OnSize ハンドラを呼び出している。 他の二つのメソッドについては、説明の必要はないだろう。設定されたプロパティーの値をつかって、格子の Dimension を計算しているだけだ。
これでこのクラスは完成したので、インスタンス生成関数を作ろう。宣言部は、

function CreateGridArranger(hParent:HWND;iRow,iCol,XMrgn,YMrgn,
            XSp,YSp:integer; sOnSize:TNotifyMessage): TGridArranger;

であり、実装部は、

function CreateGridArranger(hParent:HWND;iRow,iCol,XMrgn,YMrgn,
            XSp,YSp:integer; sOnSize:TNotifyMessage): TGridArranger;
begin
  result := TGridArranger.Create(hParent);
  with result do begin
    NumRow := iRow;
    NumCol := iCol;
    XMargin := XMrgn;
    YMargin := YMrgn;
    XSep := XSp;
    YSep := YSp;
    OnSize := sOnSize;
  end;
end;

となる。このクラスをテストするプログラムを Arranger02.dpr に作成しよう。 以下に全リストを示す。

program Arranger02;

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;

  PL: array[0..2] of TAPIPanel;
  Btn: array[0..2] of TAPIButton;
  GA1,GA2: TGridArranger;
  L1: TAPILabel;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure GA1Size(var Msg: TMessage);
var
  r: TRect;
begin
  PL[0].Dimension := GA1.Arrange(0,0);
  r := GA1.Arrange(1,0);
  PL[1].Dimension := SetDim(r.Left,r.Top,r.Right,r.Bottom*2+GA1.YSep);
  PL[2].Dimension := GA1.Arrange(0,1);
end;

procedure GA2Size(var Msg: TMessage);
var
  i: integer;
begin
  for i := 0 to 2 do
    Btn[i].Dimension := GA2.Arrange(0,i);
  L1.Dimension := GA2.CenterArrange(0,3,L1.Dimension);
end;

procedure BtnClick(var Msg: TMessage);
begin
  PL[TAPIButton(Msg.Msg).Data].Color := RGB(Random(256),
                       Random(256),Random(256));
end;

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

  for i := 0 to 2 do PL[i] := CreatePanel(hWindow,0,0,0,0);
  for i := 0 to 2 do begin
    Btn[i] := CreateButton(PL[1].Handle,0,0,0,0,
              'Button '+AIntToStr(i),BtnClick);
    Btn[i].Data := i;
  end;

  L1 := CreateLabel(PL[1].Handle,10,10,120,25,'CenterArrange');

  GA1 := CreateGridArranger(hWindow,2,2,5,5,2,2,GA1Size);
  GA2 := CreateGridArranger(PL[1].Handle,4,1,10,10,2,2,GA2Size);

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
  end;
  Randomize;
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.gifArranger02.zip(17.693kB)
Arranger02.gif

実行すると、二つのグリッドアレンジャーが作られる。 一つ目は、メインウィンドウを縦横に４分割し、三枚のパネルを配置している。 二つ目は、 ２番目のパネルを４行１列に分割して、上から三つにボタンを配置し、一番下ののグリッドにラベルを CenterArrange している。 この様子を右図に示す。 ボタンを押すと対応するパネルの色がランダムに変更される。サイズを変更しても相対は位置は変わらないことを確認できるだろう。

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

１１−５ ボーダーアレンジャークラス

前節のグリッドアレンジャーより TPanel の Align プロパティーに近い配置を実現するボーダーアレンジャークラスを作成しよう。 このアレンジャーは、親ウィンドウを上下左右と残りの中央の五つに分割するものだ。上下配置については高さを指定し、幅は親ウィンドウのマージン以外の幅と同じになる。 左右配置については、幅だけを指定し、高さは上下配置に挟まれた高さによって決まる。 中央配置は、 残り全部を覆う。 もちろん、幅や高さをゼロに指定すると５分割のうちの一部だけにコントロールを配置することもできる。 例えば、上下配置だけとか、左と中央だけとかである。 それでは早速、UtilClass.pas に作成しよう。

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

最初に UtilClass.pas に TBorderArranger クラスを作成する。宣言部を以下に示す。

//------------- TBorderArranger ----------------------------------------------
TBorderPos = (bpUpper,bpLower,bpLeft,bpRight,bpCenter);

TBorderArranger = class(TSubClass)
private
  FUpperHeight: integer;
  FLowerHeight: integer;
  FLeftWidth: integer;
  FRightWidth: integer;
  FXMargin: integer;
  FYMargin: integer;
  FXSep: integer;
  FYSep: integer;
  FOnSize: TNotifyMessage;
public
  constructor Create(hParent: HWND); override;
  procedure DefaultHandler(var Message);override;
  function Arrange(BorderPos:TBorderPos): TRect;
  property UpperHeight: integer read FUpperHeight write FUpperHeight;
  property LowerHeight: integer read FLowerHeight write FLowerHeight;
  property LeftWidth: integer read FLeftWidth write FLeftWidth;
  property RightWidth: integer read FRightWidth write FRightWidth;
  property XMargin: integer read FXMargin write FXMargin;
  property YMargin: integer read FYMargin write FYMargin;
  property XSep: integer read FXSep write FXSep;
  property YSep: integer read FYSep write FYSep;
  property OnSize: TNotifyMessage read FOnSize write FOnSize;
end;

上下配置の高さと左右配置の幅のプロパティーがある他は、TGridArranger とほぼ同じである。 実装部を以下に示す。

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

  Dispatcher.TrapMessage(WM_SIZE,self);
  FUpperHeight := 0;
  FLowerHeight := 0;
  FLeftWidth := 0;
  FRightWidth  := 0;
  FXMargin := 0;
  FYMargin := 0;
  FXSep := 1;
  FYSep := 1;
end;

procedure TBorderArranger.DefaultHandler(var Message);
var
  AMsg: TMessage;
begin
  AMsg := TMessage(Message);
  case AMsg.Msg of
    WM_SIZE:begin
      if Assigned(FOnSize) then begin
        AMsg.Msg := UINT(self); // sender
        OnSize(AMsg);
      end;
    end;
  end; // case
end;

function TBorderArranger.Arrange(BorderPos:TBorderPos): TRect;
var
  CR: TRect;
begin
  GetClientRect(FParent,CR);
  case BorderPos of
    bpUpper: begin
      result.Left := FXMargin;
      result.Top := FYMargin;
      result.Right := CR.Right-FXMargin*2;
      result.Bottom := FUpperHeight;
    end;
    bpLower: begin
      result.Left := FXMargin;
      result.Top := CR.Bottom-FYMargin-FLowerHeight;
      result.Right := CR.Right-FXMargin*2;
      result.Bottom := FLowerHeight;
    end;
    bpLeft: begin
      result.Left := FXMargin;
      result.Top := FYMargin+FUpperHeight+FYSep;
      result.Right := FLeftWidth;
      result.Bottom := CR.Bottom-FUpperHeight-FLowerHeight-FYMargin*2-FYSep*2;
    end;
    bpRight: begin
      result.Left := CR.Right-FXMargin-FRightWidth;
      result.Top := FYMargin+FUpperHeight+FYSep;
      result.Right := FRightWidth;
      result.Bottom := CR.Bottom-FUpperHeight-FLowerHeight-FYMargin*2-FYSep*2;
    end;
    bpCenter: begin
      result.Left := FXMargin+FLeftWidth+XSep;
      result.Top := FYMargin+FUpperHeight+YSep;
      result.Right := CR.Right-FLeftWidth-FRightWidth-FXSep*2-FXMargin*2;
      result.Bottom := CR.Bottom-FUpperHeight-FLowerHeight-FYMargin*2-FYSep*2;
    end;
  end;
end;

実装部については説明の必要はないだろう。 最後にインスタンス生成関数をつくる。宣言部は、

function CreateBorderArranger(hParent:HWND;UH,LH,LW,RW,XMrgn,YMrgn,
            XSp,YSp:integer; sOnSize:TNotifyMessage): TBorderArranger;

であり、実装部は、

function CreateBorderArranger(hParent:HWND;UH,LH,LW,RW,XMrgn,YMrgn,
            XSp,YSp:integer; sOnSize:TNotifyMessage): TBorderArranger;
begin
  result := TBorderArranger.Create(hParent);
  with result do begin
    UpperHeight := UH;
    LowerHeight := LH;
    LeftWidth := LW;
    RightWidth := RW;
    XMargin := XMrgn;
    YMargin := YMrgn;
    XSep := XSp;
    YSep := YSp;
    OnSize := sOnSize;
  end;
end;

である。

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

program Arranger03;

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;

  Pnl: array[0..4] of TAPIPanel;
  Btn: array[0..4] of TAPIButton;
  BA: TBorderArranger;
  GA: TGridArranger;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure BtnClick(var Msg: TMessage);
begin
  Pnl[TAPIButton(Msg.Msg).Data].Color := RGB(Random(256),
                                         Random(256),Random(256));
end;

procedure OnBASize(var Msg: TMessage);
var
  i: integer;
begin
  for i := 0 to 4 do
    Pnl[i].Dimension := BA.Arrange(TBorderPos(i));
end;

procedure OnGASize(var Msg: TMessage);
var
  i: integer;
begin
  for i := 0 to 4 do
    Btn[i].Dimension := GA.Arrange(0,i);
end;

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

  for i := 0 to 4 do Pnl[i] := CreatePanel(hWindow,0,0,0,0);

  for i := 0 to 4 do begin
    Btn[i] := CreateButton(Pnl[3].Handle,0,0,0,0,
                            'Button '+AIntToStr(i),BtnClick);
    Btn[i].Data := i;
  end;

  BA := CreateBorderArranger(hWindow,20,40,50,120,3,3,0,0,OnBASize);
  GA := CreateGridArranger(Pnl[3].Handle,6,1,5,5,3,3,OnGASize);

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

  Randomize;
end;

procedure OnTest(hWindow: HWND);
begin
  with Pnl[4] do begin
    EdgeWidth := 4;
    InnerEdge := esSunken;
  end;
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.gifArranger03.zip(17.152kB)
Arranger03.gif

実行すると右の図のようになる。 MainCreate( ) ハンドラでパネルとボタンを五個ずつつくり、グリッドアレンジャーとボーダーアレンジャーを一つずつ作っている。 ボーダーアレンジャーでパネルを配置し、 グリッドアレンジャーで左配置のパネルにボタンを配置している。 ボタンを押すと対応するパネルの色がランダムに変更される。 Test! メニューで中央配置のパネルのエッジスタイルが変更される。
Arranger04.gif

グリッドアレンジャーとボーダーアレンジャーを組み合わせるといろいろな配置ができるようになる。 右の図のような配置にするにはどうしたらよいか、考えてほしい。

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

１１−６ メッセージトラッパ

前節までに作成した二つのアレンジャークラスは、特定のウィンドウオブジェクトの WM_SIZE メッセージを捕捉して処理する非可視のクラスであった。 特定のウィンドウオブジェクトのウィンドウ関数に送られる任意のメッセージを捕捉してイベントハンドラのかたちで公開できれば、例えば一切のイベントを公開していない TAPIPanel や、ボタン類やリストボックスのような標準コントロールでも公開していないメッセージを処理することができるようになるだろう。 この節では、 TSubClass から派生し、特定のウィンドウオブジェクトから任意のメッセージを任意個捕捉して、イベントハンドラのかたちで呼び出す小さなクラス TMessageTrapper を作成しよう。

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

まず UtilClass.pas に、TMessageTrapper クラスを作成しよう。 宣言部を以下に示す。

//------------- MessageTrapper ---------------------------------
TMessageTrapper = class(TSubClass)
private
  FTrapMessage: TIntegerList;
  FHandler: TIntegerList;
  FNumTrap: integer;
public
  constructor Create(hParent: HWND); override;
  destructor Destroy; override;
  procedure DefaultHandler(var Message);override;
  procedure TrapMessage(TrapMsg: UINT; Handler: TNotifyMessage);
end;

private 部の FTrapMessage は捕捉するメッセージを、FHandler は対応する TNotifyMessage 型のイベントハンドラのアドレスを、FNumTrap は捕捉するメッセージの数を、それぞれ保持するためのものである。 実装部を以下に示す。

//------------- MessageTrapper ---------------------------------
constructor TMessageTrapper.Create(hParent: HWND);
begin
  inherited Create(hParent);
  FTrapMessage := TIntegerList.Create(1,1);
  FHandler := TIntegerList.Create(1,1);
end;

destructor TMessageTrapper.Destroy;
begin
  FTrapMessage.Free;
  FHandler.Free;
  inherited Destroy;
end;

procedure TMessageTrapper.DefaultHandler(var Message);
var
  AMsg: TMessage;
  i: integer;
begin
  AMsg := TMessage(Message);
  for i := 0 to FNumTrap-1 do
    if AMsg.Msg = DWORD(FTrapMessage[i]) then
      if FHandler[i] <> 0 then begin
        TNotifyMessage(FHandler[i])(AMsg);
        if AMsg.Result <> 0 then
          TMessage(Message).result := AMsg.Result;
      end;
end;

procedure TMessageTrapper.TrapMessage(TrapMsg: UINT;Handler: TNotifyMessage);
begin
  FTrapMessage.Add(TrapMsg);
  FHandler.Add(integer(@Handler));
  Dispatcher.TrapMessage(TrapMsg,self);
  inc(FNumTrap);
end;

コンストラクタでは、二つの TIntegerList 型のフィールド変数を生成し、デストラクタで破棄している。 TrapMessage( ) メソッドでは、捕捉するメッセージとハンドラを記憶してから Dispatcher に配送してくれるよう依頼している。 DefaultHandler( ) では、メッセージに対応したイベントハンドラを呼び出しているだけだ。 これで TMessageTrapper クラスは完成したので MessageTrapper.dpr にテストプログラムを書こう。 以下に全リストを示す。 

program MessageTrapper;

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,L2: TAPILabel;
  PL: TAPIPanel;
  Btn: TAPIButton;

  MT1,MT2,MT3: TMessageTrapper;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainMouseMove(var Msg: TMessage);
begin
  L1.Text := 'X = '+AIntToStr(Msg.LParamLo)+#9+
             'Y = '+AIntToStr(Msg.LParamHi);
end;

procedure PanelMouseMove(var Msg: TMessage);
begin
  L2.Text := 'X = '+AIntToStr(Msg.LParamLo)+#9+
             'Y = '+AIntToStr(Msg.LParamHi);
end;

procedure PanelLButtonUp(var Msg: TMessage);
begin
  PL.Color := clrGreen;
end;

procedure PanelRButtonUp(var Msg: TMessage);
begin
  MainWnd.Close;
end;

procedure ButtonMouseMove(var Msg: TMessage);
begin
  Btn.Caption := 'X = '+AIntToStr(Msg.LParamLo)+
                 ' Y = '+AIntToStr(Msg.LParamHi);
end;

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

  L1 := CreateLabel(hWindow,10,10,200,30,'Label');
  PL := CreatePanel(hWindow,10,50,200,100);
  L2 := CreateLabel(PL.Handle,10,10,180,30,'LabelOnPanel');
  Btn := CreateButton(hWindow,10,160,200,90,'Button',nil);

  MT1 := TMessageTrapper.Create(hWindow);
  MT1.TrapMessage(WM_MOUSEMOVE,MainMouseMove);

  MT2 := TMessageTrapper.Create(PL.Handle);
  MT2.TrapMessage(WM_MOUSEMOVE,PanelMouseMove);
  MT2.TrapMessage(WM_LBUTTONUP,PanelLButtonUp);
  MT2.TrapMessage(WM_RBUTTONUP,PanelRButtonUp);

  MT3 := TMessageTrapper.Create(Btn.Handle);
  MT3.TrapMessage(WM_MOUSEMOVE,ButtonMouseMove);

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

procedure OnTest(hWindow: HWND);
begin
  PL.XPos := 150;
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.gifMessageTrapper.zip(17.526kB)
MessageTrapper.gif

実行すると右図のようになる。 MainCreate( ) で、パネルとボタンをつくり、さらに三個のメッセージトラッパをつくっている。それぞれ、メインウィンドウとパネルとボタンの WM_MOUSEMOVE メッセージを捕捉し、マウス座標をラベルやテキストに表示している。 ボタンもウィンドウであることが実感できるだろう。 さらにパネルでは、 WM_LBUTTONUP メッセージを捕捉して背景色を変更し、WM_RBUTTONUP ではプログラムを終了している。

ここで作成した TMessageTrapper クラスは、もちろん ＲＡＤでの Form1 やその他のウィンドウオブジェクトに対しても正常に動作する。試してほしい。

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

１１−７ まとめ

前章では、メインウィンドウのラッパークラスを作成した。 続いて、本章では、 汎用子ウィンドウとしてパネルのラッパークラス TAPIPanel を作成した。 また、パネルや他のコントロールを配置するコードを包み込んで、グリッドアレンジャー TGridArranger とボーダーアレンジャー TBorderArranger クラスを作成しテストした。 さらに、特定のウィンドウオブジェクトの任意のメッセージを捕捉してイベントハンドラを呼び出す TMessageTrapper クラスを作成した。

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

  1. Skeleton03.dpr (2 kB)
  2. UtilFunc.pas (10 kB)
  3. UtilClass.pas (31 kB)
  4. GDIObject.pas (16 kB)
  5. APIControl.pas (28 kB)
  6. APIWindow.pas (19 kB)


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