xsfhds.cls

企业的进销存源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "XsFhds"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'QQ:75347626
'MSN:[e-mail]
Option Explicit
Dim OXsFhds As Collection

Public Property Get Name() As String
   Name = "XsFhds"
End Property

Private Sub Class_Initialize()
   Set OXsFhds = New Collection
End Sub

Public Sub Add(oXsFhd As XsFhd, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vXsFhd As XsFhd
   For Each vXsFhd In OXsFhds
      If mKey < vXsFhd.XsFhdKey Then
         mKey = vXsFhd.XsFhdKey
      End If
   Next
   oXsFhd.XsFhdKey = mKey + 1
   If Needsave = 1 Then
      oXsFhd.Save
   End If
   OXsFhds.Add Item:=oXsFhd, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim oXsFhd As XsFhd
   Set oXsFhd = Item(Vindex)
   If Needdel = 1 And oXsFhd.XsFhdId = 1 Then
      oXsFhd.Del
   End If
   OXsFhds.Remove (Vindex)
   Set oXsFhd = Nothing
   
End Sub

Public Property Get Count() As Integer
   Count = OXsFhds.Count
End Property

Public Function Item(Vindex) As XsFhd
Attribute Item.VB_UserMemId = 0
   Set Item = OXsFhds.Item(Vindex)
End Function

Public Sub ClearAll()
   Dim I, Vcount As Integer
   Vcount = OXsFhds.Count
   For I = 1 To Vcount
      OXsFhds.Remove (1)
   Next
End Sub

Public Sub Fillbydb(vXsFhdh As XsFhdh)
   Dim oXsFhd As XsFhd
   Dim mRs As ADODB.Recordset
   Dim mKey As Integer
On Error GoTo Errorhandle

   ClearAll
   Set mRs = Conn.Execute("SELECT XSFHD_XSFHDHNO,XSFHD_XSSODDOCNO=COALESCE((SELECT XSSODHDOCNO FROM XSSODHREC,XSSODREC WHERE XSSODNO=XSFHD_XSSODNO AND XSSODHNO=XSSOD_XSSODHNO),''),XSFHD_XSSODNO,XsFhd_HWBMCODE=HWBMCODE,XsFhd_HWBMNO,XSFHD_HWCKMC=HWCKMC,XSFHD_HWCKNO,XsFhdQTY,XsFhdPRICE,XsFhdAMT,XsFhdBZ,XsFhdSYSDAT,XsFhdSYSTIME,XsFhdNO FROM XsFhdREC,HWBMREC,HWCKREC WHERE XSFHD_XSFHDHNO=" & CStr(vXsFhdh.XsFhdhNo) & " AND HWBMNO=XsFhd_HWBMNO AND HWCKNO=XSFHD_HWCKNO")
   
   mKey = 1
   Do Until mRs.EOF
      Set oXsFhd = New XsFhd
      Set oXsFhd.XsFhdh = vXsFhdh
      oXsFhd.XsFhdKey = mKey
      oXsFhd.BatchLet mRs!XsFhd_XsFhdhno, mRs!XsFhd_XsSodDocno, mRs!XsFhd_XsSodno, mRs!XsFhd_HwBmCode, mRs!XsFhd_HwBmno, mRs!XsFhd_HwCkMc, mRs!XsFhd_HwCkno, mRs!XsFhdQty, mRs!XsFhdPrice, mRs!XsFhdAmt, mRs!XsFhdBz, mRs!XsFhdSysDat, mRs!XsFhdSysTime, mRs!XsFhdNo
      OXsFhds.Add Item:=oXsFhd, Key:=CStr(mKey)
      mRs.MoveNext
      mKey = mKey + 1
   Loop
   
   mRs.Close
   Set mRs = Nothing

Exit Sub
Errorhandle:
   If Not mRs Is Nothing Then
     mRs.Close
   End If
   Set mRs = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
  Set NewEnum = OXsFhds.[_NewEnum]
End Function

Private Sub Class_Terminate()
   ClearAll
   Set OXsFhds = Nothing
End Sub

Public Sub Save(vXsFhdh As XsFhdh)
   Dim mNotSaved As Collection
   Dim mXsFhd As XsFhd
On Error GoTo Errorhandle
   
   Set mNotSaved = New Collection
   
   For Each mXsFhd In vXsFhdh.XsFhds
      If mXsFhd.XsFhdId = -1 Then
         mNotSaved.Add mXsFhd
      End If
      mXsFhd.Save
   Next
   
   Set mNotSaved = Nothing
   
Exit Sub
Errorhandle:
   For Each mXsFhd In mNotSaved
      mXsFhd.XsFhdId = -1
   Next
   Set mNotSaved = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub