cgshdaps.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 = "CgShdAps"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim OCgShdAps As Collection

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

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

Public Sub Add(oCgShdAp As CgShdAp, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vCgShdAp As CgShdAp
   For Each vCgShdAp In OCgShdAps
      If mKey < vCgShdAp.CgShdApKey Then
         mKey = vCgShdAp.CgShdApKey
      End If
   Next
   oCgShdAp.CgShdApKey = mKey + 1
   If Needsave = 1 Then
      oCgShdAp.Save
   End If
   OCgShdAps.Add Item:=oCgShdAp, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim oCgShdAp As CgShdAp
   Set oCgShdAp = Item(Vindex)
   If Needdel = 1 And oCgShdAp.CgShdApId = 1 Then
      oCgShdAp.Del
   End If
   OCgShdAps.Remove (Vindex)
   Set oCgShdAp = Nothing
   
End Sub

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

Public Function Item(Vindex) As CgShdAp
Attribute Item.VB_UserMemId = 0
   Set Item = OCgShdAps.Item(Vindex)
End Function

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

Public Sub Fillbydb(vCgShdAph As CgShdAph)
   Dim oCgShdAp As CgShdAp
   Dim mRs As DbRs
   Dim mKey As Integer
   Dim mSqlStr As String
On Error GoTo Errorhandle

   ClearAll
   
   mSqlStr = "SELECT CgShdAp_CgShdApHNO,CgShdAp_CgPodDOCNO=COALESCE((SELECT CgPodHDOCNO FROM CgPodHREC,CgPodREC WHERE CgPodNO=CgShdAp_CgPodNO AND CgPodHNO=CgPod_CgPodHNO),''),CgShdAp_CgPodNO,"
   mSqlStr = mSqlStr & "CgShdAp_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=CgShdAp_HWBMNO),''),CgShdAp_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=CgShdAp_HWBMNO),''),CgShdAp_HWBMNO,"
   mSqlStr = mSqlStr & "CgShdAp_HwCkMc=COALESCE((SELECT HwCkMc FROM HWCKREC WHERE HWCKNO=CgShdAp_HWCKNO),''),CgShdAp_HWCKNO,"
   mSqlStr = mSqlStr & "CgShdAp_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=CgShdAp_HWDWNO),''),CgShdAp_HWDWNO,CgShdAp_HWDWCONV,"
   mSqlStr = mSqlStr & "CgShdApQTY,CgShdApPRICE,CgShdApAMT,CgShdApQAMT,CgShdApTAMT,CgShdApIPRICE,CgShdApIAMT,"
   mSqlStr = mSqlStr & "CgShdAp_CWSMCODE=COALESCE((SELECT CWSMCODE FROM CWSMREC WHERE CWSMNO=CgShdAp_CWSMNO),''),CgShdAp_CWSMNO,CgShdAp_CWSMCONV,"
   mSqlStr = mSqlStr & "CgShdApBZ,CgShdApMIONO,CgShdApNO FROM CgShdApREC WHERE CgShdAp_CgShdApHNO=" & CStr(vCgShdAph.CgShdAphNo)
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   mRs.MoveFirst
   
   mKey = 1
   Do Until mRs.EOF
      Set oCgShdAp = New CgShdAp
      Set oCgShdAp.CgShdAph = vCgShdAph
      oCgShdAp.CgShdApKey = mKey
      oCgShdAp.BatchLet mRs!CgShdAp_CgShdAphno, mRs!CgShdAp_CgPodDocno, mRs!CgShdAp_CgPodno, mRs!CgShdAp_HwBmCode, mRs!CgShdAp_HwBmMc, mRs!CgShdAp_HwBmno, _
                      mRs!CgShdAp_HwCkMc, mRs!CgShdAp_HwCkno, mRs!CgShdAp_HwDwCode, mRs!CgShdAp_HwDwno, mRs!CgShdAp_HwDwConv, _
                      mRs!CgShdApQty, mRs!CgShdApPrice, mRs!CgShdApAmt, mRs!CgShdApQAmt, mRs!CgShdApTAmt, mRs!CgShdApIPrice, mRs!CgShdApIAmt, _
                      mRs!CgShdAp_CwSmCode, mRs!CgShdAp_CwSmno, mRs!CgShdAp_CwsmConv, _
                      mRs!CgShdApBz, mRs!CgShdApMioNo, mRs!CgShdApNo
      OCgShdAps.Add Item:=oCgShdAp, Key:=CStr(mKey)
      mRs.MoveNext
      mKey = mKey + 1
   Loop
   
   Set mRs = Nothing

Exit Sub
Errorhandle:
   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 = OCgShdAps.[_NewEnum]
End Function

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

Public Sub Save(vCgShdAph As CgShdAph)
   Dim mNotSaved As Collection
   Dim mCgShdAp As CgShdAp
On Error GoTo Errorhandle
   
   Set mNotSaved = New Collection
   
   For Each mCgShdAp In vCgShdAph.CgShdAps
      If mCgShdAp.CgShdApId = -1 Then
         mNotSaved.Add mCgShdAp
      End If
      mCgShdAp.Save
   Next
   
   Set mNotSaved = Nothing
   
Exit Sub
Errorhandle:
   For Each mCgShdAp In mNotSaved
      mCgShdAp.CgShdApId = -1
   Next
   Set mNotSaved = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub