📄 mainform.frm
字号:
'判断磁盘类型
Dim DiskKey As String
'截取磁盘列表前两个字符
DiskKey = Left(DriveList.List(i), 2)
Select Case GetDriveBusType(DiskKey)
Case "1394"
Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 6)
Case "Ata"
Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 5)
Case "Atapi"
Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 1)
Case "Fibre"
Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 6)
Case "RAID"
Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 5)
Case "Scsi"
Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 1)
Case "Ssa"
Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 6)
Case "Usb"
Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 4)
Case "未知"
Set DrivItem = MyDriverList.ListItems.Add(, , DriveList.List(i), 6)
Case Else
End Select
End If '结束有效性判断
Next i '遍历下一个磁盘
End Sub
'** 无窗口拖动 **
'当鼠标在标题栏上时,实现拖动操作
Private Sub TitlePicture_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim r As Long, i
If Button = 1 Then
i = ReleaseCapture()
r = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub
Private Sub Say_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim r As Long, i
If Button = 1 Then
i = ReleaseCapture()
r = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End If
End Sub
'/** 内存自动清理 **/
Private Sub NeiCun_Timer()
SetProcessWorkingSetSize GetCurrentProcess, -1, -1
End Sub
'考虑到可扩展性,所以没有命名成复合词形式.例如btnUnload
'/** 鼠标在第一个按钮上点击触发的更换图片事件 **/
Private Sub Btn1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Btn1.Picture = LoadResPicture(106, 0)
End Sub
'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn1
'当鼠标未按下任何按键的时候
If Button = 0 Then
'判断鼠标是否在该控件上
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
'载入没有焦点时候的图
Btn1.Picture = LoadResPicture(103, 0)
Else
'反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
SetCapture .hwnd
'载入有焦点的图
Btn1.Picture = LoadResPicture(102, 0)
End If
End If
End With
End Sub
Private Sub Btn2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Btn2.Picture = LoadResPicture(107, 0)
End Sub
'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn2
'当鼠标未按下任何按键的时候
If Button = 0 Then
'判断鼠标是否在该控件上
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
'载入没有焦点时候的图
Btn2.Picture = LoadResPicture(103, 0)
Else
'反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
SetCapture .hwnd
'载入有焦点的图
Btn2.Picture = LoadResPicture(102, 0)
End If
End If
End With
End Sub
Private Sub Btn3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Btn3.Picture = LoadResPicture(108, 0)
End Sub
'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn3
'当鼠标未按下任何按键的时候
If Button = 0 Then
'判断鼠标是否在该控件上
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
'载入没有焦点时候的图
Btn3.Picture = LoadResPicture(103, 0)
Else
'反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
SetCapture .hwnd
'载入有焦点的图
Btn3.Picture = LoadResPicture(102, 0)
End If
End If
End With
End Sub
Private Sub Btn4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Btn4.Picture = LoadResPicture(109, 0)
End Sub
'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn4
'当鼠标未按下任何按键的时候
If Button = 0 Then
'判断鼠标是否在该控件上
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
'载入没有焦点时候的图
Btn4.Picture = LoadResPicture(103, 0)
Else
'反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
SetCapture .hwnd
'载入有焦点的图
Btn4.Picture = LoadResPicture(102, 0)
End If
End If
End With
End Sub
Private Sub Btn5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Btn5.Picture = LoadResPicture(104, 0)
End Sub
'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn5
'当鼠标未按下任何按键的时候
If Button = 0 Then
'判断鼠标是否在该控件上
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
'载入没有焦点时候的图
Btn5.Picture = LoadResPicture(103, 0)
Else
'反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
SetCapture .hwnd
'载入有焦点的图
Btn5.Picture = LoadResPicture(102, 0)
End If
End If
End With
End Sub
Private Sub Btn6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Btn6.Picture = LoadResPicture(105, 0)
End Sub
'/** 鼠标在第一个按钮上滑动触发的更换图片事件 **/
Private Sub Btn6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With Btn6
'当鼠标未按下任何按键的时候
If Button = 0 Then
'判断鼠标是否在该控件上
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
'载入没有焦点时候的图
Btn6.Picture = LoadResPicture(103, 0)
Else
'反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
SetCapture .hwnd
'载入有焦点的图
Btn6.Picture = LoadResPicture(102, 0)
End If
End If
End With
End Sub
Private Sub MyDriverList_ItemClick(ByVal Item As MSComctlLib.ListItem)
ChooseDriver = MyDriverList.ListItems(MyDriverList.SelectedItem.Index).Text
LblTip.Caption = "点击卸载按钮,卸载盘符为 " & ChooseDriver & " 的磁盘"
End Sub
Private Sub btn2_Click()
'设置路径变量
StrPath = ChooseDriver & ":\"
'接着判断是不是USB设备
If GetDriveBusType(Left(StrPath, 2)) <> "Usb" Then
'显示错误信息
MsgBox "驱动器类型错误,请选择一个USB设备!", vbCritical, "错误"
'还原没有焦点的图片
Btn2.Picture = LoadResPicture(103, 0)
'退出子过程
Exit Sub
'判断结束
End If
'如果没有发生上面不愉快的事情,那么确定是USB设备,进行下一步操作
blnIsUsb = True
'锁定卸载按钮,防止重复卸载
Me.Btn2.Enabled = False
Me.Btn3.Enabled = False
'对设备进行卸载
If CloseLockFileHandle(Left(StrPath, 2), GetCurrentProcessId) Then
'检查卸载完成否
If blnIsUsb Then
'卸载成功
If RemoveUsbDrive("\\.\" & Left(StrPath, 2), True) Then
MsgBox "安全卸载USB设备成功!!", , "提示"
'卸载失败
Else
MsgBox "安全卸载USB设备失败!!", vbCritical, "提示"
End If
End If
Else
'当发现有句柄没有关闭
MsgBox "发现有锁定文件还没解锁!!", vbCritical, "提示"
End If
'操作执行完毕,还原卸载按钮可用
Me.Btn2.Enabled = True
Me.Btn3.Enabled = True
'检测磁盘
Call ReLoadList
End Sub
'强力卸载
Private Sub btn3_Click()
Dim hwndShell As Long, i As Long
Me.Btn2.Enabled = False
Me.Btn3.Enabled = False
hwndShell = FindWindow("Progman", vbNullString)
i = PostMessage(hwndShell, WM_QUIT, 0, 0)
If i = 0 Then Exit Sub
Do While True
hwndShell = FindWindow("Progman", vbNullString)
If hwndShell = 0 Then
Exit Do
End If
DoEvents
Loop
Shell "Explorer.exe", vbNormalFocus
Me.Btn2.Enabled = True
Me.Btn3.Enabled = True
'检测磁盘
Call ReLoadList
End Sub
Private Sub btn1_Click()
'检测磁盘
Call ReLoadList
LblTip.Caption = "请先选择您要卸载的磁盘"
End Sub
Private Sub Btn5_Click()
Update
End Sub
Private Sub Btn6_Click()
MsgBox "俺还没想好界面怎么画。", vbCritical, "郁闷"
Btn6.Picture = LoadResPicture(103, 0)
Exit Sub
End Sub
'/** 鼠标在最小化按钮上点击触发的更换图片事件 **/
Private Sub btnMin_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnMin.Picture = LoadResPicture("btnmin3", 0)
End Sub
'/** 鼠标在最小化按钮上点击触发的窗体最小化事件 **/
Private Sub btnMin_Click()
'Call CloseWindow(Me.hwnd) '为什么不能用....
MainForm.Hide
btnMin.Picture = LoadResPicture("btnmin1", 0)
End Sub
'/** 鼠标在最小化按钮上滑动触发的更换图片事件 **/
Private Sub btnMin_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With btnMin
'当鼠标未按下任何按键的时候
If Button = 0 Then
'判断鼠标是否在该控件上
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
'载入没有焦点时候的图
btnMin.Picture = LoadResPicture("btnmin1", 0)
Else
'反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
SetCapture .hwnd
'载入有焦点的图
btnMin.Picture = LoadResPicture("btnmin2", 0)
End If
End If
End With
End Sub
'/** 鼠标在最大化按钮上点击触发的更换图片事件 **/
Private Sub btnMax_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnMax.Picture = LoadResPicture("btnmax3", 0)
End Sub
'/** 鼠标在最大化按钮上点击触发的窗体最小化事件 **/
Private Sub btnMax_Click()
MainForm.Hide
Unload MainForm
MsgBox "程序已经最小化至托盘,随时听从您的差遣。", vbInformation, "后台运行提示"
End Sub
'/** 鼠标在最大化按钮上滑动触发的更换图片事件 **/
Private Sub btnMax_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With btnMax
'当鼠标未按下任何按键的时候
If Button = 0 Then
'判断鼠标是否在该控件上
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
'载入没有焦点时候的图
btnMax.Picture = LoadResPicture("btnmax1", 0)
Else
'反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
SetCapture .hwnd
'载入有焦点的图
btnMax.Picture = LoadResPicture("btnmax2", 0)
End If
End If
End With
End Sub
'/** 鼠标在关闭按钮上点击触发的更换图片事件 **/
Private Sub btnEnd_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
btnEnd.Picture = LoadResPicture("btnend3", 0)
End Sub
'/** 鼠标在关闭按钮上点击触发的窗体最小化事件 **/
Private Sub btnEnd_Click()
'卸载窗体 - 擦除窗体可视部分
LetExitMe
'如果不关闭就还原没有焦点的图
btnEnd.Picture = LoadResPicture("btnend1", 0)
End Sub
'/** 鼠标在关闭按钮上滑动触发的更换图片事件 **/
Private Sub btnEnd_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'用With限制仅仅捕获该指定控件的鼠标位置
With btnEnd
'当鼠标未按下任何按键的时候
If Button = 0 Then
'判断鼠标是否在该控件上
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
'载入没有焦点时候的图
btnEnd.Picture = LoadResPicture("btnend1", 0)
Else
'反之,如果鼠标在该控件上,那么捕获该鼠标和它的事件
SetCapture .hwnd
'载入有焦点的图
btnEnd.Picture = LoadResPicture("btnend2", 0)
End If
End If
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -