frmxsfhd.frm

初级进销存系统学习,想学数据库编程的可以参考此示例

Dim oXsFhdhs As XsFhdhs
Dim oXsFhdh As XsFhdh
Dim oXsFhd As XsFhd

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

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

   Select Case Flex(FlexXsFhd).ColKey(Col)
   Case "XSFHD_HWBMCODE"
         
   Case "XSFHDQTY", "XSFHDPRICE", "XSFHDBZ"
         If oXsFhd 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(FlexXsFhd).Editable = flexEDKbdMouse
   
   Flex(FlexXsFhdh).ColKey(1) = "XSFHDHDOCNO"
   Flex(FlexXsFhdh).ColKey(2) = "XSFHDHDAT"
   Flex(FlexXsFhdh).ColKey(3) = "XSFHDH_KHCODE"
   
   Flex(FlexXsFhd).ColKey(1) = "XSFHD_XSSODDOCNO"
   Flex(FlexXsFhd).ColKey(2) = "XSFHD_HWBMCODE"
   Flex(FlexXsFhd).ColKey(3) = "XSFHD_HWBMMC"
   Flex(FlexXsFhd).ColKey(4) = "XSFHD_HWBMDW"
   Flex(FlexXsFhd).ColKey(5) = "XSFHD_HWCKMC"
   Flex(FlexXsFhd).ColKey(6) = "XSFHDQTY"
   Flex(FlexXsFhd).ColKey(7) = "XSFHDPRICE"
   Flex(FlexXsFhd).ColKey(8) = "XSFHDAMT"
   Flex(FlexXsFhd).ColKey(9) = "XSFHDBZ"
   
   FillComboWithSql Me, Combo(CBxXsFhd_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=1 ORDER BY KHCODE", "KHNO"
   
   LoadDataIntoGrid "XsFhdH"
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid(Index As String)
   Dim ItemStr As String
   Dim mXsFhdh As XsFhdh
   Dim mXsFhd As XsFhd
On Error GoTo Errorhandle
   
   Select Case UCase(Index)
   Case "XSFHDH"
   
      Flex(FlexXsFhdh).Rows = 1
      
      Set oXsFhdhs = New XsFhdhs
      oXsFhdhs.Fillbydb " XSFHDHTYPE=1 "
         
      For Each mXsFhdh In oXsFhdhs
         ItemStr = vbTab & mXsFhdh.XsFhdhDocno & vbTab & mXsFhdh.XsFhdhDat & vbTab & mXsFhdh.Kh.KhCode
         Flex(FlexXsFhdh).AddItem ItemStr
         Flex(FlexXsFhdh).RowData(Flex(FlexXsFhdh).Rows - 1) = mXsFhdh.XsFhdhKey
      Next
      If Flex(FlexXsFhdh).Rows > 1 Then
         Flex(FlexXsFhdh).Row = 1
         Set oXsFhdh = oXsFhdhs(CStr(Flex(FlexXsFhdh).RowData(1)))
         SetValueToControl
      Else
         Set oXsFhdh = Nothing
         Clearcontrol
      End If
   
   Case "XSFHD"
   
      Flex(FlexXsFhd).Rows = 1
      Flex(FlexXsFhd).AddItem ""
      
      oXsFhdh.XsFhds.Fillbydb oXsFhdh
      
      For Each mXsFhd In oXsFhdh.XsFhds
         ItemStr = vbTab & mXsFhd.XsSod.XsSodh.XsSodhDocno & vbTab & mXsFhd.Hwbm.HwBmCode & vbTab & mXsFhd.Hwbm.HwBmMc & vbTab & mXsFhd.Hwbm.HwBmDw & vbTab & mXsFhd.HwCk.HwCkMc & vbTab & mXsFhd.XsFhdQty & vbTab & mXsFhd.XsFhdPrice & vbTab & mXsFhd.XsFhdAmt & mXsFhd.XsFhdBz
         Flex(FlexXsFhd).AddItem ItemStr, Flex(FlexXsFhd).Rows - 1
         Flex(FlexXsFhd).RowData(Flex(FlexXsFhd).Rows - 2) = mXsFhd.XsFhdKey
      Next
      If Flex(FlexXsFhd).Rows > 2 Then
         Flex(FlexXsFhd).Row = 1
         Set oXsFhd = oXsFhdh.XsFhds(CStr(Flex(FlexXsFhd).RowData(1)))
      Else
         Set oXsFhd = Nothing
      End If
   
   End Select

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

Private Sub AddRecord()
On Error GoTo Errorhandle

   Set oXsFhdh = New XsFhdh
   Set oXsFhd = Nothing
   Clearcontrol
   Text(TxtXsFhdDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtXsFhdDocno).Text = ""
   Text(DtpXsFhdDat).Text = ""
   Combo(CBxXsFhd_KhCode).Text = ""
   
   Flex(FlexXsFhd).Rows = 1
   Flex(FlexXsFhd).AddItem ""
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord()
On Error GoTo Errorhandle
    
   SetValueToObject

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

Private Sub SetValueToObject()
   Dim mXsFhd As XsFhd
   Dim I As Integer
On Error GoTo Errorhandle

   oXsFhdh.XsFhdhType = 1
   oXsFhdh.XsFhdhDocno = Trim(Text(TxtXsFhdDocno).Text)
   oXsFhdh.XsFhdhDat = Dtp(DtpXsFhdDat).Value
   oXsFhdh.XsFhdh_KhCode = Trim(Combo(CBxXsFhd_KhCode).Text)
   
   For I = 1 To Flex(FlexXsFhd).Rows - 2
      Set mXsFhd = oXsFhdh.XsFhds(CStr(Flex(FlexXsFhd).RowData(I)))
      mXsFhd.XsFhd_HwBmCode = Trim(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("XSFHD_HWBMCODE")))
      mXsFhd.XsFhd_HwCkMc = Trim(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("XSFHD_HWCKMC")))
      mXsFhd.XsFhdQty = Val(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("XSFHDQTY")))
      mXsFhd.XsFhdPrice = Val(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("XSFHDPRICE")))
      mXsFhd.XsFhdBz = Trim(Flex(FlexXsFhd).TextMatrix(I, Flex(FlexXsFhd).ColIndex("XSFHDBZ")))
   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 & oXsFhdh.XsFhdhDocno & vbTab & oXsFhdh.XsFhdhDat & vbTab & oXsFhdh.Kh.KhCode
      Flex(FlexXsFhdh).AddItem ItemStr
      Flex(FlexXsFhdh).RowData(Flex(FlexXsFhdh).Rows - 1) = oXsFhdh.XsFhdhKey
      Flex(FlexXsFhdh).Row = Flex(FlexXsFhdh).Rows - 1
   Else
      Flex(FlexXsFhdh).TextMatrix(Flex(FlexXsFhdh).Row, Flex(FlexXsFhdh).ColIndex("XSFHDHDOCNO")) = oXsFhdh.XsFhdhDocno
      Flex(FlexXsFhdh).TextMatrix(Flex(FlexXsFhdh).Row, Flex(FlexXsFhdh).ColIndex("XSFHDHDAT")) = oXsFhdh.XsFhdhDat
      Flex(FlexXsFhdh).TextMatrix(Flex(FlexXsFhdh).Row, Flex(FlexXsFhdh).ColIndex("XSFHDH_KHCODE")) = oXsFhdh.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 "XSFHDH"
   
         If Flex(FlexXsFhdh).Rows = 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo) = vbYes Then
            oXsFhdhs.Remove CStr(oXsFhdh.XsFhdhKey)
            Flex(FlexXsFhdh).RemoveItem Flex(FlexXsFhdh).Row
            If Flex(FlexXsFhdh).Rows = 1 Then
               Set oXsFhd = Nothing
               Set oXsFhdh = Nothing
               Clearcontrol
            Else
               Set oXsFhdh = oXsFhdhs(CStr(Flex(FlexXsFhdh).RowData(Flex(FlexXsFhdh).Row)))
               SetValueToControl
            End If
         End If
   
   
   Case "XSFHD"
   
         If Flex(FlexXsFhd).Row = Flex(FlexXsFhd).Rows - 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo) = vbYes Then
            oXsFhdh.XsFhds.Remove CStr(oXsFhd.XsFhdKey)
            Flex(FlexXsFhd).RemoveItem Flex(FlexXsFhd).Row
            If Flex(FlexXsFhd).Rows = 2 Then
               Set oXsFhd = Nothing
               Flex(FlexXsFhdh).RemoveItem Flex(FlexXsFhdh).Row
               If Flex(FlexXsFhdh).Rows = 1 Then
                  Set oXsFhdh = Nothing
               Else
                  Set oXsFhdh = oXsFhdhs(CStr(Flex(FlexXsFhdh).RowData(Flex(FlexXsFhdh).Row)))
                  SetValueToControl
               End If
            Else
               If Flex(FlexXsFhd).Row = Flex(FlexXsFhd).Rows - 1 Then
                  Flex(FlexXsFhd).Row = Flex(FlexXsFhd).Row - 1
               End If
               Set oXsFhd = oXsFhdh.XsFhds(CStr(Flex(FlexXsFhd).RowData(Flex(FlexXsFhd).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 FlexXsFhdh
   
         If Flex(FlexXsFhdh).Rows > 1 Then
            Set oXsFhdh = oXsFhdhs(CStr(Flex(FlexXsFhdh).RowData(Flex(FlexXsFhdh).Row)))
            SetValueToControl
         Else
            Set oXsFhdh = Nothing
            Clearcontrol
         End If
   
   Case FlexXsFhd
   
         If Flex(FlexXsFhd).Row <> Flex(FlexXsFhd).Rows - 1 Then
            Set oXsFhd = oXsFhdh.XsFhds(CStr(Flex(FlexXsFhd).RowData(Flex(FlexXsFhd).Row)))
         Else
            Set oXsFhd = Nothing
         End If
   
   End Select
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetValueToControl()
On Error GoTo Errorhandle

   Text(TxtXsFhdDocno).Text = oXsFhdh.XsFhdhDocno
   Dtp(DtpXsFhdDat).Value = oXsFhdh.XsFhdhDat
   Combo(CBxXsFhd_KhCode).Text = oXsFhdh.Kh.KhCode
   
   LoadDataIntoGrid "XsFhd"
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   Set oXsFhdhs = Nothing
   Set oXsFhdh = Nothing
   Set oXsFhd = 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(FlexXsFhd).Row
   mCurCol = Flex(FlexXsFhd).Col
   
   Select Case Flex(FlexXsFhd).ColKey(Flex(FlexXsFhd).Col)
   Case "XSFHD_HWBMCODE"
         If oXsFhd Is Nothing Then
            AddNewRecord
         Else
            oXsFhd.XsFhd_HwBmCode = Trim(Flex(FlexXsFhd).TextMatrix(mCurRow, mCurCol))
            Flex(FlexXsFhd).TextMatrix(mCurRow, Flex(FlexXsFhd).ColIndex("XSFHD_HWBMMC")) = oXsFhd.Hwbm.HwBmMc
            Flex(FlexXsFhd).TextMatrix(mCurRow, Flex(FlexXsFhd).ColIndex("XSFHD_HWBMDW")) = oXsFhd.Hwbm.HwBmDw
         End If
   
   Case "XSFHD_HWCKMC"
         If Not oXsFhd Is Nothing Then
            oXsFhd.XsFhd_HwCkMc = Trim(Flex(FlexXsFhd).TextMatrix(mCurRow, mCurCol))
         End If
   
   Case "XSFHDQTY"
         If Not oXsFhd Is Nothing Then
            oXsFhd.XsFhdQty = Val(Flex(FlexXsFhd).TextMatrix(Flex(FlexXsFhd).Row, mCurCol))
            Flex(FlexXsFhd).TextMatrix(Flex(FlexXsFhd).Row, Flex(FlexXsFhd).ColIndex("XSFHDAMT")) = oXsFhd.XsFhdAmt
         End If
   
   Case "XSFHDPRICE"
         If Not oXsFhd Is Nothing Then
            oXsFhd.XsFhdPrice = Val(Flex(FlexXsFhd).TextMatrix(Flex(FlexXsFhd).Row, mCurCol))
            Flex(FlexXsFhd).TextMatrix(Flex(FlexXsFhd).Row, Flex(FlexXsFhd).ColIndex("XSFHDAMT")) = oXsFhd.XsFhdAmt
         End If
   
   Case "XSFHDBZ"
         If Not oXsFhd Is Nothing Then
            oXsFhd.XsFhdBz = Trim(Flex(FlexXsFhd).TextMatrix(Flex(FlexXsFhd).Row, mCurCol))
         End If
   
   End Select


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

   If Trim(Flex(FlexXsFhd).TextMatrix(mCurRow, Flex(FlexXsFhd).Col)) <> "" Then
      Set oXsFhd = New XsFhd
      Set oXsFhd.XsFhdh = oXsFhdh
      oXsFhd.XsFhd_HwBmCode = Trim(Flex(FlexXsFhd).TextMatrix(mCurRow, Flex(FlexXsFhd).Col))
      oXsFhdh.XsFhds.Add oXsFhd, 0
      Flex(FlexXsFhd).TextMatrix(mCurRow, Flex(FlexXsFhd).ColIndex("XSFHD_HWBMMC")) = oXsFhd.Hwbm.HwBmMc
      Flex(FlexXsFhd).TextMatrix(mCurRow, Flex(FlexXsFhd).ColIndex("XSFHD_HWBMDW")) = oXsFhd.Hwbm.HwBmDw
      Flex(FlexXsFhd).RowData(Flex(FlexXsFhd).Rows - 1) = oXsFhd.XsFhdKey
      Flex(FlexXsFhd).AddItem ""
   End If

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