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

jageme jageme 墨衍会员 · AI 创作全网分发 墨衍智能分发 通过墨衍一键同步至各平台 可同步平台 CSDN微信公众号微博知乎掘金百家号博客园抖音小红书 你的文章也可以这样分发 墨衍会员 ¥399起/年,写一次发全网 我也要 + 加入社区
最近在做一个软件.当然是自娱自乐为目的.
目的就想做一个类似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



















...全文

相关推荐

vb icon图标大全

图标响应事件:除了静态显示,图标还可以与控件事件关联,例如,当鼠标悬停在带图标的按钮上时,可以改变按钮的图标,以提供反馈信息。6.

kuangwuqiufeng9

实现VB任务栏图标右键菜单功能

本文还有配套的精品资源,点击获取 简介:在VB编程中,创建任务栏图标右键菜单功能涉及Windows API调用、上下文菜单的设计与事件处理。本教程通过实例代码详细介绍了创建和实现右键菜单的步骤,包括添加菜单项、事件处理、API函数调用、设置任务栏图标以及响应右键点击等关键技术点。 1. 上下文菜单控件使用 在现代的软件应用中,上下文菜单(通常被称为右键菜单)...

焦虑中

VB系统托盘图标操作完整实例源码

系统托盘图标是指显示在Windows任务栏右侧通知区域的小型图标,常用于指示应用程序在后台运行的状态。在VB(Visual Basic)开发中,合理使用托盘图标不仅能提升应用程序的专业度,还能增强用户体验。通过托盘图标,用户可以快速访问程序核心功能,而无需始终保持主窗体可见,从而节省桌面空间并优化系统资源使用。本章将从系统托盘图标的定义出发,解析其在桌面应用开发中的重要性,并探讨为何在VB项目中引入托盘图标是一项值得实践的设计策略,为后续编程实现打下坚实基础。NotifyIcon。

岑秋苑

VB编程实战:构建可最小化至托盘的程序

在计算机操作系统中,托盘程序通常指的是那些常驻在系统托盘区域的应用程序。这些程序提供了快速访问常用功能的途径,同时不占用任务栏空间,保持桌面整洁。对于开发者而言,掌握如何创建托盘程序是提升用户体验和增强程序功能性的重要技能之一。在Windows应用程序中,系统托盘区域(通常位于屏幕右下角的时钟旁边)常被用来显示应用程序的状态或提供快捷操作。控件是.NET框架提供的一个组件,用于在系统托盘区域创建图标,从而允许程序与用户进行一些轻量级的交互。

八位数花园

vb任务栏图标右键菜单

在VB(Visual Basic)编程中,任务栏图标右键菜单是一项常见的功能,它允许用户通过右键点击任务栏上的程序图标来访问各种快捷操作。

fanpin88
评论 3
收藏 已收藏
分享
返回顶部
jageme
API 1,488 成员 23,270 内容