frmsugorder.frm

用VB6.0编写的关于车辆运输调度的系统

VERSION 5.00
Begin VB.Form frmSugOrder 
   Caption         =   "Suggest Order"
   ClientHeight    =   3495
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5625
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form5"
   MDIChild        =   -1  'True
   ScaleHeight     =   3495
   ScaleWidth      =   5625
   WindowState     =   2  'Maximized
   Begin VB.CommandButton cmdPrint 
      Caption         =   "Order List"
      Height          =   495
      Left            =   3480
      TabIndex        =   1
      Top             =   1440
      Width           =   1215
   End
   Begin VB.CommandButton cmdRelease 
      Caption         =   "Release"
      Height          =   495
      Left            =   840
      TabIndex        =   0
      Top             =   1440
      Width           =   1215
   End
End
Attribute VB_Name = "frmSugOrder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const iniCode = 1000

Const LineWidth = 400
Const ColWidth = 2000

Private Enum enuDetailCols
     procode = 1
     prodesc
     maxleve
     safleve
     currlev
     inleve
     ordnum
     Qty
     
     MaxCols = Qty          '总的列数
End Enum

Private Sub cmdDBF_Click()

End Sub

Private Sub cmdprint_Click()
'    Call PrintOrder
    frmOrderlist.Show
End Sub

Private Sub cmdRelease_Click()
On Error GoTo err
Dim lOrderCount As Long
Dim sSQL As String, sSQL1 As String, sSQL2 As String
Dim rstCut As New Recordset
Dim rstcus As New Recordset
Dim iCount As Long, i As Long
Dim lprocode As Long, lSugNumber As Long
Dim lsugonum As Long, lSugoCre As Long
Dim OrderSum As Long, lMaxLeve As Long, lMinLeve As Long, lActLeve As Long, lSafLeve As Long
Dim lcuscode As Long, sCusCode As String, sitedesc As String
Dim smeaunit As String
    
    lOrderCount = 0
    iCount = 1
    sSQL = "select distinct cuscode from appcut where astatus='Y'"
    Set rstcus = Acs_cnt.Execute(sSQL)
    With rstcus
    Do While Not .EOF
        lcuscode = rstcus!cuscode
        sSQL = "select a.*,b.itedesc from appcut a,appite b where a.actleve + a.orderso + a.orderdo + a.orderto < a.safleve and a.astatus='Y' and a.cuscode=" & lcuscode & " and a.procode=b.itecode"
        Set rstCut = Acs_cnt.Execute(sSQL)
        If Not rstCut.EOF Then
            lOrderCount = lOrderCount + 1
            lsugonum = GetSugONum
            lSugoCre = ChangeDate(Date)
                       
            i = 0
            Do While Not rstCut.EOF
                OrderSum = rstCut!orderso + rstCut!orderdo + rstCut!orderto
                lMaxLeve = rstCut!maxleve
                lMinLeve = rstCut!minleve
                lSafLeve = rstCut!safleve
                lActLeve = rstCut!actleve
                smeaunit = rstCut!Meaunit
                
                i = i + 1
                If lActLeve + OrderSum < lSafLeve Then
                    lSugNumber = lMaxLeve - (OrderSum + lActLeve)
                    lprocode = rstCut!procode
                    sitedesc = rstCut!Itedesc
                    sSQL1 = "insert into orderd(cmpcode,entcode,cuscode,sugonum,sugolin,sugolnc,itecode,itedesc,sugoqty,meaunit)" & _
                         " values('" & gsCmpCode & "','" & gsEntCode & "'," & lcuscode & "," & lsugonum & "," & i & "," & lSugoCre & "," & lprocode & ",'" & sitedesc & "'," & lSugNumber & ",'" & smeaunit & "')"
                    
                    sSQL2 = "update appcut set orderso=" & lSugNumber & " where cuscode=" & lcuscode & " and Procode=" & lprocode & ""
                    
                    Acs_cnt.BeginTrans
                    Acs_cnt.Execute (sSQL1)
                    Acs_cnt.Execute (sSQL2)
                    Acs_cnt.CommitTrans
                    
                End If
                rstCut.MoveNext
              Loop
        End If

        .MoveNext
    Loop
    End With
    
    MsgBox "" & lOrderCount & " Order is released!", vbOKOnly
        
    
    rstcus.Close
    Set rstcus = Nothing
    
    If lOrderCount > 0 And Printer.Orientation = 2 Then
        Call PrintOrder
    ElseIf lOrderCount > 0 And Printer.Orientation = 1 Then
        Printer.Orientation = 2
        Call PrintOrder
    End If
    
    Exit Sub
    
err:
    MsgBox err.Description, vbOKOnly, "Error"
    
End Sub


Private Sub PrintOrder()
On Error Resume Next
Dim sCompany As String, lcuscode As Long, lentcode As Long
Dim lMaxLeve As Long, lSafLeve As Long, lActLeve As Long, lOrdNum As Long
Dim rstOrderH As Recordset, rstOrderd As Recordset
Dim sStr As String, sSQL As String
Dim lsugonum As Long
Dim iRow As Long
Dim scusdesc As String

Printer.Orientation = 2

sSQL = "select distinct a.cuscode,b.cusdesc,a.sugonum from orderd a,appcus b where a.cuscode=b.cuscode and a.sugonum>0"
Set rstOrderH = Acs_cnt.Execute(sSQL)
With rstOrderH
    Do While Not .EOF
        lsugonum = rstOrderH!sugonum
        lcuscode = rstOrderH!cuscode
        scusdesc = rstOrderH!Cusdesc
       
        sSQL = "select a.*,b.maxleve,b.safleve,b.actleve,b.orderso,b.orderdo,b.orderto from orderd a,appcut b where a.cuscode=" & lcuscode & " and a.itecode=b.procode and a.sugonum=" & lsugonum & ""
        Set rstOrderd = Acs_cnt.Execute(sSQL)
        With rstOrderd
'Print Head
            sStr = "Suggested Order"
            Call PrintString(8000, 1000, 14, sStr)
            
            sStr = "Company:" & gsCmpDesc
            Call PrintString(500, 1500, 12, sStr)
            
            sStr = "Enity:" & gsEntDesc
            Call PrintString(500, 2000, 12, sStr)
            
            sStr = "Report Date:" & Format(Date, "dd/mm/yyyy")
            Call PrintString(12000, 2000, 12, sStr)
            
            sStr = "Customer Code/Desc:" & lcuscode & "/" & scusdesc
            Call PrintString(500, 2500, 12, sStr)
            
            sStr = "Report Time:" & Format(Time, "hh:mm")
            Call PrintString(12000, 2500, 12, sStr)
            
            sStr = "Product Code/Desc:"
            Call PrintString(500, 3000, 12, sStr)
            
            sStr = "Max Tank Lvl"
            Call PrintString(3000, 3000, 12, sStr)
            
            sStr = "Safety Stock"
            Call PrintString(5000, 3000, 12, sStr)
            
            sStr = "Curr Tank Lvl"
            Call PrintString(7000, 3000, 12, sStr)
            
            sStr = "In-Transit Level"
            Call PrintString(9000, 3000, 12, sStr)
            
            sStr = "Order Num"
            Call PrintString(11000, 3000, 12, sStr)
            
            sStr = "Ln Num"
            Call PrintString(12000, 3000, 12, sStr)
            
            sStr = "Qty"
            Call PrintString(13000, 3000, 12, sStr)
            
            sStr = "EOQ Order"
            Call PrintString(14000, 3000, 12, sStr)
            
            iRow = 0
            Do While Not .EOF
'Print Detail
                iRow = iRow + 1
                
                sStr = rstOrderd!Itecode & "/" & rstOrderd!Itedesc
                Call PrintString(500, 3000 + iRow * LineWidth, 12, sStr)
    
                'sStr = rstOrderD!maxleve
                'Call PrintString(4000, 5000, 12, sStr)
                sStr = rstOrderd!maxleve
                Call PrintString(3000, 3000 + iRow * LineWidth, 12, sStr)
                
                sStr = rstOrderd!safleve
                Call PrintString(5000, 3000 + iRow * LineWidth, 12, sStr)
                
                sStr = rstOrderd!actleve
                Call PrintString(7000, 3000 + iRow * LineWidth, 12, sStr)
                
                sStr = rstOrderd!orderso + rstOrderd!orderdo + rstOrderd!orderto
                Call PrintString(9000, 3000 + iRow * LineWidth, 12, sStr)
                
                sStr = lsugonum
                Call PrintString(11000, 3000 + iRow * LineWidth, 12, sStr)
                
                sStr = rstOrderd!sugolin
                Call PrintString(12000, 3000 + iRow * LineWidth, 12, sStr)
    
                sStr = rstOrderd!sugoqty
                Call PrintString(13000, 3000 + iRow * LineWidth, 12, sStr)
                
            
                .MoveNext
            Loop
        End With
  'Print Detail
        sStr = "Verified by(OPS):"
        Call PrintString(500, 3000 + (iRow + 2) * LineWidth, 12, sStr)
'        Printer.Line (2000, 3000 + (iRow + 2) * LineWidth)-(8000, 3000 + (iRow + 2) * LineWidth)
                
        sStr = "Date:"
        Call PrintString(10000, 3000 + (iRow + 2) * LineWidth, 12, sStr)
'        Printer.Line (11000, 3000 + (iRow + 2) * LineWidth)-(16000, 3000 + (iRow + 2) * LineWidth)
                        
        sStr = "Confirmed by(Sales):"
        Call PrintString(500, 3000 + (iRow + 3) * LineWidth, 12, sStr)
'        Printer.Line (2000, 3000 + (iRow + 3) * LineWidth)-(8000, 3000 + (iRow + 3) * LineWidth)
                        
        sStr = "Date:"
        Call PrintString(10000, 3000 + (iRow + 3) * LineWidth, 12, sStr)
'        Printer.Line (11000, 3000 + (iRow + 3) * LineWidth)-(16000, 3000 + (iRow + 3) * LineWidth)
        
        .MoveNext
        Printer.NewPage
    Loop
    Printer.EndDoc
    End With
    
End Sub

Private Sub PrintString(ByVal X As Long, ByVal Y As Long, lFontSize As Long, sStr As String)
On Error Resume Next
'Printer.ScaleMode = vbCentimeters
Printer.CurrentX = X
Printer.CurrentY = Y
Printer.FontSize = 12
Printer.Print sStr
'Printer.EndDoc

End Sub

Private Function GetSugONum() As Long
Dim sSQL As String
Dim rstCode As Recordset

sSQL = " select max(sugonum) as maxcode from orderd where sugonum>0"
Set rstCode = Acs_cnt.Execute(sSQL)
If rstCode.EOF Then
    GetSugONum = CLng(iniCode)
ElseIf IsNull(rstCode!maxcode) = False And rstCode!maxcode <> "" Then
    GetSugONum = CLng(rstCode!maxcode) + 1
Else
    GetSugONum = CLng(iniCode) + 1
End If

End Function