【分享】VB6.0用WinAPI创建窗口
acmilan2015/10/05软件综合 IP:四川
只是写着玩而已。。。
<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年2个月前 - 2015/10/06 01:58:00]

来自:计算机科学 / 软件综合
5
已屏蔽 原因:{{ notice.reason }}已屏蔽
{{notice.noticeContent}}
~~空空如也
acmilan 作者
9年2个月前 IP:四川
792386
万能的Long。。。另外虽然用的是VB6.0,但创建的是Unicode窗口哦。。。[s:;P]
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
acmilan作者
9年2个月前 IP:四川
792397
VB6.0比较奇怪的一点是,它的字符串是基于Unicode的(称作BSTR),但是它连接WinAPI的方式却是ANSI方式,且在WinNT平台上也是如此。因此用它开发出的程序并不能支持显示和输入Unicode字符。另外,VB6.0最为蛋疼的两点,一是没有靠谱的移位指令,二是没有靠谱的指针重解析指令。数据重解析只能使用CopyMemory(RtlMoveMemory)。
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
acmilan作者
9年2个月前 IP:四川
792403
在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)传递结构体指针。
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
acmilan作者
9年2个月前 IP:四川
792406
as long as you see...
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
acmilan作者
9年0个月前 IP:四川
798075
其实如果想偷懒的话,用res文件写个对话框,然后用DialogBoxParamW加载就可以了,就是WndProc要换成DlgProc→_→
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论

想参与大家的讨论?现在就 登录 或者 注册

所属专业
所属分类
上级专业
同级专业
acmilan
进士 学者 笔友
文章
461
回复
2934
学术分
4
2009/05/30注册,5年10个月前活动
暂无简介
主体类型:个人
所属领域:无
认证方式:邮箱
IP归属地:未同步
文件下载
加载中...
{{errorInfo}}
{{downloadWarning}}
你在 {{downloadTime}} 下载过当前文件。
文件名称:{{resource.defaultFile.name}}
下载次数:{{resource.hits}}
上传用户:{{uploader.username}}
所需积分:{{costScores}},{{holdScores}}下载当前附件免费{{description}}
积分不足,去充值
文件已丢失

当前账号的附件下载数量限制如下:
时段 个数
{{f.startingTime}}点 - {{f.endTime}}点 {{f.fileCount}}
视频暂不能访问,请登录试试
仅供内部学术交流或培训使用,请先保存到本地。本内容不代表科创观点,未经原作者同意,请勿转载。
音频暂不能访问,请登录试试
支持的图片格式:jpg, jpeg, png
插入公式
评论控制
加载中...
文号:{{pid}}
投诉或举报
加载中...
{{tip}}
请选择违规类型:
{{reason.type}}

空空如也

加载中...
详情
详情
推送到专栏从专栏移除
设为匿名取消匿名
查看作者
回复
只看作者
加入收藏取消收藏
收藏
取消收藏
折叠回复
置顶取消置顶
评学术分
鼓励
设为精选取消精选
管理提醒
编辑
通过审核
评论控制
退修或删除
历史版本
违规记录
投诉或举报
加入黑名单移除黑名单
查看IP
{{format('YYYY/MM/DD HH:mm:ss', toc)}}