jageme 2014年01月06日
求助 VB 任务栏图标 不响应双击事件
最近在做一个软件.当然是自娱自乐为目的.
目的就想做一个类似QQ的登录界面.
然而,当我在做实现这个最小化到状态栏时,软件却不响应双击事件,不能还原,
一直不知道问题出在什么地方!有大神帮忙看一下

谢谢



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



















...全文
168 点赞 收藏 3
写回复
3 条回复

还没有回复,快来抢沙发~

发动态
发帖子
API
创建于2007-09-28

1196

社区成员

2.3w+

社区内容

VB API
社区公告
暂无公告