frmmain.frm

收银机库存销售管理程序

Private Sub cmdChangeUser_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("       Change User", frmMain.cmdChangeUser, 0, 0, 170, 30, frmLogin.Source, 182, 30, 2)
End Sub

Private Sub cmdChangeUser_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("       Change User", frmMain.cmdChangeUser, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
End Sub

Private Sub cmdShutdown_Click()
    'UnloadAllForms
    Call DoExitWindows
End Sub

Private Sub cmdShutdown_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("         Shutdown", frmMain.cmdShutdown, 0, 0, 170, 30, frmLogin.Source, 182, 30, 2)
End Sub

Private Sub cmdShutdown_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("         Shutdown", frmMain.cmdShutdown, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
End Sub


Private Sub Form_Load()
    Dim VolName As String, fSys As String
    Dim Drive As String, DriveType As Long, erg As Long
    Dim OSInfo As OSVERSIONINFO
        OSInfo.dwOSVersionInfoSize = Len(OSInfo)
        Call GetVersionEx(OSInfo)
        mIsWin32 = (OSInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS)
        tmrUpdate_Timer
        tmrUpdate.Enabled = True
    sDriveLetter = "C:\"
    nReturnValue = GetDiskFreeSpace(sDriveLetter, SectorsPerCluster, BytesPerSector, FreeClusters, TotalClusters)
    If nReturnValue = "0" Then
        txtLabel = ""
        txtFsys = ""
        txtDriveType = ""
        txtFreeSpace = ""
        txtDiskSize = ""
        txtUsedKB = ""
        'lblFree.Visible = False
        'lblTotal.Visible = False
        'lblUsed.Visible = False
   Else
        VolName = Space(127)
        fSys = Space(127)
        Drive = sDriveLetter
        DriveType& = GetDriveType(Drive$)
        'erg& = GetVolumeInformation(Drive$, VolName$, 127, 0, 0, 0, fSys, 127)
        txtLabel = VolName$
        txtFsys = fSys$
    Select Case DriveType
        Case 1:
            txtDriveType = "Unknown"
        Case 2:
            txtDriveType = "Removable"
        Case 3:
            txtDriveType = "Fixed"
        Case 4:
            txtDriveType = "Remote"
        Case 5:
            txtDriveType = "CD-Rom"
        Case 6:
            txtDriveType = "RAMdisk"
        Case Else:
            txtDriveType = "*ERROR*"
    End Select
    intDiskSize = SectorsPerCluster * BytesPerSector * (TotalClusters \ 1024) \ 1024
    intfreeKB = SectorsPerCluster * BytesPerSector * (FreeClusters \ 1024) \ 1024
    intUsedKB = intDiskSize - intfreeKB
    If intDiskSize > 1024 Then
       intDiskSize = Format((intDiskSize / 1024), "##,##0.00")
       lblTotal = "Gigabytes"
       lblTotal.Visible = True
     Else
       lblTotal = "MBytes"
       lblTotal.Visible = True
    End If
    
    If intfreeKB > 1024 Then
       intfreeKB = Format((intfreeKB / 1024), "##,##0.00")
       lblFree = "Gigabytes"
       lblFree.Visible = True
     Else
       lblFree = "MBytes"
       lblFree.Visible = True
    End If
    If intUsedKB > 1024 Then
       intUsedKB = Format((intUsedKB / 1024), "##,##0.00")
       lblUsed = "Gigabytes"
       lblUsed.Visible = True
     Else
       lblUsed = "MBytes"
       lblUsed.Visible = True
    End If
    txtUsedKB = intUsedKB
    txtFreeSpace = intfreeKB
    txtDiskSize = intDiskSize
  End If
    Call ColForm(BoxContainer, 217, 211, 213, 125)
    Call ColForm(MenuContainer, 217, 211, 213, 125)
    Call ColForm(Applets, 217, 211, 213, 125)
    Call CreateMacOSTitleBar(titleBar, " Point-of-Sales System 2000-Pharmaceutical Version ")
    Call CreateMacOSTitleBar(MenuHeader, " Main Menu ")
    Call MacButton("       Change User", frmMain.cmdChangeUser, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
    Call MacButton("            About", frmMain.cmdAbout, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
    Call MacButton("         Shutdown", frmMain.cmdShutdown, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
    Call BitBlt(frmMain.Closed.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 107, SRCCOPY)
    frmMain.Closed.Refresh
    Call BitBlt(frmMain.Maximized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 72, SRCCOPY)
    frmMain.Maximized.Refresh
    Call BitBlt(frmMain.Minimized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 124, SRCCOPY)
    frmMain.Minimized.Refresh
    KeyPreview = True
    StatusMessage.Caption = " Today is " + Date$
    Set datsecondary = frmLogin.db.OpenRecordset("select * from INVOICE order by INVOICE_NO")
    Set datthirdary = frmLogin.db.OpenRecordset("select * from INVOICE_DETAIL order by INVOICE_NOD")
    Set datprimary = frmLogin.db.OpenRecordset("select * from SETUP order by COMPANY_NAME")
End Sub

Public Sub Operation_CleanUp()
    'On Error Resume Next
    If datsecondary.RecordCount <> 0 Then
        datsecondary.MoveFirst
        Do While Not datsecondary.EOF
            datsecondary.Delete
            datsecondary.MoveNext
        Loop
    End If
    If datthirdary.RecordCount <> 0 Then
        datthirdary.MoveFirst
        Do While Not datthirdary.EOF
            datthirdary.Delete
            datthirdary.MoveNext
        Loop
    End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    Dim AltDown
    AltDown = (Shift And vbAltMask) > 0
    Select Case KeyCode
        Case vbKeyEscape:
                UnloadAllForms
                End
        Case vbKeyC:
                If AltDown Then
                    Call MacButton("       Change User", frmMain.cmdChangeUser, 0, 0, 170, 30, frmLogin.Source, 182, 30, 2)
                    cmdChangeUser_Click
                    Call MacButton("       Change User", frmMain.cmdChangeUser, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
                End If
        Case vbKeyA:
                If AltDown Then
                    Call MacButton("            About", frmMain.cmdAbout, 0, 0, 170, 30, frmLogin.Source, 182, 30, 2)
                    cmdAbout_Click
                    Call MacButton("            About", frmMain.cmdAbout, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
                End If
        Case vbKeyS:
                If AltDown Then
                    Call MacButton("         Shutdown", frmMain.cmdShutdown, 0, 0, 170, 30, frmLogin.Source, 182, 30, 2)
                    cmdShutdown_Click
                    Call MacButton("         Shutdown", frmMain.cmdShutdown, 0, 0, 170, 30, frmLogin.Source, 147, 0, 2)
                End If
        Case vbKeyReturn:
                Call MenuFunction
    End Select
End Sub
    
Function MenuFunction()
                If MenuList = "Supplier Masterfile" Then
                    frmSupplier.Show
                ElseIf MenuList = "Product Masterfile" Then
                    frmProduct.Show
                ElseIf MenuList = "Category Masterfile" Then
                    frmCategory.Show
                ElseIf MenuList = "Selling Transaction" Then
                    frmSelling.Show
                ElseIf MenuList = "Receiving Transaction" Then
                    frmReceiving.Show
                ElseIf MenuList = "Stocks Re-order Report" Then
                    ReportIt.ReportFileName = App.Path & "\REPORTS\PRODLEFT.RPT"
                    ReportIt.WindowTitle = MenuList
                    ReportIt.Action = 1
                ElseIf MenuList = "Selling History Report" Then
                    frmPrint.Show
                    frmPrint.PrintIt.WindowTitle = MenuList
                    What_Rpt = MenuList
                ElseIf MenuList = "Receiving History Report" Then
                    frmPrint.Show
                    frmPrint.PrintIt.WindowTitle = MenuList
                    What_Rpt = MenuList
                ElseIf MenuList = "Stocks Per Supplier Report" Then
                    frmPrint.Show
                    frmPrint.PrintIt.WindowTitle = MenuList
                    What_Rpt = MenuList
                ElseIf MenuList = "Product Listing Report" Then
                    ReportIt.ReportFileName = App.Path & "\REPORTS\PRODLIST.RPT"
                    ReportIt.WindowTitle = MenuList
                    ReportIt.Action = 1
                ElseIf MenuList = "Supplier Listing Report" Then
                    ReportIt.ReportFileName = App.Path & "\REPORTS\SUPPLIER.RPT"
                    ReportIt.WindowTitle = MenuList
                    ReportIt.Action = 1
                ElseIf MenuList = "Backup/Restore Files" Then
                    frmBackup.Show
                ElseIf MenuList = "Password Security" Then
                    frmPassword.Show
                ElseIf MenuList = "Code File Setup" Then
                    frmCodeFile.Show
                ElseIf MenuList = "Software Setup" Then
                    frmSetup.Show
                End If
End Function

Private Sub Maximized_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(frmMain.Maximized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 18, 72, SRCCOPY)
    frmMain.Maximized.Refresh
End Sub

Private Sub Maximized_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(frmMain.Maximized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 72, SRCCOPY)
    frmMain.Maximized.Refresh
End Sub

Private Sub MenuList_Click()
'    Call MenuFunction
End Sub

Private Sub Minimized_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(frmMain.Minimized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 18, 124, SRCCOPY)
    frmMain.Minimized.Refresh
End Sub

Private Sub Minimized_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(frmMain.Minimized.hDC, 0, 0, 73, 50, frmLogin.Source.hDC, 0, 124, SRCCOPY)
    frmMain.Minimized.Refresh
End Sub

Private Sub Timer1_Timer()
    On Error Resume Next
    If datsecondary.RecordCount = 0 And datthirdary.RecordCount = 0 Then
    Else
        If datprimary("SELLING_CLEANUPDATE") <= Date Then
            Call MessageBox("frmMain", "You are scheduled for Invoice Cleanup." & vbCrLf & _
                            "Do you want to proceed with Invoice Cleanup ?", 1)
            frmMessageBox2.Show
            frmMessageBox2.SetFocus
        End If
    End If
End Sub

Private Sub titleBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call DragForm(Me)
End Sub

Private Sub tmrUpdate_Timer()
    On Local Error Resume Next
    Dim MS As MEMORYSTATUS
    Today = Now
    Clock.Caption = Format(Today, "hh:mm:ss ampm ")
    MS.dwLength = Len(MS)
    Call GlobalMemoryStatus(MS)
    With MS
        lbl(0) = Format$(.dwTotalPhys / 1024, "#,###") & " Kb"
        lbl(1) = Format$(.dwAvailPhys / 1024, "#,###") & " Kb"
        lbl(2) = Format$(.dwTotalVirtual / 1024, "#,###") & " Kb"
        lbl(3) = Format$(.dwAvailVirtual / 1024, "#,###") & " Kb"
        lbl(4) = Format$(.dwTotalPageFile / 1024, "#,###") & " Kb"
        lbl(5) = Format$(.dwAvailPageFile / 1024, "#,###") & " Kb"
        lbl(6) = Format$(.dwMemoryLoad, "##0") & "%"
    End With
    If mIsWin32 Then
        Dim nIndex As Integer
            guageSystem.Value = pBGetFreeSystemResources(SR)
            guageSystem.ForeColor = AssignColour(guageSystem.Value)
            guageUser.Value = pBGetFreeSystemResources(USR)
            guageUser.ForeColor = AssignColour(guageUser.Value)
            guageGDI.Value = pBGetFreeSystemResources(GDI)
            guageGDI.ForeColor = AssignColour(guageGDI.Value)
            Select Case guageSystem.Value
                Case Is > 99
                Case Is < 1
                Case Else
                    nIndex = (100 - guageSystem.Value) * 0.13
                Select Case nIndex
                    Case Is < 0
                        nIndex = 0
                    Case Is > 12
                        nIndex = 12
                End Select
        End Select
    End If
End Sub

Private Function AssignColour(nPercent As Integer) As Long
    Select Case nPercent
        Case Is < 10
            AssignColour = vbRed
        Case Is < 25
            AssignColour = vbMagenta
        Case Else
            AssignColour = vbBlue
    End Select
End Function