Цитата(iff @ 1.11.2007, 21:42  ) | | Как создать неразворачивающееся во весь экран окно...? |
| Код |
'CreateWindow.bas
Option Explicit
Private Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Private Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
Private Declare 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
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Private Type WNDCLASS
style As Long
lpfnwndproc As Long
cbClsextra As Long
cbWndExtra2 As Long
hInstance As Long
hIcon As Long
hCursor As Long
hbrBackground As Long
lpszMenuName As String
lpszClassName As String
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type Msg
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Const CS_VREDRAW = &H1
Private Const CS_HREDRAW = &H2
Private Const WS_VISIBLE = &H10000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_CAPTION = &HC00000
Private Const WS_SYSMENU = &H80000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_OVERLAPPEDWINDOW = (WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_CLIPCHILDREN Or WS_CAPTION Or _
WS_SYSMENU Or WS_MINIMIZEBOX)
Private Const COLOR_WINDOW = 5
Private Const WM_DESTROY = &H2
Private Const SW_SHOWNORMAL = 1
Private Const IDC_ARROW = 32512&
Public Sub Main()
Dim lngTemp As Long
If MyRegisterClass Then
If MyCreateWindow Then
MyMessageLoop
End If
MyUnregisterClass
End If
End Sub
Private Function MyCreateWindow() As Boolean
Dim hWnd As Long
hWnd = CreateWindowEx(0, "myWindowClass", "myWindowCaption", WS_OVERLAPPEDWINDOW, 0, 0, 400, 300, 0, 0, App.hInstance, ByVal 0&)
If hWnd <> 0 Then ShowWindow hWnd, SW_SHOWNORMAL
MyCreateWindow = (hWnd <> 0)
End Function
Private Function MyRegisterClass() As Boolean
Dim wndcls As WNDCLASS
wndcls.style = CS_HREDRAW + CS_VREDRAW
wndcls.lpfnwndproc = GetMyWndProc(AddressOf MyWndProc)
wndcls.cbClsextra = 0
wndcls.cbWndExtra2 = 0
wndcls.hInstance = App.hInstance
wndcls.hIcon = 0
wndcls.hCursor = LoadCursor(0, IDC_ARROW)
wndcls.hbrBackground = COLOR_WINDOW
wndcls.lpszMenuName = 0
wndcls.lpszClassName = "myWindowClass"
MyRegisterClass = (RegisterClass(wndcls) <> 0)
End Function
Private Sub MyUnregisterClass()
UnregisterClass "myWindowClass", App.hInstance
End Sub
Private Function MyWndProc(ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case message
Case WM_DESTROY
PostQuitMessage (0)
End Select
MyWndProc = DefWindowProc(hWnd, message, wParam, lParam)
End Function
Private Function GetMyWndProc(ByVal lWndProc As Long) As Long
GetMyWndProc = lWndProc
End Function
Private Sub MyMessageLoop()
Dim aMsg As Msg
Do While GetMessage(aMsg, 0, 0, 0)
DispatchMessage aMsg
Loop
End Sub
|
| Цитата(iff @ 1.11.2007, 22:41 ) | | Надеюсь на ней можно рисовать мышкой кнопочки, фреймы и др. |
Это всего лишь окно, а не графический редактор... Впрочем, если сможешь отслеживать мышиные события и создавать на родительском окне соответствующие дочерние, то твои надежды не беспочвенны 
|
