frmmain.frm

VB数据库设计的代码。需要根据自己的数据库再作调整

      End
      Begin VB.Menu mnuViewBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuMemberShopList 
         Caption         =   "成员店列表(&S)"
      End
      Begin VB.Menu mnuOpUserList 
         Caption         =   "操作员列表(&O)"
      End
      Begin VB.Menu mnuKindList 
         Caption         =   "商品类别列表(&K)"
      End
      Begin VB.Menu mnuMerchandiseList 
         Caption         =   "商品列表(&M)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于(&A) "
      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()
    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)
    
    '菜单可用状态初始化
    SetMenuEnable
    
    '左侧TreeView初始化
    IniTreeView Me.tvTreeView
    
    '右侧显示连锁店列表
    IniListViewInMemberShop Me.lvListView
End Sub


Private Sub Form_Paint()
    lvListView.View = Val(GetSetting(App.Title, "Settings", "ViewMode", "0"))
    Select Case lvListView.View
        Case lvwIcon
            tbToolBar.Buttons(LISTVIEW_MODE0).Value = tbrPressed
        Case lvwSmallIcon
            tbToolBar.Buttons(LISTVIEW_MODE1).Value = tbrPressed
        Case lvwList
            tbToolBar.Buttons(LISTVIEW_MODE2).Value = tbrPressed
        Case lvwReport
            tbToolBar.Buttons(LISTVIEW_MODE3).Value = tbrPressed
    End Select
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

'***********************************************************************
'* 过程名：mnuAllowInput_Click
'* 功  能：核准菜单事件响应
'* 参  数：
'* 版  本：2006.01.04 颜志军 初版
'***********************************************************************
Private Sub mnuAllowInput_Click()
    EditApply Me.lvListView
End Sub

'***********************************************************************
'* 过程名：mnuAppendInputApply_Click
'* 功  能：提交补货申请菜单事件响应
'* 参  数：
'* 版  本：2006.01.03 颜志军 初版
'***********************************************************************
Private Sub mnuAppendInputApply_Click()
    AppendNewApply Me.lvListView
End Sub

'***********************************************************************
'* 过程名：mnuAppendNewMerchandise_Click
'* 功  能：追加新商品菜单事件响应
'* 参  数：
'* 版  本：2006.01.03 颜志军 初版
'***********************************************************************
Private Sub mnuAppendNewMerchandise_Click()
    AppendMerchandise Me.lvListView
    IniTreeView Me.tvTreeView
End Sub

'***********************************************************************
'* 过程名：mnuAppendNewMerchandiseKind_Click
'* 功  能：追加新商品类别菜单事件响应
'* 参  数：
'* 版  本：2006.01.03 颜志军 初版
'***********************************************************************
Private Sub mnuAppendNewMerchandiseKind_Click()
    AppendMerchandiseKind Me.lvListView
    IniTreeView Me.tvTreeView
End Sub

'***********************************************************************
'* 过程名：mnuAppendNewOpMan_Click
'* 功  能：追加新联系人菜单事件响应
'* 参  数：
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Private Sub mnuAppendNewOpMan_Click()
    AppendNewUser Me.lvListView
End Sub

'***********************************************************************
'* 过程名：mnuAppendNewShop_Click
'* 功  能：追加新店菜单事件响应
'* 参  数：
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Private Sub mnuAppendNewShop_Click()
    AppendNewShop Me.lvListView
End Sub

'***********************************************************************
'* 过程名：mnuDatabaseConn_Click
'* 功  能：数据库连接参数设定菜单事件响应
'* 参  数：
'* 版  本：2006.01.06 颜志军 初版
'***********************************************************************
Private Sub mnuDatabaseConn_Click()
    frmDatabaseConnInfo.Show vbModal
End Sub

'***********************************************************************
'* 过程名：mnuDayReportQuery_Click
'* 功  能：日报统计查询菜单事件响应
'* 参  数：
'* 版  本：2006.01.06 颜志军 初版
'***********************************************************************
Private Sub mnuDayReportQuery_Click()
    Dim shopId As Integer
    Dim selDate As Date
    Dim buttonSel As UserClickButton
    
    frmQueryReport.Show vbModal
    shopId = frmQueryReport.g_ShopId
    selDate = frmQueryReport.g_QueryDate
    buttonSel = frmQueryReport.g_ButtonSel
    
    If buttonSel = QUERYBUTTON Then
        DspDayReport Me.lvListView, shopId, selDate
    ElseIf buttonSel = PREPRINTBUTTON Then
        PrePrintDayReport Me.lvListView, shopId, selDate
    ElseIf buttonSel = PRINTBUTTON Then
        PrintDayReport Me.lvListView, shopId, selDate
    End If
    
    Unload frmQueryReport
End Sub

'***********************************************************************
'* 过程名：mnuDeleteDayReport_Click
'* 功  能：删除日报条目菜单事件响应
'* 参  数：
'* 版  本：2006.01.03 颜志军 初版
'***********************************************************************
Private Sub mnuDeleteDayReport_Click()
    RemoveDayReport Me.lvListView
End Sub

'***********************************************************************
'* 过程名：mnuDeleteInputApply_Click
'* 功  能：删除补货申请菜单事件响应
'* 参  数：
'* 版  本：2006.01.03 颜志军 初版
'***********************************************************************
Private Sub mnuDeleteInputApply_Click()
    RemoveApply Me.lvListView
End Sub

'***********************************************************************
'* 过程名：mnuDeleteMerchandise_Click
'* 功  能：删除商品菜单事件响应
'* 参  数：
'* 版  本：2006.01.03 颜志军 初版
'***********************************************************************
Private Sub mnuDeleteMerchandise_Click()
    RemoveMerchandise Me.lvListView
    IniTreeView Me.tvTreeView
End Sub

'***********************************************************************
'* 过程名：mnuDeleteMerchandiseKind_Click
'* 功  能：删除商品类别菜单事件响应
'* 参  数：
'* 版  本：2006.01.03 颜志军 初版
'***********************************************************************
Private Sub mnuDeleteMerchandiseKind_Click()
    RemoveMerchandiseKind Me.lvListView
    IniTreeView Me.tvTreeView
End Sub

'***********************************************************************
'* 过程名：mnuDeleteOpMan_Click
'* 功  能：删除操作员菜单事件响应
'* 参  数：
'* 版  本：2006.01.01 颜志军 初版
'***********************************************************************
Private Sub mnuDeleteOpMan_Click()
    RemoveOpUser Me.lvListView
End Sub

'***********************************************************************
'* 过程名：mnuDeleteShop_Click
'* 功  能：删除连锁店菜单事件响应
'* 参  数：
'* 版  本：2006.01.02 颜志军 初版