frmapivd.frm

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

Const TxtApivdh_CwqjCode = 5

Const CBxApivdh_KhCode = 0
Const CBxApivdh_CwBzCode = 2

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

Dim mCurColOldValue As String

Dim oApivdhs As Apivdhs
Dim oApivdh As Apivdh
Dim oApivd As Apivd

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

   Text(TxtApivdhDocno).Text = vDocno
   Text_LostFocus TxtApivdhDocno

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(TlbApivd).Tag = "" Then
      Exit Sub
   End If
   
   Select Case Index
   Case CBxApivdh_KhCode
         If Trim(Combo(CBxApivdh_KhCode).Text) <> "" Then
            oApivdh.Apivdh_KhCode = Combo(CBxApivdh_KhCode).Text
            Combo(CBxApivdh_CwBzCode).Text = oApivdh.Apivdh_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(TlbApivd).Tag = "" Then
      Cancel = True
   End If
   
   If oApivdh Is Nothing Then
      Cancel = True
   End If

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

   Select Case Flex(FlexApivd).ColKey(Col)
   Case "HWBMCODE"
         
   Case "APIVD_HWDWCONV", "APIVDQTY", "APIVDPRICE", "APIVDNTAMT", "APIVDTAMT", "APIVDAMT", "APIVDBZ"
         If oApivd Is Nothing Then
            Cancel = True
         End If
         
   Case "HWDWCODE"
         If oApivd Is Nothing Then
            Cancel = True
         End If
         
   Case "CWSMCODE"
         If oApivd 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(TxtApivdhDocno).SetFocus
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle
  
   Flex(FlexApivd).Editable = flexEDKbdMouse
   
   Flex(FlexApivd).ColKey(1) = "HWBMCODE"
   Flex(FlexApivd).ColKey(2) = "HWBMMC"
   Flex(FlexApivd).ColKey(3) = "HWDWCODE"
   Flex(FlexApivd).ColKey(4) = "APIVD_HWDWCONV"
   Flex(FlexApivd).ColKey(5) = "APIVDQTY"
   Flex(FlexApivd).ColKey(6) = "APIVDPRICE"
   Flex(FlexApivd).ColKey(7) = "APIVDNTAMT"
   Flex(FlexApivd).ColKey(8) = "APIVDTAMT"
   Flex(FlexApivd).ColKey(9) = "APIVDAMT"
   Flex(FlexApivd).ColKey(10) = "CWSMCODE"
   Flex(FlexApivd).ColKey(11) = "APIVDBZ"
      
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbApivd), Img(ImgApivd), SBar(SbarApivd)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "Apivd", "TXTAPIVDHDOCNO", "CBXCWBZCODE"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexApivd), Text(TxtApivdhDocno)
   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(CBxApivdh_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=2 ORDER BY KHCODE", "KHNO", 0
   gPublicFunction.FillComboWithSql Me, Combo(CBxApivdh_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 mApivdh As Apivdh
   Dim mApivd As Apivd
On Error GoTo Errorhandle
   
   Flex(FlexApivd).Rows = 1
   Flex(FlexApivd).AddItem ""
   
   oApivdh.Apivds.FillbyDb oApivdh
   
   For Each mApivd In oApivdh.Apivds
      ItemStr = vbTab & mApivd.Apivd_HwBmCode & vbTab & mApivd.Apivd_HwBmMc
      ItemStr = ItemStr & vbTab & mApivd.Apivd_HwDwCode & vbTab & mApivd.Apivd_HwDwConv
      ItemStr = ItemStr & vbTab & mApivd.ApivdQty & vbTab & mApivd.ApivdPrice & vbTab & mApivd.ApivdNtAmt & vbTab & mApivd.ApivdTAmt & vbTab & mApivd.ApivdAmt & vbTab & mApivd.Apivd_CwSmCode & vbTab & mApivd.ApivdBz
      Flex(FlexApivd).AddItem ItemStr, Flex(FlexApivd).Rows - 1
      Flex(FlexApivd).RowData(Flex(FlexApivd).Rows - 2) = mApivd.ApivdKey
   Next
   If Flex(FlexApivd).Rows > 2 Then
      Flex(FlexApivd).Row = 1
      Set oApivd = oApivdh.Apivds(CStr(Flex(FlexApivd).RowData(1)))
   Else
      Set oApivd = Nothing
   End If
   
   gPublicFunction.SumFlexQtyAmt Flex(FlexApivd), "APIVDQTY,APIVDNTAMT,APIVDTAMT,APIVDAMT", 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 oApivdh = New Apivdh
   Set oApivd = Nothing
   Clearcontrol
   Text(TxtApivdhDocno).SetFocus
   
   If Text(TxtApivdhDat).Text = "" Then
      Text(TxtApivdhDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
   End If
   
   oApivdh.ApivdhDat = Trim(Text(TxtApivdhDat).Text)
   Text(TxtApivdh_CwqjCode).Text = oApivdh.Apivdh_CwQjCode
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbApivd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

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

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

   If oApivdh.ApivdhId = -1 Then
      Clearcontrol
      Set oApivd = Nothing
      Set oApivdh = Nothing
   Else
      oApivdh.Requery oApivdh.ApivdhDocno
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbApivd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub


Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtApivdhDocno).Text = ""
   Text(TxtApivdh_CwqjCode).Text = ""
   Combo(CBxApivdh_KhCode).Text = ""
   Combo(CBxApivdh_CwBzCode).Text = ""
   
   Text(TxtTotalQty).Text = ""
   Text(TxtTotalNtAmt).Text = ""
   Text(TxtTotalTAmt).Text = ""
   Text(TxtTotalAmt).Text = ""
   
   Flex(FlexApivd).Rows = 1
   Flex(FlexApivd).AddItem ""
   
   Text(TxtApivdhDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

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

Private Sub SetValueToObject()
   Dim mApivd As Apivd
   Dim I As Integer
On Error GoTo Errorhandle

   oApivdh.ApivdhType = 1
   oApivdh.ApivdhDocno = Trim(Text(TxtApivdhDocno).Text)
   oApivdh.ApivdhDat = gPublicFunction.ConvDateToString(Text(TxtApivdhDat).Text)
   oApivdh.Apivdh_CwQjCode = Trim(Text(TxtApivdh_CwqjCode).Text)
   oApivdh.Apivdh_KhCode = Trim(Combo(CBxApivdh_KhCode).Text)
   oApivdh.Apivdh_CwBzCode = Trim(Combo(CBxApivdh_CwBzCode).Text)
   oApivdh.ApivdhAmt = Val(Text(TxtTotalAmt).Text)
   oApivdh.ApivdhForm = UCase(Me.Name)
   
   For I = 1 To Flex(FlexApivd).Rows - 2
      Set mApivd = oApivdh.Apivds(CStr(Flex(FlexApivd).RowData(I)))
      mApivd.Apivd_HwBmCode = Trim(Flex(FlexApivd).TextMatrix(I, Flex(FlexApivd).ColIndex("HWBMCODE")))
      mApivd.Apivd_HwDwCode = Trim(Flex(FlexApivd).TextMatrix(I, Flex(FlexApivd).ColIndex("HWDWCODE")))
      mApivd.Apivd_HwDwConv = Val(Flex(FlexApivd).TextMatrix(I, Flex(FlexApivd).ColIndex("APIVD_HWDWCONV")))
      mApivd.ApivdQty = Val(Flex(FlexApivd).TextMatrix(I, Flex(FlexApivd).ColIndex("APIVDQTY")))
      mApivd.ApivdPrice = Val(Flex(FlexApivd).TextMatrix(I, Flex(FlexApivd).ColIndex("APIVDPRICE")))
      mApivd.ApivdNtAmt = Val(Flex(FlexApivd).TextMatrix(I, Flex(FlexApivd).ColIndex("APIVDNTAMT")))
      mApivd.ApivdAmt = Val(Flex(FlexApivd).TextMatrix(I, Flex(FlexApivd).ColIndex("APIVDAMT")))
      mApivd.Apivd_CwSmCode = Trim(Flex(FlexApivd).TextMatrix(I, Flex(FlexApivd).ColIndex("CWSMCODE")))
      mApivd.ApivdBz = Trim(Flex(FlexApivd).TextMatrix(I, Flex(FlexApivd).ColIndex("APIVDBZ")))
   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 oApivdh Is Nothing Then
            Err.Raise vbObjectError + 1, , "无单据，不能进行删除！"
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo + vbQuestion) = vbYes Then
            oApivdh.Del
            Set oApivd = Nothing
            Set oApivdh = Nothing
            Clearcontrol
         End If
   
   Case "DEF"
   
         If Flex(FlexApivd).Row = Flex(FlexApivd).Rows - 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo + vbQuestion) = vbYes Then
            oApivdh.Apivds.Remove CStr(oApivd.ApivdKey)
            Flex(FlexApivd).RemoveItem Flex(FlexApivd).Row
            If Flex(FlexApivd).Rows = 2 Then
               Set oApivd = Nothing
               Set oApivdh = Nothing
               Clearcontrol
               gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbApivd), "CAN"
            Else
               If Flex(FlexApivd).Row = Flex(FlexApivd).Rows - 1 Then
                  Flex(FlexApivd).Row = Flex(FlexApivd).Row - 1
               End If
               Set oApivd = oApivdh.Apivds(CStr(Flex(FlexApivd).RowData(Flex(FlexApivd).Row)))
            End If
            gPublicFunction.SumFlexQtyAmt Flex(FlexApivd), "APIVDQTY,APIVDNTAMT,APIVDTAMT,APIVDAMT", Text(TxtTotalQty), Text(TxtTotalNtAmt), Text(TxtTotalTAmt), Text(TxtTotalAmt)