- UID
- 2129
- 帖子
- 4614
- 精华
- 0
- 贡献
- 2
- 推广
- 0
- 有效BUG
- 0
- 注册时间
- 2005-8-8
|
有条件的编译试试看吧,我也不知道是干什么的,反正代码挺多的
-
- Option Explicit
- Public 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
- Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
- Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As String) As Long
- Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
- Public Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Integer
- Public Declare Function ShowWindow Lib "user32" (ByVal handle_of_window As Long, ByVal nCmdShow As Long) As Long
- Public Declare Function UpdateWindow Lib "user32" (ByVal handle_of_window As Long) As Long
- Public Declare Function SetFocus Lib "user32" (ByVal handle_of_window As Long) As Long
- Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal handle_of_window As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal handle_of_window As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Public Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal handle_of_window As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
- Public Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
- Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
- Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
- Public Declare Function BeginPaint Lib "user32" (ByVal handle_of_window As Long, lpPaint As PAINTSTRUCT) As Long
- Public Declare Function EndPaint Lib "user32" (ByVal handle_of_window As Long, lpPaint As PAINTSTRUCT) As Long
- Public Declare Function GetClientRect Lib "user32" (ByVal handle_of_window As Long, lpRect As RECT) As Long
- Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
-
-
- Type WNDCLASSEX
- cbSize As Long
- style As Long
- lpfnWndProc As Long
- cbClsExtra As Long
- cbWndExtra As Long
- hInstance As Long
- hIcon As Long
- hCursor As Long
- hbrBackground As Long
- lpszMenuName As String
- lpszClassName As String
- hIconSm As Long
- End Type
- Type POINTAPI
- x As Long
- y As Long
- End Type
- Type MSG
- handle_of_window As Long
- message As Long
- wParam As Long
- lParam As Long
- time As Long
- pt As POINTAPI
- End Type
- Type RECT
- Left As Long
- Top As Long
- Right As Long
- Bottom As Long
- End Type
- Type PAINTSTRUCT
- hdc As Long
- fErase As Long
- rcPaint As RECT
- fRestore As Long
- fIncUpdate As Long
- rgbReserved(32) As Byte 'this was declared incorrectly in VB API viewer
- End Type
- Public Const WS_VISIBLE As Long = &H10000000
- Public Const WS_VSCROLL As Long = &H200000
- Public Const WS_TABSTOP As Long = &H10000
- Public Const WS_THICKFRAME As Long = &H40000
- Public Const WS_MAXIMIZE As Long = &H1000000
- Public Const WS_MAXIMIZEBOX As Long = &H10000
- Public Const WS_MINIMIZE As Long = &H20000000
- Public Const WS_MINIMIZEBOX As Long = &H20000
- Public Const WS_SYSMENU As Long = &H80000
- Public Const WS_BORDER As Long = &H800000
- Public Const WS_CAPTION As Long = &HC00000 ' WS_BORDER Or WS_DLGFRAME
- Public Const WS_CHILD As Long = &H40000000
- Public Const WS_CHILDWINDOW As Long = (WS_CHILD)
- Public Const WS_CLIPCHILDREN As Long = &H2000000
- Public Const WS_CLIPSIBLINGS As Long = &H4000000
- Public Const WS_DISABLED As Long = &H8000000
- Public Const WS_DLGFRAME As Long = &H400000
- Public Const WS_EX_ACCEPTFILES As Long = &H10&
- Public Const WS_EX_DLGMODALFRAME As Long = &H1&
- Public Const WS_EX_NOPARENTNOTIFY As Long = &H4&
- Public Const WS_EX_TOPMOST As Long = &H8&
- Public Const WS_EX_TRANSPARENT As Long = &H20&
- Public Const WS_GROUP As Long = &H20000
- Public Const WS_HSCROLL As Long = &H100000
- Public Const WS_ICONIC As Long = WS_MINIMIZE
- Public Const WS_OVERLAPPED As Long = &H0&
- Public Const WS_OVERLAPPEDWINDOW As Long = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
- Public Const WS_POPUP As Long = &H80000000
- Public Const WS_POPUPWINDOW As Long = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
- Public Const WS_SIZEBOX As Long = WS_THICKFRAME
- Public Const WS_TILED As Long = WS_OVERLAPPED
- Public Const WS_TILEDWINDOW As Long = WS_OVERLAPPEDWINDOW
- Public Const CW_USEDEFAULT As Long = &H80000000
- Public Const CS_HREDRAW As Long = &H2
- Public Const CS_VREDRAW As Long = &H1
- Public Const IDI_APPLICATION As Long = 32512&
- Public Const IDC_ARROW As Long = 32512&
- Public Const WHITE_BRUSH As Integer = 0
- Public Const BLACK_BRUSH As Integer = 4
- Public Const WM_KEYDOWN As Long = &H100
- Public Const WM_CLOSE As Long = &H10
- Public Const WM_DESTROY As Long = &H2
- Public Const WM_PAINT As Long = &HF
- Public Const SW_SHOWNORMAL As Long = 1
- Public Const DT_CENTER As Long = &H1
- Public Const DT_SINGLELINE As Long = &H20
- Public Const DT_VCENTER As Long = &H4
- Sub Main()
- Call vbWinMain
- End Sub
- Public Function vbWinMain() As Long
- Const CLASSNAME = "hello_world_vb"
- Const TITLE = "hello, world!"
- Dim handle_of_window As Long
- Dim window_class As WNDCLASSEX
- Dim message As MSG
- window_class.cbSize = Len(window_class)
- window_class.style = CS_HREDRAW Or CS_VREDRAW
- window_class.lpfnWndProc = GetFuncPtr(AddressOf WindowProc)
- window_class.cbClsExtra = 0&
- window_class.cbWndExtra = 0&
- window_class.hInstance = App.hInstance
- window_class.hIcon = LoadIcon(App.hInstance, IDI_APPLICATION)
- window_class.hCursor = LoadCursor(App.hInstance, IDC_ARROW)
- window_class.hbrBackground = GetStockObject(WHITE_BRUSH)
- window_class.lpszMenuName = 0&
- window_class.lpszClassName = CLASSNAME
- window_class.hIconSm = LoadIcon(App.hInstance, IDI_APPLICATION)
-
- RegisterClassEx window_class
-
- handle_of_window = CreateWindowEx(0&, CLASSNAME, TITLE, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0&, 0&, App.hInstance, 0&)
-
- ShowWindow handle_of_window, SW_SHOWNORMAL
- UpdateWindow handle_of_window
- SetFocus handle_of_window
- Do While 0 <> GetMessage(message, 0&, 0&, 0&)
- TranslateMessage message
- DispatchMessage message
- Loop
-
- vbWinMain = message.wParam
- End Function
- Public Function WindowProc(ByVal handle_of_window As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Dim ps As PAINTSTRUCT
- Dim rc As RECT
- Dim hdc As Long
- Dim str As String
- Select Case message
- Case WM_PAINT
- hdc = BeginPaint(handle_of_window, ps)
- Call GetClientRect(handle_of_window, rc)
- str = "hello, world!"
- Call DrawText(hdc, str, Len(str), rc, DT_SINGLELINE Or DT_CENTER Or DT_VCENTER)
- Call EndPaint(handle_of_window, ps)
- Exit Function
-
- 'Case WM_KEYDOWN
- ' Call PostMessage(handle_of_window, WM_CLOSE, 0, 0)
- ' Exit Function
-
- Case WM_DESTROY
- PostQuitMessage 0&
- Exit Function
-
- Case Else
- WindowProc = DefWindowProc(handle_of_window, message, wParam, lParam)
- End Select
- End Function
- Function GetFuncPtr(ByVal lngFnPtr As Long) As Long
- GetFuncPtr = lngFnPtr
- End Function
复制代码 |
|