📄 frmmain.frm
字号:
EndProperty
End
Begin TabDlg.SSTab sstabView
Height = 5370
Left = 2310
TabIndex = 6
Top = 1665
Width = 7185
_ExtentX = 12674
_ExtentY = 9472
_Version = 393216
Tabs = 1
TabsPerRow = 1
TabHeight = 520
TabMaxWidth = 2646
TabCaption(0) = "所有图像"
TabPicture(0) = "frmMain.frx":124AC
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "lvImage"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).Control(1)= "picFrame"
Tab(0).Control(1).Enabled= 0 'False
Tab(0).ControlCount= 2
Begin VB.PictureBox picFrame
BackColor = &H80000009&
BorderStyle = 0 'None
Height = 3885
Left = 930
ScaleHeight = 259
ScaleMode = 3 'Pixel
ScaleWidth = 381
TabIndex = 10
Top = 990
Width = 5715
Begin VB.VScrollBar vsbSlide
Height = 2520
Left = 5340
TabIndex = 14
Top = 135
Width = 345
End
Begin VB.PictureBox picSlide
BackColor = &H80000009&
BorderStyle = 0 'None
Height = 3465
Left = 180
ScaleHeight = 231
ScaleMode = 3 'Pixel
ScaleWidth = 283
TabIndex = 11
Top = 120
Width = 4245
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
Height = 2490
Index = 0
Left = 525
ScaleHeight = 166
ScaleMode = 3 'Pixel
ScaleWidth = 170
TabIndex = 12
Top = 270
Width = 2550
End
End
End
Begin MSComctlLib.ListView lvImage
Height = 4380
Left = 630
TabIndex = 7
Top = 720
Width = 6255
_ExtentX = 11033
_ExtentY = 7726
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
Icons = "imlViewBIcon"
SmallIcons = "imlViewSIcon"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
End
Begin VB.Image imgSplitter
Height = 4788
Left = 1965
MousePointer = 9 'Size W E
Top = 705
Width = 150
End
Begin VB.Menu mnuSystem
Caption = "系统"
Begin VB.Menu mnuSystemUser
Caption = "用户管理"
End
Begin VB.Menu mnu_Back
Caption = "返回"
End
Begin VB.Menu mnuSystemExit
Caption = "退出"
End
End
Begin VB.Menu mnuView
Caption = "视图"
Begin VB.Menu mnuViewStatusBar
Caption = "状态栏目"
Checked = -1 'True
End
Begin VB.Menu mnuViewBar0
Caption = "-"
End
Begin VB.Menu mnuListViewBMode
Caption = "大图标"
Index = 0
End
Begin VB.Menu mnuListViewSMode
Caption = "小图标"
Index = 1
End
Begin VB.Menu mnuListViewMode
Caption = "列表"
Index = 2
End
Begin VB.Menu mnuListAViewMode
Caption = "详细资料"
Index = 3
End
Begin VB.Menu mnuListViewSLTMode
Caption = "缩略图"
End
Begin VB.Menu mnuViewBar1
Caption = "-"
End
Begin VB.Menu mnuViewArrangeIcons
Caption = "排列图表"
End
Begin VB.Menu mnuViewBar2
Caption = "-"
End
Begin VB.Menu mnuViewRefresh
Caption = "刷新"
End
End
Begin VB.Menu mnuIType
Caption = "图像类型管理"
Begin VB.Menu mnuITypeAdd
Caption = "添加图像类型"
End
Begin VB.Menu mnuITypeModify
Caption = "修改图像类型"
End
Begin VB.Menu mnuITypeDel
Caption = "删除图像类型"
End
End
Begin VB.Menu mnuImage
Caption = "图像管理"
Begin VB.Menu mnuImageAdd
Caption = "添加图像"
End
Begin VB.Menu mnuImageModify
Caption = "修改图像信息"
End
Begin VB.Menu mnuImageDel
Caption = "删除图像信息"
End
Begin VB.Menu mnuImageSearch
Caption = "查找图像"
End
End
Begin VB.Menu mnuHelp
Caption = "帮助"
Begin VB.Menu mnuHelpAbout
Caption = "关于"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const NAME_COLUMN = 0
Const TYPE_COLUMN = 1
Const SIZE_COLUMN = 2
Const DATE_COLUMN = 3
Dim fso As New FileSystemObject
Dim sDirectory As String
Dim mbMoving As Boolean
Public ssDirectory As String
Const sglSplitLimit = 500
Private Declare Function StretchBlt Lib "GDI32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Sub Form_Load()
LoadResStrings Me
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
lvImage.View = Val(GetSetting(App.Title, "Settings", "ViewMode", "0"))
sDirectory = App.path & "\图像"
sDirectory = CheckPath(sDirectory)
If fso.FolderExists(sDirectory) = False Then
fso.CreateFolder (sDirectory)
End If
'初始化数据
Call InitMain
' filhidden.Pattern = "*.bmp;*.dib;*.rle;*.gif;*.jpg;*.wmf;*.emf;*.ico;*.cur"
picFrame.Visible = False
End Sub
Private Sub CreateThumbs()
Dim Index As Long
Dim lIdx As Long
Dim lFilCnt As Long
Dim sText As String, i As Integer
picSlide.Move 0, 0, Picture1(0).Width, Picture1(0).Height
picSlide.Visible = True
lFilCnt = lvImage.ListItems.Count
Set Picture1(0).Picture = LoadPicture
Picture1(0).Visible = False
If Picture1.Count > 1 Then
For i = 1 To Picture1.Count - 1
Unload Picture1(i)
Next
End If
For lIdx = 0 To lFilCnt - 1
If lIdx = 0 Then
Picture1(lIdx).Visible = True
Else
Load Picture1(lIdx)
Picture1(lIdx).Visible = True
End If
Next lIdx
Call FormResize
Dim objs As New clsImages
Dim rstObjs As clsImages
Dim obj As clsImage
Dim sFor As String
Dim sNam As String
DoEvents
For Index = 1 To lFilCnt
picload.Picture = LoadPicture
Picture1(Index - 1).Cls
'reSearch的参数取默认值，
Set rstObjs = objs.Research(lvImage.ListItems(Index))
'检查是否找到数据
If rstObjs Is Nothing Then
Exit Sub
End If
For i = 1 To rstObjs.Count
Set obj = rstObjs.Item(i)
Next i
sNam = lvImage.ListItems(Index).SubItems(1)
picload.Picture = LoadPicture(App.path & "\图像" & "\" & sNam & "\" & obj.IName)
StretchBlt Picture1(Index - 1).hdc, 0, 0, Picture1(Index - 1).ScaleWidth, Picture1(Index - 1).ScaleHeight, picload.hdc, 0, 0, picload.ScaleWidth, picload.ScaleHeight, vbSrcCopy
DoEvents
Next Index
Set picload.Picture = LoadPicture()
Set objs = Nothing
Set rstObjs = Nothing
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.Width < 3000 Then Me.Width = 3000
SizeControls imgSplitter.Left
End Sub
Private Sub FormResize()
Dim X As Long
Dim Y As Long
Dim lIdx As Long
Dim lCols As Long
picFrame.Move lvImage.Left + 50, lvImage.Top + 50, lvImage.Width - 100, lvImage.Height - 100
vsbSlide.Move picFrame.ScaleWidth - vsbSlide.Width, 0, vsbSlide.Width, picFrame.ScaleHeight
lCols = Int((picFrame.ScaleWidth - vsbSlide.Width) / Picture1(0).Width)
For lIdx = 0 To Picture1.Count - 1
X = (lIdx Mod lCols) * Picture1(0).Width
Y = Int(lIdx / lCols) * Picture1(0).Height
Picture1(lIdx).Move X, Y
Next lIdx
picSlide.Width = lCols * Picture1(0).Width
picSlide.Height = Int(Picture1.Count / lCols) * Picture1(0).Height
If Int(Picture1.Count / lCols) < (Picture1.Count / lCols) Then
picSlide.Height = picSlide.Height + Picture1(0).Height
End If
vsbSlide.Value = 0
vsbSlide.Max = picSlide.Height - picFrame.ScaleHeight
If vsbSlide.Max < 0 Then
vsbSlide.Max = 0
vsbSlide.Enabled = False
Else
vsbSlide.Enabled = True
vsbSlide.SmallChange = Picture1(0).Height
vsbSlide.LargeChange = picFrame.ScaleHeight
End If
' Picture2.Move (picFrame.Width - Picture2.Width) / 2, (picFrame.Height - Picture2.Height) / 2
End Sub
'Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'
' ReleaseCapture
' SendMessage Picture1.hWnd, WM_SYSCOMMAND, SC_MOVE, 0
'End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -