frmkcdbd.frm

企业的进销存源码

   Case CmdDelh
         Delrecord "KcDbdH"
   Case CmdSave
         SaveRecord
   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 oKcDbdh Is Nothing Then
      Cancel = True
   End If

   Select Case Flex(FlexKcDbd).ColKey(Col)
   Case "KCDBD_HWBMCODE"
         
   Case "KCDBD_FROMHWCKMC", "KCDBD_TOHWCKMC", "KCDBDQTY", "KCDBDBZ"
         If oKcDbd Is Nothing Then
            Cancel = True
         End If
   Case Else
         Cancel = True
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle
  
   Flex(FlexKcDbd).Editable = flexEDKbdMouse
   
   Flex(FlexKcDbdh).ColKey(1) = "KCDBDHDOCNO"
   Flex(FlexKcDbdh).ColKey(2) = "KCDBDHDAT"
   
   Flex(FlexKcDbd).ColKey(1) = "KCDBD_HWBMCODE"
   Flex(FlexKcDbd).ColKey(2) = "KCDBD_HWBMMC"
   Flex(FlexKcDbd).ColKey(3) = "KCDBD_HWBMDW"
   Flex(FlexKcDbd).ColKey(4) = "KCDBD_FROMHWCKMC"
   Flex(FlexKcDbd).ColKey(5) = "KCDBD_TOHWCKMC"
   Flex(FlexKcDbd).ColKey(6) = "KCDBDQTY"
   Flex(FlexKcDbd).ColKey(7) = "KCDBDBZ"
   
   LoadDataIntoGrid "KcDbdH"
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid(Index As String)
   Dim ItemStr As String
   Dim mKcDbdh As KcDbdh
   Dim mKcDbd As KcDbd
On Error GoTo Errorhandle
   
   Select Case UCase(Index)
   Case "KCDBDH"
   
      Flex(FlexKcDbdh).Rows = 1
      
      Set oKcDbdhs = New KcDbdhs
      oKcDbdhs.Fillbydb
         
      For Each mKcDbdh In oKcDbdhs
         ItemStr = vbTab & mKcDbdh.KcDbdhDocno & vbTab & mKcDbdh.KcDbdhDat
         Flex(FlexKcDbdh).AddItem ItemStr
         Flex(FlexKcDbdh).RowData(Flex(FlexKcDbdh).Rows - 1) = mKcDbdh.KcDbdhKey
      Next
      If Flex(FlexKcDbdh).Rows > 1 Then
         Flex(FlexKcDbdh).Row = 1
         Set oKcDbdh = oKcDbdhs(CStr(Flex(FlexKcDbdh).RowData(1)))
         SetValueToControl
      Else
         Set oKcDbdh = Nothing
         Clearcontrol
      End If
   
   Case "KCDBD"
   
      Flex(FlexKcDbd).Rows = 1
      Flex(FlexKcDbd).AddItem ""
      
      oKcDbdh.KcDbds.Fillbydb oKcDbdh
      
      For Each mKcDbd In oKcDbdh.KcDbds
         ItemStr = vbTab & mKcDbd.Hwbm.HwBmCode & vbTab & mKcDbd.Hwbm.HwBmMc & vbTab & mKcDbd.Hwbm.HwBmDw & vbTab & mKcDbd.FromHwCk.HwCkMc & vbTab & mKcDbd.ToHwCk.HwCkMc & vbTab & mKcDbd.KcDbdQty & mKcDbd.KcDbdBz
         Flex(FlexKcDbd).AddItem ItemStr, Flex(FlexKcDbd).Rows - 1
         Flex(FlexKcDbd).RowData(Flex(FlexKcDbd).Rows - 2) = mKcDbd.KcDbdKey
      Next
      If Flex(FlexKcDbd).Rows > 2 Then
         Flex(FlexKcDbd).Row = 1
         Set oKcDbd = oKcDbdh.KcDbds(CStr(Flex(FlexKcDbd).RowData(1)))
      Else
         Set oKcDbd = Nothing
      End If
   
   End Select

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

Private Sub AddRecord()
On Error GoTo Errorhandle

   Set oKcDbdh = New KcDbdh
   Set oKcDbd = Nothing
   Clearcontrol
   Text(TxtKcDbdDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtKcDbdDocno).Text = ""
   Text(DtpKcDbdDat).Text = ""
   
   Flex(FlexKcDbd).Rows = 1
   Flex(FlexKcDbd).AddItem ""
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord()
On Error GoTo Errorhandle
    
   SetValueToObject

   If oKcDbdh.KcDbdhId = -1 Then
      oKcDbdhs.Add oKcDbdh
      ChgGrid "ADD"
   Else
      oKcDbdh.Save
      ChgGrid "CHG"
   End If
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToObject()
   Dim mKcDbd As KcDbd
   Dim I As Integer
On Error GoTo Errorhandle

   oKcDbdh.KcDbdhDocno = Trim(Text(TxtKcDbdDocno).Text)
   oKcDbdh.KcDbdhDat = Dtp(DtpKcDbdDat).Value
   
   For I = 1 To Flex(FlexKcDbd).Rows - 2
      Set mKcDbd = oKcDbdh.KcDbds(CStr(Flex(FlexKcDbd).RowData(I)))
      mKcDbd.KcDbd_HwBmCode = Trim(Flex(FlexKcDbd).TextMatrix(I, Flex(FlexKcDbd).ColIndex("KCDBD_HWBMCODE")))
      mKcDbd.KcDbd_FromHwCkMc = Trim(Flex(FlexKcDbd).TextMatrix(I, Flex(FlexKcDbd).ColIndex("KCDBD_FROMHWCKMC")))
      mKcDbd.KcDbd_ToHwCkMc = Trim(Flex(FlexKcDbd).TextMatrix(I, Flex(FlexKcDbd).ColIndex("KCDBD_TOHWCKMC")))
      mKcDbd.KcDbdQty = Val(Flex(FlexKcDbd).TextMatrix(I, Flex(FlexKcDbd).ColIndex("KCDBDQTY")))
      mKcDbd.KcDbdBz = Trim(Flex(FlexKcDbd).TextMatrix(I, Flex(FlexKcDbd).ColIndex("KCDBDBZ")))
   Next
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgGrid(RecordName As String)
   Dim ItemStr As String
On Error GoTo Errorhandle
   
   If RecordName = "ADD" Then
      ItemStr = vbTab & oKcDbdh.KcDbdhDocno & vbTab & oKcDbdh.KcDbdhDat
      Flex(FlexKcDbdh).AddItem ItemStr
      Flex(FlexKcDbdh).RowData(Flex(FlexKcDbdh).Rows - 1) = oKcDbdh.KcDbdhKey
      Flex(FlexKcDbdh).Row = Flex(FlexKcDbdh).Rows - 1
   Else
      Flex(FlexKcDbdh).TextMatrix(Flex(FlexKcDbdh).Row, Flex(FlexKcDbdh).ColIndex("KcDbdHDOCNO")) = oKcDbdh.KcDbdhDocno
      Flex(FlexKcDbdh).TextMatrix(Flex(FlexKcDbdh).Row, Flex(FlexKcDbdh).ColIndex("KcDbdHDAT")) = oKcDbdh.KcDbdhDat
   End If

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

Private Sub Delrecord(Index As String)
On Error GoTo Errorhandle


   Select Case UCase(Index)
   Case "KCDBDH"
   
         If Flex(FlexKcDbdh).Rows = 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo) = vbYes Then
            oKcDbdhs.Remove CStr(oKcDbdh.KcDbdhKey)
            Flex(FlexKcDbdh).RemoveItem Flex(FlexKcDbdh).Row
            If Flex(FlexKcDbdh).Rows = 1 Then
               Set oKcDbd = Nothing
               Set oKcDbdh = Nothing
               Clearcontrol
            Else
               Set oKcDbdh = oKcDbdhs(CStr(Flex(FlexKcDbdh).RowData(Flex(FlexKcDbdh).Row)))
               SetValueToControl
            End If
         End If
   
   
   Case "KCDBD"
   
         If Flex(FlexKcDbd).Row = Flex(FlexKcDbd).Rows - 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo) = vbYes Then
            oKcDbdh.KcDbds.Remove CStr(oKcDbd.KcDbdKey)
            Flex(FlexKcDbd).RemoveItem Flex(FlexKcDbd).Row
            If Flex(FlexKcDbd).Rows = 2 Then
               Set oKcDbd = Nothing
               Flex(FlexKcDbdh).RemoveItem Flex(FlexKcDbdh).Row
               If Flex(FlexKcDbdh).Rows = 1 Then
                  Set oKcDbdh = Nothing
               Else
                  Set oKcDbdh = oKcDbdhs(CStr(Flex(FlexKcDbdh).RowData(Flex(FlexKcDbdh).Row)))
                  SetValueToControl
               End If
            Else
               If Flex(FlexKcDbd).Row = Flex(FlexKcDbd).Rows - 1 Then
                  Flex(FlexKcDbd).Row = Flex(FlexKcDbd).Row - 1
               End If
               Set oKcDbd = oKcDbdh.KcDbds(CStr(Flex(FlexKcDbd).RowData(Flex(FlexKcDbd).Row)))
            End If
         End If
      
   End Select
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Flex_RowColChange(Index As Integer)
On Error GoTo Errorhandle

   Select Case Index
   Case FlexKcDbdh
   
         If Flex(FlexKcDbdh).Rows > 1 Then
            Set oKcDbdh = oKcDbdhs(CStr(Flex(FlexKcDbdh).RowData(Flex(FlexKcDbdh).Row)))
            SetValueToControl
         Else
            Set oKcDbdh = Nothing
            Clearcontrol
         End If
   
   Case FlexKcDbd
   
         If Flex(FlexKcDbd).Row <> Flex(FlexKcDbd).Rows - 1 Then
            Set oKcDbd = oKcDbdh.KcDbds(CStr(Flex(FlexKcDbd).RowData(Flex(FlexKcDbd).Row)))
         Else
            Set oKcDbd = Nothing
         End If
   
   End Select
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetValueToControl()
On Error GoTo Errorhandle

   Text(TxtKcDbdDocno).Text = oKcDbdh.KcDbdhDocno
   Dtp(DtpKcDbdDat).Value = oKcDbdh.KcDbdhDat
   
   LoadDataIntoGrid "KcDbd"
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Errorhandle

   Set oKcDbdhs = Nothing
   Set oKcDbdh = Nothing
   Set oKcDbd = Nothing
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetControlToFlex()
   Dim mCurCol As Integer
   Dim mCurRow As Integer
On Error GoTo Errorhandle

   
   mCurRow = Flex(FlexKcDbd).Row
   mCurCol = Flex(FlexKcDbd).Col
   
   Select Case Flex(FlexKcDbd).ColKey(Flex(FlexKcDbd).Col)
   Case "KCDBD_HWBMCODE"
         If oKcDbd Is Nothing Then
            AddNewRecord
         Else
            oKcDbd.KcDbd_HwBmCode = Trim(Flex(FlexKcDbd).TextMatrix(mCurRow, mCurCol))
            Flex(FlexKcDbd).TextMatrix(mCurRow, Flex(FlexKcDbd).ColIndex("KCDBD_HWBMMC")) = oKcDbd.Hwbm.HwBmMc
            Flex(FlexKcDbd).TextMatrix(mCurRow, Flex(FlexKcDbd).ColIndex("KCDBD_HWBMDW")) = oKcDbd.Hwbm.HwBmDw
         End If
   
   Case "KCDBD_FROMHWCKMC"
         If Not oKcDbd Is Nothing Then
            oKcDbd.KcDbd_FromHwCkMc = Trim(Flex(FlexKcDbd).TextMatrix(mCurRow, mCurCol))
         End If
   
   Case "KCDBD_TOHWCKMC"
         If Not oKcDbd Is Nothing Then
            oKcDbd.KcDbd_ToHwCkMc = Trim(Flex(FlexKcDbd).TextMatrix(mCurRow, mCurCol))
         End If
   
   Case "KCDBDQTY"
         If Not oKcDbd Is Nothing Then
            oKcDbd.KcDbdQty = Val(Flex(FlexKcDbd).TextMatrix(Flex(FlexKcDbd).Row, mCurCol))
         End If
   
   Case "KCDBDBZ"
         If Not oKcDbd Is Nothing Then
            oKcDbd.KcDbdBz = Trim(Flex(FlexKcDbd).TextMatrix(Flex(FlexKcDbd).Row, mCurCol))
         End If
   
   End Select
   

Exit Sub
Errorhandle:
   'Flex(FlexKcDbd).TextMatrix(mCurRow, mCurCol) = mCurColOldValue
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub AddNewRecord()
   Dim mCurRow As Integer
On Error GoTo Errorhandle

   mCurRow = Flex(FlexKcDbd).Row

   If Trim(Flex(FlexKcDbd).TextMatrix(mCurRow, Flex(FlexKcDbd).Col)) <> "" Then
      Set oKcDbd = New KcDbd
      Set oKcDbd.KcDbdh = oKcDbdh
      oKcDbd.KcDbd_HwBmCode = Trim(Flex(FlexKcDbd).TextMatrix(mCurRow, Flex(FlexKcDbd).Col))
      oKcDbdh.KcDbds.Add oKcDbd, 0
      Flex(FlexKcDbd).TextMatrix(mCurRow, Flex(FlexKcDbd).ColIndex("KCDBD_HWBMMC")) = oKcDbd.Hwbm.HwBmMc
      Flex(FlexKcDbd).TextMatrix(mCurRow, Flex(FlexKcDbd).ColIndex("KCDBD_HWBMDW")) = oKcDbd.Hwbm.HwBmDw
      Flex(FlexKcDbd).RowData(Flex(FlexKcDbd).Rows - 1) = oKcDbd.KcDbdKey
      Flex(FlexKcDbd).AddItem ""
   End If

Exit Sub
Errorhandle:
   Set oKcDbd = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Form_Resize()
On Error GoTo Errorhandle
   Resize_ALL Me
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub