frmcgshd.frm

本人写了一个简单的初级进销存系统开放出来让大家学习

Dim oCgShdhs As CgShdhs
Dim oCgShdh As CgShdh
Dim oCgShd As CgShd

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

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

   Select Case Flex(FlexCgShd).ColKey(Col)
   Case "CGSHD_HWBMCODE"
         
   Case "CGSHDQTY", "CGSHDPRICE", "CGSHDBZ"
         If oCgShd Is Nothing Then
            Cancel = True
         End If
                  
   End Select

Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle
  
   Flex(FlexCgShd).Editable = flexEDKbdMouse
   
   Flex(FlexCgShdh).ColKey(1) = "CGSHDHDOCNO"
   Flex(FlexCgShdh).ColKey(2) = "CGSHDHDAT"
   Flex(FlexCgShdh).ColKey(3) = "CGSHDH_KHCODE"
   
   Flex(FlexCgShd).ColKey(1) = "CGSHD_CGPODDOCNO"
   Flex(FlexCgShd).ColKey(2) = "CGSHD_HWBMCODE"
   Flex(FlexCgShd).ColKey(3) = "CGSHD_HWBMMC"
   Flex(FlexCgShd).ColKey(4) = "CGSHD_HWBMDW"
   Flex(FlexCgShd).ColKey(5) = "CGSHD_HWCKMC"
   Flex(FlexCgShd).ColKey(6) = "CGSHDQTY"
   Flex(FlexCgShd).ColKey(7) = "CGSHDPRICE"
   Flex(FlexCgShd).ColKey(8) = "CGSHDAMT"
   Flex(FlexCgShd).ColKey(9) = "CGSHDBZ"
   
   FillComboWithSql Me, Combo(CBxCgShd_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=2 ORDER BY KHCODE", "KHNO"
   
   LoadDataIntoGrid "CgShdH"
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid(Index As String)
   Dim ItemStr As String
   Dim mCgShdh As CgShdh
   Dim mCgShd As CgShd
On Error GoTo Errorhandle
   
   Select Case UCase(Index)
   Case "CGSHDH"
   
      Flex(FlexCgShdh).Rows = 1
      
      Set oCgShdhs = New CgShdhs
      oCgShdhs.Fillbydb " CgShdHTYPE=1 "
         
      For Each mCgShdh In oCgShdhs
         ItemStr = vbTab & mCgShdh.CgShdhDocno & vbTab & mCgShdh.CgShdhDat & vbTab & mCgShdh.Kh.KhCode
         Flex(FlexCgShdh).AddItem ItemStr
         Flex(FlexCgShdh).RowData(Flex(FlexCgShdh).Rows - 1) = mCgShdh.CgShdhKey
      Next
      If Flex(FlexCgShdh).Rows > 1 Then
         Flex(FlexCgShdh).Row = 1
         Set oCgShdh = oCgShdhs(CStr(Flex(FlexCgShdh).RowData(1)))
         SetValueToControl
      Else
         Set oCgShdh = Nothing
         Clearcontrol
      End If
   
   Case "CGSHD"
   
      Flex(FlexCgShd).Rows = 1
      Flex(FlexCgShd).AddItem ""
      
      oCgShdh.CgShds.Fillbydb oCgShdh
      
      For Each mCgShd In oCgShdh.CgShds
         ItemStr = vbTab & mCgShd.CgPod.CgPodh.CgPodhDocno & vbTab & mCgShd.Hwbm.HwBmCode & vbTab & mCgShd.Hwbm.HwBmMc & vbTab & mCgShd.Hwbm.HwBmDw & vbTab & mCgShd.HwCk.HwCkMc & vbTab & mCgShd.CgShdQty & vbTab & mCgShd.CgShdPrice & vbTab & mCgShd.CgShdAmt & mCgShd.CgShdBz
         Flex(FlexCgShd).AddItem ItemStr, Flex(FlexCgShd).Rows - 1
         Flex(FlexCgShd).RowData(Flex(FlexCgShd).Rows - 2) = mCgShd.CgShdKey
      Next
      If Flex(FlexCgShd).Rows > 2 Then
         Flex(FlexCgShd).Row = 1
         Set oCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(1)))
      Else
         Set oCgShd = Nothing
      End If
   
   End Select

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

Private Sub AddRecord()
On Error GoTo Errorhandle

   Set oCgShdh = New CgShdh
   Set oCgShd = Nothing
   Clearcontrol
   Text(TxtCgShdDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtCgShdDocno).Text = ""
   Text(DtpCgShdDat).Text = ""
   Combo(CBxCgShd_KhCode).Text = ""
   
   Flex(FlexCgShd).Rows = 1
   Flex(FlexCgShd).AddItem ""
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord()
On Error GoTo Errorhandle
    
   SetValueToObject

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

Private Sub SetValueToObject()
   Dim mCgShd As CgShd
   Dim I As Integer
On Error GoTo Errorhandle

   oCgShdh.CgShdhType = 1
   oCgShdh.CgShdhDocno = Trim(Text(TxtCgShdDocno).Text)
   oCgShdh.CgShdhDat = Dtp(DtpCgShdDat).Value
   oCgShdh.CgShdh_KhCode = Trim(Combo(CBxCgShd_KhCode).Text)
   
   For I = 1 To Flex(FlexCgShd).Rows - 2
      Set mCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(I)))
      mCgShd.CgShd_HwBmCode = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CgShd_HWBMCODE")))
      mCgShd.CgShd_HwCkMc = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CgShd_HWCKMC")))
      mCgShd.CgShdQty = Val(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CgShdQTY")))
      mCgShd.CgShdPrice = Val(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CgShdPRICE")))
      mCgShd.CgShdBz = Trim(Flex(FlexCgShd).TextMatrix(I, Flex(FlexCgShd).ColIndex("CgShdBZ")))
   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 & oCgShdh.CgShdhDocno & vbTab & oCgShdh.CgShdhDat & vbTab & oCgShdh.Kh.KhCode
      Flex(FlexCgShdh).AddItem ItemStr
      Flex(FlexCgShdh).RowData(Flex(FlexCgShdh).Rows - 1) = oCgShdh.CgShdhKey
      Flex(FlexCgShdh).Row = Flex(FlexCgShdh).Rows - 1
   Else
      Flex(FlexCgShdh).TextMatrix(Flex(FlexCgShdh).Row, Flex(FlexCgShdh).ColIndex("CgShdHDOCNO")) = oCgShdh.CgShdhDocno
      Flex(FlexCgShdh).TextMatrix(Flex(FlexCgShdh).Row, Flex(FlexCgShdh).ColIndex("CgShdHDAT")) = oCgShdh.CgShdhDat
      Flex(FlexCgShdh).TextMatrix(Flex(FlexCgShdh).Row, Flex(FlexCgShdh).ColIndex("CgShdH_KHCODE")) = oCgShdh.Kh.KhCode
   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 "CGSHDH"
   
         If Flex(FlexCgShdh).Rows = 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo) = vbYes Then
            oCgShdhs.Remove CStr(oCgShdh.CgShdhKey)
            Flex(FlexCgShdh).RemoveItem Flex(FlexCgShdh).Row
            If Flex(FlexCgShdh).Rows = 1 Then
               Set oCgShd = Nothing
               Set oCgShdh = Nothing
               Clearcontrol
            Else
               Set oCgShdh = oCgShdhs(CStr(Flex(FlexCgShdh).RowData(Flex(FlexCgShdh).Row)))
               SetValueToControl
            End If
         End If
   
   
   Case "CGSHD"
   
         If Flex(FlexCgShd).Row = Flex(FlexCgShd).Rows - 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo) = vbYes Then
            oCgShdh.CgShds.Remove CStr(oCgShd.CgShdKey)
            Flex(FlexCgShd).RemoveItem Flex(FlexCgShd).Row
            If Flex(FlexCgShd).Rows = 2 Then
               Set oCgShd = Nothing
               Flex(FlexCgShdh).RemoveItem Flex(FlexCgShdh).Row
               If Flex(FlexCgShdh).Rows = 1 Then
                  Set oCgShdh = Nothing
               Else
                  Set oCgShdh = oCgShdhs(CStr(Flex(FlexCgShdh).RowData(Flex(FlexCgShdh).Row)))
                  SetValueToControl
               End If
            Else
               If Flex(FlexCgShd).Row = Flex(FlexCgShd).Rows - 1 Then
                  Flex(FlexCgShd).Row = Flex(FlexCgShd).Row - 1
               End If
               Set oCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(Flex(FlexCgShd).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 FlexCgShdh
   
         If Flex(FlexCgShdh).Rows > 1 Then
            Set oCgShdh = oCgShdhs(CStr(Flex(FlexCgShdh).RowData(Flex(FlexCgShdh).Row)))
            SetValueToControl
         Else
            Set oCgShdh = Nothing
            Clearcontrol
         End If
   
   Case FlexCgShd
   
         If Flex(FlexCgShd).Row <> Flex(FlexCgShd).Rows - 1 Then
            Set oCgShd = oCgShdh.CgShds(CStr(Flex(FlexCgShd).RowData(Flex(FlexCgShd).Row)))
         Else
            Set oCgShd = Nothing
         End If
   
   End Select
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetValueToControl()
On Error GoTo Errorhandle

   Text(TxtCgShdDocno).Text = oCgShdh.CgShdhDocno
   Dtp(DtpCgShdDat).Value = oCgShdh.CgShdhDat
   Combo(CBxCgShd_KhCode).Text = oCgShdh.Kh.KhCode
   
   LoadDataIntoGrid "CgShd"
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   Set oCgShdhs = Nothing
   Set oCgShdh = Nothing
   Set oCgShd = 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(FlexCgShd).Row
   mCurCol = Flex(FlexCgShd).Col
   
   Select Case Flex(FlexCgShd).ColKey(Flex(FlexCgShd).Col)
   Case "CGSHD_HWBMCODE"
         If oCgShd Is Nothing Then
            AddNewRecord
         Else
            oCgShd.CgShd_HwBmCode = Trim(Flex(FlexCgShd).TextMatrix(mCurRow, mCurCol))
            Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).ColIndex("CGSHD_HWBMMC")) = oCgShd.Hwbm.HwBmMc
            Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).ColIndex("CGSHD_HWBMDW")) = oCgShd.Hwbm.HwBmDw
         End If
   
   Case "CGSHD_HWCKMC"
         If Not oCgShd Is Nothing Then
            oCgShd.CgShd_HwCkMc = Trim(Flex(FlexCgShd).TextMatrix(mCurRow, mCurCol))
         End If
   
   Case "CGSHDQTY"
         If Not oCgShd Is Nothing Then
            oCgShd.CgShdQty = Val(Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, mCurCol))
            Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, Flex(FlexCgShd).ColIndex("CGSHDAMT")) = oCgShd.CgShdAmt
         End If
   
   Case "CGSHDPRICE"
         If Not oCgShd Is Nothing Then
            oCgShd.CgShdPrice = Val(Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, mCurCol))
            Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, Flex(FlexCgShd).ColIndex("CGSHDAMT")) = oCgShd.CgShdAmt
         End If
   
   Case "CGSHDBZ"
         If Not oCgShd Is Nothing Then
            oCgShd.CgShdBz = Trim(Flex(FlexCgShd).TextMatrix(Flex(FlexCgShd).Row, mCurCol))
         End If
   
   End Select
   

Exit Sub
Errorhandle:
   'Flex(FlexCgShd).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(FlexCgShd).Row

   If Trim(Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).Col)) <> "" Then
      Set oCgShd = New CgShd
      Set oCgShd.CgShdh = oCgShdh
      oCgShd.CgShd_HwBmCode = Trim(Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).Col))
      oCgShdh.CgShds.Add oCgShd, 0
      Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).ColIndex("CGSHD_HWBMMC")) = oCgShd.Hwbm.HwBmMc
      Flex(FlexCgShd).TextMatrix(mCurRow, Flex(FlexCgShd).ColIndex("CGSHD_HWBMDW")) = oCgShd.Hwbm.HwBmDw
      Flex(FlexCgShd).RowData(Flex(FlexCgShd).Rows - 1) = oCgShd.CgShdKey
      Flex(FlexCgShd).AddItem ""
   End If

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