frmxsthdar.frm

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

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(TlbXsFhdAr).Tag = "" Then
      Exit Sub
   End If
   
   Select Case Index
   Case CBxXsFhdArh_KhCode
         If Trim(Combo(CBxXsFhdArh_KhCode).Text) <> "" Then
            oXsFhdArh.XsFhdArh_KhCode = Combo(CBxXsFhdArh_KhCode).Text
            Combo(CBxXsFhdArh_CwBzCode).Text = oXsFhdArh.XsFhdArh_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(TlbXsFhdAr).Tag = "" Then
      Cancel = True
   End If
   
   If oXsFhdArh Is Nothing Then
      Cancel = True
   End If

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

   Select Case Flex(FlexXsFhdAr).ColKey(Col)
   Case "HWBMCODE"
         
   Case "HWCKMC", "XSFHDAR_HWDWCONV", "XSFHDARQTY", "XSFHDARPRICE", "XSFHDARAMT", "XSFHDARBZ"
         If oXsFhdAr Is Nothing Then
            Cancel = True
         End If
         
   Case "HWDWCODE"
         If oXsFhdAr Is Nothing Then
            Cancel = True
         End If
         
   Case "CWSMCODE"
         If oXsFhdAr 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(TxtXsFhdArhDocno).SetFocus
  
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo Errorhandle
  
   Flex(FlexXsFhdAr).Editable = flexEDKbdMouse
   
   Flex(FlexXsFhdAr).ColKey(1) = "XSSODHDOCNO"
   Flex(FlexXsFhdAr).ColKey(2) = "HWBMCODE"
   Flex(FlexXsFhdAr).ColKey(3) = "HWBMMC"
   Flex(FlexXsFhdAr).ColKey(4) = "HWDWCODE"
   Flex(FlexXsFhdAr).ColKey(5) = "XSFHDAR_HWDWCONV"
   Flex(FlexXsFhdAr).ColKey(6) = "HWCKMC"
   Flex(FlexXsFhdAr).ColKey(7) = "XSFHDARQTY"
   Flex(FlexXsFhdAr).ColKey(8) = "XSFHDARPRICE"
   Flex(FlexXsFhdAr).ColKey(9) = "XSFHDARAMT"
   Flex(FlexXsFhdAr).ColKey(10) = "CWSMCODE"
   Flex(FlexXsFhdAr).ColKey(11) = "XSFHDARBZ"
      
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbXsFhdAr), Img(ImgXsFhdAr), SBar(SbarXsFhdAr)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "XSFHDAR", "TXTXsFhdArHDOCNO", "CBXCWBZCODE"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexXsFhdAr), Text(TxtXsFhdArhDocno)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Text(TxtTotalQty), Text(TxtTotalAmt)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Text(TxtTotalQty), Text(TxtTotalAmt)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   gPublicFunction.FillComboWithSql Me, Combo(CBxXsFhdArh_KhCode), "SELECT KHCODE,KHNO FROM KHREC WHERE KHTYPE=1 ORDER BY KHCODE", "KHNO", 0
   gPublicFunction.FillComboWithSql Me, Combo(CBxXsFhdArh_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 mXsFhdArh As XsFhdArh
   Dim mXsFhdAr As XsFhdAr
On Error GoTo Errorhandle
   
   Flex(FlexXsFhdAr).Rows = 1
   Flex(FlexXsFhdAr).AddItem ""
   
   oXsFhdArh.XsFhdArs.FillbyDb oXsFhdArh
   
   For Each mXsFhdAr In oXsFhdArh.XsFhdArs
      ItemStr = vbTab & mXsFhdAr.XsFhdAr_XsSodDocno & vbTab & mXsFhdAr.XsFhdAr_HwBmCode & vbTab & mXsFhdAr.XsFhdAr_HwBmMc
      ItemStr = ItemStr & vbTab & mXsFhdAr.XsFhdAr_HwDwCode & vbTab & mXsFhdAr.XsFhdAr_HwDwConv & vbTab & mXsFhdAr.XsFhdAr_HwCkMc
      ItemStr = ItemStr & vbTab & mXsFhdAr.XsFhdArQty & vbTab & mXsFhdAr.XsFhdArPrice & vbTab & mXsFhdAr.XsFhdArAmt & vbTab & mXsFhdAr.XsFhdAr_CwSmCode & vbTab & mXsFhdAr.XsFhdArBz
      Flex(FlexXsFhdAr).AddItem ItemStr, Flex(FlexXsFhdAr).Rows - 1
      Flex(FlexXsFhdAr).RowData(Flex(FlexXsFhdAr).Rows - 2) = mXsFhdAr.XsFhdArKey
   Next
   If Flex(FlexXsFhdAr).Rows > 2 Then
      Flex(FlexXsFhdAr).Row = 1
      Set oXsFhdAr = oXsFhdArh.XsFhdArs(CStr(Flex(FlexXsFhdAr).RowData(1)))
   Else
      Set oXsFhdAr = Nothing
   End If
   
   gPublicFunction.SumFlexQtyAmt Flex(FlexXsFhdAr), "XSFHDARQTY,XSFHDARAMT", Text(TxtTotalQty), Text(TxtTotalAmt)


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

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

   Set oXsFhdArh = New XsFhdArh
   Set oXsFhdAr = Nothing
   Clearcontrol
   Text(TxtXsFhdArhDocno).SetFocus
   
   If Text(TxtXsFhdArhDat).Text = "" Then
      Text(TxtXsFhdArhDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
   End If
   
   oXsFhdArh.XsFhdArhDat = Trim(Text(TxtXsFhdArhDat).Text)
   Text(TxtXsFhdArh_CwqjCode).Text = oXsFhdArh.XsFhdArh_CwQjCode
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbXsFhdAr), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

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

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

   If oXsFhdArh.XsFhdArhId = -1 Then
      Clearcontrol
      Set oXsFhdAr = Nothing
      Set oXsFhdArh = Nothing
   Else
      oXsFhdArh.Requery oXsFhdArh.XsFhdArhDocno
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbXsFhdAr), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub


Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtXsFhdArhDocno).Text = ""
   Text(TxtXsFhdArh_CwqjCode).Text = ""
   Combo(CBxXsFhdArh_KhCode).Text = ""
   Combo(CBxXsFhdArh_CwBzCode).Text = ""
   
   Text(TxtTotalQty).Text = ""
   Text(TxtTotalAmt).Text = ""
   
   Flex(FlexXsFhdAr).Rows = 1
   Flex(FlexXsFhdAr).AddItem ""
   
   Text(TxtXsFhdArhDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

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

Private Sub SetValueToObject()
   Dim mXsFhdAr As XsFhdAr
   Dim I As Integer
On Error GoTo Errorhandle

   oXsFhdArh.XsFhdArhType = 2
   oXsFhdArh.XsFhdArhDocno = Trim(Text(TxtXsFhdArhDocno).Text)
   oXsFhdArh.XsFhdArhDat = gPublicFunction.ConvDateToString(Text(TxtXsFhdArhDat).Text)
   oXsFhdArh.XsFhdArh_CwQjCode = Trim(Text(TxtXsFhdArh_CwqjCode).Text)
   oXsFhdArh.XsFhdArh_KhCode = Trim(Combo(CBxXsFhdArh_KhCode).Text)
   oXsFhdArh.XsFhdArh_CwBzCode = Trim(Combo(CBxXsFhdArh_CwBzCode).Text)
   oXsFhdArh.XsFhdArhForm = UCase(Me.Name)
   
   For I = 1 To Flex(FlexXsFhdAr).Rows - 2
      Set mXsFhdAr = oXsFhdArh.XsFhdArs(CStr(Flex(FlexXsFhdAr).RowData(I)))
      mXsFhdAr.XsFhdAr_HwBmCode = Trim(Flex(FlexXsFhdAr).TextMatrix(I, Flex(FlexXsFhdAr).ColIndex("HWBMCODE")))
      mXsFhdAr.XsFhdAr_HwDwCode = Trim(Flex(FlexXsFhdAr).TextMatrix(I, Flex(FlexXsFhdAr).ColIndex("HWDWCODE")))
      mXsFhdAr.XsFhdAr_HwDwConv = Val(Flex(FlexXsFhdAr).TextMatrix(I, Flex(FlexXsFhdAr).ColIndex("XSFHDAR_HWDWCONV")))
      mXsFhdAr.XsFhdAr_HwCkMc = Trim(Flex(FlexXsFhdAr).TextMatrix(I, Flex(FlexXsFhdAr).ColIndex("HWCKMC")))
      mXsFhdAr.XsFhdArQty = Val(Flex(FlexXsFhdAr).TextMatrix(I, Flex(FlexXsFhdAr).ColIndex("XSFHDARQTY")))
      mXsFhdAr.XsFhdArPrice = Val(Flex(FlexXsFhdAr).TextMatrix(I, Flex(FlexXsFhdAr).ColIndex("XSFHDARPRICE")))
      mXsFhdAr.XsFhdArAmt = Val(Flex(FlexXsFhdAr).TextMatrix(I, Flex(FlexXsFhdAr).ColIndex("XSFHDARAMT")))
      mXsFhdAr.XsFhdAr_CwSmCode = Trim(Flex(FlexXsFhdAr).TextMatrix(I, Flex(FlexXsFhdAr).ColIndex("CWSMCODE")))
      mXsFhdAr.XsFhdArBz = Trim(Flex(FlexXsFhdAr).TextMatrix(I, Flex(FlexXsFhdAr).ColIndex("XSFHDARBZ")))
   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 oXsFhdArh Is Nothing Then
            Err.Raise vbObjectError + 1, , "无单据，不能进行删除！"
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo + vbQuestion) = vbYes Then
            oXsFhdArh.Del
            Set oXsFhdAr = Nothing
            Set oXsFhdArh = Nothing
            Clearcontrol
         End If
   
   Case "DEF"
   
         If Flex(FlexXsFhdAr).Row = Flex(FlexXsFhdAr).Rows - 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo + vbQuestion) = vbYes Then
            oXsFhdArh.XsFhdArs.Remove CStr(oXsFhdAr.XsFhdArKey)
            Flex(FlexXsFhdAr).RemoveItem Flex(FlexXsFhdAr).Row
            If Flex(FlexXsFhdAr).Rows = 2 Then
               Set oXsFhdAr = Nothing
               Set oXsFhdArh = Nothing
               Clearcontrol
               gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbXsFhdAr), "CAN"
            Else
               If Flex(FlexXsFhdAr).Row = Flex(FlexXsFhdAr).Rows - 1 Then
                  Flex(FlexXsFhdAr).Row = Flex(FlexXsFhdAr).Row - 1
               End If
               Set oXsFhdAr = oXsFhdArh.XsFhdArs(CStr(Flex(FlexXsFhdAr).RowData(Flex(FlexXsFhdAr).Row)))
            End If
         End If
         
         gPublicFunction.SumFlexQtyAmt Flex(FlexXsFhdAr), "XSFHDARQTY,XSFHDARAMT", Text(TxtTotalQty), Text(TxtTotalAmt)