frmkcbfd.frm

企业的进销存源码

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

   Select Case Index
   Case CBxKcBfd_HwCkMc
         If oKcBfdh Is Nothing Then
            Exit Sub
         End If
         If oKcBfdh.HwCk.HwCkMc <> Trim(Combo(Index).Text) Then
            oKcBfdh.KcBfdh_HwCkMc = Trim(Combo(Index).Text)
         End If
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

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

   Select Case Index
   Case CmdAdd
         AddRecord
   Case CmdDel
         Delrecord "KcBfd"
   Case CmdDelh
         Delrecord "KcBfdH"
   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 oKcBfdh Is Nothing Then
      Cancel = True
   End If

   Select Case Flex(FlexKcBfd).ColKey(Col)
   Case "KCBFD_HWBMCODE"
         
   Case "KCBFDQTY", "KCBFD_HWBFRCMC", "KCBFDBZ"
         If oKcBfd 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(FlexKcBfd).Editable = flexEDKbdMouse
   
   Flex(FlexKcBfdh).ColKey(1) = "KCBFDHDOCNO"
   Flex(FlexKcBfdh).ColKey(2) = "KCBFDHDAT"
   Flex(FlexKcBfdh).ColKey(3) = "KCBFDH_HWCKMC"
   
   Flex(FlexKcBfd).ColKey(1) = "KCBFD_HWBMCODE"
   Flex(FlexKcBfd).ColKey(2) = "KCBFD_HWBMMC"
   Flex(FlexKcBfd).ColKey(3) = "KCBFD_HWBMDW"
   Flex(FlexKcBfd).ColKey(4) = "KCBFDQTY"
   Flex(FlexKcBfd).ColKey(5) = "KCBFD_HWBFRCMC"
   Flex(FlexKcBfd).ColKey(6) = "KCBFDBZ"
   
   FillComboWithSql Me, Combo(CBxKcBfd_HwCkMc), "SELECT HwCkMc,HwCkNO FROM HwCkREC ORDER BY HwCkMc", "HWCKNO"
   
   LoadDataIntoGrid "KcBfdH"
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid(Index As String)
   Dim ItemStr As String
   Dim mKcBfdh As KcBfdh
   Dim mKcBfd As KcBfd
On Error GoTo Errorhandle
   
   Select Case UCase(Index)
   Case "KCBFDH"
   
      Flex(FlexKcBfdh).Rows = 1
      
      Set oKcBfdhs = New KcBfdhs
      oKcBfdhs.Fillbydb
         
      For Each mKcBfdh In oKcBfdhs
         ItemStr = vbTab & mKcBfdh.KcBfdhDocno & vbTab & mKcBfdh.KcBfdhDat & vbTab & mKcBfdh.HwCk.HwCkMc
         Flex(FlexKcBfdh).AddItem ItemStr
         Flex(FlexKcBfdh).RowData(Flex(FlexKcBfdh).Rows - 1) = mKcBfdh.KcBfdhKey
      Next
      If Flex(FlexKcBfdh).Rows > 1 Then
         Flex(FlexKcBfdh).Row = 1
         Set oKcBfdh = oKcBfdhs(CStr(Flex(FlexKcBfdh).RowData(1)))
         SetValueToControl
      Else
         Set oKcBfdh = Nothing
         Clearcontrol
      End If
   
   Case "KCBFD"
   
      Flex(FlexKcBfd).Rows = 1
      Flex(FlexKcBfd).AddItem ""
      
      oKcBfdh.KcBfds.Fillbydb oKcBfdh
      
      For Each mKcBfd In oKcBfdh.KcBfds
         ItemStr = vbTab & mKcBfd.Hwbm.HwBmCode & vbTab & mKcBfd.Hwbm.HwBmMc & vbTab & mKcBfd.Hwbm.HwBmDw & vbTab & mKcBfd.KcBfdQty & vbTab & mKcBfd.HwBfrc.HwBfRcMc & vbTab & mKcBfd.KcBfdBz
         Flex(FlexKcBfd).AddItem ItemStr, Flex(FlexKcBfd).Rows - 1
         Flex(FlexKcBfd).RowData(Flex(FlexKcBfd).Rows - 2) = mKcBfd.KcBfdKey
      Next
      If Flex(FlexKcBfd).Rows > 2 Then
         Flex(FlexKcBfd).Row = 1
         Set oKcBfd = oKcBfdh.KcBfds(CStr(Flex(FlexKcBfd).RowData(1)))
      Else
         Set oKcBfd = Nothing
      End If
   
   End Select

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

Private Sub AddRecord()
On Error GoTo Errorhandle

   Set oKcBfdh = New KcBfdh
   Set oKcBfd = Nothing
   Clearcontrol
   Text(TxtKcBfdDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtKcBfdDocno).Text = ""
   Text(DtpKcBfdDat).Text = ""
   Combo(CBxKcBfd_HwCkMc).Text = ""
   
   Flex(FlexKcBfd).Rows = 1
   Flex(FlexKcBfd).AddItem ""
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord()
On Error GoTo Errorhandle
    
   SetValueToObject

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

Private Sub SetValueToObject()
   Dim mKcBfd As KcBfd
   Dim I As Integer
On Error GoTo Errorhandle

   oKcBfdh.KcBfdhDocno = Trim(Text(TxtKcBfdDocno).Text)
   oKcBfdh.KcBfdhDat = Dtp(DtpKcBfdDat).Value
   oKcBfdh.KcBfdh_HwCkMc = Trim(Combo(CBxKcBfd_HwCkMc).Text)
   
   For I = 1 To Flex(FlexKcBfd).Rows - 2
      Set mKcBfd = oKcBfdh.KcBfds(CStr(Flex(FlexKcBfd).RowData(I)))
      mKcBfd.KcBfd_HwBmCode = Trim(Flex(FlexKcBfd).TextMatrix(I, Flex(FlexKcBfd).ColIndex("KCBFD_HWBMCODE")))
      mKcBfd.KcBfdQty = Val(Flex(FlexKcBfd).TextMatrix(I, Flex(FlexKcBfd).ColIndex("KCBFDQTY")))
      mKcBfd.KcBfd_HwBfrcMc = Trim(Flex(FlexKcBfd).TextMatrix(I, Flex(FlexKcBfd).ColIndex("KCBFD_HWBFRCMC")))
      mKcBfd.KcBfdBz = Trim(Flex(FlexKcBfd).TextMatrix(I, Flex(FlexKcBfd).ColIndex("KCBFDBZ")))
   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 & oKcBfdh.KcBfdhDocno & vbTab & oKcBfdh.KcBfdhDat & vbTab & oKcBfdh.HwCk.HwCkMc
      Flex(FlexKcBfdh).AddItem ItemStr
      Flex(FlexKcBfdh).RowData(Flex(FlexKcBfdh).Rows - 1) = oKcBfdh.KcBfdhKey
      Flex(FlexKcBfdh).Row = Flex(FlexKcBfdh).Rows - 1
   Else
      Flex(FlexKcBfdh).TextMatrix(Flex(FlexKcBfdh).Row, Flex(FlexKcBfdh).ColIndex("KCBFDHDOCNO")) = oKcBfdh.KcBfdhDocno
      Flex(FlexKcBfdh).TextMatrix(Flex(FlexKcBfdh).Row, Flex(FlexKcBfdh).ColIndex("KCBFDHDAT")) = oKcBfdh.KcBfdhDat
      Flex(FlexKcBfdh).TextMatrix(Flex(FlexKcBfdh).Row, Flex(FlexKcBfdh).ColIndex("KCBFDH_HWCKMC")) = oKcBfdh.HwCk.HwCkMc
   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 "KCBFDH"
   
         If Flex(FlexKcBfdh).Rows = 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo) = vbYes Then
            oKcBfdhs.Remove CStr(oKcBfdh.KcBfdhKey)
            Flex(FlexKcBfdh).RemoveItem Flex(FlexKcBfdh).Row
            If Flex(FlexKcBfdh).Rows = 1 Then
               Set oKcBfd = Nothing
               Set oKcBfdh = Nothing
               Clearcontrol
            Else
               Set oKcBfdh = oKcBfdhs(CStr(Flex(FlexKcBfdh).RowData(Flex(FlexKcBfdh).Row)))
               SetValueToControl
            End If
         End If
   
   
   Case "KCBFD"
   
         If Flex(FlexKcBfd).Row = Flex(FlexKcBfd).Rows - 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo) = vbYes Then
            oKcBfdh.KcBfds.Remove CStr(oKcBfd.KcBfdKey)
            Flex(FlexKcBfd).RemoveItem Flex(FlexKcBfd).Row
            If Flex(FlexKcBfd).Rows = 2 Then
               Set oKcBfd = Nothing
               Flex(FlexKcBfdh).RemoveItem Flex(FlexKcBfdh).Row
               If Flex(FlexKcBfdh).Rows = 1 Then
                  Set oKcBfdh = Nothing
                  Clearcontrol
               Else
                  Set oKcBfdh = oKcBfdhs(CStr(Flex(FlexKcBfdh).RowData(Flex(FlexKcBfdh).Row)))
                  SetValueToControl
               End If
            Else
               If Flex(FlexKcBfd).Row = Flex(FlexKcBfd).Rows - 1 Then
                  Flex(FlexKcBfd).Row = Flex(FlexKcBfd).Row - 1
               End If
               Set oKcBfd = oKcBfdh.KcBfds(CStr(Flex(FlexKcBfd).RowData(Flex(FlexKcBfd).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 FlexKcBfdh
   
         If Flex(FlexKcBfdh).Rows > 1 Then
            Set oKcBfdh = oKcBfdhs(CStr(Flex(FlexKcBfdh).RowData(Flex(FlexKcBfdh).Row)))
            SetValueToControl
         Else
            Set oKcBfdh = Nothing
            Clearcontrol
         End If
   
   Case FlexKcBfd
   
         If Flex(FlexKcBfd).Row <> Flex(FlexKcBfd).Rows - 1 Then
            Set oKcBfd = oKcBfdh.KcBfds(CStr(Flex(FlexKcBfd).RowData(Flex(FlexKcBfd).Row)))
         Else
            Set oKcBfd = Nothing
         End If
   
   End Select
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetValueToControl()
On Error GoTo Errorhandle

   Text(TxtKcBfdDocno).Text = oKcBfdh.KcBfdhDocno
   Dtp(DtpKcBfdDat).Value = oKcBfdh.KcBfdhDat
   Combo(CBxKcBfd_HwCkMc).Text = oKcBfdh.HwCk.HwCkMc
   
   LoadDataIntoGrid "KcBfd"
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   Set oKcBfdhs = Nothing
   Set oKcBfdh = Nothing
   Set oKcBfd = 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(FlexKcBfd).Row
   mCurCol = Flex(FlexKcBfd).Col
   
   Select Case Flex(FlexKcBfd).ColKey(Flex(FlexKcBfd).Col)
   Case "KCBFD_HWBMCODE"
         If oKcBfd Is Nothing Then
            AddNewRecord
         Else
            oKcBfd.KcBfd_HwBmCode = Trim(Flex(FlexKcBfd).TextMatrix(mCurRow, mCurCol))
            Flex(FlexKcBfd).TextMatrix(mCurRow, Flex(FlexKcBfd).ColIndex("KCBFD_HWBMMC")) = oKcBfd.Hwbm.HwBmMc
            Flex(FlexKcBfd).TextMatrix(mCurRow, Flex(FlexKcBfd).ColIndex("KCBFD_HWBMDW")) = oKcBfd.Hwbm.HwBmDw
         End If
   
   Case "KCBFDQTY"
         If Not oKcBfd Is Nothing Then
            oKcBfd.KcBfdQty = Val(Flex(FlexKcBfd).TextMatrix(Flex(FlexKcBfd).Row, mCurCol))
         End If
   
   Case "KCBFD_HWBFRCMC"
         If Not oKcBfd Is Nothing Then
            oKcBfd.KcBfd_HwBfrcMc = Trim(Flex(FlexKcBfd).TextMatrix(Flex(FlexKcBfd).Row, mCurCol))
         End If
   
   Case "KCBFDBZ"
         If Not oKcBfd Is Nothing Then
            oKcBfd.KcBfdBz = Trim(Flex(FlexKcBfd).TextMatrix(Flex(FlexKcBfd).Row, mCurCol))
         End If
   
   End Select
   

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

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

   mCurRow = Flex(FlexKcBfd).Row

   If Trim(Flex(FlexKcBfd).TextMatrix(mCurRow, Flex(FlexKcBfd).Col)) <> "" Then
      Set oKcBfd = New KcBfd
      Set oKcBfd.KcBfdh = oKcBfdh
      oKcBfd.KcBfd_HwBmCode = Trim(Flex(FlexKcBfd).TextMatrix(mCurRow, Flex(FlexKcBfd).Col))
      oKcBfdh.KcBfds.Add oKcBfd, 0
      Flex(FlexKcBfd).TextMatrix(mCurRow, Flex(FlexKcBfd).ColIndex("KCBFD_HWBMMC")) = oKcBfd.Hwbm.HwBmMc
      Flex(FlexKcBfd).TextMatrix(mCurRow, Flex(FlexKcBfd).ColIndex("KCBFD_HWBMDW")) = oKcBfd.Hwbm.HwBmDw
      Flex(FlexKcBfd).RowData(Flex(FlexKcBfd).Rows - 1) = oKcBfd.KcBfdKey
      Flex(FlexKcBfd).AddItem ""
   End If

Exit Sub
Errorhandle:
   Set oKcBfd = 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