本例效果图:



本例在窗体建立时, 动态添加了三个菜单; 并赋予它们自我删除的功能.

本例使用的资源文件(TestRes.rc):
MyMenu1 MENUEX
BEGIN
  POPUP "&File"
  BEGIN
    MENUITEM "E&xit"  ,101
  END
END

本例代码文件:
program Project1;

{$R 'TestRes.res' 'TestRes.rc'}

uses
  Windows, Messages;

const
  IDM_1 = 1; {定义三个标识菜单项的常量}
  IDM_2 = 2;
  IDM_3 = 3;

{收到 WM_CREATE 消息时添加三个菜单项}
procedure OnCreate(h: HWND);
var
  hm: HMENU;
begin
  hm := GetMenu(h);                            {获取窗口主菜单句柄}
  AppendMenu(hm, MFT_STRING, IDM_1, 'Menu&1'); {添加菜单项}
  AppendMenu(hm, MFT_STRING, IDM_2, 'Menu&2');
  AppendMenu(hm, MFT_STRING, IDM_3, 'Menu&3');
end;

{收到 WM_COMMAND 消息时需要做的工作}
procedure OnCommand(h: HWND; wParam: Integer);
var
  w: Word;
begin
  w := LoWord(wParam);
  case w of
    101: DestroyWindow(h);          {关闭窗口; 101 是在资源文件中给 Exit 菜单指定的标识}
    IDM_1, IDM_2, IDM_3: begin      {点击新建的三个菜单时...}
      DeleteMenu(GetMenu(h), w, 0); {删除该菜单}
      DrawMenuBar(h);               {重绘菜单}
    end;
  end;
end;

function WndProc(wnd: HWND; msg: UINT; wParam: Integer; lParam: Integer): Integer; stdcall;
begin
  Result := 0;
  case msg of
    WM_CREATE  : OnCreate(wnd);          {收到 WM_CREATE 消息后调用 OnCreate 过程}
    WM_COMMAND : OnCommand(wnd, wParam); {收到 WM_COMMAND 消息后调用 OnCommand 过程}
    WM_DESTROY : PostQuitMessage(0);
  else
    Result := DefWindowProc(wnd, msg, wParam, lParam);
  end;
end;

function RegMyWndClass: Boolean;
var
  cls: TWndClass;
begin
  cls.style         := CS_HREDRAW or CS_VREDRAW;
  cls.lpfnWndProc   := @WndProc;
  cls.cbClsExtra    := 0;
  cls.cbWndExtra    := 0;
  cls.hInstance     := HInstance;
  cls.hIcon         := 0;
  cls.hCursor       := LoadCursor(0, IDC_ARROW);
  cls.hbrBackground := HBRUSH(COLOR_WINDOW + 1);
  cls.lpszMenuName  := 'MyMenu1';
  cls.lpszClassName := 'MyWnd';
  Result := RegisterClass(cls) <> 0;
end;

{程序入口}
const
  tit = 'New Form';
  ws = WS_OVERLAPPEDWINDOW;
  x = 100; y = 100; w = 300; h = 180;
var
  hWnd: THandle;
  Msg : TMsg;
begin
  RegMyWndClass;
  hWnd := CreateWindow('MyWnd', tit, ws, x, y, w, h, 0, 0, HInstance, nil);
  ShowWindow(hWnd, SW_SHOWNORMAL);
  UpdateWindow(hWnd);

  while(GetMessage(Msg, 0, 0, 0)) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end.

posted on 2008-04-22 22:02  万一  阅读(6047)  评论(1编辑  收藏  举报