⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 scdmflds.cls

📁 制造业产供销与往来系统源码,包括进销存及全部控件!
💻 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 = "ScdmFlds"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Dim OScdmFlds As Collection

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

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

Public Sub Add(oScdmFld As ScdmFld, Optional Needsave As Integer = 1)
   Dim mKey As Integer
   Dim vScdmFld As ScdmFld
   For Each vScdmFld In OScdmFlds
      If mKey < vScdmFld.ScdmFldKey Then
         mKey = vScdmFld.ScdmFldKey
      End If
   Next
   oScdmFld.ScdmFldKey = mKey + 1
   If Needsave = 1 Then
      oScdmFld.Save
   End If
   OScdmFlds.Add Item:=oScdmFld, Key:=CStr(mKey + 1)
End Sub

Public Sub Remove(Vindex, Optional Needdel As Integer = 1)
 
   Dim oScdmFld As ScdmFld
   Set oScdmFld = Item(Vindex)
   If Needdel = 1 And oScdmFld.ScdmFldId = 1 Then
      oScdmFld.Del
   End If
   OScdmFlds.Remove (Vindex)
   Set oScdmFld = Nothing
   
End Sub

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

Public Function Item(Vindex) As ScdmFld
Attribute Item.VB_UserMemId = 0
   Set Item = OScdmFlds.Item(Vindex)
End Function

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

Public Sub Fillbydb(vScdmFldh As ScdmFldh)
   Dim oScdmFld As ScdmFld
   Dim mRs As DbRs
   Dim mKey As Integer
   Dim mSqlStr As String
On Error GoTo Errorhandle

   ClearAll
   
   mSqlStr = "SELECT ScdmFld_ScdmFldHNO,SCDMFLD_SCDDOCNO=COALESCE((SELECT SCDDOCNO FROM SCDREC,SCDMREC WHERE SCDMNO=SCDMFLD_SCDMNO AND SCDNO=SCDM_SCDNO),''),SCDMFLD_SCDMNO,"
   mSqlStr = mSqlStr & "SCDMFLD_SCDMQTY=COALESCE((SELECT SCDMQTY FROM SCDMREC WHERE SCDMNO=SCDMFLD_SCDMNO),0),SCDMFLD_SCDMFQTY=COALESCE((SELECT SCDMFQTY FROM SCDMREC WHERE SCDMNO=SCDMFLD_SCDMNO),0),"
   mSqlStr = mSqlStr & "ScdmFld_HwBmCode=COALESCE((SELECT HwBmCode FROM HWBMREC WHERE HWBMNO=ScdmFld_HWBMNO),''),ScdmFld_HwBmMc=COALESCE((SELECT HwBmMc FROM HWBMREC WHERE HWBMNO=ScdmFld_HWBMNO),''),ScdmFld_HWBMNO,"
   mSqlStr = mSqlStr & "ScdmFld_HwCkMc=COALESCE((SELECT HwCkMc FROM HWCKREC WHERE HWCKNO=ScdmFld_HWCKNO),''),ScdmFld_HWCKNO,"
   mSqlStr = mSqlStr & "ScdmFld_HwDwCode=COALESCE((SELECT HWDWCode FROM HWDWREC WHERE HWDWNO=ScdmFld_HWDWNO),''),ScdmFld_HWDWNO,ScdmFld_HWDWCONV,"
   mSqlStr = mSqlStr & "ScdmFldQTY,ScdmFldPRICE,ScdmFldAMT,ScdmFldBZ,ScdmFldMIONO,ScdmFldNO FROM ScdmFldREC WHERE ScdmFld_ScdmFldHNO=" & CStr(vScdmFldh.ScdmFldhNo)
   
   Set mRs = New DbRs
   mRs.Fillbydb mSqlStr
   
   mRs.MoveFirst
   
   mKey = 1
   Do Until mRs.EOF
      Set oScdmFld = New ScdmFld
      Set oScdmFld.ScdmFldh = vScdmFldh
      oScdmFld.ScdmFldKey = mKey
      oScdmFld.BatchLet mRs!ScdmFld_ScdmFldhno, mRs!ScdmFld_Scdmno, mRs!ScdmFld_ScdDocno, mRs!ScdmFld_HwBmCode, mRs!ScdmFld_HwBmMc, mRs!ScdmFld_HwBmno, _
                        mRs!ScdmFld_HwCkMc, mRs!ScdmFld_HwCkno, mRs!ScdmFld_HwDwCode, mRs!ScdmFld_HwDwno, mRs!ScdmFld_HwDwConv, _
                        mRs!ScdmFld_ScdmQty, mRs!ScdmFld_ScdmFQty, mRs!ScdmFldQty, mRs!ScdmFldPrice, mRs!ScdmFldAmt, mRs!ScdmFldBz, mRs!ScdmFldMioNo, mRs!ScdmFldNo
      OScdmFlds.Add Item:=oScdmFld, 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 = OScdmFlds.[_NewEnum]
End Function

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

Public Sub Save(vScdmFldh As ScdmFldh)
   Dim mNotSaved As Collection
   Dim mScdmFld As ScdmFld
On Error GoTo Errorhandle
   
   Set mNotSaved = New Collection
   
   For Each mScdmFld In vScdmFldh.ScdmFlds
      If mScdmFld.ScdmFldId = -1 Then
         mNotSaved.Add mScdmFld
      End If
      mScdmFld.Save
   Next
   
   Set mNotSaved = Nothing
   
Exit Sub
Errorhandle:
   For Each mScdmFld In mNotSaved
      mScdmFld.ScdmFldId = -1
   Next
   Set mNotSaved = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub




⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -