第２９章 タブコントロールとページコントロール


Delphi のＩＤＥ環境におけるコンポーネントパレットには、多数のコンポーネントがグループ分けされて登録されており、グループ毎にページを示すタブを選択することにより、非常に限られた領域において多数のコンポーネントにアクセスできるように工夫されている｡ これには、タブコントロールを利用したページコントロールが使用されている｡ このようなタブコントロールは、１６ビットの Delphi の最初のバージョンにもあったが、Win32 以降でＯＳがサポートするコントロールとして提供されたものである｡ コンポーネントパレットの Win32 ページの最初は、タブコントロールとページコントロールである｡ どちらも、限られたスペース内で多くの機能にアクセスするために用いられる｡ タブコントロールは単独で使われることはあまりなく、ページコントロールの枠組みを与えるコントロールと思われる｡ この章では､ Win32 が提供するコモンコントロールの一つとして、タブコントロールの使い方を調べ、そのラッパークラスを作成する。さらに、タブの選択と同期してパネルの可視・不可視プロパティーを制御することにより、ＶＣＬのページコントロールに相当するクラスを作成する。

２９−０ この章の内容


第２９章 タブコントロールとページコントロール
２９−１ タブコントロールをコードでつくる
２９−２ フォントとアイコンを設定する
２９−３ さまざまなスタイル
２９−４ タブコントロールのラッパークラス
２９−５ 縦型タブ
２９−６ ページコントロールをコードで作る
２９−７ ページコントロールのラッパークラス
２９−８ まとめ


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

２９−１ タブコントロールをコードでつくる

タブコントロールは CreateWindow( ) または CreateWindowEx( ) に、WC_TABCONTROL クラスを指定して作成する。

const
  WC_TABCONTROL = 'SysTabControl32';

ウィンドウスタイルには、WS_CHILD（必須）のほか WS_VISIBLE、WS_TABSTOP、WS_CLIPSIBLINGS、 WS_CLIPCHILDREN などの他、後にしめすように、このクラス特有のスタイルが定義されている｡ この節では、デフォルトスタイルと TCS_MULTILINE スタイルについて試してみよう。TCS_MULTILINE スタイルは、サイズ変更したときなど全部のタブが表示しきれなくなると自動的に複数行に表示されるので便利である｡ このスタイルを設定しないと、デフォルトでは横向きのアップダウンコントロールによってタブ部分のスクロールがサポートされる｡

タブコントロールは作成された後で、他のコントロール同様、特別のメッセージを送ることにより遠隔操作される｡ ここでは、その幾つかについて試してみよう。作成直後のタブコントロールには、「タブつまみ」が一つもなく、単なるパネルのように見える。タブを追加するには以下のメッセージを送る。

TCM_INSERTITEM 
  wParam = (WPARAM) (int) iItem;               //index of the new tab 
  lParam = (LPARAM) (const TC_ITEM FAR*) pitem;  //pointer to struct specifying tab attributes

wParam には、追加・挿入するタブの位置を指定するゼロベースのインデックスを指定する。lParam には、追加・挿入するタブの内容を設定する以下のレコードのアドレスを指定する。

type
  PTCItemA = ^TTCItemA;
  PTCItem = PTCItemA;
  TTCItemA = packed record
    mask: UINT;
    lpReserved1: UINT;
    lpReserved2: UINT;
    pszText: PAnsiChar;
    cchTextMax: Integer;
    iImage: Integer;
    lParam: LPARAM;
  end;
  TTCItem = TTCItemA;

このレコードの mask フィールドには設定・取得するフィールドを指定する以下の定数を指定する｡

const
  TCIF_TEXT  = $0001;       // pszText フィールドが有効
  TCIF_IMAGE = $0002;       // iImage フィールドが有効
  TCIF_RTLREADING = $0004;  // アラビア語のように pszText を右から表示
  TCIF_PARAM = $0008;       // lParam フィールドが有効

pszText フィールドには、タブに表示するテキストのポインタを指定する。cchTextMax は、タブ情報を取得するときに用いられ、pszText フィールドで受け取る文字列バッファの最大値を指定する｡ iImage には、タブに表示するイメージのイメージリスト内でのインデックスを指定する｡ lParam は、アプリケーション定義の任意の３２ビットデータを設定できる。テキストだけであれば mask に TCIF_TEXT を設定し、pszText に PChar 型でテキストを設定すればよい｡ TCM_INSERTITEM メッセージの戻り値は、追加・挿入されたタブのインデックスである｡ 失敗するとー１を返す｡ これで、タブ項目が設定できた。各タブ項目の情報を取得するには、

TCM_GETITEM 
  wParam = (WPARAM) (int) iItem; 
  lParam = (LPARAM) (TC_ITEM FAR *) pitem;

メッセージを送る。wParam に取得したい項目のインデックスを、lParam には上記の TTCItem レコードの変数のアドレスを設定する。成功するとゼロ以外の数値が戻り値となる。すでに設置したタブ項目の内容を変更するには、

TCM_SETITEM 
  wParam = (WPARAM) (int) iItem;            // index of the item 
  lParam = (LPARAM) (TC_ITEM FAR *) pitem;  // pointer to struct containing item attributes

メッセージを送る。パラメータは、TCM_INSERTITEM のときと同じである。

ユーザーがマウスでタブを選択したときなどに親ウィンドウに送られる通知メッセージについて調べよう。

const
  TCN_KEYDOWN             = TCN_FIRST - 0; // キーが押された
  TCN_SELCHANGE           = TCN_FIRST - 1; // 選択タブが変更された
  TCN_SELCHANGING         = TCN_FIRST - 2; // 選択タブが変更されようとしている

これらは、WM_NOTIFY メッセージを通じて親ウィンドウに送られる。すでに ２５−１ コモンコントロール入門 で説明したが、繰り返すと

WM_NOTIFY 
  idCtrl = (int) wParam; 
  pnmh = (LPNMHDR) lParam;

通知メッセージは、この lParam でポインタとして渡される TNMHdr 型レコードの code フィールドに設定されている｡ このレコードの hwndFrom には、メッセージを送ったタブコントロールのハンドルが設定されている｡ 現在選択されているタブ項目のインデックスは、 TCM_GETCURSEL メッセージを送って取得する。

TCM_GETCURSEL 
  wParam = 0;   // not used; must be zero 
  lParam = 0;   // not used; must be zero

このメッセージの戻り値としてインデックスを取得できる｡ コードで特定のタブ項目を選択するには、TCM_SETCURSEL を送る。

TCM_SETCURSEL 
  wParam = (WPARAM) (int) iItem;  // index of the tab to select 
  lParam = 0;                     // not used; must be zero

wParam に選択するタブのインデックスを設定する。戻り値は、直前に選択されていたタブ項目のインデックスである｡ このメッセージを送ると、タブ部分は選択状態が指定通りに変化するが、TCN_SELCHANGE や TCN_SELCHANGING の通知が送られないことに注意すること｡ タブコントロールのタブ部分を除いた領域（表示領域）とタブコントロール全体のウィンドウ矩形との相互変換は、TCM_ADJUSTRECT メッセージを送って計算する｡

TCM_ADJUSTRECT 
  wParam = (WPARAM) (BOOL) fLarger;  // operation to perform 
  lParam = (LPARAM) (LPRECT) prc;    // pointer to a RECT structure

wParam にゼロを指定して、lParam に ウィンドウ矩形が入った TRect 型変数のアドレスを設定すると、この変数に表示領域の矩形が設定されて戻ってくる。wParam にゼロ以外を指定して､ lParam に表示領域を設定すると、それに対応するタブコントロールのウィンドウ矩形が得られる｡ 親ウィンドウの WM_SIZE メッセージに同期してタブコントロールの配置を変更するときは、このメッセージを使って表示領域の矩形を取得し、タブコントロールの子コントロールの配置を変更することもできる｡

以上の知識を使って、コードでタブコントロールを作ってテストしてみよう｡

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

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

program Tab01;

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

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

  hTab:HWND;

  Lbl:TAPILabel;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function GetTabText(hWindow:HWND;indx:integer):string;
var
  tci: TTCItem;
  PC:PChar;
begin
  GetMem(PC,50);
  tci.mask := TCIF_TEXT;
  tci.pszText := PC;
  tci.cchTextMax := 50;
  SendMessage(hWindow,TCM_GETITEM,indx,LPARAM(@tci));
  SetString(result,PC,lstrlen(PC));
  FreeMem(PC);
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainNotify(var Msg:TMessage);
var
  pNM: PNMHdr;
  PageNo: integer;
begin
  pNM := PNMHdr(Msg.LParam);
  if pNM^.hwndFrom <> hTab then exit;
  if pNM^.code = TCN_SELCHANGE then begin
    PageNo := SendMessage(hTab,TCM_GETCURSEL,0,0);
    Lbl.Text := GetTabText(hTab,PageNo);
  end;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
const
  Page: array[0..4] of string =
  ('Page 1','２ページ','三頁', 'fourth', '5-th Page');
var
  hWindow: HWND;
  tci: TTCItem;
  i:integer;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  InitCommonControls;

  hTab := CreateWindowEx(WS_EX_CONTROLPARENT,
                         WC_TABCONTROL,
                         '',
                         WS_VISIBLE or WS_CHILD or WS_TABSTOP or
                         WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
                         10,10,300,300,
                         hWindow,
                         0,
                         hInstance,
                         nil);
  tci.mask := TCIF_TEXT;
  for i := 0 to 4 do begin
    tci.pszText := PChar(Page[i]);
    SendMessage( hTab,TCM_INSERTITEM,i,integer(@tci));
  end;

  Lbl := CreateLabel(hTab,50,100,200,35,'Page 1');

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 320;
    Center;
    Trap(WM_NOTIFY,MainNotify);
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  SetWindowLong(hTab,GWL_STYLE,
        GetWindowLong(hTab,GWL_STYLE) or TCS_MULTILINE);
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.gifTab01.zip(26.743kB)
Tab01.gif

実行すると右図のようになる。タブつまみをマウスで選択すると選択状況がラベルに表示される。Test! メニューを選択すると TCS_MULTILINE スタイルが追加され、タブ部分の表示が二段になる。

コードを調べよう。タブコントロールは CreateWindowEx( ) に WC_TABCONTROL クラスを指定して作成している。

  hTab := CreateWindowEx(WS_EX_CONTROLPARENT,
                         WC_TABCONTROL,
                         '',
                         WS_VISIBLE or WS_CHILD or WS_TABSTOP or
                         WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
                         10,10,300,300,
                         hWindow,
                         0,
                         hInstance,
                         nil);

ここでは、タブコントロール特有のスタイルを一つも設定していないので、作成されるのはデフォルトのタブコントロールである。作成後、以下のようにして５つの項目を追加している。

  tci.mask := TCIF_TEXT;
  for i := 0 to 4 do begin
    tci.pszText := PChar(Page[i]);
    SendMessage( hTab,TCM_INSERTITEM,i,integer(@tci));
  end;

ここでは、文字項目だけを設定している｡ Test! メニューでは、以下のようにして TCS_MULTILINE スタイルを追加している。

procedure OnTest(hWindow: HWND);
begin
  SetWindowLong(hTab,GWL_STYLE,
        GetWindowLong(hTab,GWL_STYLE) or TCS_MULTILINE);
end;

このように、タブコントロール特有のスタイルの多くは、コントロールを作成後でも設定・解除ができるようだ。ユーザがマウスでタブ項目をクリックすると TCN_SELCHANGE 通知メッセージを WM_NOTIFY メッセージにのせて親ウィンドウに送られる。ここでは、MainWnd でこれを捕まえ、以下のようにして処理している。

procedure MainNotify(var Msg:TMessage);
var
  pNM: PNMHdr;
  PageNo: integer;
begin
  pNM := PNMHdr(Msg.LParam);
  if pNM^.hwndFrom <> hTab then exit;
  if pNM^.code = TCN_SELCHANGE then begin
    PageNo := SendMessage(hTab,TCM_GETCURSEL,0,0);
    Lbl.Text := GetTabText(hTab,PageNo);
  end;
end;

ここでは、lParam から TNMHdr レコードへのポインタを取り出して、そのフィールドを参照して、このメッセージが hTab から送られたこと、そして、通知が TCN_SELCHANGE であることを確認してから、選択状態にあるタブのインデックスを取得し、さらにそのテキストを取得してラベルに表示している。タブ項目のテキストは以下のようにして取得している。

function GetTabText(hWindow:HWND;indx:integer):string;
var
  tci: TTCItem;
  PC:PChar;
begin
  GetMem(PC,50);
  tci.mask := TCIF_TEXT;
  tci.pszText := PC;
  tci.cchTextMax := 50;
  SendMessage(hWindow,TCM_GETITEM,indx,LPARAM(@tci));
  SetString(result,PC,lstrlen(PC));
  FreeMem(PC);
end;

これは、設定時と違って pszText フィールドに文字列を受け取るバッファを設定しているだけである｡

以上で、基本的なタブコントロールに対する具体的なイメージが得られただろう。

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

２９−２ フォントとアイコンを設定する

この節では､ タブコントロールにフォントとアイコンを設定してみよう。フォントの設定は通常の標準コントロールと同様に WM_SETFONT メッセージを送るだけである。

WM_SETFONT 
  wParam = (WPARAM) hfont;            // handle of font 
  lParam = MAKELPARAM(fRedraw, 0);    // redraw flag

この節では、この機構をカプセル化して １６−５ 論理フォントのカプセル化：その３ で作った TAPICFont クラスのインスタンスを使ってみよう｡ タブつまみ部分に画像を表示するには、画像を保持したイメージリストをタブコントロールに設定し、各項目ごとに、そのイメージリストが保持しているイメージのインデックスを指定してやればよいのだ。タブコントロールにイメージリストを設定するには、

TCM_SETIMAGELIST 
  wParam = 0;                           // not used; must be zero 
  lParam = (LPARAM) (HIMAGELIST) himl;  // handle of image list to assign to tab control

メッセージを送る。また、設定されているイメージリストのハンドルを取得するには、

TCM_GETIMAGELIST 
  wParam = 0;   // not used; must be zero 
  lParam = 0;   // not used; must be zero

メッセージを送ると戻り値として得られる｡ それでは早速試してみよう。

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

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

program Tab02;

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

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

  hTab:HWND;

  Lbl:TAPILabel;
  hIM: HImageList;
  ft: TAPICFont;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function GetTabText(hWindow:HWND;indx:integer):string;
var
  tci: TTCItem;
  PC:PChar;
begin
  GetMem(PC,50);
  tci.mask := TCIF_TEXT;
  tci.pszText := PC;
  tci.cchTextMax := 50;
  SendMessage(hWindow,TCM_GETITEM,indx,LPARAM(@tci));
  SetString(result,PC,lstrlen(PC));
  FreeMem(PC);
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainNotify(var Msg:TMessage);
var
  pNM: PNMHdr;
  PageNo: integer;
begin
  pNM := PNMHdr(Msg.LParam);
  if pNM^.hwndFrom <> hTab then exit;
  if pNM^.code = TCN_SELCHANGE then begin
    PageNo := SendMessage(hTab,TCM_GETCURSEL,0,0);
    Lbl.Text := GetTabText(hTab,PageNo);
  end;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
const
  Page: array[0..5] of string =
  ('Page 1','２ページ','三頁', 'fourth', '5-th Page','６ぺーじ');
var
  hWindow: HWND;
  tci: TTCItem;
  i:integer;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  InitCommonControls;

  hTab := CreateWindowEx(WS_EX_CONTROLPARENT,
                         WC_TABCONTROL,
                         '',
                         WS_VISIBLE or WS_CHILD or WS_TABSTOP or
                         WS_CLIPSIBLINGS or WS_CLIPCHILDREN or
                         TCS_MULTILINE,
                         10,10,300,300,
                         hWindow,
                         0,
                         hInstance,
                         nil);

  hIM := ImageList_Create(16,16,ILC_COLOR8 or ILC_MASK,0,0);

  for i := 0 to 5 do
    ImageList_AddIcon(hIM,LoadIcon(0,MakeIntResource(32512+i)));

  SendMessage(hTab,TCM_SETIMAGELIST,0,hIM);

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

  ft.SetHandle(hTab);

  tci.mask := TCIF_TEXT or TCIF_IMAGE;
  for i := 0 to 5 do begin
    tci.pszText := PChar(Page[i]);
    tci.iImage := i;
    SendMessage( hTab,TCM_INSERTITEM,i,integer(@tci));
  end;

  Lbl := CreateLabel(hTab,50,100,200,35,'Page 1');

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 320;
    Center;
    Trap(WM_NOTIFY,MainNotify);
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  with ft do begin
    ResetHandle(hTab);
    Name := 'ＭＳ Ｐゴシック';
    Size := 8;
    GetHandle;
    SetHandle(hTab);
  end;
  SetWindowLong(hTab,GWL_STYLE,
        GetWindowLong(hTab,GWL_STYLE) or TCS_FIXEDWIDTH);
end;

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

procedure MainDestroy(var Msg: TMessage);
begin
  ImageList_Destroy(hIM);
  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.gifTab02.zip(27.238kB)
Tab02.gif

実行すると右図のようになる。Test! メニューを選択するとフォントが変更されるのと同時に、TCS_FIXEDWIDTH スタイルが追加されて、タブの幅が全て同じになる｡

コードを見てみよう。イメージリストは以下のように設定している。

  hIM := ImageList_Create(16,16,ILC_COLOR8 or ILC_MASK,0,0);

  for i := 0 to 5 do
    ImageList_AddIcon(hIM,LoadIcon(0,MakeIntResource(32512+i)));

  SendMessage(hTab,TCM_SETIMAGELIST,0,hIM);

ここでは、前章でカプセル化したクラスを使わずに、ImageList_Create( ) でイメージリストを作成し、６個の定義済みアイコンを追加してから、そのハンドルをタブコントロールに設定している。ここでは、16x16 の小さいアイコンにしたが、32x32 のサイズにしたらどうなるか、試してみてほしい。設定されたタブコントロールのタブ部分の高さや幅が自動的に調整されるのが分かるだろう。イメージリストが保持している画像と各タブつまみの対応は、

  tci.mask := TCIF_TEXT or TCIF_IMAGE;
  for i := 0 to 5 do begin
    tci.pszText := PChar(Page[i]);
    tci.iImage := i;
    SendMessage( hTab,TCM_INSERTITEM,i,integer(@tci));
  end;

のようにして、iImage フィールドに画像のインデックスを指定することで行う｡

フォントは以下のように TAPICFont クラスのインスタンスを作成して設定している。

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

  ft.SetHandle(hTab);

そして、この作成したイメージリストと TAPICFont クラスのインスタンスは MainDestroy( ) で破棄している。

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

２９−３ さまざまなスタイル

この節では､ タブコントロールにいろいろなスタイルを設定してみよう。その前に、このコントロールに送れるメッセージについてまとめておこう。

const
  TCM_FIRST              = $1300;
  TCM_GETIMAGELIST       = TCM_FIRST + 2;  // イメージリストのハンドルを取得
  TCM_SETIMAGELIST       = TCM_FIRST + 3;  // イメージリストの割り当て 
  TCM_GETITEMCOUNT       = TCM_FIRST + 4;  // タブ項目の数の取得
  TCM_DELETEITEM         = TCM_FIRST + 8;  // タブ項目の削除
  TCM_DELETEALLITEMS     = TCM_FIRST + 9;  // 全ての項目を削除
  TCM_GETITEMRECT        = TCM_FIRST + 10; // 特定タブ項目の境界矩形の取得
  TCM_GETCURSEL          = TCM_FIRST + 11; // 現在選択されているタブ項目の取得
  TCM_SETCURSEL          = TCM_FIRST + 12; // タブ項目の選択
  TCM_HITTEST            = TCM_FIRST + 13; // 特定の座標点にタブ項目があるかテスト
  TCM_SETITEMEXTRA       = TCM_FIRST + 14; // タブ項目に関連づけるデータのバイト数を設定
  TCM_ADJUSTRECT         = TCM_FIRST + 40; // ウィンドウ領域と表示領域の相互変換
  TCM_SETITEMSIZE        = TCM_FIRST + 41; // タブの幅と高さを設定
  TCM_REMOVEIMAGE        = TCM_FIRST + 42; // イメージリストから特定のイメージを削除
  TCM_SETPADDING         = TCM_FIRST + 43; // タブのアイコンとラベルの間に割り当てる領域の設定
  TCM_GETROWCOUNT        = TCM_FIRST + 44; // タブの行数の取得
  TCM_GETTOOLTIPS        = TCM_FIRST + 45; // ツールヒントのハンドルの取得
  TCM_SETTOOLTIPS        = TCM_FIRST + 46; // ツールヒントの割り当て
  TCM_GETCURFOCUS        = TCM_FIRST + 47; // フォーカスのあるタブ項目の取得
  TCM_SETCURFOCUS        = TCM_FIRST + 48; // 特定のタブ項目にフォーカスを設定
  TCM_GETITEM            = TCM_FIRST + 5;  // タブ項目の情報の取得
  TCM_SETITEM            = TCM_FIRST + 6;  // タブ項目の情報の設定
  TCM_INSERTITEM         = TCM_FIRST + 7;  // タブ項目の挿入

  TCM_SETMINTABWIDTH     = TCM_FIRST + 49; // タブつまみの最小幅を設定
  TCM_DESELECTALL        = TCM_FIRST + 50; // TCS_BUTTONS スタイル時に選択項目なしにする
  TCM_HIGHLIGHTITEM      = TCM_FIRST + 51; // 特定タブ項目をハイライト表示する
  TCM_SETEXTENDEDSTYLE   = TCM_FIRST + 52; // 拡張スタイルを設定する
  TCM_GETEXTENDEDSTYLE   = TCM_FIRST + 53; // 拡張スタイルを取得する

筆者の Delphi 3.1 の CommCtrl.pas には、TCM_SETMINTABWIDTH 以下のメッセージは定義されていない。最新バージョンでは定義されているかもしれないので、各自確認してほしい。

タブコントロールに設定できるウィンドウスタイルには以下のものがある｡

const
  TCS_SCROLLOPPOSITE    = $0001; // 選択されていないタブ項目を反対側に移動する
  TCS_BOTTOM            = $0002; // タブ項目を下に付ける
  TCS_RIGHT             = $0002; // TCS_VERTICAL と併用して、タブを右側に設置
  TCS_FORCEICONLEFT     = $0010; // アイコンを左詰めにし、テキストをセンタリング
  TCS_FORCELABELLEFT    = $0020; // アイコンとテキストを左詰めにする
  TCS_HOTTRACK          = $0040; // カーソルの下のボタンをハイライト表示する
  TCS_VERTICAL          = $0080; // TCS_RIGHT とともに設定してタブを右側に付ける
  TCS_TABS              = $0000; // デフォルト
  TCS_BUTTONS           = $0100; // タブ項目をボタンとして表示
  TCS_SINGLELINE        = $0000; // タブ項目は一行 + スクロール（デフォルト）
  TCS_MULTILINE         = $0200; // 表示しきれないときタブ項目を複数行にする
  TCS_RIGHTJUSTIFY      = $0000; // デフォルト
  TCS_FIXEDWIDTH        = $0400; // 全てのタブの幅は同じ
  TCS_RAGGEDRIGHT       = $0800; // タブ項目を左詰に表示
  TCS_FOCUSONBUTTONDOWN = $1000; // TCS_BUTTONS とともに設定してフォーカスを受け取る
  TCS_OWNERDRAWFIXED    = $2000; // オーナー描画
  TCS_TOOLTIPS          = $4000; // ツールヒントコントロールを作成する
  TCS_FOCUSNEVER        = $8000; // フォーカスを受け取らない

  TCS_MULTISELECT       = $0004; // TCS_BUTTONS と併用して､ 同時に複数選択可にする
  TCS_FLATBUTTONS       = $0008; // TCS_BUTTONS と併用して､ 平らなボタンにする

筆者の Delphi 3.1 の CommCtrl.pas には、TCS_MULTISELECT 以下のスタイルは定義されていない。最新バージョンでは定義されているかもしれないので、各自確認してほしい。

最新のヘルプを見ると、コントロール作成後に設定できるスタイルとして以下のものが挙げてある。

TCS_BOTTOM 
TCS_BUTTONS 
TCS_FIXEDWIDTH 
TCS_FLATBUTTONS 
TCS_FORCEICONLEFT 
TCS_FORCELABELLEFT 
TCS_MULTILINE 
TCS_OWNERDRAWFIXED 
TCS_RAGGEDRIGHT 
TCS_RIGHT 
TCS_VERTICAL

それでは早速試してみよう。

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

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

program Tab03;

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

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

  hTab:HWND;

  hIM: HImageList;
  CG:TCheckGroup;
  PNL:TAPIPanel;

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
function GetStyle(hWindow:HWND):LongInt;
begin
  result := GetWindowLong(hWindow,GWL_STYLE);
end;

procedure AddStyle(hWindow:HWND;adStyle:LongInt);
begin
  SetWindowLong(hWindow,GWL_STYLE,GetStyle(hWindow) or adStyle);
end;

procedure SubStyle(hWindow:HWND;sbStyle:LongInt);
begin
  SetWindowLong(hWindow,GWL_STYLE,GetStyle(hTab) and (not sbStyle));
end;

procedure StyleChanged;
var
  r:TRect;
begin
  GetClientRect(hTab,r);
  SendMessage(hTab,TCM_ADJUSTRECT,0,LPARAM(@r));
  ChangeWindowPos(PNL.Handle,r.Left,r.Top);
  ChangeWindowSize(PNL.Handle,r.Right-r.Left,r.Bottom-r.Top);
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainNotify(var Msg:TMessage);
const
  PnlColor: array[0..5] of COLORREF =
   (clrRed,clrGreen,clrBlue,clrPurple,clrOlive,clrTeal);
var
  pNM: PNMHdr;
  PageNo: integer;
begin
  pNM := PNMHdr(Msg.LParam);
  if pNM^.hwndFrom <> hTab then exit;
  if pNM^.code = TCN_SELCHANGE then begin
    PageNo := SendMessage(hTab,TCM_GETCURSEL,0,0);
    PNL.Color := PnlColor[PageNo];
  end;
end;

procedure CGClick(var Msg:TMessage);
begin
  case Msg.WParam of
    0:if CG.Checked[0] then
        AddStyle(hTab,TCS_MULTILINE)
      else
        SubStyle(hTab,TCS_MULTILINE);
    1:if CG.Checked[1] then
        AddStyle(hTab,TCS_BOTTOM)
      else
        SubStyle(hTab,TCS_BOTTOM);
    2:if CG.Checked[2] then
        AddStyle(hTab,TCS_FIXEDWIDTH or TCS_FORCEICONLEFT)
      else
        SubStyle(hTab,TCS_FIXEDWIDTH or TCS_FORCEICONLEFT);
    3:if CG.Checked[3] then
        AddStyle(hTab,TCS_RAGGEDRIGHT)
      else
        SubStyle(hTab,TCS_RAGGEDRIGHT);
    4:if CG.Checked[4] then
        AddStyle(hTab,TCS_VERTICAL)
      else
        SubStyle(hTab,TCS_VERTICAL);
    5:if CG.Checked[5] then
        AddStyle(hTab,TCS_BUTTONS)
      else
        SubStyle(hTab,TCS_BUTTONS);
  end;
  StyleChanged;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
const
  Page: array[0..5] of string =
  ('1 Red','2 Green','3 Blue', '4 Purple', '5 Olive','6 Teal');
  CheckTitle: array[0..5] of string =
  ('MULTILINE','BOTTOM (RIGHT)','FIXEDWIDTH','RAGGEDRIGHT','VERTICAL',
   'BUTTONS');
var
  hWindow: HWND;
  tci: TTCItem;
  i:integer;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  InitCommonControls;

  hTab := CreateWindowEx(WS_EX_CONTROLPARENT,
                         WC_TABCONTROL,
                         '',
                         WS_VISIBLE or WS_CHILD or WS_TABSTOP or
                         WS_CLIPSIBLINGS or WS_CLIPCHILDREN,
                         10,10,220,300,
                         hWindow,
                         0,
                         hInstance,
                         nil);

  hIM := ImageList_Create(16,16,ILC_COLOR8 or ILC_MASK,0,0);

  for i := 0 to 5 do
    ImageList_AddIcon(hIM,LoadIcon(0,MakeIntResource(32512+i)));

  SendMessage(hTab,TCM_SETIMAGELIST,0,hIM);

  CG := CreateCheckGroup(hWindow,true,280,30,160,240,6,CGClick);
  for i := 0 to 5 do CG.Captions[i] := CheckTitle[i];

  tci.mask := TCIF_TEXT or TCIF_IMAGE;
  for i := 0 to 5 do begin
    tci.pszText := PChar(Page[i]);
    tci.iImage := i;
    SendMessage( hTab,TCM_INSERTITEM,i,integer(@tci));
  end;

  PNL := CreatePanel(hTab,0,0,0,0);
  PNL.OuterEdge := esSunken;
  PNL.Color := clrRed;
  StyleChanged;

  with MainWnd do begin
    ClientWidth := 460;
    ClientHeight := 320;
    Center;
    Trap(WM_NOTIFY,MainNotify);
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  MessageBeep($FFFFFFFF);
  //SendMessage(hTab,TCM_SETPADDING,0,MakeLong(2,2));
end;

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

procedure MainDestroy(var Msg: TMessage);
begin
  ImageList_Destroy(hIM);
  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.gifTab03.zip(27.425kB)
Tab03.gif

実行すると右図のようになる｡ 右側のチェックグループのチェック状態により、各ウィンドウスタイルを設定・解除している。

コードを見てみよう。タブコントロールを作成し、イメージリストを設定してからタブ項目を追加するところまでは前節と同じである。そのあと、のちにページコントロールを作ることを考えて、タブコントロールの子ウィンドウとしてパネルを作成している。

  PNL := CreatePanel(hTab,0,0,0,0);
  PNL.OuterEdge := esSunken;
  PNL.Color := clrRed;
  StyleChanged;

ここでは、最初に表示されるタブ項目を考慮して、パネルの色を赤にしている。タブコントロールの「表示領域」いっぱいにパネルを配置するために、StyleChanged ヘルパ手続きを使っている。

procedure StyleChanged;
var
  r:TRect;
begin
  GetClientRect(hTab,r);
  SendMessage(hTab,TCM_ADJUSTRECT,0,LPARAM(@r));
  ChangeWindowPos(PNL.Handle,r.Left,r.Top);
  ChangeWindowSize(PNL.Handle,r.Right-r.Left,r.Bottom-r.Top);
end;

ここでは、タブコントロールの現在のサイズを GetClientRect( ) で取得し、TCM_ADJUSTRECT メッセージを送って現在の状況における表示領域を取得し、パネルのサイズと位置を設定している｡ これは、タブ項目の表示スタイルが変更されると表示領域も変更されるので、そのたびに呼び出す必要がある｡ TCS_BUTTONS と TCS_BOTTOM スタイルが同時に設定されていると、TCM_ADJUSTRECT メッセージを送って得られる表示領域は、正しくないことに注目してほしい。

上記のスタイル定義の定数を見れば分かるように、各スタイルは、特定ビットの on/off で設定されているので、以下のようなヘルパ手続きを使って、取得・設定・解除ができる。

function GetStyle(hWindow:HWND):LongInt;
begin
  result := GetWindowLong(hWindow,GWL_STYLE);
end;

procedure AddStyle(hWindow:HWND;adStyle:LongInt);
begin
  SetWindowLong(hWindow,GWL_STYLE,GetStyle(hWindow) or adStyle);
end;

procedure SubStyle(hWindow:HWND;sbStyle:LongInt);
begin
  SetWindowLong(hWindow,GWL_STYLE,GetStyle(hTab) and (not sbStyle));
end;

これは説明の必要はないだろう。

最後に、コントロール作成時のみ設定可能なスタイルとして、TCS_SCROLLOPPOSITE を試してみよう。上記の Tab03.dpr で変更するところは、以下の二カ所である。

最初はコントロールを作成しているところである。

  hTab := CreateWindowEx(WS_EX_CONTROLPARENT,
                         WC_TABCONTROL,
                         '',
                         WS_VISIBLE or WS_CHILD or WS_TABSTOP or
                         WS_CLIPSIBLINGS or WS_CLIPCHILDREN or
                         TCS_SCROLLOPPOSITE,  // このスタイルを追加 
                         10,10,220,300,
                         hWindow,
                         0,
                         hInstance,
                         nil);

もう一つは、WM_NOTIFY メッセージを処理しているところである。

procedure MainNotify(var Msg:TMessage);
const
  PnlColor: array[0..5] of COLORREF =
   (clrRed,clrGreen,clrBlue,clrPurple,clrOlive,clrTeal);
var
  pNM: PNMHdr;
  PageNo: integer;
begin
  pNM := PNMHdr(Msg.LParam);
  if pNM^.hwndFrom <> hTab then exit;
  if pNM^.code = TCN_SELCHANGE then begin
    PageNo := SendMessage(hTab,TCM_GETCURSEL,0,0);
    PNL.Color := PnlColor[PageNo];
    StyleChanged;    // これを追加
  end;
end;
Tab03_1.gif

タブ項目の選択状況により表示領域が移動することがあるので、そのたびにパネルの配置を修正する必要があるのだ。実行すると右図のようになる。選択されていない項目の列がコントロールの反対側に移動しているのが分かるだろう。また TCS_SCROLLOPPOSITE スタイルを設定すると自動的に TCS_MULTILINE スタイルが設定されるのも分かる｡ さらに、TCS_BUTTONS スタイルとの併用ができないことも重要である。

以上、この節ではタブコントロールのさまざまなスタイルを試してみた｡ また、スタイルの変更に伴う表示領域の変更についても調べてみた｡

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

２９−４ タブコントロールのラッパークラス

前節までに調べたタブコントロールのラッパークラスを作成しよう｡ タブコントロールを作成するときに指定するこのコントロール特有のスタイルは、既に調べたように作成後にも変更できるものが多いので、デフォルトのスタイルのタブコントロールを作成しよう。そして、作成後に設定できるスタイルについては、Boolean 型のプロパティーとして装備しよう。それでは、タブコントロールのラッパークラス TAPITab を作成して、テストするプログラムを作ろう。

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

最初に、前節でも使ったスタイルを設定する３つの手続きを UtilFunc.pas に作ろう｡ 宣言部の一番下に

function GetStyle(hWindow:HWND):LongInt;
procedure AddStyle(hWindow:HWND;adStyle:LongInt);
procedure SubStyle(hWindow:HWND;sbStyle:LongInt);

と宣言する。実装部の一番下に

function GetStyle(hWindow:HWND):LongInt;
begin
  result := GetWindowLong(hWindow,GWL_STYLE);
end;

procedure AddStyle(hWindow:HWND;adStyle:LongInt);
begin
  SetWindowLong(hWindow,GWL_STYLE,GetStyle(hWindow) or adStyle);
end;

procedure SubStyle(hWindow:HWND;sbStyle:LongInt);
begin
  SetWindowLong(hWindow,GWL_STYLE,GetStyle(hWindow) and (not sbStyle));
end;

として実装する。次に､ CmCtrl.pas に TAPITab クラスを作成しよう。宣言部を以下に示す｡

//--------------------- TAPITab -----------------------
TAPITab = class(TCmCtrl)
private
  FDim:TRect;
  FRect:TRect;
  FHImageList:HImageList;
  FMultiline:Boolean;
  FBottom:Boolean;
  FFixedWidth:Boolean;
  FRaggedRight:Boolean;
  FButton:Boolean;
  FOnTabChange:TNotifyMessage;
  FSelChange: TNotifyMessage;
  FSelChanging: TNotifyMessage;
  procedure SetDimension(val:TRect);
  procedure SetImageList(val:HImageList);
  function GetItemCount:integer;
  function GetDisplayArea:TRect;
  procedure SetMultiline(val:Boolean);
  procedure SetBottom(val:Boolean);
  procedure SetFixedWidth(val:Boolean);
  procedure SetRaggedRight(val:Boolean);
  procedure SetButton(val:Boolean);
  function GetCurSel: integer;
  procedure SetCurSel(value:integer);
  function GetTabString(indx:integer):string;
  procedure SetTabString(indx:integer;value:string);
  function GetRowCount:integer;
  function GetImageIndex(indx:integer):integer;
  procedure SetImageIndex(indx:integer;val:integer);
  function GetTabData(indx:integer):integer;
  procedure SetTabData(indx:integer;val:integer);
protected
  function DefineStyle: DWORD; virtual;
  procedure CreateControl;override;
public
  constructor Create(hParent:HWND); override;
  destructor Destroy; override;
  procedure DefaultHandler(var Message);override;
  procedure TabChange;virtual;
  function InsertTab(indx: integer; title: string):integer;virtual;
  function AddTab(title:string):integer;virtual;
  function DeleteTab(indx: integer): Boolean;virtual;
  function DeleteAllTab: Boolean;virtual;
  property Dimension: TRect read FDim write SetDimension;
  property TabCount: integer read GetItemCount;
  property TabString[indx: integer]: string read GetTabString write SetTabString;
  property ImageIndex[indx:integer]: integer read GetImageIndex write SetImageIndex;
  property TabData[indx:integer]: integer read GetTabData write SetTabData;
  property RowCount: integer read GetRowCount;
  property DisplayArea: TRect read GetDisplayArea;
  property ImageList: HImageList read FHImageList write SetImageList;
  property MultiLine: Boolean read FMultiline write SetMultiline;
  property Bottom: Boolean read FBottom write SetBottom;
  property FixedWidth: Boolean read FFixedWidth write SetFixedWidth;
  property RaggedRight: Boolean read FRaggedRight write SetRaggedRight;
  property Button: Boolean read FButton write SetButton;
  property Selected: integer read GetCurSel write SetCurSel;
  property OnTabChange: TNotifyMessage read FOnTabChange write FOnTabChange;
  property OnSelChange: TNotifyMessage read FSelChange write FSelChange;
  property OnSelChanging: TNotifyMessage read FSelChanging write FSelChanging;
end;

function CreateTab(hParent:HWND;x,y,cx,cy:integer;sOnSelChange:TNotifyMessage):TAPITab;

public 部のメソッドは、その名前から機能を類推できるだろう｡ MultiLine プロパティーから Button プロパティーまでは、動的に設定できるスタイルの設定・解除をカプセル化したものである。OnSelChange イベントは、スタイル変更などのときに表示領域が変更されるときに発生する。実装部を以下に示す｡

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

  CreateControl;
end;

destructor TAPITab.Destroy;
begin
  if FHImageList <> 0 then ImageList_Destroy(FHImageList);
  inherited;
end;

procedure TAPITab.CreateControl;
begin
  FHandle := CreateWindow(WC_TABCONTROL,
                          '',
                          DefineStyle,
                          0,0,100,100,
                          Parent,
                          ID_CmCtrl,
                          hInstance,
                          nil);

  FID := ID_CmCtrl;
  inc(ID_CmCtrl);
end;

function TAPITab.DefineStyle: DWORD;
begin
  result := WS_VISIBLE or WS_CHILD or WS_TABSTOP or
            WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
end;

procedure TAPITab.DefaultHandler(var Message);
var
  AMsg:TMessage;
  pNM: PNMHdr;
begin
  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_NOTIFY: begin
      pNM := PNMHdr(AMsg.LParam);
      if pNM^.hwndFrom = FHandle then
        case pNM^.code of
          TCN_SELCHANGE:begin
            AMsg.Msg := UINT(self);
            if Assigned(FSelChange) then OnSelChange(AMsg);
;         end;
          TCN_SELCHANGING:begin
            AMsg.Msg := UINT(self);
            if Assigned(FSelChanging) then OnSelChanging(AMsg);
;         end;
        end; // case
    end;
  end;
end;

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

function TAPITab.InsertTab(indx: integer; title: string): integer;
var
  tci: TTCItem;
begin
  tci.mask := TCIF_TEXT or TCIF_IMAGE;
  tci.iImage := indx;
  tci.pszText := PChar(title);
  result := SendMessage( FHandle,TCM_INSERTITEM,indx,integer(@tci));
  TabChange;
end;

function TAPITab.GetItemCount:integer;
begin
  result := SendMessage(FHandle,TCM_GETITEMCOUNT,0,0);
end;

function TAPITab.AddTab(title:string):integer;
begin
  result := InsertTab(TabCount,title);
end;

function TAPITab.DeleteTab(indx:integer):Boolean;
begin
  result := (SendMessage(FHandle,TCM_DELETEITEM,indx,0) <> 0);
  TabChange;
end;

function TAPITab.DeleteAllTab:Boolean;
begin
  result := (SendMessage(FHandle,TCM_DELETEALLITEMS,0,0) <> 0);
  TabChange;
end;

procedure TAPITab.TabChange;
var
  AMsg: TMessage;
begin
  AMsg.Msg := UINT(self);
  if Assigned(FOnTabChange) then OnTabChange(AMsg);
end;

procedure TAPITab.SetImageList(val:HImageList);
begin
  if FHImageList <> 0 then ImageList_Destroy(FHImageList);
  FHImageList := val;
  SendMessage(FHandle,TCM_SETIMAGELIST,0,FHImageList);
end;

function TAPITab.GetDisplayArea:TRect;
begin
  GetClientRect(FHandle,result);
  SendMessage(FHandle,TCM_ADJUSTRECT,0,integer(@result));
end;

function TAPITab.GetTabString(indx:integer):string;
var
  tci: TTCItem;
  PC:PChar;
begin
  GetMem(PC,50);
  tci.mask := TCIF_TEXT;
  tci.pszText := PC;
  tci.cchTextMax := 50;
  SendMessage(FHandle,TCM_GETITEM,indx,LPARAM(@tci));
  SetString(result,PC,lstrlen(PC));
  FreeMem(PC);
end;

procedure TAPITab.SetTabString(indx:integer;value:string);
var
  tci: TTCItem;
begin
  tci.mask := TCIF_TEXT;
  tci.pszText := PChar(value);
  SendMessage(FHandle,TCM_SETITEM,indx,integer(@tci));
  TabChange;
end;

procedure TAPITab.SetMultiline(val:Boolean);
begin
  if FMultiline = val then exit;
  FMultiline := val;
  if val then
    AddStyle(FHandle,TCS_MULTILINE)
  else
    SubStyle(FHandle,TCS_MULTILINE);
  TabChange;
end;

procedure TAPITab.SetBottom(val:Boolean);
begin
  if FBottom = val then exit;
  FBottom := val;
  if val then
    AddStyle(FHandle,TCS_BOTTOM)
  else
    SubStyle(FHandle,TCS_BOTTOM);
  TabChange;
end;

procedure TAPITab.SetFixedWidth(val:Boolean);
begin
  if FFixedWidth = val then exit;
  FFixedWidth := val;
  if val then
    AddStyle(FHandle,TCS_FIXEDWIDTH or TCS_FORCEICONLEFT)
  else
    SubStyle(FHandle,TCS_FIXEDWIDTH or TCS_FORCEICONLEFT);
  TabChange;
end;

procedure TAPITab.SetRaggedRight(val:Boolean);
begin
  if FRaggedRight = val then exit;
  FRaggedRight := val;
  if val then
    AddStyle(FHandle,TCS_RAGGEDRIGHT)
  else
    SubStyle(FHandle,TCS_RAGGEDRIGHT);
  TabChange;
end;

procedure TAPITab.SetButton(val:Boolean);
begin
  if FButton = val then exit;
  FButton := val;
  if val then
    AddStyle(FHandle,TCS_BUTTONS)
  else
    SubStyle(FHandle,TCS_BUTTONS);
  TabChange;
end;

function TAPITab.GetCurSel: integer;
begin
  result := SendMessage(FHandle,TCM_GETCURSEL,0,0);
end;

procedure TAPITab.SetCurSel(value: integer);
var
  Msg: TMessage;
  NM: TNMHdr;
begin
  NM.hwndFrom := FHandle;
  NM.idFrom := FID;
  NM.code := TCN_SELCHANGING;
  Msg.Msg := WM_NOTIFY;
  Msg.WParam := FID;
  Msg.LParam := integer(@NM);
  Dispatch(Msg);
  SendMessage(FHandle,TCM_SETCURSEL,value,0);
  NM.code := TCN_SELCHANGE;
  Dispatch(Msg);
end;

function TAPITab.GetRowCount:integer;
begin
  result := SendMessage(FHandle,TCM_GETROWCOUNT,0,0);
end;

function TAPITab.GetImageIndex(indx:integer):integer;
var
  tci: TTCItem;
begin
  tci.mask := TCIF_IMAGE;
  SendMessage(FHandle,TCM_GETITEM,indx,LPARAM(@tci));
  result := tci.iImage;
end;

procedure TAPITab.SetImageIndex(indx:integer;val:integer);
var
  tci: TTCItem;
begin
  tci.mask := TCIF_IMAGE;
  tci.iImage := val;
  SendMessage(FHandle,TCM_SETITEM,indx,integer(@tci));
end;

function TAPITab.GetTabData(indx:integer):integer;
var
  tci: TTCItem;
begin
  tci.mask := TCIF_PARAM;
  SendMessage(FHandle,TCM_GETITEM,indx,LPARAM(@tci));
  result := tci.lParam;
end;

procedure TAPITab.SetTabData(indx:integer;val:integer);
var
  tci: TTCItem;
begin
  tci.mask := TCIF_PARAM;
  tci.lParam := val;
  SendMessage(FHandle,TCM_SETITEM,indx,integer(@tci));
end;

function CreateTab(hParent:HWND;x,y,cx,cy:integer;
                    sOnSelChange:TNotifyMessage):TAPITab;
begin
  result := TAPITab.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    OnSelChange := sOnSelChange;
  end;
end;

これらのコードは、前節までの説明で理解できるだろう｡ コードで選択タブ項目の変更を行う SetCurSel メソッドでは、TCM_SETCURSEL メッセージをコントロールに送っても TCN_SELCHANGING も TCN_SELCHANGE 通知メッセージも発生しないので、コードで発生させている｡ スタイルの変更にともなって表示領域が変更されるので、各設定メソッドでは TabChange メソッドを実行して、OnTabChange イベントを発生させ、ユーザにパネルなどの配置変更の機会を与えている｡

それでは、このクラスを試してみよう。Tab04.dpr の全リストを以下に示す｡

program Tab04;

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

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

  TB:TAPITab;
  PNL:TAPIPanel;
  CG:TCheckGroup;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure TBTabChange(var Msg:TMessage);
var
  r:TRect;
begin
  r := TB.DisplayArea;
  if Assigned(PNL) then
    PNL.Dimension := SetDim(r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top);
end;

procedure TBSelChange(var Msg:TMessage);
const
  PnlColor: array[0..5] of COLORREF =
   (clrRed,clrGreen,clrBlue,clrPurple,clrOlive,clrTeal);
begin
  PNL.Color := PnlColor[TB.Selected];
  MainWnd.Title := TB.TabString[TB.Selected]
end;

procedure CGClick(var Msg:TMessage);
begin
  case Msg.WParam of
    0: TB.MultiLine := CG.Checked[0];
    1: TB.Bottom := CG.Checked[1];
    2: TB.FixedWidth := CG.Checked[2];
    3: TB.RaggedRight := CG.Checked[3];
    4: TB.Button := CG.Checked[4];
  end;
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
const
  Page: array[0..5] of string =
  ('1 Red','2 Green','3 Blue', '4 Purple', '5 Olive','6 Teal');
  CheckTitle: array[0..4] of string =
  ('MULTILINE','BOTTOM','FIXEDWIDTH','RAGGEDRIGHT',
   'BUTTONS');
var
  hWindow: HWND;
  i:integer;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  TB := CreateTab(hWindow,10,10,220,300,TBSelChange);
  TB.OnTabChange := TBTabChange;

  PNL := CreatePanel(TB.Handle,0,0,0,0);
  PNL.OuterEdge := esSunken;
  PNL.Color := clrRed;

  for i := 0 to 5 do TB.AddTab(Page[i]);

  TB.ImageList := ImageList_Create(16,16,ILC_COLOR8 or ILC_MASK,0,0);
  for i := 0 to 5 do
    ImageList_AddIcon(TB.ImageList,LoadIcon(0,MakeIntResource(32512+i)));

  CG := CreateCheckGroup(hWindow,true,280,30,160,180,5,CGClick);
  for i := 0 to 4 do CG.Captions[i] := CheckTitle[i];

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

procedure OnTest(hWindow: HWND);
begin
  //MessageBeep($FFFFFFFF);
  //TB.DeleteTab(1);
  //TB.InsertTab(1,'Insert');
  //MainWnd.Title := AIntToStr(TB.RowCount);
  TB.TabString[1] := TB.TabString[1]+'PP';
  //TB.ImageIndex[2] := 5;
  //MainWnd.Title := AIntToStr(TB.ImageIndex[2]);
  //TB.TabData[1] := 12345;
  //MainWnd.Title := AIntToStr(TB.TabData[1]);
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.gifTab04.zip(28.213kB)
Tab04.gif

実行すると、右図に示すように前節と同じように動作する。しかし、ラッパークラスを使っているので大幅にコードが簡単になっていることが分かるだろう｡

動的に変更できるスタイルのうち、今回カプセル化しなかったものについては、今回、UtilFunc.pas につくった関数で設定・解除ができるだろう。また、TCS_SCROLLOPPOSITE のように作成時にのみ設定可能なスタイルについては、TAPITab クラスでは protected 部の仮想メソッド DefineStyle でウィンドウスタイルを設定しているので、このクラスを継承して DefineStyle を override するクラスを簡単に作成して実現できるだろう｡ 各自試してほしい。

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

２９−５ 縦型タブ

動的に変更できるスタイルとして TCS_VERTICAL スタイルを設定して､ 縦型のタブ項目について試してみよう。２９−３ 節でも試してみたが、文字が横に寝ていたり、アイコンがあるとタブ表示の途中でテキストが切れてしまったりするので、あまり良い効果は期待できない｡ ここでは、フォントに名前の最初に＠が付く縦書き用のフォントを指定して、アイコンなしの縦型タブについて試してみよう｡

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

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

program Tab05;

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

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

  TB:TAPITab;

  L1,L2,L3: TAPILabel;

  CF: TAPICFont;

type
  TCData = record
    Name: string;
    TEL:string;
    FAX:string
  end;

const
  Data: array[0..2] of TCData =
      ((Name:' 山田太郎';TEL:'03-3456-7890';FAX:'03-3456-9870'),
       (Name:' 川田次郎';TEL:'0454-225-9987';FAX:'0454-225-8888'),
       (Name:' 海野三郎';TEL:'013332-4-9999';FAX:'013332-4-7654'));

//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------
procedure DisplayInfo(indx: integer);
begin
  L1.Text := ' 名前 : '+Data[indx].Name;
  L2.Text := ' TEL  : '+Data[indx].TEL;
  L3.Text := ' FAX  : '+Data[indx].FAX;
end;

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure TBSelChange(var Msg:TMessage);
begin
  DisplayInfo(TB.Selected);
end;

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

  TB := CreateTab(hWindow,10,10,340,240,TBSelChange);
  TB.Multiline := true;
  AddStyle(TB.Handle,TCS_VERTICAL or TCS_RIGHT);
  TB.RaggedRight := true;

  CF := TAPICFont.Create;
  with CF do begin
    Name := '@ＭＳ 明朝';
    Size := 12;
    GetHandle;
  end;
  CF.SetHandle(TB.Handle);

  for i := 0 to 2 do TB.AddTab(Data[i].Name);

  L1 := CreateLabel(TB.Handle,10,30,250,30,'');
  L2 := CreateLabel(TB.Handle,10,70,250,30,'');
  L3 := CreateLabel(TB.Handle,10,110,250,30,'');

  DisplayInfo(0);

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    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
  CF.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.gifTab05.zip(27.934kB)
Tab05.gif

実行すると右図のようになる｡ 日本語の縦書きフォントを設定すると具合がよいようだ。

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

２９−６ ページコントロールをコードで作る

タブコントロールは、タブ項目の選択状況を通知するだけであり､ 表示領域には一つのウィンドウ（自分自身）しか持っていない｡ タブコントロールは、リソースから作られるモードなしダイアログボックスと連動して、項目の選択と同期して異なるダイアログボックスを表示することもできる｡ 多くの用途では、このような使用方法が用いられる｡ Delphi のＶＣＬでは、TPageControl クラスが複数のダイアログボックスの表示に用いられる｡ このクラスでは、各ページに表示されるウィンドウは、TWinControl を継承した TTabSheet クラスである｡ この節では､ TTabSheet クラスに相当するパネルのインスタンスを作成し､ 前節で作った TAPITab と連携して、ページコントロールのような機能を実現してみよう｡

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

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

program Page01;

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

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

  TB:TAPITab;
  Pnl: array[0..2] of TAPIPanel;

  Memo: TAPIMemo;
  EFC:TEnumFontComboBox;
  Btn:TAPIButton;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure TBTabChange(var Msg:TMessage);
var
  r:TRect;
  h,w,i:integer;
begin
  r := TB.DisplayArea;
  if Assigned(Pnl[0]) then begin
    w := r.Right-r.Left;
    h := r.Bottom-r.Top;
    for i := 0 to 2 do
      Pnl[i].Dimension := SetDim(r.Left,r.Top,w,h);
    Memo.Dimension := SetDim(5,5,w-10,h-10);
    EFC.Dimension := SetDim(5,5,180,h-10);
  end;
end;

procedure TBSelChange(var Msg:TMessage);
var
  i:integer;
begin
  for i := 0 to 2 do Pnl[i].Visible := false;
  Pnl[TB.Selected].Visible := true;
end;

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

  TB := CreateTab(hWindow,10,10,300,240,TBSelChange);
  TB.OnTabChange := TBTabChange;

  TB.ImageList := ImageList_Create(16,16,ILC_COLOR8 or ILC_MASK,0,0);
  for i := 0 to 5 do
    ImageList_AddIcon(TB.ImageList,LoadIcon(0,MakeIntResource(32512+i)));

  for i := 0 to 2 do begin
    Pnl[i] := CreatePanel(TB.Handle,0,0,0,0);
    Pnl[i].Visible := false;
    Pnl[i].OuterEdge := esNone;
  end;

  Memo := CreateMemo(Pnl[0].Handle,0,0,0,0);
  EFC := TEnumFontComboBox.Create(Pnl[1].Handle);
  Btn := CreateButton(Pnl[2].Handle,20,50,150,35,'Button for Pge 2',nil);

  for i := 0 to 2 do TB.AddTab('Page '+AIntToStr(i));
  Pnl[0].Visible := true;

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

procedure OnTest(hWindow: HWND);
begin
  //MessageBeep($FFFFFFFF);
  TB.Bottom := not TB.Bottom;
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.gifPage01.zip(29.191kB)
Page01.gif

実行すると右図のようになる。各「ページ」には、対応するパネルが取り付けられそれぞれにコントロールを配置し、タブ項目の選択状況に応じて可視性を制御している。Test! を選択すると、タブコントロールの Bottom プロパティーが反転する。

以上のように､ ページコントロールはタブ項目の数と同じ数のパネルを子ウィンドウとして保持し、タブ項目の選択状況に応じて自動的に可視性を制御できればよいことが分かった。

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

２９−７ ページコントロールのラッパークラス

前節までに作った TAPITab と TAPIPanel を組み合わせ､ TAPITab クラスから派生してページコントロールに相当する TAPIPage クラスを作ってテストしよう。

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

最初に CmCtrl.pas に TAPITab クラスを継承して TAPIPage クラスを作成しよう。usesにAPIWindowを追加する。宣言部を以下に示す｡

//----------------- TAPIPage -------------------------------------
type
TAPIPage = class(TAPITab)
private
  FTabSheet: TIntegerList;
  function GetTabSheet(indx:integer):TAPIPanel;
protected
public
  constructor Create(hParent:HWND); override;
  destructor Destroy; override;
  procedure DefaultHandler(var Message);override;
  procedure TabChange;override;
  function InsertTab(indx: integer; title: string):integer;override;
  function DeleteTab(indx: integer): Boolean;override;
  function DeleteAllTab: Boolean;override;
  property TabSheet[indx:integer]:TAPIPanel read GetTabSheet;
end;

function CreatePage(hParent:HWND;x,y,cx,cy:integer;
                    sOnSelChange:TNotifyMessage):TAPIPage;

ここでは、各タブ項目に対応する TAPIPanel のインスタンスを整数型にキャストして TIntegerList 型の FTabSheet フィールドで保持している。TabSheet プロパティーを通して各パネルへのインスタンス参照が得られるので、パネルの上に載せる子コントロール作成時に使うことができる。実装部を以下に示す｡

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

  FTabSheet := TIntegerList.Create(0,0);
end;

destructor TAPIPage.Destroy;
begin
  FTabSheet.Free;
  inherited;
end;

procedure TAPIPage.DefaultHandler(var Message);
var
  AMsg:TMessage;
  pNM: PNMHdr;
begin
  AMsg := TMessage(Message);

  case AMsg.Msg of

    WM_NOTIFY: begin
      pNM := PNMHdr(AMsg.LParam);
      if pNM^.hwndFrom = FHandle then
        case pNM^.code of
          TCN_SELCHANGE:begin
            TAPIPanel(FTabSheet[Selected]).Visible := true;
            AMsg.Msg := UINT(self);
            if Assigned(FSelChange) then OnSelChange(AMsg);
          end;
          TCN_SELCHANGING:begin
            TAPIPanel(FTabSheet[Selected]).Visible := false;
            AMsg.Msg := UINT(self);
            if Assigned(FSelChanging) then OnSelChanging(AMsg);
          end;
        end; // case
    end;
  end;
end;

procedure TAPIPage.TabChange;
var
  r:TRect;
  h,w,i:integer;
begin
  if FTabSheet.Count > 0 then begin
    r := DisplayArea;
    w := r.Right-r.Left;
    h := r.Bottom-r.Top;
    for i := 0 to FTabSheet.Count-1 do
      TAPIPanel(FTabSheet[i]).Dimension := SetDim(r.Left,r.Top,w,h);
  end;
  inherited;
end;

function TAPIPage.InsertTab(indx: integer; title: string):integer;
var
  tci: TTCItem;
  Pnl:TAPIPanel;
begin
  tci.mask := TCIF_TEXT or TCIF_IMAGE;
  tci.iImage := indx;
  tci.pszText := PChar(title);
  result := SendMessage( FHandle,TCM_INSERTITEM,indx,integer(@tci));
  Pnl := CreatePanel(FHandle,0,0,0,0);
  Pnl.OuterEdge := esNone;
  if result <> 0 then Pnl.Visible := false;
  if result = FTabSheet.Count then
    FTabSheet.Add(integer(Pnl))             
  else
    FTabSheet.Insert(result,integer(Pnl));
  TabChange;
end;

function TAPIPage.DeleteTab(indx:integer):Boolean;
begin
  if Selected = indx then
    if indx = 0 then Selected := 1 else Selected := 0;
  result := (SendMessage(FHandle,TCM_DELETEITEM,indx,0) <> 0);
  if result then begin
    DestroyWindow(TAPIPanel(FTabSheet[indx]).Handle);
    FTabSheet.Delete(indx);
    TabChange;
  end;
end;

function TAPIPage.DeleteAllTab:Boolean;
var
  i,Count:integer;
begin
  result := false;
  Count := TabCount;
  if Count > 0 then begin
    for i := 0 to Count-1 do DestroyWindow(TAPIPanel(FTabSheet[i]).Handle);
    FTabSheet.Clear;
    result := (SendMessage(FHandle,TCM_DELETEALLITEMS,0,0) <> 0);
  end;
end;

function TAPIPage.GetTabSheet(indx:integer):TAPIPanel;
begin
  result := TAPIPanel(FTabSheet[indx]);
end;

function CreatePage(hParent:HWND;x,y,cx,cy:integer;
                    sOnSelChange:TNotifyMessage):TAPIPage;
begin
  result := TAPIPage.Create(hParent);
  with result do begin
    Dimension := SetDim(x,y,cx,cy);
    OnSelChange := sOnSelChange;
  end;
end;

コードを見てみよう。InsertTab( ) メソッドでは、タブコントロールにタブを挿入するのと同時に対応するパネルを作成している。そして、TabChange メソッドにより表示領域に配置している。DeleteTab( ) では、逆に、タブ項目を削除してからパネルを破棄している。TAPIPanel クラスは、親ウィンドウが破棄されるとき自動的にウィンドウオブジェクトが破棄されることを利用して、パスカルオブジェクトを破棄していた｡ 逆に、パスカルオブジェクトを Free で破棄してもウィンドウオブジェクトは破棄されないようになっている。そこで、Handle を利用して DestroyWindow( ) によりウィンドウオブジェクト経由でパスカルオブジェクトを破棄されるようにしている｡ DefaultHandler( ) では、TCN_SELCHANGING と TCN_SELCHANGE 通知を使って、パネルの可視性を切り替えている。

このクラスをテストする Page02.dpr の全リストを以下に示す｡

program Page02;

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

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

  PG:TAPIPage;

  Memo: TAPIMemo;
  EFC:TEnumFontComboBox;
  Btn:TAPIButton;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure PGTabChange(var Msg:TMessage);
var
  r:TRect;
  h,w:integer;
begin
  r := PG.DisplayArea;
  w := r.Right-r.Left;
  h := r.Bottom-r.Top;
  if Assigned(Memo) then  Memo.Dimension := SetDim(5,5,w-10,h-10);
  if Assigned(EFC) then  EFC.Dimension := SetDim(5,5,180,h-10);
end;

//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
const
  SheetColor: array[0..5] of COLORREF =
    (clrRed,clrGreen,clrBlue,clrPurple,clrOlive,clrTeal);
  Page: array[0..5] of string =
    ('1 Red','2 Green','3 Blue', '4 Purple', '5 Olive','6 Teal');
var
  hWindow: HWND;
  i:integer;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  PG := CreatePage(hWindow,10,10,340,240,nil);
  PG.OnTabChange := PGTabChange;
  PG.Multiline := true;
  PG.RaggedRight := true;
  for i := 0 to 5 do begin
    PG.AddTab(Page[i]);
    PG.TabSheet[i].Color := SheetColor[i];
  end;

  Memo := CreateMemo(PG.TabSheet[0].Handle,0,0,0,0);
  EFC := TEnumFontComboBox.Create(PG.TabSheet[1].Handle);
  Btn := CreateButton(PG.TabSheet[2].Handle,20,50,150,35,
                                  'Button for Pge 2',nil);

  PG.TabChange;

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

procedure OnTest(hWindow: HWND);
begin
  //MessageBeep($FFFFFFFF);
  //PG.Bottom := not PG.Bottom;
  PG.InsertTab(1,'Inserted');
  PG.TabSheet[1].OuterEdge := esSunken;
  PG.TabSheet[1].Color := clrWhite;
  {Memo := nil;
  EFC := nil;
  PG.DeleteTab(0);
  PG.DeleteTab(0);}
  //PG.DeleteAllTab;
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.gifPage02.zip(29.594kB)
Page02.gif

実行すると右図のようになる。前節のプログラムと同様の動作をする。Test! メニューを選択すると、インデックス１のところにタブ項目が挿入され、白い背景のパネルが貼り付く。OnTest( ) には、コメントアウトしてある幾つかのテストコードがある。特に、タブ項目を削除するときには注意が必要である｡ 対応するパネルも破棄されるので、その上に載っている子コントロールも破棄される。その後にこのオブジェクトを参照するとアクセス違反が起きるので、このコードのように最初にオブジェクト参照に nil を代入してから、項目を削除する。そして、PGTabChange( ) のコードのようにオブジェクト参照を使うときには if Assigned(Memo) then のように確認するコードが必要である｡ もちろん、通常は実行時にはタブ項目を追加するだけで、挿入や削除を行わないだろうから、このときはこのような注意は必要ないだろう｡ 本稿のようなコードベースのプログラミングのときだけではなく、ＩＤＥでＶＣＬアプリを作成するときでも、実行時に削除したオブジェクトを参照する可能性には、十分注意しなければならない｡

以上のように本節では、ＶＣＬ の TPageControl に相当する TAPIPage クラスを作成してテストした｡

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

２９−８ まとめ

本章では､ タブコントロールを調べた｡ タブコントロールは、一つの表示領域を持つタブ部分の選択機能をカプセル化したものであることが分かった｡ タブの表示形態は多数あるが、そのほとんどはコントロールを作成後でも動的に変更できることが分かった｡ここでは、その幾つかを取り込んでカプセル化したクラスを作成した｡

タブ項目の選択状況に同期して、子ウィンドウとしてのパネルの可視性を変更することにより、ページコントロールと同様の動作をすることができた。この機能をカプセル化して TAPIPage クラスを作成してテストした。

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

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

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



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