frmmain.frm

一个简单进销存系统

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain 
   Caption         =   "进销存"
   ClientHeight    =   7680
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   10125
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   7680
   ScaleWidth      =   10125
   StartUpPosition =   3  '窗口缺省
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   2160
      Top             =   2640
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   48
      ImageHeight     =   48
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   5
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":08CA
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0EA7
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":4339
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":5213
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":60ED
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   1110
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   10125
      _ExtentX        =   17859
      _ExtentY        =   1958
      ButtonWidth     =   1455
      ButtonHeight    =   1799
      Appearance      =   1
      ImageList       =   "ImageList1"
      DisabledImageList=   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   4
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "入库"
            Key             =   "入库"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "销售"
            Key             =   "销售"
            ImageIndex      =   3
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "查看库存"
            Key             =   "查看库存"
            ImageIndex      =   4
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退货处理"
            ImageIndex      =   5
         EndProperty
      EndProperty
      BorderStyle     =   1
   End
   Begin MSComDlg.CommonDialog dlgCommonDialog 
      Left            =   1800
      Top             =   3600
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSComctlLib.StatusBar sbStatusBar 
      Align           =   2  'Align Bottom
      Height          =   270
      Left            =   0
      TabIndex        =   0
      Top             =   7410
      Width           =   10125
      _ExtentX        =   17859
      _ExtentY        =   476
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   3
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   12224
            Text            =   "状态"
            TextSave        =   "状态"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            AutoSize        =   2
            TextSave        =   "2008-04-15"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   5
            AutoSize        =   2
            TextSave        =   "21:25"
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuFile 
      Caption         =   "库存(&K)"
      Begin VB.Menu mnuFileNew 
         Caption         =   "入库(&R)"
         Shortcut        =   ^R
      End
      Begin VB.Menu mnuFileBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuSale 
         Caption         =   "发货单(&F)"
         Shortcut        =   ^F
      End
      Begin VB.Menu mnuFileBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileMRU 
         Caption         =   ""
         Index           =   1
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileMRU 
         Caption         =   ""
         Index           =   2
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileMRU 
         Caption         =   ""
         Index           =   3
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileBar4 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu show 
      Caption         =   "查看(&S)"
      Begin VB.Menu mnuShowBase 
         Caption         =   "查看库存"
      End
      Begin VB.Menu mnuShowIncome 
         Caption         =   "查看进货单"
      End
      Begin VB.Menu mnuShowSend 
         Caption         =   "查看、补打发货单"
      End
   End
   Begin VB.Menu mnuSystem 
      Caption         =   "系统"
      Begin VB.Menu mnuClear 
         Caption         =   "清库"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpContents 
         Caption         =   "目录(&C)"
      End
      Begin VB.Menu mnuHelpSearchForHelpOn 
         Caption         =   "搜索帮助主题(&S)..."
      End
      Begin VB.Menu mnuHelpBar0 
         Caption         =   "-"
      End
      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

Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

Private dlgIncomeOne As New dlgIncome
Private dlgSaleOne As New dlgSale

Private Sub mnuClear_Click()
    '清库代码
    If MsgBox("当前功能将彻底清空清据，并且无法恢复，是否要继续操作?", vbYesNo) <> vbYes Then
            Exit Sub
    End If
    pubConn.Execute "delete * from Income"
    pubConn.Execute "delete * from sale"
    pubConn.Execute "delete * from stock"
    pubConn.Close
    DBEngine.CompactDatabase App.Path & "\data.mdb", App.Path & "\temp.mdb", , , ";pwd=13623290828"
    Kill App.Path & "\data.mdb"
    FileCopy App.Path & "\temp.mdb", App.Path & "\data.mdb"
    Kill App.Path & "\temp.mdb"
    Dim strSQl As String
    strSQl = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data.mdb" & ";Jet OLEDB:Database Password=13623290828;"
    pubConn.Open strSQl, "admin", ""

    'DBEngine.CompactDatabase Location, App.Path & "\data.mdb", , , ";pwd=13623290828"
End Sub

Private Sub mnuShowIncome_Click()
    '显示进货单
    Dim dlgShowIncome1 As New dlgShowIncome
    Dim rsSaleMain As New ADODB.Recordset
    rsSaleMain.CursorLocation = adUseClient
    strSQl = "select DISTINCT(编号),日期 from income order by 编号"
    rsSaleMain.Open strSQl, pubConn, adOpenDynamic, adLockReadOnly
    If rsSaleMain.RecordCount = 0 Then
        MsgBox "进货单为空！"
        rsSaleMain.Close
        Exit Sub
    End If
    
    dlgShowIncome1.show vbModal

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "销售"
            mnuSale_Click
        Case "入库"
            mnuFileNew_Click
        Case "查看库存"
            mnuShowBase_Click
        Case Else
            MsgBox "该功能还没有完成"
    End Select
End Sub

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)
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
End Sub

Private Sub mnuHelpAbout_Click()
    MsgBox "版本 " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else

    On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub

Private Sub mnuHelpContents_Click()
    Dim nRet As Integer

    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub


Private Sub mnuFileExit_Click()
    '卸载窗体
    Unload Me

End Sub

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



Private Sub mnuFileOpen_Click()
    Dim sFile As String


    With dlgCommonDialog
        .DialogTitle = "打开"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "所有文件 (*.*)|*.*"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    'ToDo: 添加处理打开的文件的代码

End Sub

Private Sub mnuFileNew_Click()
    '应做:添加 入库 代码。
    If IsEmpty(dlgIncomeOne) Then
        Load dlgIncomeOne
        dlgIncomeOne.show 0, Me
    Else
        If dlgIncomeOne.Visible = True Then
            MsgBox "已有输入窗口显示！", vbCritical, "提示"
        Else
            dlgIncomeOne.show 0, Me
        End If
    End If
End Sub

Private Sub mnuSale_Click()
    If dlgSaleOne.Visible = False Then
        dlgSaleOne.show 0, Me
    Else
        MsgBox "已有发货窗口显示！", vbCritical, "提示"
    End If

End Sub

Private Sub mnuShowBase_Click()
    Dim dlgStock As New dlgShowBase
    dlgStock.show vbModal
End Sub

Private Sub mnuShowSend_Click()
    Dim dlgShowSaleOne As New dlgShowSale
    Dim rsSaleMain As New ADODB.Recordset
    rsSaleMain.CursorLocation = adUseClient
    strSQl = "select DISTINCT(编号),收货支数,日期 from sale order by 编号"
    rsSaleMain.Open strSQl, pubConn, adOpenDynamic, adLockReadOnly
    If rsSaleMain.RecordCount = 0 Then
        MsgBox "发货单为空！"
        rsSaleMain.Close
        Exit Sub
    End If

    
    dlgShowSaleOne.show vbModal
End Sub