原文地址:
RT
这个仅仅作为演示作品,是下一个正式作品的铺垫~
上校近期准备打算写一个有关Window32窗体运行消息机制的文章(最近研究MFC中- -),所以先用VB6实验性的模拟一下,顺便让大家了解下Win32窗体的运行机制~
不过,这个演示的代码很乱~你看看API声明的BAS 文件就知道了…………还有就是注释很少,因为只是让大家初步了解下,所以没有写那么多~正式文章会写的详细点。
PS:不知道为什么,我用VB6写出来的这个 鼠标指针显示方面有点BUG,无法正常的Update样式,但是我用CPP写就没事……哪位同学知道的说下啊~感激不尽。
然后下面是代码,就发mdlMain.bas的好了。
这个仅仅作为演示作品,是下一个正式作品的铺垫~
上校近期准备打算写一个有关Window32窗体运行消息机制的文章(最近研究MFC中- -),所以先用VB6实验性的模拟一下,顺便让大家了解下Win32窗体的运行机制~
不过,这个演示的代码很乱~你看看API声明的BAS 文件就知道了…………还有就是注释很少,因为只是让大家初步了解下,所以没有写那么多~正式文章会写的详细点。
PS:不知道为什么,我用VB6写出来的这个 鼠标指针显示方面有点BUG,无法正常的Update样式,但是我用CPP写就没事……哪位同学知道的说下啊~感激不尽。
然后下面是代码,就发mdlMain.bas的好了。
Attribute VB_Name = "mdlMain"
Option Explicit
'****************************************
'/// Project:Win32App
'/// File:mdlMain.bs
'/// Edition:NULL
'/// Coder:KingsamChen [MDSA Group] [url]http://mdsa-group.5d6d.com[/url]
'/// Last Modify:2008-5-25
'****************************************
Private Const g_strAppName As String = "KCMiniWindow"
Dim g_lngHwnd As Long
Private Sub Main()
Dim t_Msg As Msg
If RegisterWindowClass = False Then Exit Sub
If LoadWindow Then
Do While (GetMessage(t_Msg, 0&, 0&, 0&) > 0)
Call TranslateMessage(t_Msg)
Call DispatchMessage(t_Msg)
Loop
End If
Call UnregisterClass(g_strAppName, App.hInstance)
End Sub
Private Function RegisterWindowClass() As Boolean
Dim t_ws As WNDCLASS
With t_ws
.style = CS_DBLCLKS '/// 窗体外观
'/// 为了获取函数指针,必须用一个函数作为中转站
'/// 详情参考《MSDN For VB6》中对AddressOf的介绍
.lpfnwndproc = GetFunctionAddress(AddressOf WndProc) '/// 回调函数地址
'/// 窗口类扩展样式和窗口实例扩展样式,均赋值0
'/// 注意:此二者不可不赋值
.cbClsextra = 0&
.cbWndExtra2 = 0&
.hInstance = App.hInstance '/// 当前实例
.hIcon = LoadIcon(0&, IDI_APPLICATION) '/// 使用系统默认Icon
.hCursor = LoadCursor(0&, IDC_ARROW) '/// 使用系统默认鼠标指针
.hbrBackground = COLOR_BACKGROUND '/// 背景颜色
.lpszMenuName = vbNullString '/// 菜单名
.lpszClassName = g_strAppName '/// 类名 ps:这个不能乱填下面要用到
End With
RegisterWindowClass = RegisterClass(t_ws) <> 0 '/// 注册成功返回
End Function
Private Function GetFunctionAddress(ByVal lngAddress As Long) As Long
GetFunctionAddress = lngAddress
End Function
Private Function LoadWindow() As Boolean
'/// MS CreateWindow这个API不能用了,函数入口点找不到~汗~MS在CPP里面还能用……
g_lngHwnd = CreateWindowEx(0&, g_strAppName, "KingsamChen is Fucker", WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, App.hInstance, 0)
If g_lngHwnd Then
Call ShowWindow(g_lngHwnd, SW_SHOWNORMAL)
Call UpdateWindow(g_lngHwnd)
End If
LoadWindow = g_lngHwnd <> 0
End Function
Private Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'/// 非常类似SubClass消息处理的写法~
Select Case Msg
Case WM_LBUTTONDBLCLK
If MsgBox("Um...Are you sure KingsamChen is a Big Fuker", vbYesNo + vbQuestion) = vbYes Then
Load frmAbout
frmAbout.Show 1
End If
Case WM_DESTROY
Call PostQuitMessage(0)
End Select
WndProc = DefWindowProc(hwnd, Msg, wParam, lParam)
End Function