clsopimages.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 = "clsOpImageS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'管理修改操作
Public Sub ModifyS(ctl As Object)
  Dim obj As clsImage
  Dim strName As String
   
   If GetObjFromControlS(ctl, obj) = False Then
'    MsgBox "请选择图像类型"
    Exit Sub
    End If
  '显示添加客户对话框并获取数据
  If Not frmImage.ShowDlg(obj, vtModify) Then Exit Sub
  '更新数据库
  Dim Result As gxcUpdate
  Result = obj.Update
  If Result = UpdateOK Then
    '将图像在更表框中更新
    AddToLvwS obj, ctl, True
  ElseIf Result = DuplicateName_Update Then
    MsgBox "名称重复"
  Else
    MsgBox "错误"
  End If
  
End Sub
'==============================================================
'
' 处理ListView控件：AddToLvw，InitListview, ObjsToListView,
'                   FillListView, GetObjFromControl
'
'===============================================================
'将单个对象加入列表，或在列表中更新
Public Sub AddToLvwS(ByVal obj As clsImage, _
                          ByRef lvw As Object, _
                          ByVal IsOverWrite As Boolean)
  '第三个参数如果是TRUE，则说明是更新当前已存在的某个列表项，否则是新加一个列表项
  Dim Itm As ListItem
  Dim sIcon As String
  Dim bIcon As String
  
  '图标关键字
  sIcon = "sboy"
  bIcon = "bboy"
  
  '如果是更新（即覆盖），则使用当前选种的元素
  If IsOverWrite Then
    Set Itm = lvw.SelectedItem
    If Itm Is Nothing Then Exit Sub
  Else
    Set Itm = lvw.ListItems.Add(, "A" & obj.ID, , bIcon, sIcon)
  End If
  With obj  '这里要与InitListview相对应
    
    Itm.Icon = bIcon
    
  
    Itm.SmallIcon = sIcon
   Itm.Text = .IName
    Itm.SubItems(1) = .TypeName
            Itm.SubItems(2) = .Res
            Itm.SubItems(3) = .Proj
            Itm.SubItems(4) = CStr(.IDate)
            Itm.SubItems(5) = .IFormat
            Itm.SubItems(6) = CStr(.MinX)
            Itm.SubItems(7) = CStr(.MaxX)
            Itm.SubItems(8) = CStr(.MinY)
            Itm.SubItems(9) = CStr(.MaxY)
            Itm.SubItems(10) = .Introduce
            Itm.SubItems(11) = .Label
           
  End With
  Set Itm = Nothing
End Sub
'设置LISTVIEW的显示样式
Public Sub InitListviewS(ByRef lvw As Object)
 With lvw
  .ColumnHeaders.Clear
  '加入列首
  .ColumnHeaders.Add , , "名称", 1200
  .ColumnHeaders.Add , , "类别", 1500
  .ColumnHeaders.Add , , "分辨率", 1200
  .ColumnHeaders.Add , , "投影", 1300
  .ColumnHeaders.Add , , "日期", 1000
  .ColumnHeaders.Add , , "格式", 1000
  .ColumnHeaders.Add , , "最小X", 800
   .ColumnHeaders.Add , , "最大X", 800
    .ColumnHeaders.Add , , "最小Y", 800
     .ColumnHeaders.Add , , "最大Y", 800
     
  .ColumnHeaders.Add , , "介绍", 1500
   .ColumnHeaders.Add , , "标签", 1200
 End With
End Sub
'将对象集合显示到ListView中
Public Sub ObjsToListViewS(ByVal objs As clsImages, ByRef lvw As Object)
  '传入参数为图像的集合类与列表框
  Dim i As Long
  
  '如果列表还未初始化，则初始化之
  If lvw.ColumnHeaders.Count < 12 Then InitListviewS lvw
  lvw.ListItems.Clear '清除当前的列表内容
  
  For i = 1 To objs.Count
    '将每个“图像”都加入到该列表中，
    AddToLvwS objs.Item(i), lvw, False
  Next i
End Sub
'显示指定类型对象到列表控件
Public Sub FillListViewS(ByRef lvw As Object, Optional lngTypeId As Long = 0)
  Dim objs As New clsImages
  Dim rstObjs As clsImages
  
  'Search的参数取默认值，此时查找S
  Set rstObjs = objs.Search(RealString(frmImageSearch.S))
  
  '检查是否找到数据
  If rstObjs Is Nothing Then
    Exit Sub
  End If
  
  '将查找到的商品集合添加到列表控件中
  ObjsToListViewS rstObjs, lvw
  
  Set objs = Nothing
  Set rstObjs = Nothing
  
End Sub
'从列表或树型图中得到一个对象
Public Function GetObjFromControlS(ByVal lvw As Object, _
                                    ByRef obj As clsImage) As Boolean
  '如果列表中没有被选择的项，则直接退出
  If lvw.SelectedItem Is Nothing Then
    GetObjFromControlS = False
    Exit Function
  End If

  Dim objs As New clsImages
  Dim ID As Long
  '去除Listview中列表项的KEY属性前的字母“A”，即为该商品的ID值
  ID = GetID(lvw.SelectedItem.Key)

  On Error Resume Next '为了防止未查找到，因此加入了错误判断语句
  Set obj = objs.Search(RealString(frmImageSearch.S)).Item(1)
  GetObjFromControlS = (Err.Number = 0)
End Function