program arch; uses SysUtils, Windows, Messages, Dialogs; {$R *.res} type LOPARAM=LPARAM; //---------------------------------------------------------------------------- {Функция создания меню, чтоб не заморачиваться на повторных действиях} function CreateMenuItem( hMenu, SubMenu: HMENU; Cap: PChar; _uID, _wID: UINT; Sep: boolean ): boolean; var Mi: MENUITEMINFO; begin with Mi do begin cbSize := SizeOf( Mi ); fMask := MIIM_STATE or MIIM_TYPE or MIIM_SUBMENU or MIIM_ID; if not Sep then fType := MFT_STRING else fType := MFT_SEPARATOR; fState := MFS_ENABLED; wID := _wID; hSubMenu := SubMenu; dwItemData := 0; dwTypeData := Cap; cch := SizeOf( Cap ); end; Result := InsertMenuItem( hMenu, _uID, false, Mi ); end; //---------------------------------------------------------------------------- {оконная процедура} function WinProc (hWnd: THandle; nMsg: UINT; wParam, lParam: Cardinal): Cardinal; export; stdcall; const mFile = 100; mEdit = 200; sExit = 101; sFind = 201; sAdd = 202; sDelete = 203; sCheck = 204; var ListFrom,ListTo,ListSubj,ListText:THandle; Rect:TRECT; str: PChar; begin Result := 0; case nMsg of WM_COMMAND: begin case LOWORD( wParam ) of sExit: PostMessage(hWnd, WM_QUIT, 0, 0 ); sFind:UpdateWindow(hWnd); sDelete:UpdateWindow(hWnd); sAdd:UpdateWindow(hWnd); sCheck:UpdateWindow(hWnd); end; end; WM_CREATE: begin GetClientRect(hWnd,Rect); ListFrom:=CreateWindow('LISTBOX', nil, WS_CHILD or WS_VISIBLE or LBS_STANDARD, Rect.Left, 0, Rect.Right div 5, Rect.Bottom div 2, hWnd, 0, hInstance, nil); ListTo:=CreateWindow('LISTBOX', nil, WS_CHILD or WS_VISIBLE or LBS_STANDARD, Rect.Left + Rect.Right div 5, 0, Rect.Right div 5 , Rect.Bottom div 2, hWnd, 0, hInstance, nil); ListSubj:=CreateWindow('LISTBOX', nil, WS_CHILD or WS_VISIBLE or LBS_STANDARD, Rect.Left + Rect.Right div 5 * 2, 0, Rect.Right div 5*3, Rect.Bottom div 2, hWnd, 0, hInstance, nil); ListText:=CreateWindow('LISTBOX', nil, WS_CHILD or WS_VISIBLE or LBS_STANDARD, Rect.Left, Rect.Bottom div 2, Rect.Right, Rect.Bottom, hWnd, 0, hInstance, nil); str:='From'; SendMessage (ListFrom, LB_ADDSTRING ,0 ,LOPARAM(str)); str:='To'; SendMessage (ListTo, LB_ADDSTRING ,0 ,LOPARAM(str)); str:='Subject'; SendMessage (ListSubj, LB_ADDSTRING ,0 ,LOPARAM(str)); str:='Text'; SendMessage (ListText, LB_ADDSTRING ,0 ,LOPARAM(str)); UpdateWindow (hWnd); end; WM_SIZE: begin GetClientRect(hWnd,Rect); MoveWindow(ListText, Rect.Left, Rect.Bottom div 2, Rect.Right, Rect.Bottom, true); end; wm_Destroy: PostQuitMessage (0); else Result := DefWindowProc (hWnd, nMsg, wParam, lParam); end; end; //---------------------------------------------------------------------------- {основная процедура программы} procedure WinMain; const mFile = 100; mEdit = 200; sExit = 101; sFind = 201; sAdd = 202; sDelete = 203; sCheck = 204; var hWnd: THandle; Msg: TMsg; WndClassEx: TWndClassEx; MainMenu: HMENU; SubMenuFile: HMENU; SubMenuEdit: HMENU; str1:string[255]; Index:TextFile; begin MainMenu := CreateMenu; WndClassEx.cbSize := sizeOf (TWndClassEx); WndClassEx.lpszClassName := 'PlainWindow'; WndClassEx.style := cs_VRedraw or cs_HRedraw; WndClassEx.hInstance := HInstance; WndClassEx.lpfnWndProc := @WinProc; WndClassEx.cbClsExtra := 0; WndClassEx.cbWndExtra := 0; WndClassEx.hIcon := LoadIcon (hInstance, MakeIntResource ('MAINICON')); WndClassEx.hIconSm := LoadIcon (hInstance, MakeIntResource ('MAINICON')); WndClassEx.hCursor := LoadCursor (0, idc_Arrow);; WndClassEx.hbrBackground := GetStockObject (LTGRAY_BRUSH); WndClassEx.lpszMenuName := @MainMenu; // register the class if RegisterClassEx (WndClassEx) = 0 then MessageBox (0, 'Invalid class registration', 'Plain API', MB_OK) else begin SubMenuFile := CreatePopupMenu; SubMenuEdit := CreatePopupMenu; CreateMenuItem( MainMenu, subMenuFile, 'File', 0, mFile, false ); CreateMenuItem( MainMenu, subMenuEdit, 'Edit', 0, mEdit, false ); CreateMenuItem( subMenuFile, 0, 'Exit', 0, sExit, false ); CreateMenuItem( subMenuEdit, 0, 'Find ...', 0, sFind, false ); CreateMenuItem( subMenuEdit, 0, 'Add', 0, sAdd, false ); CreateMenuItem( subMenuEdit, 0, 'Delete', 0, sDelete, false ); CreateMenuItem( subMenuEdit, 0, 'Check', 0, sCheck, false ); hWnd := CreateWindowEx ( ws_Ex_OverlappedWindow, // extended styles WndClassEx.lpszClassName, // class name 'Plain API Demo', // title ws_OverlappedWindow, // styles cw_UseDefault, 0, // position cw_UseDefault, 0, // size 0, // parent window MainMenu, // menu HInstance, // instance handle nil); // initial parameters if hWnd = 0 then MessageBox (0, 'Window not created', 'Plain API', MB_OK) else begin //Создаем меню дальше ... ShowWindow (hWnd, sw_ShowNormal); UpdateWindow(hWnd); while GetMessage (Msg, 0, 0, 0) do begin TranslateMessage (Msg); DispatchMessage (Msg); end; end; end; end; begin WinMain; end.