1,488
社区成员




Dim msg As Long
msg = X / Screen.TwipsPerPixelX
If msg = WM_LBUTTONDBLCLK Then '错误出在这里,,,双击事件不响应!
Me.WindowState = 0
Me.Show
Shell_NotifyIcon NIM_DELETE, Tray
End If
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Const WM_SYSCOMMAND = &H112
Const SC_MOVE = &HF010&
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Const NIM_ADD = &H0 '在任务栏中增加一个图标
Const NIM_DELETE = &H2 '删除任务栏中的一个图标
Const NIM_MODIFY = &H1 '修改任务栏中个图标信息
Const NIF_ICON = &H2 '
Const NIF_MESSAGE = &H1 'NOTIFYICONDATA结构中uFlags的控制信息
Const NIF_TIP = &H4 '
Const WM_MOUSEMOVE = &H200 '
Const WM_LBUTTONDBLCLK = &H203
Private Type NOTIFYICONDATA
cbSize As Long '该数据结构的大小
hwnd As Long '处理任务栏中图标的窗口句柄
uID As Long '定义的任务栏中图标的标识
uFlags As Long
uCallbackMessage As Long '任务栏图标通过它与用户程序交换消息,处理该消息的窗口由hWnd决定
hIcon As Long '任务栏中的图标的控制句柄
szTip As String * 64 '图标的提示信息
End Type
Private Tray As NOTIFYICONDATA
Private vcode As String
Private IsRight As Boolean
Private outrgn As Long
Private Sub Form_Activate()
Call rgnform(Me, 8, 8) '调用子过程
End Sub
Private Sub Form_Load()
If Image1.Picture.Handle <> 0 Then '没有标志已加载则加载
Image1.Picture = Nothing
End If
If Image2.Picture.Handle <> 0 Then '没有标志已加载则加载
Image2.Picture = Nothing
End If
If Image3.Picture.Handle <> 0 Then '没有标志已加载则加载
Image3.Picture = Nothing
End If
Image4.Picture = Nothing
Image5.Picture = Nothing
Image6.Picture = Nothing
Image7.Picture = Nothing
Text1.ForeColor = &HC0C0C0
Text1.Text = "请输入用户名"
Text2.PasswordChar = ""
Text2.ForeColor = &HC0C0C0
Text2.Text = "请输入密码"
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0
SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
If Button = 1 Then
IsRight = False
ElseIf Button = 2 Then
IsRight = True
End If
Image4.Picture = Nothing
Image5.Picture = Nothing
Image6.Picture = Nothing
Image7.Picture = Nothing
If Text1.Text = "" Then
Text1.ForeColor = &HC0C0C0
Text1.Text = "请输入用户名"
End If
If Text2.Text = "" Then
Text2.PasswordChar = ""
Text2.ForeColor = &HC0C0C0
Text2.Text = "请输入密码"
End If
zhmm.Visible = False
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Image1.Picture.Handle <> 0 Then '没有标志已加载则加载
Image1.Picture = Nothing
End If
If Image2.Picture.Handle <> 0 Then '没有标志已加载则加载
Image2.Picture = Nothing
End If
If Image3.Picture.Handle <> 0 Then '没有标志已加载则加载
Image3.Picture = Nothing
End If
If Image6.Picture.Handle <> 0 Then '没有标志已加载则加载
Image6.Picture = Nothing
End If
If Image7.Picture.Handle <> 0 Then '没有标志已加载则加载
Image7.Picture = Nothing
End If
If Image8.Picture.Handle <> 0 Then '没有标志已加载则加载
Image8.Picture = Nothing
End If
zhmm.Visible = False
Dim msg As Long
msg = X / Screen.TwipsPerPixelX
If msg = WM_LBUTTONDBLCLK Then '错误出在这里,,,双击事件不响应!
Me.WindowState = 0
Me.Show
Shell_NotifyIcon NIM_DELETE, Tray
End If
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then
Tray.cbSize = Len(Tray)
Tray.uID = vbNull
Tray.hwnd = Me.hwnd
Tray.uFlags = NIF_TIP Or NIF_MESSAGE Or NIF_ICON
Tray.uCallbackMessage = WM_MOUSEMOVE
Tray.hIcon = Me.Icon
Tray.szTip = "XXXX管理" & vbNullChar
Shell_NotifyIcon NIM_ADD, Tray
Me.Hide
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject outrgn '将圆角区域使用的所有系统资源释放
End Sub
'接下来我们开始编写子过程
Private Sub rgnform(ByVal frmbox As Form, ByVal fw As Long, ByVal fh As Long)
Dim w As Long, h As Long
w = frmbox.ScaleX(frmbox.Width, vbTwips, vbPixels)
h = frmbox.ScaleY(frmbox.Height, vbTwips, vbPixels)
outrgn = CreateRoundRectRgn(0, 0, w, h, fw, fh)
Call SetWindowRgn(frmbox.hwnd, outrgn, True)
End Sub
Private Sub Image1_Click()
If Image4.Picture.Handle <> 0 Then '没有标志已加载则加载
Image4.Picture = Nothing
End If
If Image5.Picture.Handle <> 0 Then '没有标志已加载则加载
Image5.Picture = Nothing
End If
If Image6.Picture.Handle <> 0 Then '没有标志已加载则加载
Image6.Picture = Nothing
End If
If Image7.Picture.Handle <> 0 Then '没有标志已加载则加载
Image7.Picture = Nothing
End If
Me.WindowState = 1
End Sub