文号
t73879
阅读
5810
回复
5
收藏
1
【分享】VB6.0用WinAPI创建窗口
2015/10/05
IP:四川
只是写着玩而已。。。
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
[ 修改于11年2个月前 - 2015/10/06 01:58:00 ]
acmilan作者
11年2个月前IP:四川
792386
1楼
万能的Long。。。另外虽然用的是VB6.0,但创建的是Unicode窗口哦。。。[s:;P]
引用
评论
acmilan作者
11年2个月前IP:四川
792397
2楼
VB6.0比较奇怪的一点是,它的字符串是基于Unicode的(称作BSTR),但是它连接WinAPI的方式却是ANSI方式,且在WinNT平台上也是如此。因此用它开发出的程序并不能支持显示和输入Unicode字符。另外,VB6.0最为蛋疼的两点,一是没有靠谱的移位指令,二是没有靠谱的指针重解析指令。数据重解析只能使用CopyMemory(RtlMoveMemory)。
引用
评论
acmilan作者
11年2个月前IP:四川
792403
3楼
在VB6.0中WinAPI的参数如果写成ByVal x As String形式始终会导致Unicode->ANSI转换,ByRef x As MyStruct的话MyStruct中的字符串也会发生Unicode->ANSI转换,因此对于W版本的WinAPI来说,只能使用ByVal ptr As Long形式声明参数,并且使用StrPtr(x)传递字符串指针,使用VarPtr(x)传递结构体指针。
引用
评论
acmilan作者
11年2个月前IP:四川
792406
4楼
as long as you see...
引用
评论
acmilan作者
11年1个月前IP:四川
798075
5楼
其实如果想偷懒的话,用res文件写个对话框,然后用DialogBoxParamW加载就可以了,就是WndProc要换成DlgProc→_→
引用
评论
笔记
{{note.content}}
{{n.user.username}}
{{fromNow(n.toc)}} {{n.status === noteStatus.disabled ? "已屏蔽" : ""}} {{n.status === noteStatus.unknown ? "正在审核" : ""}} {{n.status === noteStatus.deleted ? '已删除' : ''}}
  • 编辑
  • 删除
  • {{n.status === 'disabled' ? "解除屏蔽" : "屏蔽" }}
我也是有底线的