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 &nbs
[1] [2] 下一页 没有相关教程
|