📄 frmmain.frm
字号:
End
Begin VB.Menu mnuWindowBar0
Caption = "-"
End
Begin VB.Menu MnuViewMain
Caption = "查看图标(&V)"
Begin VB.Menu MnuView
Caption = "显示大图标(&G) "
Index = 0
Shortcut = +{F1}
End
Begin VB.Menu MnuView
Caption = "显示小图标(&M) "
Index = 1
Shortcut = +{F2}
End
Begin VB.Menu MnuView
Caption = "显示列表(&L)"
Index = 2
Shortcut = +{F3}
End
Begin VB.Menu MnuView
Caption = "显示详细资料(&D) "
Index = 3
Shortcut = +{F4}
End
End
Begin VB.Menu mnuViewBar1
Caption = "-"
End
Begin VB.Menu mnuArrangeIcon
Caption = "排列图标(&A)"
Begin VB.Menu MnuArrangSort
Caption = "按名称排列(&N) "
Index = 0
Shortcut = +{F5}
End
Begin VB.Menu MnuArrangSort
Caption = "按大小排列(&S)"
Index = 1
Shortcut = +{F6}
End
Begin VB.Menu MnuArrangSort
Caption = "按类型排列(&T)"
Index = 2
Shortcut = +{F7}
End
Begin VB.Menu MnuArrangSort
Caption = "按日期排列(&D)"
Index = 3
Shortcut = +{F8}
End
Begin VB.Menu mnuFileBar5
Caption = "-"
End
Begin VB.Menu MnuArrangSortAuto
Caption = "按升序排列(&A)"
Shortcut = +{F11}
End
Begin VB.Menu MnuArrangSortAutoZ
Caption = "按降序排列(&E)"
Shortcut = +{F12}
End
Begin VB.Menu Line0002
Caption = "-"
End
Begin VB.Menu mnuArrangeFileIcon
Caption = "自动排列图标(&U)"
Checked = -1 'True
End
End
Begin VB.Menu mnuFileBar0
Caption = "-"
End
Begin VB.Menu mnuEditCopy
Caption = "复制(&C)"
Enabled = 0 'False
Shortcut = ^C
End
Begin VB.Menu MnuLine0002
Caption = "-"
End
Begin VB.Menu mnuEditCopyTo
Caption = "复制到(&T)..."
Enabled = 0 'False
Shortcut = ^T
End
Begin VB.Menu mnuEditMove
Caption = "移动到(&M)..."
Enabled = 0 'False
Shortcut = ^M
End
Begin VB.Menu mnuViewBar2
Caption = "-"
End
Begin VB.Menu MnuClearClipboard
Caption = "清除 Clipboard"
Enabled = 0 'False
End
Begin VB.Menu mnuFileDelete
Caption = "删除(&D)"
Enabled = 0 'False
Shortcut = {DEL}
End
Begin VB.Menu mnuFileRename
Caption = "重命名(&N)"
Enabled = 0 'False
End
Begin VB.Menu mnuEditBar1
Caption = "-"
End
Begin VB.Menu MnuRefreshDir
Caption = "刷新目录(&D)"
Shortcut = {F4}
End
Begin VB.Menu mnuViewRefresh
Caption = "刷新列表(&F)"
Shortcut = {F5}
End
Begin VB.Menu MnuLine0003
Caption = "-"
End
Begin VB.Menu MnuFileAttribute
Caption = "属性(&R)"
Shortcut = ^{F12}
End
End
Begin VB.Menu mnuWindow
Caption = "窗口(&W)"
WindowList = -1 'True
Begin VB.Menu mnuDisplayPictureViewWindow
Caption = "图片查看窗口(&V) ..."
End
Begin VB.Menu mnuViewBar0
Caption = "-"
End
Begin VB.Menu MnuMemdiaPlay
Caption = "飞龙VCD播放器 (&M) ..."
End
Begin VB.Menu mnuViewWebBrowser
Caption = "超文本浏览器 (&W) ..."
End
End
Begin VB.Menu mnuHelp
Caption = "帮助(&H)"
Begin VB.Menu mnuHelpContents
Caption = "目录(&C)"
End
Begin VB.Menu mnuHelpSearchForHelpOn
Caption = "搜索帮助主题(&S)..."
End
Begin VB.Menu mnuHelpBar0
Caption = "-"
End
Begin VB.Menu mnuHelpAbout
Caption = "关于(&A) "
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义工具栏开始号
Const View_Number = 14
Const Display_Number = 22
Const Printer_Number = 12
Const Copy_Number = 7
Const sglSplitLimit = 50
Const PD_PRINTSETUP = &H40
Dim OldShowSize As Integer '显示大小
Dim mbMoving As Boolean, UndoK As Boolean, DisplayTrue As Boolean
Dim mlNextClipboardViewer As Long
Dim OldName As String
Dim OldItem As String, NewItem As String
'定义源文件与目标文件
Public SourceFile As String
Public TargetFile As String
Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hWnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Private Declare Function ShellExecuteEx Lib "shell32" (lpSEI As SHELLEXECUTEINFO) As Long
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hWnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Sub AudioDisplay_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
PopupMenu MnuVideo
End If
End Sub
Private Sub AudioDisplay_OpenComplete()
AudioDisplay.Visible = True
If AudioDisplay.Width >= picDisplay.Width Then
AudioDisplay.Left = 0
Else
AudioDisplay.Left = (picDisplay.Width - AudioDisplay.Width) / 2
End If
If AudioDisplay.Height >= picDisplay.Height Then
AudioDisplay.Top = 0
Else
AudioDisplay.Top = (picDisplay.Height - AudioDisplay.Height) / 2
End If
lvListView.SetFocus
End Sub
Private Sub AudioDisplay_StateChange(ByVal oldState As Long, ByVal newState As Long)
If AudioDisplay.CurrentState = amvRunning Then '运行时无效
tbToolBar.Buttons(4).Enabled = False
MnuVideoPlay.Enabled = False
MnuVideoPause.Enabled = True
MnuVideoStop.Enabled = True
Else
tbToolBar.Buttons(4).Enabled = True
MnuVideoPlay.Enabled = True
MnuVideoPause.Enabled = False
MnuVideoStop.Enabled = False
End If
End Sub
Private Sub Form_Activate()
If Not tvTreeView.bLoaded Then
tvTreeView.Init
End If
'fPath$ = "C:\" '调试用
'vbGetFileList
mlNextClipboardViewer = SetClipboardViewer(Me.hWnd)
If DisplayTrue = False Then
Call mnuView_Click(Val(GetSetting(App.Title, "Settings", "ViewMode", 0)))
Call mnuViewRefresh_Click
DisplayTrue = True
End If
End Sub
Private Sub Form_Load()
'安装数据
IniData '初始化数据
picDisplay.Left = tvTreeView.Left
imgSplitter2.Left = picDisplay.Left
imgSplitter2.Width = imgSplitter.Left
SubClass Me
Me.Show
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnSubClass Me
Call ChangeClipboardChain(Me.hWnd, mlNextClipboardViewer)
'Dim i As Integer '卸载所有子窗体
'For i = Forms.Count - 1 To 1 Step -1
' Unload Forms(i)
'Next
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
SaveSetting App.Title, "Settings", "ViewMode", lvListView.View
SaveSetting App.Title, "Settings", "Position", imgSplitter.Left
SaveSetting App.Title, "Settings", "HPosition", imgSplitter2.Top
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.WindowState = 1 Then Exit Sub '最小化时退出
If Me.Width < 5000 Then Me.Width = 5000
SizeControls imgSplitter2.Width
SizeControlsH imgSplitter2.Top
End Sub
Private Sub GifView_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
lvListView.SetFocus
End Sub
Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
With imgSplitter
picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
End With
picSplitter.Visible = True
mbMoving = True
End Sub
Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sglPos As Single
If mbMoving Then
sglPos = X + imgSplitter.Left
If sglPos < sglSplitLimit Then
picSplitter.Left = sglSplitLimit
ElseIf sglPos > Me.Width - sglSplitLimit Then
picSplitter.Left = Me.Width - sglSplitLimit
Else
picSplitter.Left = sglPos
End If
End If
End Sub
Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
SizeControls picSplitter.Left
picSplitter.Visible = False
mbMoving = False
End Sub
Sub SizeControls(X As Single)
On Error Resume Next
'设置 Width 属性
If X < 2500 Then X = 2500
If X > (Me.Width - 2500) Then X = Me.Width - 2500
tvTreeView.Width = X
imgSplitter2.Width = X '垂直条
picDisplay.Width = X '预览区
imgSplitter.Left = X + 60
lvListView.Left = X + 150
lvListView.Width = Me.Width - (tvTreeView.Width + 280)
picTitles.Left = lvListView.Left
picTitles.Width = lvListView.Width
If tbToolBar.Visible Then
tvTreeView.Top = tbToolBar.Height
picTitles.Top = tbToolBar.Height
Else
tvTreeView.Top = 0
picTitles.Top = 0
End If
lvListView.Top = tvTreeView.Top + picTitles.Height
If sbStatusBar.Visible Then
lvListView.Height = Me.ScaleHeight - (picTitles.Height + picTitles.Top) - sbStatusBar.Height
Else
lvListView.Height = Me.ScaleHeight - (picTitles.Height + picTitles.Top)
End If
imgSplitter.Top = tvTreeView.Top
imgSplitter.Height = lvListView.Height + picTitles.Height
DisplayPath.Width = lvListView.Width
End Sub
Private Sub imgSplitter2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
With imgSplitter2
picSplitter2.Move .Left, .Top, .Width, .Height \ 2
End With
picSplitter2.Visible = True
mbMoving = True
End Sub
Private Sub imgSplitter2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sglPosL As Single
If mbMoving Then
sglPosL = Y + imgSplitter2.Top
If sglPosL < sglSplitLimit Then
picSplitter2.Top = sglSplitLimit
ElseIf sglPosL > Me.Height - sglSplitLimit Then
picSplitter2.Top = Me.Height - sglSplitLimit
Else
picSplitter2.Top = sglPosL
End If
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -