万能的Long。。。另外虽然用的是VB6.0,但创建的是Unicode窗口哦。。。[s:;P]
<code class="lang-vb">Option Explicit Declare Function LoadIconW Lib "user32.dll" _ (ByVal a As Long, ByVal b As Long) As Long Declare Function LoadCursorW Lib "user32.dll" _ (ByVal a As Long, ByVal b As Long) As Long Declare Function GetStockObject Lib "gdi32.dll" _ (ByVal a As Long) As Long Declare Function RegisterClassW Lib "user32.dll" (ByVal a As Long) As Long Declare Function CreateWindowExW Lib "user32.dll" _ (ByVal a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, _ ByVal e As Long, ByVal f As Long, ByVal g As Long, ByVal h As Long, _ ByVal i As Long, ByVal j As Long, ByVal k As Long, ByVal l As Long) _ As Long Declare Function ShowWindow Lib "user32.dll" _ (ByVal a As Long, ByVal b As Long) As Long Declare Function UpdateWindow Lib "user32.dll" (ByVal a As Long) As Long Declare Function GetMessageW Lib "user32.dll" _ (ByVal a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long) _ As Long Declare Function TranslateMessage Lib "user32.dll" (ByVal a As Long) As Long Declare Function DispatchMessageW Lib "user32.dll" (ByVal a As Long) As Long Declare Function PostQuitMessage Lib "user32.dll" (ByVal a As Long) As Long Declare Function DefWindowProcW Lib "user32.dll" _ (ByVal a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long) _ As Long Declare Function MoveWindow Lib "user32.dll" _ (ByVal a As Long, ByVal b As Long, ByVal c As Long, _ ByVal d As Long, ByVal e As Long, ByVal f As Long) As Long Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _ (ByVal dst As Long, ByVal src As Long, ByVal length As Long) Type WNDCLASSW 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 Long lpszClassName As Long End Type Type MSG hwnd As Long message As Long wParam As Long lParam As Long time As Long pt_x As Long pt_y As Long End Type Type POINTS x As Integer y As Integer End Type '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Program starts here Function GetAddr(ByVal a As Long) As Long GetAddr = a End Function Function MakePOINTS(ByVal l As Long) As POINTS CopyMemory VarPtr(MakePOINTS), VarPtr(l), 4 End Function Public Function WndProc(ByVal hwnd As Long, ByVal message As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Static hEdit As Long Select Case message Case 1 ' WM_CREATE ' edit, ID = 1 ' &H200 = WS_EX_CLIENTEDGE ' &H50200004 = WS_CHILD|WS_VISIBLE|WS_VSCROLL|ES_MULTILINE hEdit = CreateWindowExW(&H200, StrPtr("edit"), _ 0, &H50200004, _ 10, 10, 200, 100, _ hwnd, 1, 0, 0) WndProc = 0 Case 5 ' WM_SIZE Dim ps As POINTS ps = MakePOINTS(lParam) MoveWindow hEdit, 10, 10, ps.x - 20, ps.y - 20, 1 WndProc = 0 Case 2 ' WM_DESTROY PostQuitMessage 0 WndProc = 0 Case Else WndProc = DefWindowProcW(hwnd, message, wParam, lParam) End Select End Function Sub Main() Dim wc As WNDCLASSW wc.style = 3 ' CS_HREDRAW | CS_VREDRAW wc.lpfnWndProc = GetAddr(AddressOf WndProc) wc.hIcon = LoadIconW(0, 32512) 'IDI_APPLICATION wc.hCursor = LoadCursorW(0, 32512) ' IDC_ARROW wc.hbrBackground = GetStockObject(0) ' WHITE_BRUSH wc.lpszClassName = StrPtr("MyVbClass") RegisterClassW VarPtr(wc) Dim hwnd As Long ' &HCF0000 = WS_OVERLAPPEDWINDOW ' &H80000000 = CW_USEDEFAULT hwnd = CreateWindowExW(0, StrPtr("MyVbClass"), StrPtr("Title"), &HCF0000, _ &H80000000, &H80000000, &H80000000, &H80000000, _ 0, 0, 0, 0) ShowWindow hwnd, 5 ' SW_SHOW UpdateWindow hwnd Dim mymsg As MSG Do While GetMessageW(VarPtr(mymsg), 0, 0, 0) TranslateMessage VarPtr(mymsg) DispatchMessageW VarPtr(mymsg) Loop End Sub</code>
[修改于 9年3个月前 - 2015/10/06 01:58:00]
时段 | 个数 |
---|---|
{{f.startingTime}}点 - {{f.endTime}}点 | {{f.fileCount}} |
200字以内,仅用于支线交流,主线讨论请采用回复功能。