第２２章 メニューの研究 その２

前章では、メニューリソースを使ったメニューの作成法を簡単に調べ、その後、ＡＰＩ関数をつかってメニューをコードで作成する機能をカプセル化した TAMainMenu と TAPopupMenu クラスを MenuClass.pas に作成した｡ 本章では、これに続いて、ショートカットメニューやシステムメニュー、アクセレレータなどの機能を調べ、メニュークラスの充実をはかる｡ いずれもユーザインタフェースとしては非常に重要である｡

２２−０ この章の内容

第２２章 メニューの研究 その２
２２−１ ショートカットメニュー
２２−２ コントロールへの対応
２２−３ ウィンドウメニュー
２２−４ ウィンドウメニュークラス
２２−５ アクセレレータ
２２−６ アクセレレータリソース
２２−７ アクセレレータクラス
２２−８ メニューとの連携
２２−９ まとめ


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

２２−１ ショートカットメニュー

NotepadShortCutMenu.gif

メモ帳の 'EDIT' コントロールの上でマウスで右クリックすると右図のようなポップアップメニューが表示されて、編集コマンドを実行することができる｡ また、'EDIT' にフォーカスがあるときに [SHIFT]+[f.10] キーを押すと同様なメニューが 'EDIT' の中央に表示され、矢印キーと[ENTER]キーをつかってコマンドを選択できる｡ このようなメニューをフローティングポップアップメニューまたはショートカットメニューという。ショートカットメニューは、メインウィンドウはもちろん、どんなウィンドウオブジェクトに対しても個別に表示できる｡ この節では､ ＡＰＩ関数を使ってショートカットメニューを表示してみよう｡

ショートカットメニューを表示して､ コマンドを選択するには、以下の関数を使う｡

function TrackPopupMenuEx(hMenu: HMENU; 
                          Flags: UINT; 
                           x, y: Integer;
                            Wnd: HWND; 
                      TPMParams: PTPMParams): BOOL; stdcall;

この関数は、hMenu で設定されたポップアップメニューをスクリーン座標（x,y）に表示し、Wnd で設定されたウィンドウのウィンドウ関数に WM_COMMAND メッセージを送出する｡ 前章の ２１−７ メニューメッセージ 節で述べたように、メニューの表示はモーダルループなので、ショートカットメニューが表示されて、ユーザがコマンドを選択するか、ウィンドウの他の部分をクリックして選択をキャンセルするかして表示を終了してこの関数から復帰しない限り、他のコードは一切実行されない｡ Flags には、以下の定数の幾つかを or で結合して指定できる｡

const
  { Flags for TrackPopupMenu }
  
  TPM_LEFTBUTTON = 0;     // メニュー項目を左ボタンで選択（デフォルト）
  TPM_RIGHTBUTTON = 2;    // メニュー項目を左または右ボタンで選択
  
  TPM_LEFTALIGN = 0;      // x を左にして配置（デフォルト）
  TPM_CENTERALIGN = 4;    // x に対して中央に配置
  TPM_RIGHTALIGN = 8;     // x を右にして配置
  
  TPM_TOPALIGN = 0;       // y を上にして配置（デフォルト）
  TPM_VCENTERALIGN = $10; // y に対して中央に配置
  TPM_BOTTOMALIGN = $20;  // y を下にして配置

  TPM_HORIZONTAL = 0;     // 水平配置を優先する（デフォルト）
  TPM_VERTICAL = $40;     // 垂直配置を優先する
  
  TPM_NONOTIFY = $80;     // メニュー項目を選択しても通知メッセージを送らない
  TPM_RETURNCMD = $100;   // 関数の戻り値としてメニューＩＤを返す

メモ帳のショートカットメニューは右クリックでもメニュー項目を選択できるので、少なくとも TPM_RIGHTBUTTON を含んでいる。

TPMParams には、メニュー表示を回避する矩形領域を以下のようなレコードのアドレスで指定する｡

  PTPMParams = ^TTPMParams;
  TTPMParams = packed record
    cbSize: UINT;     // このレコードのサイズ
    rcExclude: TRect; // 表示を回避する矩形領域のスクリーン座標
  end;

筆者は、このレコードを使用した経験がない｡ 通常は、このパラメータを nil にしておけばよいだろう｡

TrackPopupMenuEx( ) は、 Flags が TPM_RETURNCMD を含んでいるときは選択されたメニュー項目のＩＤを、キャンセルされたときはゼロを戻す｡ Flags が TPM_RETURNCMD を含んでいないときは、成功すればノンゼロ、失敗するとゼロを戻す｡

ショートカットメニューはどのようなタイミングで表示したらよいのだろうか｡ ほとんどショートカットメニューの表示をするためだけに使われる、一般のウィンドウメッセージとして WM_CONTEXTMENU メッセージがある｡

WM_CONTEXTMENU
  hwnd = (HWND) wParam;  // このメッセージを発行したウィンドウのハンドル
  xPos = LOWORD(lParam); // マウスの x スクリーン座標
  yPos = HIWORD(lParam); // マウスの y スクリーン座標

このメッセージは、ユーザがウィンドウの上で右クリックしたとき（正確には、WM_RBUTTONUP メッセージのあとに）、または [SHIFT]+[f.10] キーか VK_APPS 仮想キーを押したときに送られる｡ 筆者のキーボードには VK_APPS に相当するキーがあって（プルダウンメニューの絵がキートップに描かれている）、メモ帳で試すことが出来た｡ lParam には、このときのマウスの座標がスクリーン座標で設定されている｡ 上記のキーを押して表示されたときは lParam = -1 になっている｡ 子ウィンドウのウィンドウ関数でこのメッセージが処理されずに DefWindowProc( ) に渡された場合は、親ウィンドウに送られる。

ここまでの知識を使って、ショートカットメニューを表示してみよう。

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

このテストプログラムでは、TAPIPanel クラスと TAPIButton クラスのインスタンスと、メインウィンドウにショートカットメニューを関連づけて表示したい。これらはすべてウィンドウオブジェクトなので、自前のウィンドウ関数で WM_CONTEXTMENU を受け取れる。しかし、このメッセージを DefWindowProc( ) に渡すと親ウィンドウに転送されてしまう｡ TAPIPanel は APIWinodw.pas に実装されているが、そのウィンドウ関数は次のようになっている｡ 

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;

このウィンドウ関数では、WM_PAINT、WM_ERASEBKGND、WM_DESTROY 以外のメッセージは DefWindowProc( ) に渡ってしまうため、今の場合のように親ウィンドウで WM_CONTEXTMENU メッセージを処理していると独自の処理を行うことが出来ない｡ TMessageTrapper を使っても、上位クラスの TSubClass のウィンドウ関数は、先に元のウィンドウ関数を実行するので事情は同じである｡ これを回避するために、以下のように、WM_PAINT、WM_ERASEBKGND、の後ろに WM_CONTEXTMENU を追加して、DefWindowProc( ) を迂回することにしよう｡

     WM_PAINT,WM_ERASEBKGND,WM_CONTEXTMENU: begin
       WPMsg.Msg := Msg;
       ........

つぎに、TAPIButton などの標準コントロールについて考えよう｡ これらのコントロールのラッパークラスの上位クラスである TSelfSubClass で、自分自身をサブクラス化してメッセージを捕捉していた｡ APIControl.pas にある、そのウィンドウ関数を以下に示す｡

function SelfSubClassProc(hWnd: HWND; Msg: UINT;
                       wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  PascalObject: TSelfSubClass;
  OriginalProc: TFNWndProc;
  SBMsg: TMessage;
begin

  OriginalProc := TFNWndProc(GetProp(hWnd,'WNDPROC'));

  result := CallWindowProc(OriginalProc,hWnd,Msg,wParam,lParam);

  PascalObject := TSelfSubClass(GetProp(hWnd,'OBJECT'));

  case Msg of

    WM_DESTROY:if Assigned(PascalObject) then PascalObject.Free;

  else
    if Assigned(PascalObject) then begin
      SBMsg.Msg := Msg;
      SBMsg.WParam := wParam;
      SBMsg.LParam := lParam;
      SBMsg.Result := 0;
      PascalObject.Dispatch(SBMsg);
      if SBMsg.Result <> 0 then result := SBMsg.Result;
    end;
  end; // case

end;

このウィンドウ関数でも、元のウィンドウ関数を先に呼び出して実行しているので、親ウィンドウが WM_CONTEXTMENU を処理していると、自分自身のショートカットメニューを表示することが出来ない｡ ここでも、元のウィンドウ関数を呼び出すのを迂回するために 

  result := CallWindowProc(OriginalProc,hWnd,Msg,wParam,lParam);

の一行を以下の四行に置き換えることにしよう｡

  if Msg = WM_CONTEXTMENU then
    result := 0
  else
    result := CallWindowProc(OriginalProc,hWnd,Msg,wParam,lParam);

これで、このメッセージだけ迂回することが出来た｡

以上の前準備を行ってから、ShortCutMenu01.dpr を以下のようにする。

program ShortCutMenu01;

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

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

  Pnl1,Pnl2: TAPIPanel;
  Btn: TAPIButton;
  MT1,MT2,MT3: TMessageTrapper;

  PM1,PM2: TAPopupMenu;

const
  ID_PM1 = 1000;
  ID_RED = 1001;
  ID_GREEN = 1002;
  ID_BLUE = 1003;

  ID_PM2 = 2000;
  ID_RAISED = 2001;
  ID_SUNKEN = 2002;
  ID_NONE = 2003;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MT1ContextMenu(var Msg: TMessage);
var
  ret:integer;
begin
  ret := integer(TrackPopupMenuEx(PM1.Handle,TPM_RETURNCMD,
                          Msg.LParamLo,Msg.LParamHi,Pnl1.Handle,nil));
  case ret of
    ID_RED:  Pnl1.Color := clrRed;
    ID_GREEN:Pnl1.Color := clrGreen;
    ID_BLUE: Pnl1.Color := clrBlue;
  end;
end;

procedure MT2ContextMenu(var Msg: TMessage);
begin
  TrackPopupMenuEx(PM2.Handle,0,
                          Msg.LParamLo,Msg.LParamHi,Pnl2.Handle,nil);
end;

procedure MT3ContextMenu(var Msg: TMessage);
var
  ret:integer;
  x,y: integer;
  r: TRect;
begin
  if Msg.LParam = -1 then begin
    GetWindowRect(Btn.Handle,r);
    x := (r.Left+r.Right) div 2;
    y := (r.Top+r.Bottom) div 2;
  end else begin
    x := Msg.LParamLo;
    y := Msg.LParamHi;
  end;
  ret := integer(TrackPopupMenuEx(PM1.Handle,TPM_RETURNCMD,
                                           x,y,Btn.Handle,nil));
  case ret of
    ID_RED:  MainWnd.Color := clrRed;
    ID_GREEN:MainWnd.Color := clrGreen;
    ID_BLUE: MainWnd.Color := clrBlue;
  end;
end;

procedure MT2Command(var Msg: TMessage);
begin
  case Msg.WParamLo of
    ID_RAISED: Pnl2.InnerEdge := esRaised;
    ID_SUNKEN: Pnl2.InnerEdge := esSunken;
    ID_NONE:   Pnl2.InnerEdge := esNone;
  end;
end;

procedure MainContextMenu(var Msg: TMessage);
var
  hHelp:HMENU;
  x,y: integer;
  r: TRect;
begin
  hHelp := GetSubMenu(GetMenu(MainWnd.Handle),2);
  if Msg.LParam = -1 then begin
    GetWindowRect(MainWnd.Handle,r);
    x := (r.Left+r.Right) div 2;
    y := (r.Top+r.Bottom) div 2;
  end else begin
    x := Msg.LParamLo;
    y := Msg.LParamHi;
  end;
  TrackPopupMenuEx(hHelp,0,x,y,MainWnd.Handle,nil);
end;

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

  Pnl1 := CreatePanel(hWindow,10,10,100,100);
  Pnl2 := CreatePanel(hWindow,120,10,100,100);

  Btn := CreateButton(hWindow,10,120,150,50,'Please RClick!',nil);

  MT1 := TMessageTrapper.Create(Pnl1.Handle);
  MT1.TrapMessage(WM_CONTEXTMENU,MT1ContextMenu);

  MT2 := TMessageTrapper.Create(Pnl2.Handle);
  MT2.TrapMessage(WM_CONTEXTMENU,MT2ContextMenu);
  MT2.TrapMessage(WM_COMMAND,MT2Command);

  MT3 := TMessageTrapper.Create(Btn.Handle);
  MT3.TrapMessage(WM_CONTEXTMENU,MT3ContextMenu);

  PM1 := MakePopupMenu(Pnl1.Handle,ID_PM1,nil);
  PM1.AppendString('&Red',ID_RED);
  PM1.AppendString('&Green',ID_GREEN);
  PM1.AppendString('&Blue',ID_BLUE);

  PM2 := MakePopupMenu(Pnl2.Handle,ID_PM2,nil);
  PM2.AppendString('&Raised',ID_RAISED);
  PM2.AppendString('&Sunken',ID_SUNKEN);
  PM2.AppendString('&None',ID_None);

  with MainWnd do begin
    ClientWidth := 360;
    ClientHeight := 260;
    Center;
    Trap(WM_CONTEXTMENU,MainContextMenu)
  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.gifShortCutMenu01.zip(16.387kB)
ShortCutMenu01.gif

実行すると右図のように、二つのパネルと一つのボタンが作成される。実行直後に[SHIFT]+[f.10] キーを押すとウィンドウの真ん中に Help ポップアップメニューの About... が表示される。下矢印キーと[ENTER] キーを一度ずつ押してこのメニューを選択すると、いつも通りの About ダイアログが表示される｡ メインウィンドウの任意の位置で右クリックしても、同じ事ができる｡ 左のパネルの上で右クリックするとポップアップメニューが表示されて、パネルの色を変更することができる。右のパネルの上で右クリックすると表示されるポップアップメニューから、このパネルの内側のエッジスタイルを変更することができる。ボタンの上で右クリックすると表示されるメニューからメインウィンドウの背景色を変更することができる｡ ボタンを左クリックしてフォーカスをボタンに与えておいてから、[SHIFT]+[f.10] キーを押すと同じ事ができる。

コードを調べよう｡ MainCreate( ) ハンドラでは､ パネルを二つ、ボタンを一つ、メッセージトラッパを三つ、ポップアップメニューを二つ作成している｡ また、メインウィンドウの Trap( ) メソッドをつかって WM_CONTEXTMENU メッセージを捕捉している｡ メインウィンドウの上で右クリックすると実行される MainContextMenu( ) ハンドラを見てみよう。

procedure MainContextMenu(var Msg: TMessage);
var
  hHelp:HMENU;
  x,y: integer;
  r: TRect;
begin
  hHelp := GetSubMenu(GetMenu(MainWnd.Handle),2);
  if Msg.LParam = -1 then begin
    GetWindowRect(MainWnd.Handle,r);
    x := (r.Left+r.Right) div 2;
    y := (r.Top+r.Bottom) div 2;
  end else begin
    x := Msg.LParamLo;
    y := Msg.LParamHi;
  end;
  TrackPopupMenuEx(hHelp,0,x,y,MainWnd.Handle,nil);
end;

ここでは、GetMenu( ) と GetSubMenu( ) を使って、コードで作成したメニューから、[Help] ポップアップメニューのハンドルを取り出して、ローカル変数 hHelp に格納している｡ キー入力によって WM_CONTEXTMENU メッセージが発行された場合は、LParam が -1 になっているので、このときはショートカットメニューがウィンドウの中心に表示されるように座標を計算する｡ マウスの右クリックによる場合は､ LParam から座標を取り出す。そして、TrackPopupMenuEx( ) を実行して、ショートカットメニューを表示する。メニュー項目が選択されると送出される WM_COMMAND メッセージの宛先として、第五パラメータにメインウィンドウのハンドルを指定しているので､ 通常の Skeleton03 と同じ経路で処理され、About ダイアログが表示される。このように、ショートカットメニューは、メインメニューの中の任意のポップアップメニューを取り出して表示する事ができる｡

左のパネルの上で右クリックすると、メッセージトラッパ MT1 により WM_CONTEXTMENU が捕捉されて MT1ContextMenu( ) ハンドラが呼び出される｡

procedure MT1ContextMenu(var Msg: TMessage);
var
  ret:integer;
begin
  ret := integer(TrackPopupMenuEx(PM1.Handle,TPM_RETURNCMD,
                          Msg.LParamLo,Msg.LParamHi,Pnl1.Handle,nil));
  case ret of
    ID_RED:  Pnl1.Color := clrRed;
    ID_GREEN:Pnl1.Color := clrGreen;
    ID_BLUE: Pnl1.Color := clrBlue;
  end;
end;

パネルはフォーカスを持たないのでキー入力による WM_CONTEXTMENU メッセージを受け取ることがない｡ マウスの右クリックによるものだけを想定すればよい｡ ここでは直ちに TrackPopupMenuEx( ) を実行して、PM1 ポップアップメニューが表示される。そのとき、第二パラメータに TPM_RETURNCMD フラグを指定しているので、メニューの選択項目のＩＤがこの関数の戻り値になる。これを case 文のセレクタにして、パネルの背景色を変更している｡ この例のように、WM_CONTEXTMENU ハンドラの中で、ユーザのメニュー項目選択にしたがった処理を行うことができる｡ フラグに TPM_RETURNCMD を指定を指定すると、TPM_NONOTIFY を設定していないのにもかかわらず、筆者の調査では Pnl1 のウィンドウ関数には WM_COMMAND が送出されていない｡

右のパネルで右クリックするとメッセージトラッパ MT2 により WM_CONTEXTMENU が捕捉されて MT2ContextMenu( ) が呼び出される｡

procedure MT2ContextMenu(var Msg: TMessage);
begin
  TrackPopupMenuEx(PM2.Handle,0,
                          Msg.LParamLo,Msg.LParamHi,Pnl2.Handle,nil);
end;

ここでは、PM2 をショートカットメニューとして表示している｡ メニュー項目が選択されると Pnl2 のウィンドウ関数に WM_COMMAND が送られる｡ すると、再び MT2 によりこのメッセージが捕捉されて

procedure MT2Command(var Msg: TMessage);
begin
  case Msg.WParamLo of
    ID_RAISED: Pnl2.InnerEdge := esRaised;
    ID_SUNKEN: Pnl2.InnerEdge := esSunken;
    ID_NONE:   Pnl2.InnerEdge := esNone;
  end;
end;

が呼び出され、このパネルの内側のエッジスタイルが変更される｡

ボタンからの右クリックやキー入力により、ＯＳがボタンに向けて送出する WM_CONTEXTMENU メッセージは、メッセージトラッパ MT3 により捕捉され、

procedure MT3ContextMenu(var Msg: TMessage);
var
  ret:integer;
  x,y: integer;
  r: TRect;
begin
  if Msg.LParam = -1 then begin
    GetWindowRect(Btn.Handle,r);
    x := (r.Left+r.Right) div 2;
    y := (r.Top+r.Bottom) div 2;
  end else begin
    x := Msg.LParamLo;
    y := Msg.LParamHi;
  end;
  ret := integer(TrackPopupMenuEx(PM1.Handle,TPM_RETURNCMD,
                                           x,y,Btn.Handle,nil));
  case ret of
    ID_RED:  MainWnd.Color := clrRed;
    ID_GREEN:MainWnd.Color := clrGreen;
    ID_BLUE: MainWnd.Color := clrBlue;
  end;
end;

が呼び出される。ここでも、キー入力の場合とマウスの右クリックの場合のときの座標を計算してから、TPM_RETURNCMD を指定してショートカットメニュー PM1 を表示し、戻り値によりメインウィンドウの背景色を変更している｡

以上、本節ではコードによってショートカットメニューを表示してメニューメッセージの処理をテストした｡

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

２２−２ コントロールへの対応

本稿でこれまでに扱ってきた標準コントロールのなかで、右クリックによりショートカットメニューを表示するのは、'EDIT' クラスと 'COMBOBOX' クラスのエディットコントロールだけであった｡ メモ帳のエディット領域は 'EDIT' コントロールなので、メモ帳のショートカットメニューは、EDIT コントロールのデフォルトのものである｡ 前節で、WM_CONTEXTMENU をコントロールのオリジナルのウィンドウ関数に渡すのをバイパスしたので、このままでは TAPIMemo はショートカットメニューを表示しない｡ 本節では､ EDIT のほか、ボタンやリストボックスなどのコントロールでショートカットメニューを使えるようにする事を考えよう｡ 前節では､ パネルやボタンのウィンドウ内の WM_CONTEXTMENU メッセージを捕捉するために、TMessageTrapper クラスを使った。これでは不便なので、標準コントロールに WM_CONTEXTMENU に対応するイベントを装備する事を考える｡ これらのコントロールのラッパークラスの共通の上位クラスには､ 自分自身のウィンドウ関数を自動的に入れ替える TSelfSubClass クラスがある。ここで、このメッセージを捕捉してイベントを装備すると、全てのコントロールクラスでショートカットメニューを使えることになる。

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

最初に、APIControl.pas にある TSelfSubClass に OnPopupMenu イベントを追加しよう｡ これまで本稿で作成してきた多くのクラスでは、原則としてメッセージの処理は､ そのクラスの DefaultHandler( ) で処理し、継承メソッドを呼び出さない事にしていた｡ したがって、コントロールのラッパークラスの上位クラスである TSelSubClass で DefaultHandler( ) において WM_CONTEXTMENU を処理しても、永久に呼び出されることはないのである。ここでは、この原則を例外として破り、message 指令を使ったメッセージ処理ハンドラで行おう｡ WM_COMNTEXTMENU メッセージは、ほとんどショートカットメニューを表示するためのタイミングだけで用いられるので、この例外は重大な欠陥とはならないだろう｡ message 指令を使ったメッセージ処理ハンドラについては、すでに ３−４−２ メッセージ処理ハンドラ のところで紹介した｡ 変更後の TSelfSubClass の宣言部を以下に示す｡

//----------- TSelfSubClass -----------------------------------------
TSelfSubClass = class(TSubClass)
private
  FHandle: HWND;
  FID: HMenu;
  FOnPopupMenu: TNotifyMessage;                                              // ここ
protected
  procedure APICreateParams(var Params: TAPICreateParams); virtual; abstract;
  procedure Initialize; virtual; abstract;
  procedure WMContextMenu(var Msg: TMessage); message WM_CONTEXTMENU;        // ここ
public
  constructor Create(hParent: HWND); override;
  destructor Destroy; override;
  procedure DestroyObject;
  property Handle: HWND read FHandle;
  property ID: HMenu read FID;
  property OnPopupMenu: TNotifyMessage read FOnPopupMenu write FOnPopupMenu;  // ここ
end;

protected 部の WMContextMenu( ) で WM_CONTEXTMENU メッセージを捕まえて、OnPopupMenu イベントを呼び出す｡ このメソッドの実装部を以下に示す｡

procedure TSelfSubClass.WMContextMenu(var Msg: TMessage);
var
  OriginalProc: TFNWndProc;
begin
  if Assigned(FOnPopupMenu) then begin
    Msg.Msg := integer(self); // sender
    FOnPopupMenu(Msg);
  end else begin
    OriginalProc := TFNWndProc(GetProp(FHandle,'WNDPROC'));
    Msg.Result := CallWindowProc(OriginalProc,FHandle,
                                   Msg.Msg,Msg.wParam,Msg.lParam);
  end;
end;

ここでは、イベントハンドラが設置されているときはそれを呼び出し､ 設置されていないときは前節で、SelfSubClassProc( ) でバイパスしたこのメッセージをもとのウィンドウ関数に送り出す。このようにすると 'EDIT' クラスでもデフォルトのショートカットメニューを表示できるだろう｡

つぎに、MenuClass.pas の TAPopupMenu クラスに TrackPopupMenuEx( ) ＡＰＩをカプセル化したメソッドと、メニュー選択の結果を親のウィンドウ関数に転送するメソッドを追加しよう。宣言部を以下に示す｡

TAPopupMenu = class(TMenuBase)
private
  FID: UINT;
  FAttachedMenu: HMENU;
  FOnInitPopup: TNotifyMessage;
  function GetChecked(mID:UINT):Boolean;
  procedure SetChecked(mID:UINT;value:Boolean);
  function GetEnabled(mID:UINT):Boolean;
  procedure SetEnabled(mID:UINT;value:Boolean);
protected
public
  constructor Create(hParent:HWND);override;
  destructor Destroy; override;
  procedure DefaultHandler(var AMessage); override;
  function AppendSeparator(mID:UINT):Boolean;
  function InsertSeparator(position:integer;mID:UINT):Boolean;
  function AppendRadio(st:string;mID:UINT):Boolean;
  function InsertRadio(position:integer;st:string;mID:UINT):Boolean;
  function AppendBitmap(hB:HBITMAP;mID:UINT):Boolean;
  function InsertBitmap(position:integer;hB:HBITMAP;mID:UINT):Boolean;
  function AttachMenu(Menu:TMenuBase;position:Integer;st:string):Boolean;
  function DetachMenu: Boolean;
  function CheckRadio(First,Last,Check:UINT):Boolean;
  function ChangeBitmap(mID:UINT;hB:HBITMAP):Boolean;
  function Track(Msg:TMessage;FromWnd:HWND):integer;                  // ここ
  procedure EchoBack(mID:UINT);                                       // ここ
  property ID: UINT read FID write FID;
  property AttachedMenu: HMENU read FAttachedMenu;
  property Checked[mID:UINT]:Boolean read GetChecked write SetChecked;
  property Enabled[mID:UINT]:Boolean read GetEnabled write SetEnabled;
  property OnInitPopup: TNotifyMessage read FOnInitPopup write FOnInitPopup;
end;

対応する実装部に以下のコードを追加する。

function TAPopupMenu.Track(Msg:TMessage;FromWnd:HWND):integer;
var
  x,y:integer;
  r:TRect;
begin
  if FromWnd = 0 then FromWnd := Parent;

  if Msg.LParam=-1 then begin
    GetWindowRect(FromWnd,r);
    x := (r.Left+r.Right) div 2;
    y := (r.Top+r.Bottom) div 2;
  end else begin
    x := Msg.LParamLo;
    y := Msg.LParamHi;
  end;
  result := integer(TrackPopupMenu(FHandle,TPM_RIGHTBUTTON or
                       TPM_RETURNCMD or TPM_NONOTIFY,x,y,0,Parent,nil));
end;

procedure TAPopupMenu.EchoBack(mID:UINT);
begin
  SendMessage(Parent,WM_COMMAND,MakeLong(mID,0),0);
end;

Track( ) メソッドは、WM_CONTEXTMENU とそれを発行したウィンドウのハンドルをパラメータとして受け取る。そして、前節と同じコードでショートカットメニューを表示する座標を計算する。 そして TrackPopupMenuEx( ) でメニューを表示する。第二パラメータには、TPM_RIGHTBUTTON or TPM_RETURNCMD or TPM_NONOTIFY フラグを設定しているので、メニュー項目は左右両方のマウスボタンで選択でき､ その結果のメニューＩＤを関数の戻り値とし、どのウィンドウ関数にも WM_COMMAND メッセージを発行しない｡ 前節の例で見たように、WM_CONTEXTMENU の処理ハンドラでこのメニュー項目選択の結果を処理してもよいし、メインメニューと共通なポップアップメニューのときは EchoBack( ) メソッドで親ウィンドウに転送して処理してもよい｡ これで、全てのコントロールでポップアップメニューが表示できるようになった。さっそく試してみよう｡ ShortCutMenu02.dpr の全リストを以下に示す｡

program ShortCutMenu02;

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

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

  MainMenu: TAMainMenu;
  FileMenu,HelpMenu: TAPopupMenu;

  MM: TAPIMemo;
  Btn: TAPIButton;
  LB: TAPILIstBox;

  PMMemo,PMBtn,PMListB: TAPopupMenu;

const
  ID_EXIT = 200;
  ID_TEST = 201;
  ID_ABOUT = 202;

  ID_FILE = 300;
  ID_HELP = 301;

  ID_PMMEMO = 1000;
  ID_PMBTN = 2000;
  ID_PMLISTB = 3000;

  ID_MEMO_LTPINK = 400;
  ID_MEMO_LTGREEN = 401;
  ID_MEMO_LTAQUA = 402;
  ID_MEMO_WHITE = 403;

  ID_LB_LTPINK = 500;
  ID_LB_LTGREEN = 501;
  ID_LB_LTAQUA = 502;
  ID_LB_WHITE = 503;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MMPopupMenu(var Msg: TMessage);
begin
  PMMemo.EchoBack(PMMemo.Track(Msg,MM.Handle));
end;

procedure BtnPopupMenu(var Msg: TMessage);
var
  ret:integer;
begin
  ret := PMBtn.Track(Msg,Btn.Handle);
  Btn.Caption := 'MenuID = '+AIntToStr(ret);
end;

procedure LBPopupMenu(var Msg: TMessage);
begin
  PMListB.EchoBack(PMListB.Track(Msg,LB.Handle));
end;

procedure MainMenuCommand(var Msg: TMessage);
begin
  case Msg.WParamLo of

    ID_MEMO_LTPINK: MM.Color := RGB(255,230,230);
    ID_MEMO_LTGREEN:MM.Color := RGB(230,255,230);
    ID_MEMO_LTAQUA: MM.Color := RGB(230,230,255);
    ID_MEMO_WHITE:  MM.Color := clrWhite;

    ID_LB_LTPINK: LB.Color := RGB(255,230,230);
    ID_LB_LTGREEN:LB.Color := RGB(230,255,230);
    ID_LB_LTAQUA: LB.Color := RGB(230,230,255);
    ID_LB_WHITE:  LB.Color := clrWhite;
    
  end;
end;

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

  MainMenu := MakeMainMenu(hWindow,MainMenuCommand);

    FileMenu := MakePopupMenu(hWindow,ID_FILE,nil);
    FileMenu.AppendString('E&xit',ID_EXIT);
    FileMenu.AttachMenu(MainMenu,-1,'&File');

    MainMenu.AppendString('&Test!',ID_TEST);

    HelpMenu := MakePopupMenu(hWindow,ID_HELP,nil);
    HelpMenu.AppendString('&About...',ID_ABOUT);
    HelpMenu.AttachMenu(MainMenu,-1,'&Help');

  MainMenu.SetToParent;

  MM := CreateMemo(hWindow,0,0,200,150);
  Btn := CreateButton(hWindow,10,180,190,35,'Please RClick',nil);
  Btn.OnPopupMenu := BtnPopupMenu;
  LB := CreateListBox(hWindow,210,10,200,150,nil);
  LB.OnPopupMenu := LBPopupMenu;

  PMMemo := MakePopupMenu(hWindow,ID_PMMEMO,nil);
  PMMemo.AppendString('Lt&Pink',ID_MEMO_LTPINK);
  PMMemo.AppendString('Lt&Green',ID_MEMO_LTGREEN);
  PMMemo.AppendString('Lt&Aqua',ID_MEMO_LTAQUA);
  PMMemo.AppendString('&White',ID_MEMO_WHITE);
  PMMemo.AttachMenu(MainMenu,ID_HELP,'&MemoBkColor');

  PMBtn := MakePopupMenu(hWindow,ID_PMBTN,nil);
  PMBtn.AppendString('BtnMenu &1',2001);
  PMBtn.AppendString('BtnMenu &2',2002);

  PMListB := MakePopupMenu(hWindow,ID_PMLISTB,nil);
  PMListB.AppendString('Lt&Pink',ID_LB_LTPINK);
  PMListB.AppendString('Lt&Green',ID_LB_LTGREEN);
  PMListB.AppendString('Lt&Aqua',ID_LB_LTAQUA);
  PMListB.AppendString('&White',ID_LB_WHITE);
  PMListB.AttachMenu(MainMenu,ID_HELP,'&ListBoxBkColor');

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

procedure OnTest(hWindow: HWND);
begin
  MM.OnPopupMenu := MMPopupMenu;
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.gifShortCutMenu02.zip(17.225kB)
ShortCutMenu02.gif

実行して、まず、左のメモの上で右クリックするとデフォルトのショートカットメニューが表示される。Test! メニューをクリックすると、メモの OnPopupMenu にイベントハンドラが設置され、今度はメインメニューの MemoBkColor 項目と同じ項目が表示される。項目を選ぶとメモの背景色が変更される｡ 右のリストボックスにも同様なショートカットメニューが表示され背景色が変更される｡ ボタンのショートカットメニューを選ぶとそのＩＤがキャプションに表示される｡ これらのコントロールはフォーカスを得ることができるので [SHIFT]+{f.10] キーや VK_APPS キーにより、コントロールの中央にショートカットメニューが表示される｡ この様子を右図に示した｡

コードを見てみよう｡ メモの OnPopupMenu ハンドラである MMPopupMenu( ) を以下に示す｡

procedure MMPopupMenu(var Msg: TMessage);
begin
  PMMemo.EchoBack(PMMemo.Track(Msg,MM.Handle));
end;

ここでは、メインメニューの項目と共通する PMMemo ポップアップメニューを表示して､ 選択された項目のＩＤを親であるメインウィンドウに転送している｡ この WM_COMMAND メッセージは、メインメニューの MainMenu で捕捉されて、

procedure MainMenuCommand(var Msg: TMessage);
begin
  case Msg.WParamLo of

    ID_MEMO_LTPINK: MM.Color := RGB(255,230,230);
    ID_MEMO_LTGREEN:MM.Color := RGB(230,255,230);
    ID_MEMO_LTAQUA: MM.Color := RGB(230,230,255);
    ID_MEMO_WHITE:  MM.Color := clrWhite;

    ID_LB_LTPINK: LB.Color := RGB(255,230,230);
    ID_LB_LTGREEN:LB.Color := RGB(230,255,230);
    ID_LB_LTAQUA: LB.Color := RGB(230,230,255);
    ID_LB_WHITE:  LB.Color := clrWhite;
    
  end;
end;

で処理される｡ リストボックスについても同様である｡ これに対して､ボタンのショートカットメニューの選択ＩＤは

procedure BtnPopupMenu(var Msg: TMessage);
var
  ret:integer;
begin
  ret := PMBtn.Track(Msg,Btn.Handle);
  Btn.Caption := 'MenuID = '+AIntToStr(ret);
end;

のように、OnPupupMenu イベントハンドラで処理されている｡ このポップアップメニューは、メインメニューにアタッチされていないからである｡

以上のように、全てのコントロールでショートカットメニューを簡単に使用できるようになった。パネルなどの WM_CONTEXTMENU メッセージを捕捉できないクラスでは、やはり、TMessageTrapper を使わなければならないが、フォーカスを持たないウィンドウでショートカットメニューを使うことはあまりないだろう｡

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

２２−３ ウィンドウメニュー

SkeletonWindowMenu.gif

ウィンドウスタイルに WS_SYSMENU を指定して（WS_OVERLAPPEDWINDOW は WS_SYSMENU を含んでいる）作成されたウィンドウは、タイトルバーの左端に表示されているアイコンを左クリックするとドロップダウンメニューが表示される｡ 骨格プログラム Skeleton03.dpr で作られるメインウィンドウもこのスタイルを持っているので、右図のように表示される｡ このようなドロップダウンメニューをシステムメニュー、またはウィンドウメニュー、またはコントロールメニューという。名前がたくさんあるのは、マイクロソフトのドキュメントにおける混乱のせいである｡ ここでは、ウィンドウメニューと呼ぶことにしよう。ウィンドウメニューは、タイトルバーを右クリックしても、また、タスクバーのアイコンを右クリックしても同じものが表示される｡ よく知られているように、Delphi の ＲＡＤでつくられる Form1 は、アプリケーションのトップレベルウィンドウではないので、タスクバーを右クリックしたときに表示されるウィンドウメニューは、Form1 のそれと一致しない｡ これは、目に見えない Application ウィンドウのウィンドウメニューである｡ 本節では､ ウィンドウメニューをコードで制御することを考えよう｡

ウィンドウメニューのハンドルを取得するには、

function GetSystemMenu(hWnd: HWND; bRevert: BOOL): HMENU; stdcall;

を使う｡ hWnd にはウィンドウメニューを持つウィンドウのハンドルを指定する。ハンドルを取得するときは bRevert を false にする。bRevert を true にすると、ウィンドウメニューがリセットされデフォルトのウィンドウメニューになる｡ メニューハンドルが取得できたら、これまでに作成してきたメニュー作成用の関数を使って、メニュー項目の追加・挿入・削除ができる。ウィンドウメニューの項目が選択されると、そのウィンドウのウィンドウ関数に WM_SYSCOMMAND メッセージが送出される。

WM_SYSCOMMAND
uCmdType = wParam;        // type of system command requested 
xPos = LOWORD(lParam);    // horizontal postion, in screen coordinates 
yPos = HIWORD(lParam);    // vertical postion, in screen coordinates

WParam には、デフォルトでは以下の定数のうちの一つが設定されている｡ これは、メニューＩＤと同等の定数定義とみなしてよい。

const
  { System Menu Command Values }
  SC_SIZE = 61440;        // ウィンドウのサイズ変更
  SC_MOVE = 61456;        // ウィンドウの移動
  SC_MINIMIZE = 61472;    // 最小化
  SC_MAXIMIZE = 61488;    // 最大化
  SC_NEXTWINDOW = 61504;  // タスクリストの次のウィンドウへ
  SC_PREVWINDOW = 61520;  // タスクリストの前のウィンドウへ
  SC_CLOSE = 61536;       // ウィンドウが閉じる
  SC_VSCROLL = 61552;     // 垂直スクロール
  SC_HSCROLL = 61568;     // 水平スクロール
  SC_MOUSEMENU = 61584;   // マウスクリックによる項目の選択
  SC_KEYMENU = 61696;     // キー入力による選択。LParam はキーコード。
  SC_RESTORE = 61728;     // 元のサイズに戻す
  SC_TASKLIST = 61744;    // スタートメニューの表示
  SC_SCREENSAVE = 61760;  // スクリーンセーバーの実行
  SC_HOTKEY = 61776;      // ホットキーの実行。LParam はアクティブウィンドウのハンドル
  SC_DEFAULT = 61792;     // デフォルト項目。ウィンドウメニューをダブルクリックした
  SC_MONITORPOWER = 61808;// Windows95 のみ
  SC_CONTEXTHELP = 61824; // ？マークのヘルプボタンを押した
  SC_SEPARATOR = 61455;   // セパレータ

これらは、システム定義のメニューＩＤであると見なすことができ、WM_SYSCOMMAND でこのＩＤが送られてきたら、コードで処理せずに DefWindowProc( ) にそのまま渡すと、適切に処理してくれる｡ これまでのプログラムでも、ウィンドウメニューからの WN_SYSCOMMAND メッセージは全て DefWindowProc( ) に渡してきた。もし、本節で試すように、ウィンドウメニューに独自のメニュー項目を追加・挿入した場合は、その項目のＩＤを持つ WM_SYSCOMMAND メッセージを処理しなければならない｡

それでは、デフォルトのウィンドウメニューを調べ､ それに項目を追加してコマンドを処理することをテストしてみよう｡

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

このプログラムでは、ウィンドウメニューの項目のＩＤを調べたい。この目的にぴったりなＡＰＩがある。

function GetMenuItemID(hMenu: HMENU; nPos: Integer): UINT; stdcall;

hMenu に調べるメニューのハンドルを、nPos にはメニュー項目のゼロベースの位置を指定する｡ 筆者がこのＡＰＩ関数を使ってテストしてみたところ、ポップアップメニュー項目のＩＤがこの関数では正確に取得できないことが分かった｡ この関数は、比較的古い実装であり、ポップアップメニュー項目にＩＤを設定することを前提としていないもののようだ。そこで、すでに紹介した GetMenuItemInfo( ) ＡＰＩを単機能化した関数を UtilFunc.pas に作成しよう｡ SetMenuEnabled( ) の宣言の下に以下の宣言を追加する｡ 

function MenuItemID(hM:HMENU;position:UINT):UINT;

そして、実装部の対応する場所に以下のコードを書く。

function MenuItemID(hM:HMENU;position:UINT):UINT;
var
  MII:TMenuItemInfo;
begin
  FillChar(MII,SizeOf(TMenuItemInfo),0);
  with MII do begin
    cbSize := SizeOf(TMenuItemInfo);
    fMask := MIIM_ID;
  end;
  GetMenuItemInfo(hM,position,true,MII);
  result := MII.wID;
end;

つぎに、ウィンドウメニューに追加するポップアップメニューの項目にするビットマップを四つ作る。ここでは、60ｘ20 の四色のビットマップを作ってリソースにした。リソース記述ファイルを以下に示す｡

//
//  MyRes.rc
//

LtPink BITMAP "LtPink.bmp"
LtGreen BITMAP "LtGreen.bmp"
LtAqua BITMAP "LtAqua.bmp"
White BITMAP "White.bmp"

これを四つのビットマップがあるフォルダに 'MyRes.rc' として保存し、リソースコンパイラでコンパイルして MyRes.res をつくり、2203WinMenu01 フォルダにコピーする。WinMenu01.dpr の全リストを以下に示す｡

program WinMenu01;

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

  {$R MyRes.res}

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

  hWndM: HMENU;
  hLtPink,hLtGreen,hLtAqua,hWhite:HBITMAP;

  LB :TAPIListBox;
  BK: TAPopupMenu;

const
  ID_SEP1 =   100;
  ID_BK =     101;

  ID_LTPINK = 102;
  ID_LTGREEN = 103;
  ID_LTAQUA = 104;
  ID_WHITE =  105;

  ID_SEP2 = 106;
  ID_RESET = 107;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainSysCommand(var Msg: TMessage);
begin
  case Msg.WParam of
    ID_LTPINK: LB.Color := RGB(255,230,230);
    ID_LTGREEN:LB.Color := RGB(230,255,230);
    ID_LTAQUA: LB.Color := RGB(230,230,255);
    ID_WHITE:  LB.Color := clrWhite;
    ID_RESET: begin
      GetSystemMenu(MainWnd.Handle,true);
      hWndM := GetSystemMenu(MainWnd.Handle,false);
    end;
  end;
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  hWndM := GetSystemMenu(hWindow,false);

  hLtPink := LoadBitmap(hInstance,'LtPink');
  hLtGreen := LoadBitmap(hInstance,'LtGreen');
  hLtAqua := LoadBitmap(hInstance,'LtAqua');
  hWhite := LoadBitmap(hInstance,'White');

  BK := MakePopupMenu(hWindow,ID_BK,nil);
  BK.AppendBitmap(hLtPink,ID_LTPINK);
  BK.AppendBitmap(hLtGreen,ID_LTGREEN);
  BK.AppendBitmap(hLtAqua,ID_LTAQUA);
  BK.AppendBitmap(hWhite,ID_WHITE);
  BK.AppendSeparator(ID_SEP2);
  BK.AppendString('&Reset',ID_RESET);

  AppendSeparatorMenu(hWndM,ID_SEP1);
  AppendPopupMenu(hWndM,'&LBBkColor',BK.Handle,ID_BK);

  LB := CreateListBox(hWindow,10,10,430,280,nil); 

  with MainWnd do begin
    ClientWidth := 450;
    ClientHeight := 300;
    Center;
    Trap(WM_SYSCOMMAND,MainSysCommand);
  end;
end;

procedure OnTest(hWindow: HWND);
var
  IC,i,Len:integer;
  PC: PChar;
  s:string;
begin
  LB.Clear;
  IC:= GetMenuItemCount(hWndM);
  LB.AddString('WndMenu Item Count = '+AIntToStr(IC));
  LB.AddString('');
  GetMem(PC,30);
  for i := 0 to IC-1 do begin
    Len := GetMenuString(hWndM,i,PC,30,MF_BYPOSITION);
    if Len=0 then
      s := '######'
    else
      SetString(s,PC,Len);
    LB.AddString(s+'  :  ID = '+ AIntToStr(MenuItemID(hWndM,i)));
  end;
  FreeMem(PC);
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.gifWinMenu01.zip(17.740kB)
WinMenu01.gif

実行して、Test! メニューを選択するとリストボックスにウィンドウメニューの項目数と各項目の文字列とＩＤの値が表示される｡ デフォルトのメニュー項目のＩＤの値は、上記の SC_XXXX の値と対応していることが確認できるだろう｡ 右図のように、ポップアップメニューが追加されており、このメニュー項目を選択するとリストボックスの背景色が変更される｡ Reset 項目を選ぶとウィンドウメニューがデフォルトのそれに戻り、再び Test! を選んでその項目を確認できる｡

コードを調べよう｡ MainCreate( ) ハンドラでは､ 

hWndM := GetSystemMenu(hWindow,false);

によって、ウィンドウメニューのハンドルを取得し、グローバル変数 hWndM に格納している。つぎに、リソースから四つのビットマップハンドルを取得し、ポップアップメニューを組み立ててから、ウィンドウメニューにセパレータとともに追加している｡ OnTest( ) ハンドラを見てみよう｡

procedure OnTest(hWindow: HWND);
var
  IC,i,Len:integer;
  PC: PChar;
  s:string;
begin
  LB.Clear;
  IC:= GetMenuItemCount(hWndM);
  LB.AddString('WndMenu Item Count = '+AIntToStr(IC));
  LB.AddString('');
  GetMem(PC,30);
  for i := 0 to IC-1 do begin
    Len := GetMenuString(hWndM,i,PC,30,MF_BYPOSITION);
    if Len=0 then
      s := '######'
    else
      SetString(s,PC,Len);
    LB.AddString(s+'  :  ID = '+ AIntToStr(MenuItemID(hWndM,i)));
  end;
  FreeMem(PC);
end;

ここでは､ リストボックスをクリアしてから、ウィンドウメニューの項目数を取得し、それをリストボックスに表示している｡ そして、メニュー項目の文字列を取得するためのバッファをメモリから割り当ててから、各項目の文字列とＩＤを取得して、リストボックスに表示している｡ 項目の文字列を取得するには、

function GetMenuString(hMenu: HMENU; 
                     uIDItem: UINT; 
                    lpString: PChar;
                   nMaxCount: Integer; 
                       uFlag: UINT): Integer; stdcall;

を使う｡ hMenu には取得するメニューのハンドルを設定する。uFlag に、MF_BYCOMMAND を指定したときは uIDItem には取得する項目のＩＤを設定する。uFlag に MF_BYPOSITION を設定したときは uIDItem にはゼロベースの項目位置を設定する｡ lpString には、文字列を受け取るバッファを、nMaxCount にはそのバッファのサイズを指定する｡ ＩＤの値の取得には、上で UtilFunc.pas に作った MenuItemID( ) 関数を使っている｡ MainWnd の Trap( ) メソッドを使って WM_SYSCOMMAND を捕捉しているので、追加メニュー項目を選んだときには MainSysCommand( ) ハンドラが呼び出される｡

procedure MainSysCommand(var Msg: TMessage);
begin
  case Msg.WParam of
    ID_LTPINK: LB.Color := RGB(255,230,230);
    ID_LTGREEN:LB.Color := RGB(230,255,230);
    ID_LTAQUA: LB.Color := RGB(230,230,255);
    ID_WHITE:  LB.Color := clrWhite;
    ID_RESET: begin
      GetSystemMenu(MainWnd.Handle,true);
      hWndM := GetSystemMenu(MainWnd.Handle,false);
    end;
  end;
end;

ここでは、メニュー項目のＩＤ値を使って処理を分岐し、リストボックスの背景色を変更するか、ウィンドウメニューをリセットしている｡

以上のように、ウィンドウメニューのハンドルを取得すると、項目の属性を調べたり、普通のポップアップメニューと同じように項目の挿入や削除ができる。普通のポップアップメニューとの相違は、メニュー項目の選択によって WM_COMMAND ではなく WM_SYSCOMMAND メッセージが送出される点だけであることが分かった｡

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

２２−４ ウィンドウメニュークラス

前節で調べたウィンドウメニューの機能をカプセル化したクラスを作成しよう｡ ウィンドウメニューは、メニュー項目が選択されると WM_SYSCOMMAND が発行されること､ デフォルトのメニューはシステムが自動的に作ってくれることが、普通のポップアップメニューとの相違点である｡ したがって、前節までに作った TAPopupMenu クラスから派生して作成する。そうするとメニュー項目の追加・挿入のためのメソッドやその他のメソッドやプロパティーを継承することになるので、非常に簡単に作成することができる｡

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

最初に、MenuClass.pas にウィンドウメニューのラッパークラス TWindowMenu を作成する。宣言部を以下に示す｡

//--------------- TWindowMenu ----------------------------------
TWindowMenu = class(TAPopupMenu)
private
  FOnSysCommand: TNotifyMessage;
protected
public
  constructor Create(hParent:HWND);override;
  procedure DefaultHandler(var AMessage); override;
  procedure ResetMenu;
  procedure EchoBack(mID:UINT;lparam:LPARAM);
  property OnSysCommand: TNotifyMessage read FOnSysCommand write FOnSysCommand;
end;

このクラスは TAPopupMenu クラスから派生し、コンストラクタと DefaultHandler( ) をオーバーライドし、ResetMenu メソッドと OnSysCommand イベントを追加し、さらに、EchoBack( ) メソッドを書き換えている｡ 実装部を以下に示す｡

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

  DestroyMenu(FHandle);
  FHandle := GetSystemMenu(hParent,false);

  Dispatcher.TrapMessage(WM_SYSCOMMAND,self);
end;

procedure TWindowMenu.DefaultHandler(var AMessage);
var
  AMsg: TMessage;
begin
  AMsg := TMessage(AMessage);
  case AMsg.Msg of
    WM_INITMENUPOPUP:
      if AMsg.WParam = FHandle then begin
        AMsg.Msg := UINT(self);  // sender
        if Assigned(FOnInitPopup) then FOnInitPopup(AMsg);
      end;
    WM_SYSCOMMAND: begin
      AMsg.Msg := UINT(self);  // sender
      if Assigned(FOnSysCommand) then FOnSysCommand(AMsg);
    end;
  end;
end;

procedure TWindowMenu.EchoBack(mID:UINT;lparam:LPARAM);
begin
  SendMessage(Parent,WM_SYSCOMMAND,mID,lparam);
end;

procedure TWindowMenu.ResetMenu;
begin
  GetSystemMenu(Parent,true);
  FHandle := GetSystemMenu(Parent,false);
end;

コンストラクタでは、継承メソッドで上位クラスである TAPopupMenu のコンストラクタで作成された空のメニューハンドルを DestroyMenu( ) で破棄し、新たに GetSystemMenu( ) でハンドルを取得している｡ そして、Dispatcher に WM_SYSCOMMAND を配送してくれるよう依頼している｡ DefaultHandler( ) では、WM_SYSCOMMAND と WM_INITMENUPOPUP メッセージを捕捉してイベントハンドラを呼び出している｡ 上書きした EchoBack( ) メソッドでは、親ウィンドウに WM_SYSCOMMAND を組み立てて転送している｡ ResetMenu メソッドでは、ウィンドウメニューをデフォルトに戻し､ ハンドルの値を更新している｡ 例によって、インスタンス作成関数をつくる。宣言部を以下に示す｡

function MakeWindowMenu(hParent:HWND;
                                sOnSysCommand:TNotifyMessage): TWindowMenu;

実装部を以下に示す｡

function MakeWindowMenu(hParent:HWND;
                                sOnSysCommand:TNotifyMessage): TWindowMenu;
begin
  result := TWindowMenu.Create(hParent);
  result.FOnSysCommand := sOnSysCommand;
end;

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

program WinMenu02;

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

  {$R MyRes.res}

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

  hLtPink,hLtGreen,hLtAqua,hWhite:HBITMAP;

  LB :TAPIListBox;
  WM: TWindowMenu;
  BK: TAPopupMenu;

const
  ID_SEP1 =   100;
  ID_BK =     $101;

  ID_LTPINK = 102;
  ID_LTGREEN =103;
  ID_LTAQUA = 104;
  ID_WHITE =  105;

  ID_SEP2 =   200;
  ID_RED =    201;
  ID_BLUE =   202;
  ID_GREEN =  203;
  ID_BTNFACE = 204;

  ID_SEP3 = 300;
  ID_RESET = 301;
//------------------------------------------------------------
//             Helper Handlers
//------------------------------------------------------------

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MainSysCommand(var Msg: TMessage);
begin
  case Msg.WParam of
    ID_LTPINK..ID_WHITE: begin
      case Msg.WParam of
        ID_LTPINK: LB.Color := RGB(255,230,230);
        ID_LTGREEN:LB.Color := RGB(230,255,230);
        ID_LTAQUA: LB.Color := RGB(230,230,255);
        ID_WHITE:  LB.Color := clrWhite;
      end;
      BK.CheckRadio(ID_LTPINK,ID_WHITE,Msg.WParam);
    end;
    ID_RED..ID_BTNFACE: begin
      case Msg.WParam of
        ID_RED:      MainWnd.Color := clrRed;
        ID_BLUE:     MainWnd.Color := clrBlue;
        ID_GREEN:    MainWnd.Color := clrGreen;
        ID_BTNFACE:  MainWnd.Color := clrBtnFace;
      end;
      WM.CheckRadio(ID_RED,ID_BTNFACE,Msg.WParam);
    end;
    ID_RESET: WM.ResetMenu;
  end;
end;

procedure LBPopup(var Msg: TMessage);
var
  ret:UINT;
begin
  ret := WM.Track(Msg,LB.Handle);
  WM.EchoBack(ret,Msg.LParam);
end;

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

  hLtPink := LoadBitmap(hInstance,'LtPink');
  hLtGreen := LoadBitmap(hInstance,'LtGreen');
  hLtAqua := LoadBitmap(hInstance,'LtAqua');
  hWhite := LoadBitmap(hInstance,'White');

  LB := CreateListBox(hWindow,10,10,430,380,nil);
  LB.OnPopupMenu:= LBPopup;

  WM := MakeWindowMenu(hWindow,MainSysCommand);
  WM.AppendSeparator(ID_SEP1);
  WM.AppendSeparator(ID_SEP2);
  WM.AppendString('&Red',ID_RED);
  WM.AppendString('&Blue',ID_BLUE);
  WM.AppendString('&Green',ID_GREEN);
  WM.AppendString('Btn&Face',ID_BTNFACE);
  WM.AppendSeparator(ID_SEP3);
  WM.AppendString('&Reset',ID_RESET);

  BK := MakePopupMenu(hWindow,ID_BK,nil);
  BK.AppendBitmap(hLtPink,ID_LTPINK);
  BK.AppendBitmap(hLtGreen,ID_LTGREEN);
  BK.AppendBitmap(hLtAqua,ID_LTAQUA);
  BK.AppendBitmap(hWhite,ID_WHITE);
  BK.AttachMenu(WM,ID_SEP2,'&LBBkColor');

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

procedure OnTest(hWindow: HWND);
var
  IC,i,Len:integer;
  PC: PChar;
  s:string;
begin
  LB.Clear;
  IC:= GetMenuItemCount(WM.Handle);
  LB.AddString('WndMenu Item Count = '+AIntToStr(IC));
  LB.AddString('');
  GetMem(PC,30);
  for i := 0 to IC-1 do begin
    Len := GetMenuString(WM.Handle,i,PC,30,MF_BYPOSITION);
    if Len=0 then
      s := '######'
    else
      SetString(s,PC,Len);
    LB.AddString(s+'  :  ID = '+ AIntToStr(MenuItemID(WM.Handle,i)));
  end;
  FreeMem(PC);
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.gifWinMenu02.zip(18.235kB)
WinMenu02.gif

実行して、Test! メニューを選択すると、前節のプログラムと同じようにウィンドウメニューの項目の文字列とＩＤの一覧がリストボックスに表示される｡ ウィンドウメニューを開くとメインウィンドウの背景色を変更できるメニュー項目とリセットする項目、および前節と同様にリストボックスの背景色を変更するポップアップメニューが追加されている｡ また、リストボックスのうえで右クリックするとウィンドウメニューと同じショートカットメニューが表示され、コマンドが実行できる｡ このときの様子を右図に示した｡ 追加項目を選択するとラジオマークが付けられる｡

コードを見てみよう。MainCreate( ) では、TWindowMenu クラスのインスタンスがつくられ、追加メソッドにより、項目を追加している｡ OnSysCommand イベントの MainSysCommand( ) を見てみよう｡

procedure MainSysCommand(var Msg: TMessage);
begin
  case Msg.WParam of
    ID_LTPINK..ID_WHITE: begin
      case Msg.WParam of
        ID_LTPINK: LB.Color := RGB(255,230,230);
        ID_LTGREEN:LB.Color := RGB(230,255,230);
        ID_LTAQUA: LB.Color := RGB(230,230,255);
        ID_WHITE:  LB.Color := clrWhite;
      end;
      BK.CheckRadio(ID_LTPINK,ID_WHITE,Msg.WParam);
    end;
    ID_RED..ID_BTNFACE: begin
      case Msg.WParam of
        ID_RED:      MainWnd.Color := clrRed;
        ID_BLUE:     MainWnd.Color := clrBlue;
        ID_GREEN:    MainWnd.Color := clrGreen;
        ID_BTNFACE:  MainWnd.Color := clrBtnFace;
      end;
      WM.CheckRadio(ID_RED,ID_BTNFACE,Msg.WParam);
    end;
    ID_RESET: WM.ResetMenu;
  end;
end;

このようにすると、文字列項目やビットマップ項目でもラジオチェックマークが排他的につけられる｡ リストボックスの OnPopupMenu イベントの処理ハンドラ LBPopup( ) を見てみよう｡

procedure LBPopup(var Msg: TMessage);
var
  ret:UINT;
begin
  ret := WM.Track(Msg,LB.Handle);
  WM.EchoBack(ret,Msg.LParam);
end;

ウィンドウメニューも Track( ) メソッドを使って一般のポップアップメニューと同じようにショートカットメニューとして表示できる｡ ここでは、選択メニュー項目のＩＤを受け取って親ウィンドウに WM_SYSCOMMAND として転送することにより、上記の MainSysCommand( ) により処理される｡

本節では､ウィンドウメニューの機能をカプセル化した TWindowMenu クラスを TAPopupMenu クラスから派生して作り、テストした｡ ウィンドウメニューも普通のポップアップメニューとほとんど同じであることが分かっただろう｡

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

２２−５ アクセレレータ

アクセレレータは、特定のキーの入力によって WM_COMMAND メッセージを発行する仕組みである｡ メモ帳や大抵のエディタやワープロソフトでは、[CTRL]+V で貼り付け、[CTRL]+X で切り取り、などクリップボードと文字列のやりとりができる｡ また、多くのアプリケーションでは [ALT}+[f.4] でアプリケーションが終了する。この節では、アプリケーション定義のアクセレレータを試してみよう｡

アクセレレータは、特定のキー入力とそれに関連付けられ WM_COMMAND とともに送出されるＩＤの値を定義した、アクセレレータテーブルを作ることにより、アプリケーションにインストールされる。アクセレレータテーブルを作るには、

function CreateAcceleratorTable(var Accel; 
                                    Count: Integer): HACCEL; stdcall;

を使う。Accel パラメータは、この宣言では型なし変数になっているが、以下のような TAccel 型レコードの配列を指定する。Count には、Accel の配列の要素の個数を指定する。この関数は、アクセレレータテーブルのハンドルを戻す｡

type
  PAccel = ^TAccel;
  TAccel = packed record
    fVirt: Word;  
    key: Word;
    cmd: Word;
  end;

一つの TAccel 型レコードが一つのアクセレレータキーを定義する｡ fVirt に指定できる定数は以下のものの組み合わせである｡

const
{ Defines for the fVirt field of the Accelerator table structure. }
  FVIRTKEY = 1;   // key フィールドは仮想キーコードである
  FNOINVERT = 2;  // トップレベルメニューの対応項目がキー入力により反転しない
  FSHIFT = 4;     // [SHIFT] キーとの組み合わせ
  FCONTROL = 8;   // [CNTRL] キーとの組み合わせ
  FALT = $10;     // [ALT] キーとの組み合わせ

ここでの FVIRTKEY フラグを指定すると key フィールドは、仮想キーコードであると解釈される｡ これを指定しないときはアスキーコードであると解釈される｡ key フィールドには、fVirt フラグと組合わせるキーを仮想キーコードまたはアスキーコードで指定する。仮想キーコードは、Windows.pas で定義されている。以下にその一部を示す｡

  { Virtual Keys, Standard Set }
  VK_CANCEL = 3;
  VK_BACK = 8;
  VK_TAB = 9;
  VK_CLEAR = 12;
  VK_RETURN = 13;
  VK_SHIFT = $10;
  VK_CONTROL = 17;
  VK_KANA = 21;
  VK_HANGUL = 21;
  VK_KANJI = 25;
  VK_CONVERT = 28;
  VK_ESCAPE = 27;
  VK_SPACE = $20;
  VK_HOME = 36;
  VK_LEFT = 37;
  VK_UP = 38;
  VK_RIGHT = 39;
  VK_DOWN = 40;
  VK_INSERT = 45;
  VK_DELETE = 46;
  VK_HELP = 47;
{ VK_0 thru VK_9 are the same as ASCII '0' thru '9' ($30 - $39) }
{ VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' ($41 - $5A) }
  VK_APPS = 93;
  VK_F1 = 112;
  VK_F2 = 113;
  VK_F3 = 114;
  VK_F4 = 115;
  VK_F5 = 116;
  VK_F6 = 117;
  VK_F7 = 118;
  VK_F8 = 119;
  VK_F9 = 120;
  VK_F10 = 121;
  VK_F11 = 122;
  VK_F12 = 123;

ここで示したように、アルファベットの大文字と数値キーの入力に対する仮想キーは、定数定義はないがアスキーコードと同じ数値であることが分かる｡ したがって、VK_A の仮想キーコードは使えないが、これは Ord('A') と同じである｡ TAccel の cmd フィールドには、メニュー項目やコントロールと同じようにコマンドＩＤの数値を設定する。

ここまでで、TAccel 型レコードの配列を定義して CreateAcceleratorTable( ) ＡＰＩを使って、アクセレレータテーブルを作り、そのハンドルを手に入れる方法が分かった。アプリケーションを終了するときには、このテーブルを破棄しなければならない｡ それには、

function DestroyAcceleratorTable(hAccel: HACCEL): BOOL; stdcall;

を使う｡ さて、アクセレレータテーブルのハンドルが手に入ったとして、それをどうやって使うのだろうか｡ これまでの経験から、アクセレレータキーによるコマンドは､ キー入力のフォーカスがどのコントロールにある場合でも優先的に実行されることを知っているだろう｡ したがって、各ウィンドウのウィンドウ関数のなかのコードよりさらに低レベルの段階で実行されることが想像できる｡ 実は、メッセージループの中で実行されるのである｡ メッセージループについては、１−３−５ メッセージループ ですでに説明した。これまでの骨格プログラムでは、メッセージループは、UtilFunc.pas につくった以下の関数で行っていた｡

function MessageLoopNormal: integer;
var
  Msg: TMsg;
begin
  while GetMessage(Msg, 0, 0, 0) do begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
  result := Msg.wParam;
end;

ここで、GetMessage( ) でメッセージキューから取り出してきた TMsg 型レコードを以下のＡＰＩに渡す。

function TranslateAccelerator(hWnd: HWND; 
                         hAccTable: HACCEL; 
                         var lpMsg: TMsg): Integer; stdcall;

このＡＰＩは、lpMsg を受け取り、hAccTable で識別されるアクセレレータテーブルを参照して、アクセレレータキーに相当するメッセージであれば WM_COMMAND を hWnd に送り、ゼロ以外の値を返す｡、そうでなければ何もせず、ゼロを戻す｡ したがって、アクセレレータを使うときは、メッセージループを以下のようにする。

  while GetMessage(Msg, 0, 0, 0) do begin
    if not Boolean(TranslateAccelerator(MainWnd.Handle,hAcc,Msg)) then begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;

これで、アクセレレータキーの入力を WM_COMMAND としてメインウィンドウのウィンドウ関数に送ることができる。テーブルになかったときは、これまで通りの通常処理をする｡

以上の知識を使って、アクセレレータテーブルをつくって試してみよう。

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

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

program AccelTable01;

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

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

  L1: TAPILabel;

  hAcc: HACCEL;

  ACC: array[0..5] of TAccel;

const
  ID_RED = 100;
  ID_GREEN = 101;
  ID_BLUE = 102;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------

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

  L1 := CreateLabel(hWindow,10,10,180,80,'');

  with MainWnd do begin
    ClientWidth := 200;
    ClientHeight := 100;
    Center;
  end;
end;

procedure OnTest(hWindow: HWND);
begin
  ACC[0].fVirt := FCONTROL or FVIRTKEY;
  ACC[0].key   := Ord('R');
  ACC[0].cmd   := ID_RED;

  ACC[1].fVirt := FCONTROL or FVIRTKEY;
  ACC[1].key   := Ord('G');
  ACC[1].cmd   := ID_GREEN;

  ACC[2].fVirt := FCONTROL or FVIRTKEY;
  ACC[2].key   := Ord('B');
  ACC[2].cmd   := ID_BLUE;

  ACC[3].fVirt := FVIRTKEY;
  ACC[3].key   := VK_F1;
  ACC[3].cmd   := ID_RED;

  ACC[4].fVirt := FVIRTKEY;
  ACC[4].key   := VK_F2;
  ACC[4].cmd   := ID_GREEN;

  ACC[5].fVirt := FVIRTKEY;
  ACC[5].key   := VK_F3;
  ACC[5].cmd   := ID_BLUE;

  hAcc := CreateAcceleratorTable(ACC,6);
end;

procedure MainCommand(var Msg: TMessage);
begin
  if (Msg.LParam+Msg.WParamHi)=1 then
    case Msg.WParamLo of
      ID_RED:   L1.Color := clrRed;
      ID_GREEN: L1.Color := clrGreen;
      ID_BLUE:  L1.Color := clrBlue;
    end;
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

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

//------------------------------------------------------------
//             Main Procedure
//------------------------------------------------------------
var
  Msg: TMsg;
begin

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

  while GetMessage(Msg, 0, 0, 0) do begin
    if (hAcc=0) or
         (not Boolean(TranslateAccelerator(MainWnd.Handle,hAcc,Msg))) then begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;

  Halt(Msg.wParam);

end.

DownloadExe.gifAccelTable01.zip(14.988kB)
AccelTable01.gif

実行して、Test! メニューを選択するとアクセレレータテーブルが作られる。[CTRL]+R でラベルの背景色が赤色に、[CTRL]+G で緑に、[CTRL]+B で青に変更される。[f.1]、[f.2]、[f.3] キーでも同様にラベルの背景色が変更される｡ その様子を右図に示す｡

コードを見てみよう｡ グローバル変数として

  hAcc: HACCEL;

  ACC: array[0..5] of TAccel;

のように、アクセレレータテーブルのハンドルと TAccel 型レコードの６個の要素を持つ配列を宣言している｡ アクセレレータテーブルをつくる OnTest( ) ハンドラを見てみよう｡

procedure OnTest(hWindow: HWND);
begin
  ACC[0].fVirt := FCONTROL or FVIRTKEY;
  ACC[0].key   := Ord('R');
  ACC[0].cmd   := ID_RED;

  ACC[1].fVirt := FCONTROL or FVIRTKEY;
  ACC[1].key   := Ord('G');
  ACC[1].cmd   := ID_GREEN;

  ACC[2].fVirt := FCONTROL or FVIRTKEY;
  ACC[2].key   := Ord('B');
  ACC[2].cmd   := ID_BLUE;

  ACC[3].fVirt := FVIRTKEY;
  ACC[3].key   := VK_F1;
  ACC[3].cmd   := ID_RED;

  ACC[4].fVirt := FVIRTKEY;
  ACC[4].key   := VK_F2;
  ACC[4].cmd   := ID_GREEN;

  ACC[5].fVirt := FVIRTKEY;
  ACC[5].key   := VK_F3;
  ACC[5].cmd   := ID_BLUE;

  hAcc := CreateAcceleratorTable(ACC,6);
end;

ここでは、ACC の６個の要素を定義して、CreateAcceleratorTable( ) でテーブルを作成し、そのハンドルをグローバル変数 hAcc に格納している｡ この例のように、TAccel レコードの fVirt フィールドには、必ず FVIRTKEY フラグを指定し、Ord( ) を使って英数キーのキーコードを指定すると良い｡ そうすると、仮想キーコードと同じ値になる｡ MainDestroy( ) ハンドラでは、このテーブルを破棄している｡

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

メッセージループを見てみよう。

  while GetMessage(Msg, 0, 0, 0) do begin
    if (hAcc=0) or
         (not Boolean(TranslateAccelerator(MainWnd.Handle,hAcc,Msg))) then begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;

ここでは、上に述べた条件のほかにアクセレレータテーブルのハンドルが設置されていないときにも、通常処理をするようにしている｡ アクセレレータキーの入力によって発行された WM_COMMAMD メッセージの処理ハンドラ MainCommand( ) を見てみよう｡

procedure MainCommand(var Msg: TMessage);
begin
  if (Msg.LParam+Msg.WParamHi)=1 then
    case Msg.WParamLo of
      ID_RED:   L1.Color := clrRed;
      ID_GREEN: L1.Color := clrGreen;
      ID_BLUE:  L1.Color := clrBlue;
    end;
  Msg.Msg := MainWnd.Handle;
  InitMenuCommand(Msg,OnTest);
end;

最初の if 文で、このメッセージがアクセレレータキーによるものであることを確かめている｡

以上にように、アクセレレータを使うには、テーブルを作成して、そのハンドルをつかってメッセージループで実行する、という手続きがいる｡

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

２２−６ アクセレレータリソース

前節では、ＡＰＩ関数を使ってアクセレレータテーブルを作成したが、じつは、アイコンやメニューなどと同じように、アクセレレータテーブルはリソースにするのが正統的なウィンドウプログラミングの作法である｡ この節では､ 前節と同じ機能のアクセレレータテーブルをリソースとする方法を試してみよう｡

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

最初に、コマンドＩＤの定義をインクルードファイルにする｡ エディタで以下のようなテキストファイルを作る。

{       Name : AccelID.INC
   Description : Include file for Accelerator ID 
}
const
  ID_RED = 100;
  ID_GREEN = 101;
  ID_BLUE = 102;

これを、2206AccelResource フォルダに AccelID.inc という名前で保存する。つぎに、アクセレレータテーブルのリソース記述ファイルをエディタで作る。

/////////////////////////////////////////////////////
//        File: MyRes.RC
//     
// The resource for the AccelResource program
/////////////////////////////////////////////////////

#include "ACCELID.inc"

// Accelerator  
MyAccel ACCELERATORS
BEGIN
  "R",     ID_RED,   VIRTKEY, CONTROL
  "G",     ID_GREEN, VIRTKEY, CONTROL
  "B",     ID_BLUE,  VIRTKEY, CONTROL
  VK_F1,   ID_RED,   VIRTKEY
  VK_F2,   ID_GREEN, VIRTKEY
  VK_F3,   ID_BLUE,  VIRTKEY
END

これを、2206AccelResource フォルダに MyRes.rc という名前で保存する。リソースコンパイラでこれをコンパイルして、リソースファイル MyRes.res を作成する。MyAccel がこのテーブルのリソース名である。次の ACCELERATORS は、このリソースがアクセレレータテーブルであることを示している｡ 以下の BEGIN と END の間に、各キーの組み合わせを以下の書式で書く。

key, accelID, [keytype[,]] [NONINERT] [ALT] [CONTROL] [SHIFT]

key には、"R" のように英数キーを指定する。accelID には、コマンドＩＤを指定する。ここの例ではインクルードファイルの定数を指定している。keytype には、ASCII または、例のように VITRTKEY を指定する。あとの並びは、適宜指定する。

アクセレレータテーブルのリソースができたのでこれを使ってみよう｡ その前に、前節で示したように、アクセレレータを使うには､メッセージループを変更しなければならない｡ これを関数として、UtilFunc.pas に作成しておこう｡ MessageLoopNormal の宣言の下に、以下の宣言を追加する｡

function MessageLoopAccel(hWnd:HWND;var hAcc:HACCEL): integer;

対応する実装部に以下のコードを書く。

function MessageLoopAccel(hWnd:HWND;var hAcc:HACCEL): integer;
var
  Msg: TMsg;
begin
  while GetMessage(Msg, 0, 0, 0) do begin
    if (hAcc=0) or
         (not Boolean(TranslateAccelerator(hWnd,hAcc,Msg))) then begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  end;
  result := Msg.wParam;
end;

ここでは、hAcc を変数渡しのパラメータにしているので、途中でテーブルを変更しても正常に動作する｡

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

program AccelResource;

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

  {$R MyRes.res}

//------------------------------------------------------------
//             Global Types, Constants and Variables
//------------------------------------------------------------
  {$I AccelID.INC}

var
  MainWnd: TSDIMainWindow;

  L1: TAPILabel;

  hAcc: HACCEL;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------

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

  L1 := CreateLabel(hWindow,10,10,180,80,'');

  hAcc := LoadAccelerators(hInstance,'MyAccel');

  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
  if (Msg.LParam+Msg.WParamHi)=1 then
    case Msg.WParamLo of
      ID_RED:   L1.Color := clrRed;
      ID_GREEN: L1.Color := clrGreen;
      ID_BLUE:  L1.Color := clrBlue;
    end;
  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(MessageLoopAccel(MainWnd.Handle,hAcc));

end.

DownloadExe.gifAccelResource.zip(15.004kB)
AccelResource.gif

実行すると、右図のようになる。前節のプログラムと同じように､ [CTRL]+R や [CTRL]+G、[CTRL]+B、そして [f.1]、[f.2]、[f.3] キーでラベルの背景色が変更される。

MainCreate( ) ハンドラでリソースからアクセレレータテーブルを作成している｡

hAcc := LoadAccelerators(hInstance,'MyAccel');

リソースからテーブルを作ったときは、MainDestroy( ) で破棄する必要はない｡ WM_COMMAMND の処理ハンドラは前節と同じである｡ メッセージループは、ここで作った MessageLoopAccel( ) 関数を使っている｡

以上のように、本節では、リソースを使ってアクセレレータテーブルを作成する方法を示した｡

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

２２−７ アクセレレータクラス

アクセレレータテーブルの作成とハンドルを管理し、WM_COMMAND を自前で捕捉するクラスを TSubClass から派生して作ろう｡

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

最初に MenuClass.pas に TAccelTable クラスを作ろう｡ 宣言部を以下に示す｡

//--------------- TAccelTable ----------------------------------
TAccelTable = class(TSubClass)
private
  FAccelTable: array[0..30] of TAccel;
  FHandle: HACCEL;
  FCount: integer;
  FOnCommand: TNotifyMessage;
protected
public
  constructor Create(hParent:HWND);override;
  destructor Destroy; override;
  procedure DefaultHandler(var AMessage); override;
  function MakeTable:HACCEL;
  procedure AddTable(ctrlkey,key,cmd:Word);
  procedure Clear;
  property Handle: HACCEL read FHandle;
  property Count:integer read FCount;
  property OnCommand: TNotifyMessage read FOnCommand write FOnCommand;
end;

TAccelTable クラスは TSubClass から派生しており、キー定義を追加する AddTabel( ) メソッドとハンドルを管理する Handle プロパティー、キー定義のエントリ数を表す Count プロパティー、実際にテーブルを作成する MakeTable メソッド、テーブルを初期化する Clear メソッドを装備し、OnCommand イベントを持っている｡ private 部の FAccelTable は TAccel レコードの３１個の要素を持つ配列である。したがって、３１とおりのアクセレレータキーを定義できる｡ 実装部を以下に示す｡

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

  Dispatcher.TrapMessage(WM_COMMAND,self);
  FHandle := 0;
  FCount := 0;
end;

destructor TAccelTable.Destroy;
begin
  if FHandle<>0 then DestroyAcceleratorTable(FHandle);

  inherited Destroy;
end;

procedure TAccelTable.DefaultHandler(var AMessage);
var
  AMsg: TMessage;
begin
  AMsg := TMessage(AMessage);
  case AMsg.Msg of
    WM_COMMAND:
      if (AMsg.LParam+AMsg.WParamHi)=1 then begin
        AMsg.Msg := UINT(self);  // sender
        if Assigned(FOnCommand) then FOnCommand(AMsg);
      end;
  end;
end;

function TAccelTable.MakeTable:HACCEL;
begin
  FHandle := CreateAcceleratorTable(FAccelTable,FCount);
  result := FHandle;
end;

procedure TAccelTable.AddTable(ctrlkey,key,cmd:Word);
begin
  if FCount>30 then exit;
  FAccelTable[FCount].fVirt := ctrlkey or FVIRTKEY;
  FAccelTable[FCount].key := key;
  FAccelTable[FCount].cmd := cmd;
  inc(FCount);
end;

procedure TAccelTable.Clear;
begin
  FCount := 0;
  DestroyAcceleratorTable(FHandle);
  FHandle := 0;
end;

コンストラクタでは、Dispatcher に WM_COMMAND を送ってくれるよう依頼している｡ デストラクタではハンドルを使ってテーブルを破棄している｡ AddTable メソッドでは、TAccel レコードを定義して Count をインクリメントする。MakeTable メソッドでは、CreateAcceleratorTable( ) ＡＰＩを使って実際にテーブルを作成し、そのハンドルを返す｡ DefaultHandler( ) では、WM_COMMAND メッセージを捕捉して OnCommand イベントハンドラを呼び出している｡ このとき､ (AMsg.LParam+AMsg.WParamHi)=1 を確認しているので、アクセレレータからのメッセージだけがイベントを呼び出す｡ 最後に、このクラスのインスタンス作成関数を作る｡ 宣言部を以下に示す｡

function MakeAccelTable(hParent:HWND;sOnCommand:TNotifyMessage): TAccelTable;

実装部を以下に示す｡

function MakeAccelTable(hParent:HWND;sOnCommand:TNotifyMessage): TAccelTable;
begin
  result := TAccelTable.Create(hParent);
  result.FOnCommand := sOnCommand;
end;

ここで作った TAccelTable クラスをテストするプログラムを AccelClass01.dpr に書こう。全リストを以下に示す｡

program AccelClass01;

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

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

  hAcc:HACCEL;

  L1: TAPILabel;
  AT: TAccelTable;

const
  ID_RED = 100;
  ID_GREEN = 101;
  ID_BLUE = 102;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure ATCommand(var Msg: TMessage);
begin
  case Msg.WParamLo of
    ID_RED:   L1.Color := clrRed;
    ID_GREEN: L1.Color := clrGreen;
    ID_BLUE:  L1.Color := clrBlue;
  end;
end;
//------------------------------------------------------------
//             Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
  hWindow: HWND;
begin
  hWindow := MainWnd.Handle;
  MakeInitMenu(hWindow);

  L1 := CreateLabel(hWindow,10,10,180,80,'');

  AT := MakeAccelTable(hWindow,ATCommand);
  AT.AddTable(FCONTROL,Ord('R'),ID_RED);
  AT.AddTable(FCONTROL,Ord('G'),ID_GREEN);
  AT.AddTable(FCONTROL,Ord('B'),ID_BLUE);
  AT.AddTable(0,VK_F1,ID_RED);
  AT.AddTable(0,VK_F2,ID_GREEN);
  AT.AddTable(0,VK_F3,ID_BLUE);
  hAcc := AT.MakeTable;

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

procedure OnTest(hWindow: HWND);
begin
  AT.Clear;
  hAcc := 0;
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(MessageLoopAccel(MainWnd.Handle,hAcc));

end.

DownloadExe.gifAccelClass01.zip(15.292kB)
AccelClass01.gif

実行すると右図のように、前節までと同じように [CTRL]+R や [CTRL]+G、[CTRL]+B、そして [f.1]、[f.2]、[f.3] キーでラベルの背景色が変更される。Test! メニューを選ぶとアクセレレータテーブルのハンドルがクリアされ機能しなくなる｡

TAccelTable クラスのインスタンスは、MainCreate( ) ハンドラで作られ､ キー定義を６個追加してから、MakeTable メソッドを実行して、そのハンドルをグローバル変数 hAcc に格納している｡ 

  AT := MakeAccelTable(hWindow,ATCommand);
  AT.AddTable(FCONTROL,Ord('R'),ID_RED);
  AT.AddTable(FCONTROL,Ord('G'),ID_GREEN);
  AT.AddTable(FCONTROL,Ord('B'),ID_BLUE);
  AT.AddTable(0,VK_F1,ID_RED);
  AT.AddTable(0,VK_F2,ID_GREEN);
  AT.AddTable(0,VK_F3,ID_BLUE);
  hAcc := AT.MakeTable;

メッセージループを見てみよう｡

Halt(MessageLoopAccel(MainWnd.Handle,hAcc));

メインウィンドウのハンドルと hAcc を参照して、前節で作成した MessageLoopAccel を使っている。アクセレレータキーの入力による WM_COMMAND の処理は、TAccelTable クラスのイベントハンドラ ATCommand で行っている｡

以上のように、アクセレレータテーブルの作成とハンドルを管理しイベントを備えた TAccelTable クラスは、期待通りの動作をする事が分かった｡

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

２２−８ メニューとの連携

メニューは、ユーザが実行できる全てのコマンドを選択できるようにしておくのが望ましい｡ 前節までは､ アクセレレータキーの入力によってコマンドが実行できることを示した｡ アクセレレータの定義は本質的にメニューとは独立なので、意図的にメニューと無関係に実行できることを示したかったからである｡ アクセレレータキーによって実行できるコマンドは、メニュー項目の選択によっても実行できるようにすべきである｡ アクセレレータキー入力とメニュー項目の選択によって発行される WM_COMMAND は、WParamHi の値が、アクセレレータのときは１、メニューのときはゼロであることだけが相違している｡ したがって、それぞれ独立したイベントハンドラでこのメッセージを処理することができるが､ 同じ処理を別な二カ所のコードで処理するのは、無駄であるばかりではなく、コードのメンテナンスにとってもいいことではない｡ ふつうは、メニュー項目のＩＤと、それに対応するアクセレレータキーのＩＤを同じ定数を使って定義し、上記の WParamHi の値が２より小さいことを確認して、一つのイベントハンドラで処理することが多い｡ 本稿の実装方法では、WM_COMMAND を処理する TAMianMenu クラスと、前節で作った TAccelTable クラスでは､ それぞれ厳密に WParamHi の値を参照してイベントハンドラを呼び出しているので、この方法は使えない｡ ここでは、TAccelTable クラスが受け取ったメッセージを、WParamHi をゼロに加工して親ウィンドウに転送することにより、TAMainMenu のイベントハンドラが自動的に処理するようにしよう｡ こうすると、ただ端に、TAccelTable クラスに転送のためのメソッドを追加するだけでよいのある｡

実は､ アクセレレータキーの入力によって発行されるメッセージは、WM_COMMAND だけではないのである｡ もし、そのＩＤがウィンドウメニューのなかのメニュー項目のＩＤと一致したら、WM_SYSCOMMAND が TranslateAccelerator( ) から発行されるのだ｡ つまり、逆に言うと、WM_SYSCOMMAND メッセージが発行されるときは、対応するメニュー項目がウィンドウメニューの中に必ずあると言うことだ｡ WM_COMMAND の場合と違って、WM_SYSCOMMAND にはメニュー項目からかアクセレレータからか明示的に示す情報を持っていない｡ したがって、アクセレレータ入力からの WM_SYSCOMMAND メッセージは、ウィンドウメニューの処理ハンドラで自動的に処理されるはずである｡ したがって、前節の実装では TAccelTable クラスで OnSysCommand ハンドラを装備しなかったのである｡

それでは､ 上で述べたように、TAccelTable に WM_COMMAND メッセージの転送メソッドを装備し、アクセレレータとメニューとの連携を試してみよう｡

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

最初に MenuClass.pas にある TAccelTable クラスに WM_COMMAND メッセージを転送するメソッド EchoBack( ) を追加しよう。宣言部を以下に示す｡

//--------------- TAccelTable ----------------------------------
TAccelTable = class(TSubClass)
private
  FAccelTable: array[0..30] of TAccel;
  FHandle: HACCEL;
  FCount: integer;
  FOnCommand: TNotifyMessage;
protected
public
  constructor Create(hParent:HWND);override;
  destructor Destroy; override;
  procedure DefaultHandler(var AMessage); override;
  function MakeTable:HACCEL;
  procedure AddTable(ctrlkey,key,cmd:Word);
  procedure Clear;
  procedure EchoBack(Msg:TMessage);                         //  ここ！
  property Handle: HACCEL read FHandle;
  property Count:integer read FCount;
  property OnCommand: TNotifyMessage read FOnCommand write FOnCommand;
end;

実装部を以下に示す｡

procedure TAccelTable.EchoBack(Msg:TMessage);
begin
  SendMessage(Parent,WM_COMMAND,MakeLong(Msg.WParamLo,0),0);
end;

これを見ると分かるように、たんに WParamHi をゼロにして、親ウィンドウに転送しているだけだ｡ このメソッドを使って､ メニューとの連携を試してみよう｡ AccelClass02.dpr の全リストを以下に示す｡

program AccelClass02;

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

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

  hAcc:HACCEL;

  L1: TAPILabel;

  MM: TAMainMenu;
  PFile,PColor,PHelp: TAPopupMenu;
  WM: TWindowMenu;
  AT: TAccelTable;

const
  ID_RED = 100;
  ID_GREEN = 101;
  ID_BLUE = 102;

  ID_FILE = 1000;
  ID_COLOR = 1001;
  ID_HELP = 1002;

  ID_SEP1 = 1100;
  ID_WHITE = 1101;

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

//------------------------------------------------------------
//             Object Event Handlers
//------------------------------------------------------------
procedure MMCommand(var Msg: TMessage);
begin
  case Msg.WParamLo of
    ID_RED:   L1.Color := clrRed;
    ID_GREEN: L1.Color := clrGreen;
    ID_BLUE:  L1.Color := clrBlue;
  end;
end;

procedure ATCommand(var Msg: TMessage);
begin
  AT.EchoBack(Msg);
end;

procedure WMSysCommand(Var Msg: TMessage);
begin
  if Msg.WParam = ID_WHITE then L1.Color := clrWhite;
end;

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

  L1 := CreateLabel(hWindow,10,10,180,80,'');

  MM := MakeMainMenu(hWindow,MMCommand);

    PFile := MakePopupMenu(hWindow,ID_FILE,nil);
    PFile.AppendString('E&xit',IDM_EXIT);
    PFile.AttachMenu(MM,-1,'&File');

    MM.AppendString('&Test',IDM_TEST);

    PColor := MakePopupMenu(hWindow,ID_COLOR,nil);
    PColor.AppendString('&Red'+#9+'Ctrl + R , f.1',ID_RED);
    PColor.AppendString('&Green'+#9+'Ctrl + G , f.2',ID_GREEN);
    PColor.AppendString('&Blue'+#9+'Ctrl + B , f.3',ID_BLUE);
    PColor.AttachMenu(MM,-1,'&Color');

    PHelp := MakePopupMenu(hWindow,ID_HELP,nil);
    PHelp.AppendString('&About..',IDM_ABOUT);
    PHelp.AttachMenu(MM,-1,'&Help');

  MM.SetToParent;

  WM := makeWindowMenu(hWindow,WMSysCommand);
  WM.AppendSeparator(ID_SEP1);
  WM.AppendString('&White'+#9+'Ctrl + W , f.4',ID_WHITE);

  AT := MakeAccelTable(hWindow,ATCommand);
  AT.AddTable(FCONTROL,Ord('R'),ID_RED);
  AT.AddTable(FCONTROL,Ord('G'),ID_GREEN);
  AT.AddTable(FCONTROL,Ord('B'),ID_BLUE);
  AT.AddTable(FCONTROL,Ord('W'),ID_WHITE);
  AT.AddTable(0,VK_F1,ID_RED);
  AT.AddTable(0,VK_F2,ID_GREEN);
  AT.AddTable(0,VK_F3,ID_BLUE);
  AT.AddTable(0,VK_F4,ID_WHITE);
  hAcc := AT.MakeTable;

  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
  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(MessageLoopAccel(MainWnd.Handle,hAcc));

end.

DownloadExe.gifAccelClass02.zip(16.569kB)
AccelClass02.gif

実行して、'Color' ポップアップメニューを開くと右図のようになる｡ このように、メニュー項目の文字列と、対応するアクセレレータのキーの組み合わせが併記されているメニュー項目は、すでに多くのアプリケーションで見てきているだろう。メニュー項目を選択しても、標記されているアクセレレータキーを入力しても同じようにラベルの背景色が変更されるのが確かめられる｡ ウィンドウメニューの一番下のメニュー項目を選択するとラベルの背景が白くなる。同様に､ [Ctrl] + W のアクセレレータでも [f.4] でも白色に変更されるのを確認できるだろう｡

コードを見てみよう｡ MainCreate( ) では、TAMainMenu と TAPopupMenu クラスのインスタンスを使ってメニューを作成している。メニュー項目の選択による WM_COMMAND メッセージの処理は、MMCommand( ) ハンドラで行っている｡ その後、TWindowMenu クラスのインスタンス WM を作り、セパレータと '&White' 項目を追加している｡ この項目の選択による WM_SYSCOMMAND は WMSysCommand( ) ハンドラで処理している｡ この例のように、メニュー項目の文字列とアクセレレータのキー定義をメニュー項目に併記するときは、タブ（#9）で区切っておくのが作法である｡ 次に､ TAccelTable クラスのインスタンス AT を作って８個のキー定義を追加してからテーブルを作成している｡ AT で捕捉した WM_COMMAND は、ATCommand( ) で以下のように処理されている｡

procedure ATCommand(var Msg: TMessage);
begin
  AT.EchoBack(Msg);
end;

ここでは、EchoBack( ) メソッドを使って、メッセージを親ウィンドウに転送しているだけである｡ このようにすると、MMCommand( ) で自動的に処理される｡ これに対して、[Ctrl] + W や [f.4] からの WM_SYSCOMMAND に対しては、AT は何もしない｡ これは、予想通り WMSysCommand( ) ハンドラで処理されているのである。

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

２２−９ まとめ

前章と本章では、メニューについて調べた｡ 前章では､ リソースからメニューを作成する方法を調べた｡ そして、コードでメニューを作成する関数を作り、メニューの構造を調べてから､ トップレベルメニューに相当する TAMainMenu クラスと、それ以外のポップアップメニューに相当する TAPopupMenu クラスを作成してテストした｡ 本章では、ウィンドウ上で右クリックすると表示されるショートカットメニューの機能について調べ、それをカプセル化したクラスを作成した｡ さらに、ウィンドウメニューについて調べ、そのラッパークラスを作成した｡ 最後に、アクセレレータテーブルについて調べ、そのラッパークラスを作成してテストした｡

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

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

MenuClass.pas のコードは、UtilClass.pas に移動した｡

  1. Skeleton03.dpr (2 kB)
  2. UtilFunc.pas (19 kB)
  3. UtilClass.pas (74 kB)
  4. GDIObject.pas (21 kB)
  5. APIControl.pas (64 kB)
  6. APIWindow.pas (20 kB)


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