frmarivd.frm

制造业产供销与往来系统源码,包括进销存及全部控件！

Const TxtArivdh_CwqjCode = 5

Const CBxArivdh_KhCode = 0
Const CBxArivdh_CwBzCode = 2

Const TxtTotalQty = 1
Const TxtTotalNtAmt = 2
Const TxtTotalTAmt = 3
Const TxtTotalAmt = 4

Dim mCurColOldValue As String

Dim oArivdhs As Arivdhs
Dim oArivdh As Arivdh
Dim oArivd As Arivd

Public Sub LetDocno(vDocno As String)
On Error GoTo Errorhandle

   Text(TxtArivdhDocno).Text = vDocno
   Text_LostFocus TxtArivdhDocno

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Combo_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo Errorhandle

gPublicFunction.FormKeyDown Me, KeyCode, Shift, Combo(Index)

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Combo_LostFocus(Index As Integer)
On Error GoTo Errorhandle
   
   If Tlbaction(TlbArivd).Tag = "" Then
      Exit Sub
   End If
   
   Select Case Index
   Case CBxArivdh_KhCode
         If Trim(Combo(CBxArivdh_KhCode).Text) <> "" Then
            oArivdh.Arivdh_KhCode = Combo(CBxArivdh_KhCode).Text
            Combo(CBxArivdh_CwBzCode).Text = oArivdh.Arivdh_CwBzCode
         End If
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Flex_AfterEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long)
On Error GoTo Errorhandle

   SetControlToFlex

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Flex_BeforeEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
On Error GoTo Errorhandle
   
   If Tlbaction(TlbArivd).Tag = "" Then
      Cancel = True
   End If
   
   If oArivdh Is Nothing Then
      Cancel = True
   End If

   mCurColOldValue = Trim(Flex(FlexArivd).TextMatrix(Flex(FlexArivd).Row, Flex(FlexArivd).Col))

   Select Case Flex(FlexArivd).ColKey(Col)
   Case "HWBMCODE"
         
   Case "ARIVD_HWDWCONV", "ARIVDQTY", "ARIVDPRICE", "ARIVDNTAMT", "ARIVDTAMT", "ARIVDAMT", "ARIVDBZ"
         If oArivd Is Nothing Then
            Cancel = True
         End If
         
   Case "HWDWCODE"
         If oArivd Is Nothing Then
            Cancel = True
         End If
         
   Case "CWSMCODE"
         If oArivd Is Nothing Then
            Cancel = True
         End If
         
   Case Else
         Cancel = True
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Flex_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo Errorhandle

   gPublicFunction.FlexKeyDown Flex(Index), KeyCode

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Flex_KeyDownEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, KeyCode As Integer, ByVal Shift As Integer)
On Error GoTo Errorhandle

   gPublicFunction.FlexKeyDown Flex(Index), KeyCode

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Flex_KeyPressEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, KeyAscii As Integer)
On Error GoTo Errorhandle

   gPublicFunction.FlexInputCheck Me, Flex(Index), KeyAscii

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Activate()
On Error GoTo Errorhandle
  
  Text(TxtArivdhDocno).SetFocus
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle
  
   Flex(FlexArivd).Editable = flexEDKbdMouse
   
   Flex(FlexArivd).ColKey(1) = "HWBMCODE"
   Flex(FlexArivd).ColKey(2) = "HWBMMC"
   Flex(FlexArivd).ColKey(3) = "HWDWCODE"
   Flex(FlexArivd).ColKey(4) = "ARIVD_HWDWCONV"
   Flex(FlexArivd).ColKey(5) = "ARIVDQTY"
   Flex(FlexArivd).ColKey(6) = "ARIVDPRICE"
   Flex(FlexArivd).ColKey(7) = "ARIVDNTAMT"
   Flex(FlexArivd).ColKey(8) = "ARIVDTAMT"
   Flex(FlexArivd).ColKey(9) = "ARIVDAMT"
   Flex(FlexArivd).ColKey(10) = "CWSMCODE"
   Flex(FlexArivd).ColKey(11) = "ARIVDBZ"
      
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbArivd), Img(ImgArivd), SBar(SbarArivd)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "Arivd", "TXTARIVDHDOCNO", "CBXCWBZCODE"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexArivd), Text(TxtArivdhDocno)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Text(TxtTotalQty), Text(TxtTotalNtAmt), Text(TxtTotalTAmt), Text(TxtTotalAmt)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Text(TxtTotalQty), Text(TxtTotalNtAmt), Text(TxtTotalTAmt), Text(TxtTotalAmt)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   gPublicFunction.FillComboWithSql Me, Combo(CBxArivdh_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=1 ORDER BY KHCODE", "KHNO", 0
   gPublicFunction.FillComboWithSql Me, Combo(CBxArivdh_CwBzCode), "SELECT CwBzCODE,CwBzNO FROM CwBzREC ORDER BY CwBzCODE", "CwBzNO", 0
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid()
   Dim ItemStr As String
   Dim mArivdh As Arivdh
   Dim mArivd As Arivd
On Error GoTo Errorhandle
   
   Flex(FlexArivd).Rows = 1
   Flex(FlexArivd).AddItem ""
   
   oArivdh.Arivds.FillbyDb oArivdh
   
   For Each mArivd In oArivdh.Arivds
      ItemStr = vbTab & mArivd.Arivd_HwBmCode & vbTab & mArivd.Arivd_HwBmMc
      ItemStr = ItemStr & vbTab & mArivd.Arivd_HwDwCode & vbTab & mArivd.Arivd_HwDwConv
      ItemStr = ItemStr & vbTab & mArivd.ArivdQty & vbTab & mArivd.ArivdPrice & vbTab & mArivd.ArivdNtAmt & vbTab & mArivd.ArivdTAmt & vbTab & mArivd.ArivdAmt & vbTab & mArivd.Arivd_CwSmCode & vbTab & mArivd.ArivdBz
      Flex(FlexArivd).AddItem ItemStr, Flex(FlexArivd).Rows - 1
      Flex(FlexArivd).RowData(Flex(FlexArivd).Rows - 2) = mArivd.ArivdKey
   Next
   If Flex(FlexArivd).Rows > 2 Then
      Flex(FlexArivd).Row = 1
      Set oArivd = oArivdh.Arivds(CStr(Flex(FlexArivd).RowData(1)))
   Else
      Set oArivd = Nothing
   End If
   
   gPublicFunction.SumFlexQtyAmt Flex(FlexArivd), "ArivdQTY,ArivdNTAMT,ArivdTAMT,ArivdAMT", Text(TxtTotalQty), Text(TxtTotalNtAmt), Text(TxtTotalTAmt), Text(TxtTotalAmt)


Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub AddRecord(RecordName As String)
On Error GoTo Errorhandle

   Set oArivdh = New Arivdh
   Set oArivd = Nothing
   Clearcontrol
   Text(TxtArivdhDocno).SetFocus
   
   If Text(TxtArivdhDat).Text = "" Then
      Text(TxtArivdhDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
   End If
   
   oArivdh.ArivdhDat = Trim(Text(TxtArivdhDat).Text)
   Text(TxtArivdh_CwqjCode).Text = oArivdh.Arivdh_CwQjCode
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbArivd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgRecord(RecordName As String)
On Error GoTo Errorhandle
    
   If oArivdh Is Nothing Then
      Exit Sub
   End If

   Text(TxtArivdhDocno).SetFocus
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbArivd), RecordName
    
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub CancelRecord(RecordName As String)
On Error GoTo Errorhandle

   If oArivdh.ArivdhId = -1 Then
      Clearcontrol
      Set oArivd = Nothing
      Set oArivdh = Nothing
   Else
      oArivdh.Requery oArivdh.ArivdhDocno
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbArivd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub


Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtArivdhDocno).Text = ""
   Text(TxtArivdh_CwqjCode).Text = ""
   Combo(CBxArivdh_KhCode).Text = ""
   Combo(CBxArivdh_CwBzCode).Text = ""
   
   Text(TxtTotalQty).Text = ""
   Text(TxtTotalNtAmt).Text = ""
   Text(TxtTotalTAmt).Text = ""
   Text(TxtTotalAmt).Text = ""
   
   Flex(FlexArivd).Rows = 1
   Flex(FlexArivd).AddItem ""
   
   Text(TxtArivdhDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
   
   SetValueToObject
   oArivdh.Save
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbArivd), RecordName

Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToObject()
   Dim mArivd As Arivd
   Dim I As Integer
On Error GoTo Errorhandle

   oArivdh.ArivdhType = 1
   oArivdh.ArivdhDocno = Trim(Text(TxtArivdhDocno).Text)
   oArivdh.ArivdhDat = gPublicFunction.ConvDateToString(Text(TxtArivdhDat).Text)
   oArivdh.Arivdh_CwQjCode = Trim(Text(TxtArivdh_CwqjCode).Text)
   oArivdh.Arivdh_KhCode = Trim(Combo(CBxArivdh_KhCode).Text)
   oArivdh.Arivdh_CwBzCode = Trim(Combo(CBxArivdh_CwBzCode).Text)
   oArivdh.ArivdhAmt = Val(Text(TxtTotalAmt).Text)
   oArivdh.ArivdhForm = UCase(Me.Name)
   
   For I = 1 To Flex(FlexArivd).Rows - 2
      Set mArivd = oArivdh.Arivds(CStr(Flex(FlexArivd).RowData(I)))
      mArivd.Arivd_HwBmCode = Trim(Flex(FlexArivd).TextMatrix(I, Flex(FlexArivd).ColIndex("HWBMCODE")))
      mArivd.Arivd_HwDwCode = Trim(Flex(FlexArivd).TextMatrix(I, Flex(FlexArivd).ColIndex("HWDWCODE")))
      mArivd.Arivd_HwDwConv = Val(Flex(FlexArivd).TextMatrix(I, Flex(FlexArivd).ColIndex("ARIVD_HWDWCONV")))
      mArivd.ArivdQty = Val(Flex(FlexArivd).TextMatrix(I, Flex(FlexArivd).ColIndex("ARIVDQTY")))
      mArivd.ArivdPrice = Val(Flex(FlexArivd).TextMatrix(I, Flex(FlexArivd).ColIndex("ARIVDPRICE")))
      mArivd.ArivdNtAmt = Val(Flex(FlexArivd).TextMatrix(I, Flex(FlexArivd).ColIndex("ARIVDNTAMT")))
      mArivd.ArivdAmt = Val(Flex(FlexArivd).TextMatrix(I, Flex(FlexArivd).ColIndex("ARIVDAMT")))
      mArivd.Arivd_CwSmCode = Trim(Flex(FlexArivd).TextMatrix(I, Flex(FlexArivd).ColIndex("CWSMCODE")))
      mArivd.ArivdBz = Trim(Flex(FlexArivd).TextMatrix(I, Flex(FlexArivd).ColIndex("ARIVDBZ")))
   Next
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub DelRecord(RecordName As String)
On Error GoTo Errorhandle


   Select Case UCase(RecordName)
   Case "DEL"
   
         If oArivdh Is Nothing Then
            Err.Raise vbObjectError + 1, , "无单据，不能进行删除！"
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo + vbQuestion) = vbYes Then
            oArivdh.Del
            Set oArivd = Nothing
            Set oArivdh = Nothing
            Clearcontrol
         End If
   
   Case "DEF"
   
         If Flex(FlexArivd).Row = Flex(FlexArivd).Rows - 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo + vbQuestion) = vbYes Then
            oArivdh.Arivds.Remove CStr(oArivd.ArivdKey)
            Flex(FlexArivd).RemoveItem Flex(FlexArivd).Row
            If Flex(FlexArivd).Rows = 2 Then
               Set oArivd = Nothing
               Set oArivdh = Nothing
               Clearcontrol
               gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbArivd), "CAN"
            Else
               If Flex(FlexArivd).Row = Flex(FlexArivd).Rows - 1 Then
                  Flex(FlexArivd).Row = Flex(FlexArivd).Row - 1
               End If
               Set oArivd = oArivdh.Arivds(CStr(Flex(FlexArivd).RowData(Flex(FlexArivd).Row)))
            End If
            gPublicFunction.SumFlexQtyAmt Flex(FlexArivd), "ArivdQTY,ArivdNTAMT,ArivdTAMT,ArivdAMT", Text(TxtTotalQty), Text(TxtTotalNtAmt), Text(TxtTotalTAmt), Text(TxtTotalAmt)