frmmain.frm

一个客户系统,VB+SQL,其中有客户类型分类

      FlatScrollBar   =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      Icons           =   "imlViewBIcon"
      SmallIcons      =   "imlViewSIcon"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin MSComctlLib.TreeView tvTreeView 
      Height          =   4800
      Left            =   0
      TabIndex        =   5
      Top             =   705
      Width           =   2250
      _ExtentX        =   3969
      _ExtentY        =   8467
      _Version        =   393217
      HideSelection   =   0   'False
      Indentation     =   392
      LabelEdit       =   1
      LineStyle       =   1
      Style           =   7
      ImageList       =   "imlViewSIcon"
      Appearance      =   1
   End
   Begin VB.Image imgSplitter 
      Height          =   4785
      Left            =   2280
      MousePointer    =   9  'Size W E
      Top             =   705
      Width           =   150
   End
   Begin VB.Menu mnuAdmin 
      Caption         =   "系统管理"
      Begin VB.Menu mnuExit 
         Caption         =   "&X退出系统"
      End
   End
   Begin VB.Menu mnuView 
      Caption         =   "1000"
      Begin VB.Menu mnuViewToolbar 
         Caption         =   "1001"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewStatusBar 
         Caption         =   "1002"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuListViewMode 
         Caption         =   "1003"
         Index           =   0
      End
      Begin VB.Menu mnuListViewMode 
         Caption         =   "1004"
         Index           =   1
      End
      Begin VB.Menu mnuListViewMode 
         Caption         =   "1005"
         Index           =   2
      End
      Begin VB.Menu mnuListViewMode 
         Caption         =   "1006"
         Index           =   3
      End
      Begin VB.Menu mnuViewBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewArrangeIcons 
         Caption         =   "1007"
      End
      Begin VB.Menu mnuViewBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewRefresh 
         Caption         =   "1008"
      End
   End
   Begin VB.Menu mnuClientType 
      Caption         =   "客户类型管理"
      Begin VB.Menu mnuAddClientType 
         Caption         =   "&A添加客户类型"
      End
      Begin VB.Menu mnuModifyClientType 
         Caption         =   "&M修改客户类型"
      End
      Begin VB.Menu mnuDelClientType 
         Caption         =   "&D删除客户类型"
      End
   End
   Begin VB.Menu mnuClient 
      Caption         =   "客户管理"
      Begin VB.Menu mnuAddClient 
         Caption         =   "&A添加客户"
      End
      Begin VB.Menu mnuModifyClient 
         Caption         =   "&M修改客户"
      End
      Begin VB.Menu mnuDelClient 
         Caption         =   "&D删除客户"
      End
      Begin VB.Menu mnuSplit1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuSearchClient 
         Caption         =   "&S查找客户"
      End
      Begin VB.Menu mnuSplit2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuClientInfo 
         Caption         =   "&I查看客户详细信息"
      End
   End
   Begin VB.Menu mnuWarning 
      Caption         =   "提醒管理"
      Begin VB.Menu mnuShowWarn 
         Caption         =   "&T查看今日提醒"
      End
      Begin VB.Menu mnuSplitter3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuWarnSetting 
         Caption         =   "&S查看提醒设置"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "1011"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "1012"
      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 mbMoving As Boolean
Const sglSplitLimit = 500


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)
  
  lvListView.View = Val(GetSetting(App.Title, "Settings", "ViewMode", "0"))
  
  '初始化数据
  Call InitMain
  '显示今日提醒，并设为可隐藏
  frmTip.ShowWarn Me, True
  
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", lvListView.View
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 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
  lvListView.Left = X + 40
  lvListView.Width = Me.Width - (tvTreeView.Width + 140)
  lblTitle(0).Width = tvTreeView.Width
  lblTitle(1).Left = lvListView.Left + 20
  lblTitle(1).Width = lvListView.Width - 40

  '设置 Top 属性
  
  If tbToolBar.Visible Then
    tvTreeView.Top = tbToolBar.Height + picTitles.Height
  Else
    tvTreeView.Top = picTitles.Height
  End If

  lvListView.Top = tvTreeView.Top
  
  '设置 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
  
  lvListView.Height = tvTreeView.Height
  imgSplitter.Top = tvTreeView.Top
  imgSplitter.Height = tvTreeView.Height
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
  On Error Resume Next
  Select Case Button.Key
    Case "tbnClientType"
    Case "tbnAddClient"
      mnuAddClient_Click
    Case "tbnModifyClient"
      mnuModifyClient_Click
    Case "tbnDelClient"
      mnuDelClient_Click
    Case "tbnClientInfo"
      mnuClientInfo_Click
    Case "tbnSearchClient"
      mnuSearchClient_Click
    Case "tbnWarn"
      mnuShowWarn_Click
    Case "tbnWarnSetting"
      mnuWarnSetting_Click
    Case "tbnViewStyle"
    Case "tbnExit"
      mnuExit_Click
  End Select
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 "大图标"
      lvListView.View = lvwIcon
    Case "小图标"
      lvListView.View = lvwSmallIcon
    Case "列表"
      lvListView.View = lvwList
    Case "详细资料"
      lvListView.View = lvwReport
  End Select
  
End Sub

Private Sub mnuHelpAbout_Click()
  frmAbout.Show vbModal, Me
End Sub

Private Sub mnuToolsOptions_Click()
  frmOptions.Show vbModal, Me
End Sub

Private Sub mnuViewRefresh_Click()
  '应做:添加 'mnuViewRefresh_Click' 代码。
  MsgBox "添加 'mnuViewRefresh_Click' 代码。"
End Sub

Private Sub mnuVAIByDate_Click()
  'ToDo: 添加 'mnuVAIByDate_Click' 代码
'  lvListView.SortKey = DATE_COLUMN
End Sub

Private Sub mnuVAIByName_Click()
  'ToDo: 添加 'mnuVAIByName_Click' 代码
'  lvListView.SortKey = NAME_COLUMN
End Sub

Private Sub mnuVAIBySize_Click()
  'ToDo: 添加 'mnuVAIBySize_Click' 代码
'  lvListView.SortKey = SIZE_COLUMN
End Sub

Private Sub mnuVAIByType_Click()
  'ToDo: 添加 'mnuVAIByType_Click' 代码
'  lvListView.SortKey = TYPE_COLUMN