📄 frmmain.frm
字号:
Private Sub vsbSlide_Change()
picSlide.Top = -vsbSlide.Value
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
'close all sub forms
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", lvImage.View
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
Private Sub TreeView1_DragDrop(Source As Control, X As Single, Y As Single)
If Source = imgSplitter Then
SizeControls X
End If
End Sub
Sub SizeControls(X As Single)
On Error Resume Next
'设置 Width 属性
If X < 1500 Then X = 1500
If X > (Me.Width - 1500) Then X = Me.Width - 1500
tvTreeView.Width = X
imgSplitter.Left = X
sstabView.Left = X + 40
sstabView.Width = Me.Width - (tvTreeView.Width + 140)
lblTitle(0).Width = tvTreeView.Width
' lblTitle(1).Left = lvMerch.Left + 20
' lblTitle(1).Width = lvMerch.Width - 40
'设置 Top 属性
If tbToolBar.Visible Then
tvTreeView.Top = tbToolBar.Height + picTitles.Height
Else
tvTreeView.Top = picTitles.Height
End If
sstabView.Top = tvTreeView.Top - picTitles.Height
'设置 height 属性
If sbStatusBar.Visible Then
tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height + sbStatusBar.Height)
Else
tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
End If
sstabView.Height = tvTreeView.Height + picTitles.Height
imgSplitter.Top = picTitles.Top
imgSplitter.Height = tvTreeView.Height
'修改ListView控件尺寸
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is ListView Then
ctl.Left = 0
ctl.Top = sstabView.TabHeight
ctl.Width = sstabView.Width - 40
ctl.Height = sstabView.Height - sstabView.TabHeight
ctl.Visible = False
End If
Next
sstabView_Click 0
End Sub
Private Sub lvImage_DblClick()
mnuImageModify_Click
End Sub
Private Sub mnuImageSearch_Click()
frmImageSearch.Show
End Sub
'Private Sub mnu_Back_Click()
' frmStart.Show
'End Sub
Private Sub mnuListAViewMode_Click(Index As Integer)
picFrame.Visible = False
lvImage.View = lvwReport
End Sub
Private Sub mnuListViewBMode_Click(Index As Integer)
picFrame.Visible = False
lvImage.View = lvwIcon
End Sub
Private Sub mnuListViewMode_Click(Index As Integer)
picFrame.Visible = False
lvImage.View = lvwList
End Sub
Private Sub mnuListViewSLTMode_Click()
picFrame.Visible = True
CreateThumbs
End Sub
Private Sub mnuListViewSMode_Click(Index As Integer)
picFrame.Visible = False
lvImage.View = lvwSmallIcon
End Sub
Private Sub mnuSystemExit_Click()
Unload Me
End Sub
Private Sub mnuViewArrangeIcons_Click()
lvImage.Arrange = lvwAutoTop
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 属性页控件切换响应函数
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub sstabView_Click(PreviousTab As Integer)
Select Case PreviousTab
Case 0
lvImage.Visible = False
End Select
Select Case sstabView.Tab
Case 0
lvImage.Visible = True
lvImage.SetFocus
End Select
End Sub
'Private Sub mnuHelpAbout_Click()
' frmAbout.Show vbModal, Me
'End Sub
Private Sub mnuViewRefresh_Click()
'应做:添加 'mnuViewRefresh_Click' 代码。
lvImage.Refresh
End Sub
Private Sub mnuVAIByDate_Click()
'ToDo: 添加 'mnuVAIByDate_Click' 代码
' lvMerch.SortKey = DATE_COLUMN
End Sub
Private Sub mnuVAIByName_Click()
'ToDo: 添加 'mnuVAIByName_Click' 代码
' lvMerch.SortKey = NAME_COLUMN
End Sub
Private Sub mnuVAIBySize_Click()
'ToDo: 添加 'mnuVAIBySize_Click' 代码
' lvMerch.SortKey = SIZE_COLUMN
End Sub
Private Sub mnuVAIByType_Click()
'ToDo: 添加 'mnuVAIByType_Click' 代码
' lvMerch.SortKey = TYPE_COLUMN
End Sub
Private Sub mnuViewStatusBar_Click()
mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
sbStatusBar.Visible = mnuViewStatusBar.Checked
SizeControls imgSplitter.Left
End Sub
'Private Sub mnuViewToolbar_Click()
' mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
' tbToolBar.Visible = mnuViewToolbar.Checked
' SizeControls imgSplitter.Left
'End Sub
'初始化所有数据函数
Private Sub InitMain()
' InitMerchListview lvMerch '初始化列表
' ListAllMerchs lvMerch
TypeToTreeview tvTreeView '将类型显示到树型图中
' opProvider.FillListView lvProvider
opImage.FillListView lvImage
' opBuy.FillListView lvBuy
'
' opSell.FillListView lvSell
'
' opDispose.FillListView lvDispose
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 菜单响应函数
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'===============================================
' 商品类型操作
'===============================================
Private Sub mnuIType_Click()
'设置树型控件焦点
tvTreeView.SetFocus
End Sub
'添加
Private Sub mnuITypeAdd_Click()
opIType.Add tvTreeView
End Sub
'删除
Private Sub mnuITypeDel_Click()
opIType.Delete tvTreeView
End Sub
'修改
Private Sub mnuITypeModify_Click()
opIType.Modify tvTreeView
End Sub
''===============================================
''
''===============================================
'Private Sub mnuSystemUser_Click()
' frmUserList.Show vbModal
'End Sub
'===============================================
'===============================================
Private Sub mnuImage_Click()
'切换选项卡
sstabView.Tab = 0
End Sub
Private Sub mnuImageAdd_Click()
sstabView.Tab = 0
frmImage.cmdOpen.Visible = True
opImage.Add lvImage, GetID(tvTreeView.SelectedItem.Key)
End Sub
Private Sub mnuImageDel_Click()
sstabView.Tab = 0
frmImage.cmdOpen.Visible = False
opImage.Delete lvImage
End Sub
Private Sub mnuImageModify_Click()
sstabView.Tab = 0
frmImage.cmdOpen.Visible = False
opImage.Modify lvImage
End Sub
Private Sub tbToolBar_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
Select Case ButtonMenu.Key
Case "tbnAddClientType"
'mnuAddClientType_Click
Case "tbnModifyClientType"
'mnuModifyClientType_Click
Case "tbnDelClientType"
'mnuDelClientType_Click
Case "大图标"
lvImage.View = lvwIcon
Case "小图标"
lvImage.View = lvwSmallIcon
Case "列表"
lvImage.View = lvwList
Case "详细资料"
lvImage.View = lvwReport
End Select
End Sub
Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
opImage.FillListView lvImage, GetID(Node.Key)
If picFrame.Visible = True Then
mnuListViewSLTMode_Click
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -