frmscbcd.frm

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

Attribute VB_Name = "frmScBCd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const TlbScBcd = 0
Const ImgScBcd = 0
Const SbarScBcd = 0

Const FrmScBcdh = 0

Const FlexScBcd = 0

Const TxtScBcdhDocno = 0
Const TxtScBcdhDat = 6
Const TxtScBcdh_CwqjCode = 5

Const CBxScBcdh_PsBmCode = 0

Const TxtTotal_ScdQty = 4
Const TxtTotal_ScdWQty = 1
Const TxtTotal_ScBcdQty = 3
Const TxtTotalAmt = 2

Dim mCurColOldValue As String

Dim oScBcdh As ScBcdh
Dim oScBcd As ScBcd

Public Sub LetDocno(vDocno As String)
On Error GoTo ErrorHandle

   Text(TxtScBcdhDocno).Text = vDocno
   Text_LostFocus TxtScBcdhDocno

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

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 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(TlbScBcd).Tag = "" Then
      Cancel = True
   End If
   
   If oScBcdh Is Nothing Then
      Cancel = True
   End If

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

   Select Case Flex(FlexScBcd).ColKey(Col)
         
   Case "HWCKMC", "SCBCD_HWDWCONV", "SCBCDQTY", "SCBCDPRICE", "SCBCDAMT", "SCBCDBZ"
         If oScBcd Is Nothing Then
            Cancel = True
         End If
         
   Case "HWDWCODE"
         If oScBcd 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(TxtScBcdhDocno).SetFocus
  
Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo ErrorHandle
  
   Flex(FlexScBcd).Editable = flexEDKbdMouse
   
   Flex(FlexScBcd).ColKey(1) = "SCDDOCNO"
   Flex(FlexScBcd).ColKey(2) = "HWBMCODE"
   Flex(FlexScBcd).ColKey(3) = "HWBMMC"
   Flex(FlexScBcd).ColKey(4) = "HWDWCODE"
   Flex(FlexScBcd).ColKey(5) = "SCBCD_HWDWCONV"
   Flex(FlexScBcd).ColKey(6) = "HWCKMC"
   Flex(FlexScBcd).ColKey(7) = "SCDQTY"
   Flex(FlexScBcd).ColKey(8) = "SCDWQTY"
   Flex(FlexScBcd).ColKey(9) = "SCBCDQTY"
   Flex(FlexScBcd).ColKey(10) = "SCBCDPRICE"
   Flex(FlexScBcd).ColKey(11) = "SCBCDAMT"
   Flex(FlexScBcd).ColKey(12) = "SCBCDBZ"
      
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbScBcd), Img(ImgScBcd), SBar(SbarScBcd)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "ScBcd", "TXTScBcdHDOCNO", "CBXPSBMCODE"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Flex(FlexScBcd), Text(TxtScBcdhDocno)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "ADD", Text(TxtTotal_ScdQty), Text(TxtTotal_ScdWQty), Text(TxtTotal_ScBcdQty), Text(TxtTotalAmt)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "CHG", Text(TxtTotal_ScdQty), Text(TxtTotal_ScdWQty), Text(TxtTotal_ScBcdQty), Text(TxtTotalAmt)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   gPublicFunction.FillComboWithSql Me, Combo(CBxScBcdh_PsBmCode), "SELECT PsBmCODE,PsBmNO FROM PsBmREC ORDER BY PsBmCODE", "PsBmNO", 0
  
Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub LoadDataIntoGrid()
   Dim Itemstr As String
   Dim mScBcdh As ScBcdh
   Dim mScBcd As ScBcd
On Error GoTo ErrorHandle
   
   Flex(FlexScBcd).Rows = 1
   Flex(FlexScBcd).AddItem ""
   
   oScBcdh.ScBcds.FillbyDb oScBcdh
   
   For Each mScBcd In oScBcdh.ScBcds
      Itemstr = vbTab & mScBcd.ScBcd_ScdDocno & vbTab & mScBcd.ScBcd_HwBmCode & vbTab & mScBcd.ScBcd_HwBmMc
      Itemstr = Itemstr & vbTab & mScBcd.ScBcd_HwDwCode & vbTab & mScBcd.ScBcd_HwDwConv & vbTab & mScBcd.ScBcd_HwCkMc
      Itemstr = Itemstr & vbTab & mScBcd.ScBcd_ScdQty & vbTab & mScBcd.ScBcd_ScdWQty & vbTab & mScBcd.ScBcdQty & vbTab & mScBcd.ScBcdPrice & vbTab & mScBcd.ScBcdAmt & vbTab & mScBcd.ScBcdBz
      Flex(FlexScBcd).AddItem Itemstr, Flex(FlexScBcd).Rows - 1
      Flex(FlexScBcd).RowData(Flex(FlexScBcd).Rows - 2) = mScBcd.ScBcdKey
   Next
   If Flex(FlexScBcd).Rows > 2 Then
      Flex(FlexScBcd).Row = 1
      Set oScBcd = oScBcdh.ScBcds(CStr(Flex(FlexScBcd).RowData(1)))
   Else
      Set oScBcd = Nothing
   End If
   
   gPublicFunction.SumFlexQtyAmt Flex(FlexScBcd), "SCDQTY,SCDWQTY,SCBCDQTY,SCBCDAMT", Text(TxtTotal_ScdQty), Text(TxtTotal_ScdWQty), Text(TxtTotal_ScBcdQty), Text(TxtTotalAmt)


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

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

   Set oScBcdh = New ScBcdh
   Set oScBcd = Nothing
   Clearcontrol
   Text(TxtScBcdhDocno).SetFocus
   
   If Text(TxtScBcdhDat).Text = "" Then
      Text(TxtScBcdhDat).Text = gPublicCommon.PublicSysDatas("SYSTEMDATE").SysDataValue
   End If
   
   oScBcdh.ScBcdhDat = Trim(Text(TxtScBcdhDat).Text)
   Text(TxtScBcdh_CwqjCode).Text = oScBcdh.ScBcdh_CwQjCode
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbScBcd), RecordName
   
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   Text(TxtScBcdhDocno).SetFocus
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbScBcd), RecordName
    
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   If oScBcdh.ScBcdhId = -1 Then
      Clearcontrol
      Set oScBcd = Nothing
      Set oScBcdh = Nothing
   Else
      oScBcdh.Requery oScBcdh.ScBcdhDocno
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbScBcd), RecordName
   
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub


Private Sub Clearcontrol()
On Error GoTo ErrorHandle

   Text(TxtScBcdhDocno).Text = ""
   Text(TxtScBcdh_CwqjCode).Text = ""
   Combo(CBxScBcdh_PsBmCode).Text = ""
   
   Text(TxtTotal_ScBcdQty).Text = ""
   Text(TxtTotalAmt).Text = ""
   
   Flex(FlexScBcd).Rows = 1
   Flex(FlexScBcd).AddItem ""
   
   Text(TxtScBcdhDocno).SetFocus
   
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord(RecordName As String)
On Error GoTo ErrorHandle
   
   SetValueToObject
   oScBcdh.Save
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbScBcd), RecordName

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

Private Sub SetValueToObject()
   Dim mScBcd As ScBcd
   Dim I As Integer
On Error GoTo ErrorHandle

   oScBcdh.ScBcdhDocno = Trim(Text(TxtScBcdhDocno).Text)
   oScBcdh.ScBcdhDat = gPublicFunction.ConvDateToString(Text(TxtScBcdhDat).Text)
   oScBcdh.ScBcdh_CwQjCode = Trim(Text(TxtScBcdh_CwqjCode).Text)
   oScBcdh.ScBcdh_PsBmCode = Trim(Combo(CBxScBcdh_PsBmCode).Text)
   oScBcdh.ScBcdhForm = UCase(Me.Name)
   
   For I = 1 To Flex(FlexScBcd).Rows - 2
      Set mScBcd = oScBcdh.ScBcds(CStr(Flex(FlexScBcd).RowData(I)))
      mScBcd.ScBcd_HwDwCode = Trim(Flex(FlexScBcd).TextMatrix(I, Flex(FlexScBcd).ColIndex("HWDWCODE")))
      mScBcd.ScBcd_HwDwConv = Val(Flex(FlexScBcd).TextMatrix(I, Flex(FlexScBcd).ColIndex("ScBcd_HWDWCONV")))
      mScBcd.ScBcd_HwCkMc = Trim(Flex(FlexScBcd).TextMatrix(I, Flex(FlexScBcd).ColIndex("HWCKMC")))
      mScBcd.ScBcdQty = Val(Flex(FlexScBcd).TextMatrix(I, Flex(FlexScBcd).ColIndex("SCBCDQTY")))
      mScBcd.ScBcdPrice = Val(Flex(FlexScBcd).TextMatrix(I, Flex(FlexScBcd).ColIndex("SCBCDPRICE")))
      mScBcd.ScBcdAmt = Val(Flex(FlexScBcd).TextMatrix(I, Flex(FlexScBcd).ColIndex("SCBCDAMT")))
      mScBcd.ScBcdBz = Trim(Flex(FlexScBcd).TextMatrix(I, Flex(FlexScBcd).ColIndex("SCBCDBZ")))
   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 oScBcdh Is Nothing Then
            Err.Raise vbObjectError + 1, , "无单据，不能进行删除！"
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo + vbQuestion) = vbYes Then
            oScBcdh.Del
            Set oScBcd = Nothing
            Set oScBcdh = Nothing
            Clearcontrol
         End If
   
   Case "DEF"
   
         If Flex(FlexScBcd).Row = Flex(FlexScBcd).Rows - 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo + vbQuestion) = vbYes Then
            oScBcdh.ScBcds.Remove CStr(oScBcd.ScBcdKey)
            Flex(FlexScBcd).RemoveItem Flex(FlexScBcd).Row
            If Flex(FlexScBcd).Rows = 2 Then
               Set oScBcd = Nothing