FangDaJing窗体代码:
Option Explicit
'//****************************************************************************************************************************************
'//此模块示范了一个放大镜
'//****************************************************************************************************************************************
'//以下声明API函数
'//设置Settimer过程
Private Declare Function SetTimer _
Lib "user32" ( _
ByVal Hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerfunc As Long) _
As Long
'//结束Settimer过程
Private Declare Function KillTimer _
Lib "user32" ( _
ByVal Hwnd As Long, _
ByVal nIDEvent As Long) _
As Long
'//取得窗口样式位
Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal Hwnd As Long, _
ByVal nIndex As Long) _
As Long
'//设置窗口样式
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal Hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
'//查找窗口
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
'//以下定义常数及变量
Private Const WS_EX_TOOLWINDOW = &H80 '工具窗体样式
Private Const GWL_EXSTYLE = (-20) '拓展窗体样式
Private TID As Long
Private Hwnd As Long '用于寄存窗体句柄
'//****************************************************************************************************************************************
'// 过程
'//****************************************************************************************************************************************
Private Sub UserForm_Initialize()
Dim Istype As Long
'//取得窗口句柄
Hwnd = FindWindow(vbNullString, Me.Caption)
'//取得窗口拓展样式位
Istype = GetWindowLong(Hwnd, GWL_EXSTYLE)
'//窗口样式:原样式和工具窗口
Istype = Istype Or WS_EX_TOOLWINDOW
'//重设窗体样式位
SetWindowLong Hwnd, GWL_EXSTYLE, Istype
'//设置Settimer 过程
TID = SetTimer(Hwnd, 0, 20, AddressOf TimeOutProc)
End Sub
'//--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'//结束Settimer 过程
If TID <> 0 Then KillTimer Hwnd, TID
End Sub