Rem Simple VB API programming, only a white window is displayed, then write Hellorem Tianjin University of Finance and Economics Business Administration 0202Rem (c) Deng De Rong 2005-3-4REM Note: For modification, please contact the author REM E-mail. : louisdeng@monternet.com
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As LongPublic Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As LongPublic Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As Long) As LongPublic Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, 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 LongPublic Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As LongPublic Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As LongPublic Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Long, ByVal hwnd As Long, ByVal wMsgFilte rMin As Long, ByVal wMsgFilterMax As Long) As LongPublic Declare Function TranslateMessage Lib "user32" (lpMsg As Long) As LongPublic Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Long) As LongPublic Declare Function DefWindowProc Lib "user32" alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As LongPublic Declare Sub PostQuitMessage Lib "user32" ( BYVAL NEXITCODE AS Long) Public Declare Function BeginPaint Lib "
user32 "(ByVal hwnd As Long, lpPaint As Long) As LongPublic Declare Function EndPaint Lib" user32 "(ByVal hwnd As Long, lpPaint As Long) As LongPublic Declare Function TextOut Lib" gdi32 "Alias" TextOutA "(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As LongPublic Const WM_SIZE = & H5Public Const WM_PAINT = & HFPublic Const WM_DESTROY = & H2Public Const IDC_ARROW = 32512 & Public Const IDI_APPLICATION = 32512 & Public Const CW_USEDEFAULT = & H80000000Public Const WS_EX_APPWINDOW = & H40000Public const WS_OVERLAPPED = & H0 & Public const WHITE_BRUSH = 0Public const CS_HREDRAW = & H2Public const CS_VREDRAW = & H1Public const WS_CAPTION = & HC00000 'WS_BORDER Or WS_DLGFRAMEPublic const WS_SYSMENU = & H80000Public const WS_THICKFRAME = & H40000Public const WS_MAXIMIZEBOX = & H10000Public const WS_MINIMIZEBOX = & H20000Public const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME OR WS_MINIMIZEBOX or WS _MaximizeBox)
Public Type Rect Left As Long Top As Long Right As Long Bottom As LONGEND TYPE
PUBLIC TYPE PAINTSTRUCT HDC AS Long FeRase As Long Rcpaint As Rect FRESTORE As Long FinCupdate As Long Rgbreserved (32) AS BYTEEND TYPE
Public 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 Long lpszClassName As LongEnd Type
Public Type Pointapi X As long y as lonnd typepublic const color_window = 5
Public Type Msg HWND As Long Message As Long WParam As Long LPARAM As Long Time As Long Pt As Pointapiend Type
Public Function WndProc (ByVal hwnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDim ps As PAINTSTRUCTDim hdc As LongDim szBuffer As StringStatic cxCLient As LongStatic cyClient As Long
SZBuffer = "Hello, VB API"
Select Case message Case WM_SIZE cxCLient = lParam Mod 65536 cyClient = lParam / 65536 WndProc = 0 Exit Function Case WM_PAINT hdc = BeginPaint (hwnd, ByVal VarPtr (ps)) TextOut hdc, cxCLient / 2, cyClient / 2, szBuffer, Len (szBuffer ) Endpaint hwnd, byval varptr (PS) WndProc = 0 exit function case wm_destroy postquitMessage 0 WndProc = 0 exit function end selectwndProc = DefWindowProc (hwnd, message, wparam, lparam)
END FUNCTION
Private sub setWndProc (byref wc as wndclass, byval wndproc as ring)
Wc.lpfnwndproc = Wndprocend Sub Main () DIM SZAPPNAME (10) AS BYTEDIM PMSG AS MSGDIM HWND AS WC AS WNDCLASS
Szappname (0) = 97szappname (1) = 112szappname (2) = 112szAppname (3) = 0
wc.cbClsextra = 0wc.cbWndExtra2 = 0wc.hbrBackground = GetStockObject (WHITE_BRUSH) wc.hCursor = LoadCursor (0, IDC_ARROW) wc.hIcon = LoadIcon (0, IDI_APPLICATION) wc.hInstance = App.hInstanceSetWndProc wc, AddressOf WndProcwc.lpszClassName = Varptr (szappname (0)) wc.lpszMenuname = 0wc.style = cs_hredraw or cs_vredraw
If RegisterClass (ByVal VarPtr (wc)) = 0 Then MsgBox ( "Error") hwnd = CreateWindowEx (0, ByVal VarPtr (szAppName (0)), ByVal VarPtr (szAppName (0)), WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, App.hinstance, 0) ShowWindow HWnd, 1UpdateWindow Hwnd
Do While GetMessage (Byval Varptr (PMSG), 0, 0, 0) <> 0TranslateMessage Byval Varptr (PMSG) DispatchMessage Byval Varptr (PMSG) Loop
End Sub
