clsopitype.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 = "clsOpIType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Dim fso As New FileSystemObject

 Dim sDir0 As String
 Dim sDirectory0 As String


'管理添加操作
Public Sub Add(ctl As Object)
  Dim obj As clsIType
  Dim Result As gxcAddNew
  Dim sDir As String
  Dim sDirectory As String
  '显示添加客户对话框并获取数据
  If Not frmIType.ShowDlg(obj, vtadd) Then Exit Sub
  '更新数据库
  Result = obj.AddNew
  If Result = AddNewOK Then
    AddTypeToTvw obj, ctl
    sDir = obj.TypeName
    sDirectory = App.path & "\图像\" & sDir
    sDirectory = CheckPath(sDirectory)
     If fso.FolderExists(sDirectory) = False Then
     fso.CreateFolder (sDirectory)
     End If

  ElseIf Result = DuplicateName_AddNew Then
    MsgBox "名称重复"
  Else
    MsgBox "错误"
  End If
  
End Sub

'管理修改操作
Public Sub Modify(ctl As Object)
  Dim obj As clsIType
  Dim strName As String
  Dim sDir As String
  Dim sDirectory As String
  '获取树上选中的图像类型，如果没有选中的对象则退出函数
  If GetTypeFromTreeview(ctl, obj) = False Then
    MsgBox "请选择项目类型"
    Exit Sub
  End If
  
  '显示添加图像对话框并获取数据
  If Not frmIType.ShowDlg(obj, vtModify) Then Exit Sub
  '更新数据库
  Dim Result As gxcUpdate
  Result = obj.Update
  If Result = UpdateOK Then
    '将图像类型加入树型图
    ctl.SelectedItem.Text = obj.TypeName
    
    
    sDir = obj.TypeName
   
    sDirectory = App.path & "\图像\" & sDir
'    sDirectory = CheckPath(sDirectory)
    If fso.FolderExists(sDirectory) = False Then
    Call fso.CopyFolder(sDirectory0, sDirectory, False)
    Call fso.DeleteFolder(sDirectory0, False)
     End If
    
  ElseIf Result = DuplicateName_Update Then
    MsgBox "名称重复"
  Else
    MsgBox "错误"
  End If
  
End Sub

'管理删除操作
Public Sub Delete(ctl As Object)
  Dim obj As clsIType
  Dim Result As gxcDelete
  Dim sDir As String
  Dim sDirectory As String
  '获取树上选中的图像类型，如果没有选中的对象则退出函数
  If GetTypeFromTreeview(ctl, obj) = False Then
    MsgBox "请选择图像类型"
    Exit Sub
  End If
  
  If MsgBox("真的要删除吗？", vbQuestion + vbYesNo + _
            vbDefaultButton2) = vbNo Then Exit Sub
  
  '从数据库中删除
  Result = obj.Delete
  If Result = DeleteSubExists Then
    MsgBox "存在商品，不能删除"
  ElseIf Result = DeleteFail Then
    MsgBox "删除失败！"
  ElseIf Result = DeleteOK Then
    '来到这，说明删除成功，从树形图中删除节点
    ctl.Nodes.Remove ctl.SelectedItem.Index
    sDir = obj.TypeName
    sDirectory = App.path & "\图像\" & sDir
'    sDirectory = CheckPath(sDirectory)
    If fso.FolderExists(sDirectory) = True Then
    
    Call fso.DeleteFolder(sDirectory, False)
     End If
  End If

End Sub


'将一个图像类型加入到树型图中
Public Sub AddTypeToTvw(ByVal obj As clsIType, ByRef tvw As Object)
'  On Error Resume Next
    '“O0”中，第一个为字母O，第二个为数字0
  tvw.Nodes.Add "O0", tvwChild, "A" & obj.ID, obj.TypeName, "group"
  
End Sub
'

'从树型图中得到图像类型对象
Public Function GetTypeFromTreeview(ByVal tvw As Object, _
                                    ByRef obj As clsIType) As Boolean
  If tvw.SelectedItem Is Nothing Then Exit Function

  Dim objs As New clsITypes
  '按选择的节点的KEY查找对象
  If objs.Find(GetID(tvw.SelectedItem.Key)).Count = 0 Then Exit Function
  On Error Resume Next '为了防止未查找到，因此加入了错误判断语句
  Set obj = objs.Item(1)
  sDir0 = obj.TypeName
  sDirectory0 = App.path & "\图像\" & sDir0
'  sDirectory0 = CheckPath(sDirectory0)
    
  GetTypeFromTreeview = (Err.Number = 0)
End Function
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'将一个图像类型集合加到组合框中
Private Sub ObjsToCombo(ByVal objs As clsITypes, ByRef cbo As ComboBox)
  '传入参数为商品的集合类与列表框
  Dim i As Long
  
  cbo.Clear '清除当前的列表内容
  
  For i = 1 To objs.Count
    Call cbo.AddItem(objs.Item(i).TypeName, i - 1)
    cbo.ItemData(i - 1) = objs.Item(i).ID
  Next i
  
End Sub

'所有图像类型添加到组合框中
Public Sub FillCombo(ByRef cbo As Object)
  Dim objs As New clsITypes
  Dim rstObjs As clsITypes
  
  Set rstObjs = objs.Find
  ObjsToCombo rstObjs, cbo
  
  Set objs = Nothing
  Set rstObjs = Nothing
  
End Sub