procedure CopyMenuItem;
begin
{这个过程将通过 GetMenuItemInfo 获取菜单项设置并在 menuListB2 最后一个菜单项
复制一次。}
MenuInfo.cbSize := SizeOf(MenuInfo);
MenuInfo.dwTypeData := @CharBuffer[0];
{给 MenuInfo.dwTypeData 赋值一个内存区域}
MenuInfo.cch := 256;
{由于使用 GetMenuItemInfo 获取一个字符串，你需要设置 MenuInfo.cch 。}
MenuInfo.fMask := MIIM_STATE or MIIM_ID or MIIM_TYPE or MIIM_DATA or
MIIM_SUBMENU or MIIM_CHECKMARKS;
{留个标志全部使用，这样不管菜单项是字符串、分隔符、子菜单还是位图，这将得到所有的设置。}
GetMenuItemInfo(menuFile, CopyNum, False, MenuInfo);
{GetMenuItemInfo 将放置所有菜单项的设置到 MenuInfo 里面，包括类型与状态。}
SetMenuItemInfo(menuListB2, 6, True, MenuInfo);
{SetMenuItemInfo 将复制 menuFile 的所有菜单项的设置到 menuListB2 菜单的 MenuInfo 。}
if CopyNum < stresult =" $FFFFFFFF" stresult =" StResult" fstate =" MenuInfo.fState" wparam =" 901" wparam =" 902" lparam =" 0"> 2 then
begin
if CFolder[Length(CFolder)] <> '\' then
CFolder := CFolder + '\';
if DirectoryExists(CFolder) then
begin
GetShortPathName(@Cfolder[1], Buffer, 82);
Cfolder := Buffer + '*.*';
SendMessage(hListBox1, LB_RESETCONTENT, 0, 0);
SendMessage(hListBox1, LB_DIR, DDL_READONLY or DDL_DIRECTORY,
Integer(PChar(CFolder)))
end
else
MessageBox(hForm1, '文件夹不存在', '无文件夹',
MB_OK or MB_ICONERROR);
end;
end;
mID_m2AddSel: SelToLB3(True);
mID_m2Clear: SendMessage(hListBox1, LB_RESETCONTENT, 0, 0);
mID_m2ChangeItem:
begin
{这里使用 SetMenuItemInfo 函数立即改变几个菜单项属性}
MenuInfo.cbSize := SizeOf(MenuInfo);
MenuInfo.fMask := MIIM_STATE;
GetMenuItemInfo(menuListB1, 205, False, MenuInfo);
if MenuInfo.fState = MenuInfo.fState or MFS_CHECKED then
begin
MenuInfo.fMask := MIIM_STATE or MIIM_TYPE;
MenuInfo.fType := MFT_STRING;
MenuInfo.fState := MFS_UNCHECKED;
MenuInfo.dwTypeData := '旧的 菜单项';
end
else
begin
MenuInfo.fMask := MIIM_STATE or MIIM_TYPE;
MenuInfo.fType := MFT_STRING;
MenuInfo.fState := MFS_CHECKED or MFS_GRAYED;
MenuInfo.dwTypeData := '新的 菜单项';
end;
SetMenuItemInfo(menuListB1, 205, False, MenuInfo);
{这里 SetMenuItemInfo 改变菜单项的三个属性：勾选、文本与变灰。}
Returned := GetMenuDefaultItem(menuListB1, 0, 0);
{如果没有默认菜单项则返回 4294967295 = $FFFFFFFF}
SetWindowText(hEdit1, PChar(Int2Str(Returned)));
end;
mID_m2Item: DoMessage;
{上面的所有菜单项 ID 使用常量名代替了。下面会直接使用菜单项的 ID 编号，
这样知道 ID 代表哪个菜单和哪个菜单项比较困难，这里使用百位数（301，401，
501）来表示不同的子菜单，但是你需要参照菜单创建部分了解数字（如 302）
表示哪个菜单项。使用菜单项 ID 的常量是比较好的做法，采用命名约定如
mID_m1New、mID_m2NewFolder，m1 和 m2 分辨表示子菜单1 和子菜单2 。}
301:
begin
CFolder := GetWindowStr(hEdit1);
if Length(CFolder) > 2 then
begin
if CFolder[Length(CFolder)] <> '\' then
CFolder := CFolder + '\';
if DirectoryExists(CFolder) then
GetFiles(Cfolder)
else
MessageBox(hForm1, '文件夹不存在', '无文件夹',
MB_OK or MB_ICONERROR);
end;
end;
302: SelToLB3(False);
303: SendMessage(hListBox2, LB_RESETCONTENT, 0, 0);
304: CopyMenuItem;
401..402: SortListBox;
403: SendMessage(hListBox3, LB_RESETCONTENT, 0, 0);
404: if MenuCheck(3, 4) = 0 then
SetWindowText(hEdit1, 'It was Checked');
405:
begin
RemoveMenu(MenuMain, 3, MF_BYPOSITION);
{RemoveMenu 将移除菜单项但是不销毁子菜单}
EnableMenuItem(menuFile, mID_m1Show, MF_BYCOMMAND or MF_ENABLED);
{"文件"菜单的"显示菜单"菜单项将可用}
DrawMenuBar(hForm1);
{DrawMenuBar 将重绘主菜单来显示变化}
end;
501: DoMessage;
502: MoveWindow(hWnd, 1, 1, Rect1.Right - Rect1.Left, Rect1.Bottom -
Rect1.Top, True);
503: MessageBox(hForm1, About, '关于', MB_OK or
MB_ICONINFORMATION);
504: PostMessage(hForm1, WM_CLOSE, 0, 0);
701..765:
begin
{ID 编号 701 到 765 是在 menuSubFolder1 中为 C 盘文件夹准备}
GetMenuStr(True);
Cfolder := 'C:\' + MenuInfo.dwTypeData;
GetShortPathName(@Cfolder[1], Buffer, 82);
Cfolder := Buffer + '\*.*';
if MessageBox(hForm1,
PChar('你希望显示'+ MenuInfo.dwTypeData + ' 内的文件和文件夹? ?'),
MenuInfo.dwTypeData, MB_YESNO or MB_ICONQUESTION) = IDYES then
begin
SendMessage(hListBox1, LB_RESETCONTENT, 0, 0);
SendMessage(hListBox1, LB_DIR, DDL_READONLY or DDL_DIRECTORY,
Integer(@Cfolder[1]));
end;
end;
801..865:
begin
{ID 编号 801 到 865 是在 menuSubFolder2 中为 C 盘文件夹准备}
GetMenuStr(False);
Cfolder := 'C:\' + MenuInfo.dwTypeData + '\';
DlgChk := True;
GetFiles(Cfolder);
end;
end; // case LOWORD(wParam)
end;
WM_INITMENUPOPUP: if wParam = menuSubFolder2 then
begin
{在子菜单显示前会发送 WM_INITMENUPOPUP 消息，你可以修改这个子菜单使之
在显示前符合要求。}
SetSubMenu(wParam);
end
else if wParam = hSysMenu then
SetWindowText(hEdit1, PChar('系统菜单 lParam 为 ' + Int2Str(lParam)));
WM_CTLCOLORLISTBOX: if lParam = hListBox3 then
begin
{WM_CTLCOLORLISTBOX 获取列表框使用的颜色}
SetTextColor(wParam, $0000FF);
SetBkColor(wParam, $FFFF00);
Result := GetStockObject(LTGRAY_BRUSH);
Exit;
end;
WM_DESTROY: ShutDown;
end; // case Msg
Result := DefWindowProc(hWnd, Msg, wParam, lParam);
end;
begin // * * * * * * * 主程序开始
CopyNum := mID_m1New;
wClass.hInstance := hInstance;
with wClass do
begin
Style := 0;
hIcon := LoadIcon(hInstance, 'MAINICON');
lpfnWndProc := @MessageFunc;
hbrBackground := COLOR_BTNFACE + 1;
lpszClassName := 'Text Class';
hCursor := LoadCursor(0, IDC_ARROW);
cbClsExtra := 0;
cbWndExtra := 0;
lpszMenuName := nil;
end;
RegisterClass(wClass);
{这里将在创建主菜单之前创建菜单栏的子菜单，因为它们必须被加入主菜单。第一个子
菜单为"文件"菜单，但是本程序不涉及任何文件操作，因此这个子菜单仅仅用于演示。}
menuFile := CreateMenu;
{CreateMenu 函数将创建一个空菜单，在使用前必须加入菜单项。这里使用了三个函数
添加菜单项：AppendMenu、 InsertMenu 和 InsertMenuItem 。}
{这个 menuFile 菜单将使用 AppendMenu 添加菜单项，它有四个参数。第三个参数
uIDNewItem 是 ID 编号，它将在菜单单击时通过 WM_COMMAND 消息的 LOWORD(wParam)
发送。AppendMenu 按照调用次序顺次添加菜单项，类似于 Delphi 的"Add" 过程。}
AppendMenu(menuFile, MF_STRING, mID_m1New, '&N新建');
AppendMenu(menuFile, MF_STRING or MF_GRAYED, mID_m1Open, '&O打开');
AppendMenu(menuFile, MF_STRING or MF_CHECKED, mID_m1Save, '&S保存');
{MF_CHECKED 将会勾选菜单项}
AppendMenu(menuFile, MF_STRING, mID_m1SaveAs, '另存为(&A)');
AppendMenu(menuFile, MF_STRING or MF_GRAYED, mID_m1Show, '显示菜单');
AppendMenu(menuFile, MF_SEPARATOR, 1, nil);
{MF_SEPARATOR 将在菜单中添加分隔线，后两个参数不使用}
AppendMenu(menuFile, MF_STRING, mID_m1Exit, 'E&退出');
{MF_STRING 参数将会添加文本菜单项，MF_BITMAP 参数将会添加位图，MF_OWNERDRAW
将会指定一个自定义绘制的菜单项。}
EnableMenuItem(menuFile, mID_m1New, MF_GRAYED);
{这里使用 EnableMenuItem 使"新建"菜单项变灰并禁用它，"打开"菜单也会变灰，因为
它使用了 MF_GRAYED 参数。}
SetMenuDefaultItem(menuFile, mID_m1Exit, 0);
{SetMenuDefaultItem 将会使默认菜单项变粗显示，在双击菜单时会执行此默认菜单项。}
menuSubFolder1 := CreateMenu();
{menuSubFolder1 是在后面创建的 menuListB1 的子菜单。这个 menuSubFolder1 将会
在程序运行时列出 C:\ 盘的所有文件夹。}
SetSubMenu(menuSubFolder1);
{SetSubMenu 只在创建永不更新的 menuSubFolder1 过程中使用，menuSubFolder2 则是
每次子菜单显示的时候都更新。}
menuListB1 := CreateMenu;
{menuListB1 将使用 AppendMenu 添加菜单项。另一个菜单项将在最后使用 InsertMenu
不按照前面的次序添加。}
AppendMenu(menuListB1, MF_STRING, mID_m2NewFolder, '&N编辑框指定的新文件夹');
AppendMenu(menuListB1, MF_STRING, mID_m2AddSel, '加入所选项列表框3 ');
AppendMenu(menuListB1, MF_STRING, mID_m2Clear, '清空');
AppendMenu(menuListB1, MF_SEPARATOR, 1, nil);
AppendMenu(menuListB1, MF_STRING, mID_m2ChangeItem, '改变 菜单项');
AppendMenu(menuListB1, MF_STRING, mID_m2Item, '菜单项');
{下面的 InsertMenu( ) 将在菜单的第二个位置放置一个子菜单项。uPosition 为 1，
如果 Count 大于 0，你不能为空的菜单项添加子菜单。}
if Count > 0 then
InsertMenu(menuListB1, 1, MF_BYPOSITION or MF_POPUP or MF_STRING,
menuSubFolder1, 'C 盘文件夹');
{使用 MF_POPUP 标志在 menuListB1 添加一个子菜单，句柄在第四个参数。}
menuSubFolder2 := CreateMenu();
{这里创建的 menuSubFolder2 只有一个菜单项，菜单项将会在菜单显示使用目录填充，
参见上面的 WM_INITMENUPOPUP 消息部分。}
AppendMenu(menuSubFolder2, MF_STRING, 799, ' ');
{子菜单必须有一个菜单项，才能成功加入到另一个菜单的菜单项。}
menuListB2 := CreateMenu;
{利用 TMenuItemInfo 记录，使用功能强大的 InsertMenuItem() 函数，菜单项将被
加入到这个 menuListB2 菜单。}
MenuInfo.cbSize := SizeOf(MenuInfo);
{在使用 TMenuItemInfo 前注意设置 cbSize }
MenuInfo.fMask := MIIM_ID or MIIM_TYPE;
{第一个菜单项是标准的字符串菜单项，ID 编号为 301 ，因此你需要设置
MIIM_ID or MIIM_标志。}
MenuInfo.fType := MFT_STRING;
{设置 MFT_STRING 标志为菜单项放入字符串}
MenuInfo.dwTypeData := '&N编辑框指定的新文件夹';
//MenuInfo.cch := 21;
{如果 fType 标志设置为 MFT_STRING ，那么 dwTypeData 将被读取为 PChar 字符串，
你不必设置 MenuInfo.cch 为字符串长度，因为它不会从 MenuInfo.cch 读取数据。cch
将在写入字符并且不会读入 dwTypeData 时使用。}
MenuInfo.wID := 301;
{如果设置 MIIM_ID 标志，那么 wID 会被作为 ID 编号使用。注意这里是 wID，暗示这
是 WORD 类型，最大值为 65534。}
//MenuInfo.fState := 0;
//MenuInfo.hSubMenu := 0;
//MenuInfo.hbmpChecked := 0;
//MenuInfo.hbmpUnchecked := 0;
{不需要设置 MenuInfo 的其他域成员因为它们会被忽略}
InsertMenuItem(menuListB2, 0, False, MenuInfo);
{如果第三个参数设置为 False 那么第二个参数被作为 ID 使用，但是如果设置第二个
参数为 0，它就像 AppendMenu( ) 函数一样使用，将会把菜单项加入到最后位置。}
MenuInfo.fMask := MIIM_SUBMENU or MIIM_TYPE;
MenuInfo.fType := MFT_STRING;
MenuInfo.dwTypeData := 'C 盘文件夹';
MenuInfo.hSubMenu := menuSubFolder2;
InsertMenuItem(menuListB2, 1, False, MenuInfo);
MenuInfo.fMask := MIIM_ID or MIIM_TYPE;
MenuInfo.fType := MFT_STRING;
MenuInfo.dwTypeData := '加入所选项列表框3 ';
MenuInfo.wID := 302;
InsertMenuItem(menuListB2, 2, False, MenuInfo);
{如果第三个参数设置为 True 那么第二个参数被作为菜单项位置使用，
类似于 InsertMenu( ) 函数。}
MenuInfo.fMask := MIIM_ID or MIIM_TYPE;
MenuInfo.fType := MFT_STRING;
MenuInfo.dwTypeData := '清空';
MenuInfo.wID := 303;
InsertMenuItem(menuListB2, 3, False, MenuInfo);
MenuInfo.fMask := MIIM_TYPE;
MenuInfo.fType := MFT_SEPARATOR;
{使用 MFT_SEPARATOR 则不需要其他成员}
InsertMenuItem(menuListB2, 4, True, MenuInfo);
MenuInfo.fMask := MIIM_ID or MIIM_TYPE;
MenuInfo.fType := MFT_STRING;
MenuInfo.dwTypeData := '复制 菜单项';
MenuInfo.wID := 304;
InsertMenuItem(menuListB2, 5, True, MenuInfo);
MenuInfo.fMask := MIIM_ID or MIIM_TYPE;
MenuInfo.fType := MFT_STRING;
MenuInfo.dwTypeData := '尚未复制';
MenuInfo.wID := 305;
InsertMenuItem(menuListB2, 6, True, MenuInfo);
TempDC := GetDC(0);
BmpDC := CreateCompatibleDC(TempDC);
{准备在 menuListB3 菜单使用位图菜单项，这里创建位图并在上面标注"清空"。}
Bitmap1 := CreateCompatibleBitmap(TempDC, 39, 18);
SelectObject(BmpDC, Bitmap1);
SetRect(Rect1, 0, 0, 39, 18);
FillRect(BmpDC, Rect1, GetStockObject(BLACK_BRUSH));
SelectObject(BmpDC, GetStockObject(WHITE_BRUSH));
SetBkColor(BmpDC, $FFFFFF);
Ellipse(BmpDC, 0, 0, 39, 18);
SelectObject(BmpDC, GetStockObject(ANSI_VAR_FONT));
SetTextColor(BmpDC, $000000FF);
TextOut(BmpDC, 7, 2, '清空', 5);
DeleteDC(BmpDC);
ReleaseDC(0, TempDC);
menuListB3 := CreateMenu;
AppendMenu(menuListB3, MF_STRING, 401, '&S排序');
AppendMenu(menuListB3, MF_STRING, 402, '允许拖放');
AppendMenu(menuListB3, MF_BITMAP, 403, PChar(Bitmap1));
{使用 MF_BITMAP 需要把 Bitmap 句柄强制转化为 PChar}
AppendMenu(menuListB3, MF_SEPARATOR, 1, nil);
AppendMenu(menuListB3, MF_STRING, 404, '勾选');
AppendMenu(menuListB3, MF_STRING, 405, '隐藏此菜单');
CheckMenuRadioItem(menuListB3, 0, 1, 1, MF_BYPOSITION);
{CheckMenuRadioItem 将会设置一组菜单项为单选按钮风格，这组菜单项只有一个能被
用圆点形式选中。这里放置菜单项第 0 和 1 位置到分组中。}
CanDrag := True;
menuMain := CreateMenu;
{这里创建了主菜单}
{TMenuItemInfo 记录包含所有需要创建的菜单项的信息，这里还有比 AppendMenu 更
丰富的可用选项。}
MenuInfo.fMask := MIIM_SUBMENU or MIIM_TYPE;
{fMask 域你需要设置标志告知系统产生什么样的菜单属性}
MenuInfo.fType := MFT_STRING;
MenuInfo.dwTypeData := '&F文件';
MenuInfo.hSubMenu := menuFile;
InsertMenuItem(menuMain, 0, True, MenuInfo);
MenuInfo.dwTypeData := '列表框&1';
MenuInfo.hSubMenu := menuListB1;
InsertMenuItem(menuMain, 1, True, MenuInfo);
MenuInfo.dwTypeData := '列表框&2';
MenuInfo.hSubMenu := menuListB2;
InsertMenuItem(menuMain, 2, True, MenuInfo);
MenuInfo.dwTypeData := '列表框&3';
MenuInfo.hSubMenu := menuListB3;
InsertMenuItem(menuMain, 3, True, MenuInfo);
SetRect(Rect1, 0, 0, 536, 321);
if not AdjustWindowRect(Rect1, WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU,False) then
SetRect(Rect1, 0, 0, 542, 347);
hForm1 := CreateWindow(wClass.lpszClassName, '菜单与列表框',
WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU,
(GetSystemMetrics(SM_CXSCREEN) div 2) - 276,
(GetSystemMetrics(SM_CYSCREEN)div 2) - 212,
Rect1.Right - Rect1.Left, Rect1.Bottom - Rect1.Top, 0,
menuMain, // handle to main menu
hInstance, nil);
{SendMessage(CreateWindow('Static', '菜单与列表框',
WS_VISIBLE or WS_CHILD, 6, 3, 300, 20, hForm1, 0, hInstance, nil),
WM_SETFONT,GetStockObject(ANSI_VAR_FONT),0);}
{通过 WS_EX_CLIENTEDGE 风格 CreateWindowEx( ) 可以获取这些列表框的 3D 风格外观，
使用 LBS_HASSTRINGS or LBS_NOTIFY 标志在列表框使用字符串并通知父窗体消息。}
hListBox1 := CreateWindowEx(WS_EX_CLIENTEDGE, 'LISTBOX', 'C:\',
WS_VISIBLE or WS_CHILD or LBS_HASSTRINGS or LBS_NOTIFY or WS_VSCROLL,
8, 30, 150, 220, hForm1, 101, hInstance, nil);
SendMessage(hListBox1, WM_SETFONT, GetStockObject(ANSI_VAR_FONT), 0);
SendMessage(hListBox1, LB_DIR, DDL_READONLY or DDL_DIRECTORY,
Integer(PChar('C:\*.*')));
{这里使用发送 LB_DIR 消息的老办法在列表框1 中列出文件夹项，它以短文件名形式
显示，LB_DIR 主要针对过时的 Windows 3.x ，对于显示 32 位的长文件名的程序则
没有太大用处。}
PListbox1Proc := Pointer(SetWindowLong(hListBox1, GWL_WNDPROC,
Integer(@Listbox1Proc)));
{列表框1 和列表框3 被子类化，所以可以通过处理它们的消息进行很多操作。}
hListBox2 := CreateWindowEx(WS_EX_CLIENTEDGE, 'LISTBOX', nil,
WS_VISIBLE or WS_CHILD or LBS_HASSTRINGS or LBS_NOTIFY or WS_VSCROLL,
168, 30, 160, 220, hForm1, 0, hInstance, nil);
SendMessage(hListBox2, WM_SETFONT, GetStockObject(ANSI_VAR_FONT), 0);
hListBox3 := CreateWindowEx(WS_EX_CLIENTEDGE, 'LISTBOX',
'ListBox 3 selected is ',
WS_VISIBLE or WS_CHILD or LBS_HASSTRINGS or LBS_NOTIFY or WS_VSCROLL,
338, 30, 188, 220, hForm1, 0, hInstance, nil);
SendMessage(hListBox3, WM_SETFONT, GetStockObject(ANSI_FIXED_FONT), 0);
SendMessage(hListBox3, LB_INSERTSTRING, 0, Integer(PChar('列表框 3')));
{使用 LB_INSERTSTRING 添加文本到一个列表框，你需要强制转化 LParam 为 PChar，
再转化为 Integer 类型。}
PListbox3Proc := Pointer(SetWindowLong(hListBox3, GWL_WNDPROC,
Integer(@Listbox1Proc)));
{列表框1 和列表框3的子类化函数都设置为 Listbox1Proc ，这样一个列表框函数就
可以处理这两个列表框的消息。}
hEdit1 := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', 'Wacky',
WS_VISIBLE or WS_CHILD or ES_LEFT or ES_AUTOHSCROLL,
16, 272, 400, 21, hForm1, 0, hInstance, nil);
SendMessage(hEdit1, WM_SETFONT, GetStockObject(ANSI_VAR_FONT), 0);
if PListbox1Proc = PListbox3Proc then
SetWindowText(hEdit1, 'C:\WINDOWS');
{如果你测试 - if PListbox1Proc = PListbox3Proc - 它是相等的，因为系统只有
一个列表框消息处理过程，它区分不同的列表框的不同设置是通过发送给系统的消息
处理过程的列表框句柄来实现的。}
DlgChk := True;
GetFiles('C:\');
{和列表框1 不一样，在列表框2 中我们使用 GetFiles 中的 FindFirstFile，这样可以
获取长文件名和文件列表，这样你可以更好控制列出的文件。}
ShowWindow(hForm1, SW_SHOWDEFAULT);
{GetSystemMenu( ) 将会获取系统菜单句柄，你可以利用菜单相关 API 函数处理系统菜单。}
hSysMenu := GetSystemMenu(hForm1, False);
InsertMenu(hSysMenu, 0, MF_BYPOSITION or MF_STRING, 901, 'Added Item');
InsertMenu(hSysMenu, 4, MF_BYPOSITION or MF_STRING, 902, 'MOVE WINDOW');
{两个菜单项被加入系统菜单}
while GetMessage(MainMsg, 0, 0, 0) do
begin
TranslateMessage(MainMsg);
DispatchMessage(MainMsg);
end;
DlgEditText := '';
{由于 menuListB3 可以被移除，所以记得销毁它。一旦某个子菜单被移除，它就没有
Owner 来自动销毁。}
DestroyMenu(menuListB3);
end.
来源：http://blog.tom.com/jdzmc_wanqing/article/1632.html
标签： Delphi, Menu, Windows
