⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.frm

📁 利用VB和ACESS联合制作的一个人事和物品管理系统
💻 FRM
📖 第 1 页 / 共 3 页
字号:
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 + -