Lemur zaprasza
Programowanie od podstaw (2) "W powszednim odcinku: Józef powiedział Marii, że Franek go kocha, a on ją kocha, ale nie chce zrobić mu przykrości i dlatego musi się rozstać z Franczeską by nie zdenerwować ojca z powodu rozbitego Wartburga. Maria chce popełnić samobójstwo, a Wartburg ląduje w warsztacie..." - tak w skrócie można by opisać telenowele brazylijskie. A w powszedniej części artykuły pt. "Programowanie od podstaw" opisałem o co w ogóle chodzi i przedstawiłem podstawowe zagadnienia. Przejdziemy więc do praktyki... Na początek stworzymy proste okno. Tworzymy projekt i usuwamy z niego Form1, dalej wstawiamy moduł i jako procedurę startową (Project, Properties) ustawiamy sub main(). Dalej do moduły wklejamy poniższe deklaracje: ' w module ' do rejestracji klasy:Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLAsS) As Long ' do derejestracji klasyDeclare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long ' do stworzenia okna i\lub obiektów posiadających hWndDeclare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long ' do wywoływania domyślnej procedury zdarzeniowej oknaDeclare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long ' do wyjścia z procedury zdarzeniowejDeclare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long) ' do obsługi zdarzeńDeclare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As LongDeclare Function TranslateMessage Lib "user32" (lpMsg As Msg) As LongDeclare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long ' do pokazania oknaDeclare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long ' do pobrania kursoraDeclare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long ' do wywoływania domyślnej procedury zdarzeniowej okna MDI ChildDeclare Function DefMDIChildProc Lib "user32" Alias "DefMDIChildProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long ' pobiera informacje o oknie (o jego klasie)Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long ' ustawia informacje o oknie (o jego klasie)Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long ' wywołuje procedurę zdarzeniową okna i przekazuje jej pewne informacjeDeclare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long ' typ WNDCLAsS opisuje klasę oknaType WNDCLAsS style As Long ' styl lpfnwndproc As Long 'wskaźnik procedury zdarzeniowej cbClsextra As Long cbWndExtra2 As Long hInstance As Long 'instancję obsługującej aplikacji hIcon As Long ' ikonę hCursor As Long ' kursor hbrBackground As Long ' kolor tła lpszMenuName As String ' nazwę menu lpszClassName As String ' nazwę klasyEnd Type ' typ POINTAPI opisuje połażenie punktu na obiekcieType POINTAPI x As Long y As LongEnd Type ' typ Msg opisuje wiadomość przesłaną do procedury zdarzeniowej oknaType Msg hWnd As Long ' uchwyt message As Long ' wiadomość wParam As Long ' parametr W lParam As Long ' parametr L time As Long pt As POINTAPIEnd Type' style klasPublic Const CS_VREDRAW = &H1Public Const CS_HREDRAW = &H2Public Const CS_KEYCVTWINDoW = &H4Public Const CS_DBLCLKS = &H8Public Const CS_OWNDC = &H20Public Const CS_CLAsSDC = &H40Public Const CS_PARENTDC = &H80Public Const CS_NOKEYCVT = &H100Public Const CS_NOCLOSE = &H200Public Const CS_SAVEBITS = &H800Public Const CS_ByteALIGNCLIENT = &H1000Public Const CS_ByteALIGNWINDoW = &H2000Public Const CS_PublicCLAsS = &H4000' style okienPublic Const WS_OVERLAPPED = &H0&Public Const WS_POPUP = &H80000000Public Const WS_CHILD = &H40000000Public Const WS_MINIMIZE = &H20000000Public Const WS_VIsIBLE = &H10000000Public Const WS_DIsABLED = &H8000000Public Const WS_CLIPSIBLINGS = &H4000000Public Const WS_CLIPCHILDREN = &H2000000Public Const WS_MAXIMIZE = &H1000000Public Const WS_CAPTIOn = &HC00000 ' WS_BOrDER Or WS_DLGFRAMEPublic Const WS_BOrDER = &H800000Public Const WS_DLGFRAME = &H400000Public Const WS_VSCROLL = &H200000Public Const WS_HSCROLL = &H100000Public Const WS_SYSMENU = &H80000Public Const WS_THICKFRAME = &H40000Public Const WS_GROUP = &H20000Public Const WS_TABSToP = &H10000Public Const WS_MINIMIZEBOX = &H20000Public Const WS_MAXIMIZEBOX = &H10000Public Const WS_TILED = WS_OVERLAPPEDPublic Const WS_ICOnIC = WS_MINIMIZEPublic Const WS_SIZEBOX = WS_THICKFRAMEPublic Const WS_OVERLAPPEDWINDoW = (WS_OVERLAPPED Or WS_CAPTIOn Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)Public Const WS_TILEDWINDoW = WS_OVERLAPPEDWINDoWPublic Const WS_POPUPWINDoW = (WS_POPUP Or WS_BOrDER Or WS_SYSMENU)Public Const WS_CHILDWINDoW = (WS_CHILD)' rozszerzone style okienPublic Const WS_EX_DLGMODALFRAME = &H1&Public Const WS_EX_NOPARENTNotIfY = &H4&Public Const WS_EX_ToPMOST = &H8&Public Const WS_EX_ACCEPTFILES = &H10&Public Const WS_EX_TRANSPARENT = &H20&' stałe kolorów systemowychPublic Const COLOr_SCROLLBAR = 0Public Const COLOr_BACKGROUND = 1Public Const COLOr_ACTIVECAPTIOn = 2Public Const COLOr_INACTIVECAPTIOn = 3Public Const COLOr_MENU = 4Public Const COLOr_WINDoW = 5Public Const COLOr_WINDoWFRAME = 6Public Const COLOr_MENUTEXT = 7Public Const COLOr_WINDoWTEXT = 8Public Const COLOr_CAPTIOnTEXT = 9Public Const COLOr_ACTIVEBOrDER = 10Public Const COLOr_INACTIVEBOrDER = 11Public Const COLOr_APPWOrKSPACE = 12Public Const COLOr_HIGHLIGHT = 13Public Const COLOr_HIGHLIGHTTEXT = 14Public Const COLOr_BTNFACE = 15Public Const COLOr_BTNSHADoW = 16Public Const COLOr_GRAYTEXT = 17Public Const COLOr_BTNTEXT = 18Public Const COLOr_INACTIVECAPTIOnTEXT = 19Public Const COLOr_BTNHIGHLIGHT = 20' wiadomości dla okna (Window Message)Public Const WM_NULL = &H0Public Const WM_CREATE = &H1Public Const WM_DESTROY = &H2Public Const WM_MOVE = &H3Public Const WM_SIZE = &H5' komendy dla polecenia ShowWindowPublic Const SW_HIDE = 0Public Const SW_SHOWNOrMAL = 1Public Const SW_NOrMAL = 1Public Const SW_SHOWMINIMIZED = 2Public Const SW_SHOWMAXIMIZED = 3Public Const SW_MAXIMIZE = 3Public Const SW_SHOWNOACTIVATE = 4Public Const SW_SHOW = 5Public Const SW_MINIMIZE = 6Public Const SW_SHOWMINNOACTIVE = 7Public Const SW_SHOWNA = 8Public Const SW_RESTOrE = 9Public Const SW_SHOWDEFAULT = 10Public Const SW_MAX = 10' stałe kursorówPublic Const IDC_ARROW = 32512&Public Const IDC_IBEAM = 32513&Public Const IDC_WAIT = 32514&Public Const IDC_CROSS = 32515&Public Const IDC_UPARROW = 32516&Public Const IDC_SIZE = 32640&Public Const IDC_ICOn = 32641&Public Const IDC_SIZENWSE = 32642&Public Const IDC_SIZENESW = 32643&Public Const IDC_SIZEWE = 32644&Public Const IDC_SIZENS = 32645&Public Const IDC_SIZEALL = 32646&Public Const IDC_NO = 32648&Public Const IDC_APPSTARTING = 32650&Public Const GWL_WNDPROC = -4 Chciałbym przy okazji przeprosić wszystkich za błędy w kolorowaniu kodu (robi to mój mały programik, a nie jest on jeszcze dopracowany). Mamy już przygotowane wszystkie funkcje importowane z API, oraz typy i stałe wartości dla nich przeznaczone. Potrzebna nam będzie funkcja zwracająca adres danej procedury programu (pisałem już o tym w artykule o wątkach): Function GetMyWndProc(ByVal lWndProc As Long) As Long GetMyWndProc = lWndProcEnd Function Tą funkcją możemy uzyskać adres innej, np: wndcls.lpfnwndproc = GetMyWndProc(AddressOf MyWndProc) Dalej musimy stworzyć procedurę main, w której zainicjujemy klasę okna, stworzymy okno i przypiszemy mu procedurę zdarzeniową: Public Sub Main() Dim lngTemp As Long ' wywołujemy procedurę która zarejestruje klasę, jeżeli wszystko ok. to:.. If MyRegisterClass Then ' wywołujemy procedurę tworzącą okno, jeżeli wszystko ok. to:.. If MyCreateWindow Then ' wywołujemy procedurę pętli sprawdzania wiadomości MyMessageLoop End If ' procedura do derejestracji klasy MyUnregisterClass End IfEnd Sub Teraz piszemy funkcję rejestrującą klasę: Private Function MyRegisterClass() As Boolean ' inicjacja i rejestracja klasy Dim wndcls As WNDCLAsS wndcls.style = CS_HREDRAW + CS_VREDRAW ' styl wndcls.lpfnwndproc = GetMyWndProc(AddressOf MyWndProc) ' proc. zdarzeniowa wndcls.cbClsextra = 0 wndcls.cbWndExtra2 = 0 wndcls.hInstance = App.hInstance ' instancja wndcls.hIcon = 0 ' ikona wndcls.hCursor = LoadCursor(0, IDC_ARROW) ' kursor wndcls.hbrBackground = COLOr_WINDoW ' kolor tła (w tym wypadku systemowa stała tła) wndcls.lpszMenuName = 0 ' menu wndcls.lpszClassName = "myWindowClass" ' nazwa klasy ' rejestrujemy klasę i zwracamy wynik jako wynik MyRegisterClass (return) MyRegisterClass = (RegisterClass(wndcls) 0)End Function Po rejestracji klasy należy napisać funkcję tworzącą i pokazującą okno: Private Function MyCreateWindow() As Boolean Dim hWnd As Long ' tworzymy okno: hWnd = CreateWindowEx(0, "myWindowClass", "napisane okno", WS_OVERLAPPEDWINDoW, 0, 0, 400, 300, 0, 0, App.hInstance, ByVal 0&) ' jeżeli okno utworzone to hWnd 0 i możemy je pokazać: If hWnd 0 Then ShowWindow hWnd, SW_SHOWNOrMAL ' funkcja zwróci uchwyt nowego okna: MyCreateWindow = (hWnd 0)End Function A oto procedura zdarzeniowa, która zawiera komendy jakie mają być wykonane po odpowiednim zdarzeniu, np: po utworzeniu okna: Private Function MyWndProc(ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Select Case message 'reakcje na poszczególne zdarzenia Case WM_CREATE 'na utworzenie MsgBox "Okno zostało utworzone" Case WM_DESTROY 'na zamknięcie ' w wypadku zniszczenia okna (zamknięcia) jest wysyłana procedura PostQuit PostQuitMessage (0) Case WM_MOVE 'na przeniesienie MsgBox "Okno zostało przeniesione" ' ... End Select ' wywoływana jest następnie domyślna procedura okna MyWndProc = DefWindowProc(hWnd, message, wParam, lParam)End Function Należy pamiętać, że musimy derejestrować klasę okna: Private Sub MyUnregisterClass() UnregisterClass "myWindowClass", App.hInstance End Sub Jeszcze procedura do zapętlenia odbierania wiadomości o zdarzeniach (właściwie, to nie wiem jak to działa): Private Sub MyMessageLoop() Dim aMsg As Msg Do While GetMessage(aMsg, 0, 0, 0) DispatchMessage aMsg LoopEnd Sub Tak złożony kod programu powinien utworzyć okno. Uwaga! zamykaj program w czasie projektowania poprzez zamknięcie okna, bo poprzez naciśnięcie 'Stop' w VB, nastąpi błąd. Dodatkowo, by oknie nadać ikonę, należy zadeklarować poniższe funkcje w sekcji deklaracji modułu: Public Const LR_LoadFROMFILE = &H10Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As LongPublic Const IMAGE_BITMAP = 0Public Const IMAGE_ICOn = 1Public Const IMAGE_CURSOr = 2Public Const IMAGE_ENHMETAFILE = 3 Następnie, w MyRegisterClass w miejscu ustawiania ikony piszemy: wndcls.hIcon = LoadImage(0, "tutaj ścieżka i nazwa pliku ikony.ico", IMAGE_ICOn, 32, 32, LR_LoadFROMFILE) ' ikona Należy zwrócić uwagę, na użyte nazwy klasy - "myWindowClass", uchwytu deklarowanego w MyCreateWindow - hWnd, który możemy zadeklarować na zewnątrz (w deklaracjach) i posługiwać się nim do tworzenia innych kontrolek, tworzenia menu itp. W ten oto sposób powstało nam okno z ikoną, kursorem, reagujące na pewne zdarzenia. Taką aplikację możemy rozwijać, dodając rozmaite zdarzenia (szukając ich w API Viewer zaczynających się stałych na WM_), funkcje, menu itp. Powyższy program, poskładany i w całości dołączony jest do VBM: . Będę to opisywał w następnych częściach tego artykułu, a co opiszę: - jak tworzyć przycisk - jak tworzyć text box'a - jak tworzyć label'a - jak tworzyć menu - jak wstawiać kontrolki Common Controls itp. Artykuł zainspirowany . Marcin Porębski ( Doogie ) |