Новичок
Профиль
Группа: Участник
Сообщений: 12
Регистрация: 11.4.2010
Репутация: нет Всего: нет
|
| Код | program DrawingDagger;
uses Windows,Messages,CommDlg;
const WndClass='TWinApiWnd'; ChildWndClass='TChlWnd'; WndCaption='Главное меню формы на win api'; mFile=100; sOpen=101; sSave=102; sExit=103; mEdit=200; sCopy=201; sPaste=202; sCut=203; mCheck=300; sSelect=301; sNextMenu=302; sSecondLevel=311; sEparator=1;
Var //работа с формой и меню Wnd:HWND; Message:TMsg; WindowClass:TWndClass; MainMenu:HMENU; SubMenuFile:HMENU; SubMenuEdit:HMENU; SubMenuCheck:HMENU; SubMenuSecondLevel:HMENU; Check:boolean=false; Recta:TRect; //работа с дочерними окнами ChildWnd:HWND; ChildWndCl:TWndClass; //работа с изображением Bmp:HBITMAP; Image:HWND; //работа с файлами FileStructure:TOpenFilename; Path:String; FileSize:array [1..260] of Char;
function LoadPicture(Parent:HWND; Path:String):HBITMAP; begin Result:=LoadImage(HInstance, PChar(Path), IMAGE_BITMAP, 0,0, LR_LOADFROMFILE); SendMessage(Parent,STM_SETIMAGE,IMAGE_BITMAP,Result); end;
function CreateImage(Parent:HWND; Width,Height:Integer):HWND; begin Result:=CreateWindow('asfa', '', WS_CHILD or SS_BITMAP or WS_VISIBLE, 0,0, Width,Height, Parent, 0, HInstance, nil); If Result=0 then messagebox(Parent,'0','0',MB_OK) else messagebox(Parent,'asag','создано',MB_OK); end;
function CreateChldWnd(Parent:HWND; Caption:String):HWND; begin Result:=CreateWindow (ChildWndClass, PChar(Caption), WS_TILEDWINDOW or WS_CHILD, 0,0, 200,200, Parent, 0, HInstance, nil); ShowWindow(Result,CmdShow); UpdateWindow(Result); end;
//Инициализация структуры изображения procedure BmpInitialization(Width,Height:Integer); begin {bmType:=0; bmWidth:=Width; bmHeight:=Height; bmBitsPixel:=32; bmWidthBytes:=round((bmWidth*bmBitsPixel+15)/32); bmPlanes:=4;} //bmBits:=; end;
//Инициализация структуры tagPAINTSTRUCT procedure tagPAINTSTRUCTInitialization(PaintStruct:tagPAINTSTRUCT; Handle:HDC;Rect:TRect); begin With PaintStruct do begin hdc:=Handle; fErase:=true; rcPaint:=Rect; end; end;
//Инициализация струкруры файла procedure FileInitialization(AOwner:HWND); begin ZeroMemory(@FileStructure,SizeOf(FileStructure)); With FileStructure do begin lStructSize:=SizeOf(FileStructure); hWndOwner:=AOwner; hInstance:=hInstance; lpstrFilter:=PChar('Изображения (Bmp)'+#0+'*.Bmp'+#0); lpstrCustomFilter:=nil; nMaxCustFilter:=0; nFilterIndex:=1; lpstrFile:=@FileSize; nMaxFile:=SizeOf(FileSize); lpstrFileTitle:=nil; nMaxFileTitle:=0; lpstrInitialDir:=nil; lpstrTitle:=nil; Flags:=OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST or OFN_EXPLORER; nFileOffset:=0; nFileExtension:=0; lpstrDefExt:=nil; lCustData:=0; lpfnHook:=nil; lpTemplateName:=nil; pvReserved:=0; dwReserved:=0; FlagsEx:=0; end; end;
//Инициализация пунктов меню 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 WindowProc (Window:HWnd; Message, WParam:Word; LParam:LongInt): LongInt; stdcall; Var a:string; //работа с переменными для перерисовки окон PaintStruct:tagPAINTSTRUCT; Rect:TRect; WndHDC:HDC; RGN:HRGN; begin RGN:=CreateRectRgn(0,0,200,200); WindowProc:=0; //If Window=Wnd then case Message of WM_DESTROY: begin PostQuitMessage(0); Exit; end; WM_COMMAND: begin case LOWORD(WParam) of sOpen: begin GetOpenFileName(FileStructure); //Path:=FileStructure.lpstrFile; ChildWnd:=CreateChldWnd(Window,Path); {Image:=CreateImage(Wnd,100,100); Bmp:=LoadPicture(Image,Path);} end; sSave: begin Path:='E:\Документы Саши\Delphi\Delphi 7\DrawingDagger\Land.Bmp'; Image:=CreateImage(Wnd,100,100); Bmp:=LoadPicture(Image,Path); end; sExit: PostMessage(Window,WM_QUIT,0,0); sCopy: messagebox(Window,'Пункт: copy','Меню: edit',0); sCut: messagebox(Window,'Пункт: cut','Меню: edit',0); sPaste: messagebox(Window,'Пункт: paste','Меню: edit',0); sSelect: begin if Check then CheckMenuItem(SubMenuCheck,sSelect,MF_UNCHECKED) else CheckMenuItem(SubMenuCheck,sSelect,MF_CHECKED); Check:=not Check; end; sSecondLevel:MessageBeep(MB_ICONASTERISK); end; end; WM_PAINT: begin GetClientRect(Window,Rect); //tagPAINTSTRUCTInitialization(PaintStruct,Window,Rect); WndHDC:=BeginPaint(Window,PaintStruct); BitBlt(WndHDC,Rect.Top,Rect.Left,Rect.Right,Rect.Bottom,0,0,0,BLACKNESS); EndPaint(Window,PaintStruct); SendMessage(Window,WM_NCPAINT,1,0); end; end; WindowProc:=DefWindowProc(Window,Message,WParam,LParam); end;
begin // Создаем меню MainMenu:=CreateMenu; with WindowClass do begin Style:=cs_HRedraw or cs_VRedraw; lpfnWndProc:=@WindowProc; cbClsExtra:=0; cbWndExtra:=0; hInstance:=hInstance; hIcon:=LoadIcon(0,idi_Application); hCursor:=LoadCursor(0,idc_Arrow); hbrBackground:=Color_BtnFace+12; lpszMenuName:=@MainMenu; lpszClassName:=WndClass; end; With ChildWndCl do begin Style:=cs_HRedraw or cs_VRedraw or CS_PARENTDC; lpfnWndProc:=@WindowProc; cbClsExtra:=0; cbWndExtra:=0; hInstance:=hInstance; hIcon:=LoadIcon(0,idi_Application); hCursor:=LoadCursor(0,idc_Arrow); hbrBackground:=COLOR_GRAYTEXT; lpszMenuName:=nil; lpszClassName:=ChildWndClass; end; If RegisterClass(WindowClass)=0 then Halt(255); If RegisterClass(ChildWndCl)=0 then Halt(255); // Создаем подменю SubMenuFile:=CreatePopupMenu; SubMenuEdit:=CreatePopupMenu; SubMenuCheck:=CreatePopupMenu; SubMenuSecondLevel:=CreatePopupMenu; Wnd:=CreateWindow (WndClass, WndCaption, WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN, cw_UseDefault, cw_UseDefault, cw_UseDefault, cw_UseDefault, 0, MainMenu, HInstance, nil); //инициализирем структуру файлов и диалоги FileInitialization(Wnd); // Создаем пункты главного меню CreateMenuItem(MainMenu,SubMenuFile,'Файл',0,mFile,False ); CreateMenuItem(MainMenu,SubMenuedit,'Настройки',0,mFile,False ); CreateMenuItem(MainMenu,SubMenuCheck,'check',0,mFile,False ); // Подменю для пункта Файл CreateMenuItem(SubMenuFile,0,'Открыть',0,sOpen,False ); CreateMenuItem(SubMenuFile,0,'Сохранить',0,sSave,False ); CreateMenuItem(SubMenuFile,0,'',0,sEparator,True); CreateMenuItem(SubMenuFile,0,'Выход',0,sExit,False ); // Подменю для пункта настройки CreateMenuItem(SubMenuedit,0,'Копировать',0,sCopy,False); CreateMenuItem(SubMenuedit,0,'Вставить',0,sPaste,False); CreateMenuItem(SubMenuedit,0,'Вырезать',0,sCut,False); // Подменю для пункта check->nextmenu CreateMenuItem(SubMenuSecondLevel,0,'beep',0,sSecondLevel,False ); // Подменю для пункта check CreateMenuItem(SubMenuCheck,0,'select',0,sSelect,False); CreateMenuItem(SubMenuCheck,SubMenuSecondLevel,'nextmenu',0,sNextMenu,False); // Перерисовываем меню DrawMenuBar(Wnd); ShowWindow(Wnd,CmdShow); UpdateWindow(Wnd); while GetMessage (Message, 0, 0, 0) do begin TranslateMessage (Message); DispatchMessage (Message); end; Halt(Message.wParam); end.
|
Ну как же тогда с незарегиным классом как в примере, все работало?
|