📄 frmlibsearch.frm
字号:
VERSION 5.00
Object = "{A8186061-FDC6-4940-AE0B-8C8084C4A138}#1.0#0"; "GridSupport.ocx"
Begin VB.Form frmLibSearch
BorderStyle = 3 'Fixed Dialog
Caption = "查找邮件"
ClientHeight = 5025
ClientLeft = 45
ClientTop = 435
ClientWidth = 6540
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmLibSearch.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5025
ScaleWidth = 6540
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton CmnImport
Caption = "导入"
Height = 345
Left = 5250
TabIndex = 12
Top = 4590
Width = 1215
End
Begin VB.PictureBox PictureAttach
BorderStyle = 0 'None
Height = 1695
Left = 90
ScaleHeight = 1695
ScaleWidth = 6315
TabIndex = 4
Top = 60
Width = 6315
Begin VB.ComboBox cboPath
Height = 315
Left = 300
TabIndex = 8
Top = 390
Width = 5445
End
Begin VB.CommandButton cmdPick
Caption = "..."
Height = 315
Left = 5790
TabIndex = 7
ToolTipText = "Pick Folder"
Top = 360
Width = 375
End
Begin VB.CheckBox chkRecurse
Caption = "&R包含下级目录"
Height = 195
Left = 300
TabIndex = 6
Top = 780
Width = 1605
End
Begin VB.ComboBox cboFileSpec
Height = 315
ItemData = "frmLibSearch.frx":000C
Left = 1230
List = "frmLibSearch.frx":0019
Style = 2 'Dropdown List
TabIndex = 5
Top = 1020
Width = 4905
End
Begin VB.Label lblInfo
Caption = "设置需要查找的目录."
Height = 195
Left = 300
TabIndex = 10
Top = 150
Width = 1695
End
Begin VB.Label lblFileSpec
Caption = "文件类型:"
Height = 255
Left = 240
TabIndex = 9
Top = 1050
Width = 825
End
End
Begin VB.PictureBox picPage
BorderStyle = 0 'None
Height = 2655
Index = 1
Left = 60
ScaleHeight = 2655
ScaleWidth = 6345
TabIndex = 1
TabStop = 0 'False
Top = 1830
Width = 6345
Begin GridSupport.GridSuport GridFile
Height = 2145
Left = 90
TabIndex = 11
Top = 360
Width = 6135
_ExtentX = 10821
_ExtentY = 3784
BackgroundPictureHeight= 0
BackgroundPictureWidth= 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
DisableIcons = -1 'True
End
Begin VB.TextBox txtFileName
BackColor = &H8000000F&
BorderStyle = 0 'None
Height = 435
Left = 0
MultiLine = -1 'True
TabIndex = 2
TabStop = 0 'False
Text = "frmLibSearch.frx":0039
Top = 3780
Width = 5535
End
Begin VB.Label lblSearching
Caption = "正在查找..."
Height = 255
Left = 90
TabIndex = 3
Top = 90
Width = 4875
End
End
Begin VB.CommandButton cmdNext
Caption = "&N开始查找>"
Default = -1 'True
Height = 345
Left = 4020
TabIndex = 0
Top = 4590
Width = 1215
End
End
Attribute VB_Name = "frmLibSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mlngMailBoxTag As Long
'********************************************************************************
'ContractContractFile 表格定义结构
Public Enum GridContractFileCol '合同条款文件
strFileNO = 1 ' 文件序号
strFileName ' 文件名称
strMemo ' 属性
strFileFullName ' 全文件名称
strPath ' 文件路径
End Enum
'********************************************************************************
Private WithEvents m_cBrowse As cBrowseForFolder
Attribute m_cBrowse.VB_VarHelpID = -1
Private m_bCancelFind As Boolean
Public m_cSysIls As ImageListClass.cSysImageList
Private m_lTime As Long
Private m_lFileCount As Long
Private Function DirectoryExists(ByVal sDir As String) As Boolean
On Error Resume Next
Dim s As String
s = Dir(sDir, vbDirectory)
If (Err.Number = 0) And Len(s) > 0 Then
DirectoryExists = True
End If
On Error GoTo 0
End Function
Private Sub startFind(lblSearching As Label)
' Clear old results:
GridFile.Clear
Dim strType As String
If UCase(cboFileSpec.Text) = UCase("*.eml") Then
strType = "eml"
ElseIf UCase(cboFileSpec.Text) = UCase("*.msg") Then
strType = "msg"
Else
strType = "all"
End If
If DirectoryExists(cboPath.Text) Then
If Trim(cboPath.Text) <> "" Then
Call MEnumFile.FillEnumGrid(cboPath.Text, (chkRecurse.value = 1), strType, lblSearching)
End If
Else
ShowMessageBoxEx "缺少搜索路径!", vbOKOnly, "提示"
Exit Sub
End If
End Sub
Private Sub cmdNext_Click()
startFind lblSearching
End Sub
Private Sub cmdPick_Click()
Dim sFolder As String
m_cBrowse.hwndOwner = Me.hwnd
m_cBrowse.Title = "Pick Folder"
m_cBrowse.EditBox = True
m_cBrowse.ValidateEditBox = True
m_cBrowse.UseNewUI = True
If Not (DirectoryExists(cboPath.Text)) Then
m_cBrowse.InitialDir = m_cBrowse.SpecialFolderLocation(CSIDL_PROGRAM_FILES)
Else
m_cBrowse.InitialDir = cboPath.Text
End If
sFolder = m_cBrowse.BrowseForFolder()
If Len(sFolder) > 0 Then
cboPath.Text = sFolder
End If
End Sub
Private Sub CmnImport_Click()
Dim i As Long
Dim lngRow As Long
If Not GridFile.Rows > 0 Then Exit Sub
ReDim strSelFileFullName(GridFile.SelectionCount)
For i = 1 To GridFile.SelectionCount
lngRow = GridFile.SelectedRowByIndex(i)
strSelFileFullName(i) = GridFile.CellText(lngRow, GridContractFileCol.strFileFullName)
Next i
Unload Me
End Sub
Private Sub Form_Load()
ReDim strSelFileFullName(0)
Set m_cSysIls = New ImageListClass.cSysImageList
m_cSysIls.ImageListIconSizeX = 16
m_cSysIls.CreateImageList
cboFileSpec.ListIndex = 1
ConfigGridFile
Set m_cBrowse = New cBrowseForFolder
End Sub
Private Sub m_cBrowse_ValidationFailed(ByVal sMsg As String, bKeepOpen As Boolean)
If (ShowMessageBoxEx(sMsg, vbQuestion Or vbRetryCancel) = vbCancel) Then
bKeepOpen = False
Else
bKeepOpen = True
End If
End Sub
'********************************************************************************
'创建GRID
Public Sub ConfigGridFile()
Dim iCol As Long
With GridFile
.Redraw = False
' .ImageList = m_cSysIls.hIml
.GridLines = True
.GridLineMode = GridSupport.ECGGridLineMode.ecgGridStandard ' ecgGridFillControl
.GridLineColor = vb3DShadow
.GroupRowBackColor = vbWindowBackground
.GroupRowForeColor = vbWindowText
.HighlightSelectedIcons = False
.RowMode = True
.Editable = True
.MultiSelect = True
.SingleClickEdit = False
.StretchLastColumnToFit = True
.AddColumn "strFileNO", "文件序号", eSortType:=GridSupport.CCLSortString, lColumnWidth:=40 '文件序号
.AddColumn "strFileName", "文件名称", eSortType:=GridSupport.CCLSortString, lColumnWidth:=150 '文件名称
.AddColumn "strMemo", "属性", eSortType:=GridSupport.CCLSortString, lColumnWidth:=100 '属性
.AddColumn "strFileFullName", , , , 0, False, True '文件名称
.AddColumn "strPath", "文件路径", eSortType:=GridSupport.CCLSortString, lColumnWidth:=128 '文件路径
.SetHeaders
.Rows = 1
.Redraw = True
End With
End Sub
'********************************************************************************
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -