求助 VB 任务栏图标 不响应双击事件

jageme 2014-01-06 05:11:43
最近在做一个软件.当然是自娱自乐为目的.
目的就想做一个类似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



















...全文
218 3 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
jageme 2014-01-07
  • 打赏
  • 举报
回复
我靠.自己解决这个问题了,原因真他妈的不知道

我自己将from1这个窗体,删除后重新再建一个from1窗体,将代码和控件原封不去的复制过去,一切问题都解决了!
靠,
jageme 2014-01-07
  • 打赏
  • 举报
回复
引用 1 楼 Topc008 的回复:
试了一下,可以还原啊
不行啊!!最小化后,我双击状态栏的图标没得反应哦!!
一如既往哈 2014-01-06
  • 打赏
  • 举报
回复
试了一下,可以还原啊

1,488

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧