baselib.cls

一套企业设备管理系统源代码,所有的业务单据和流程都可以自定义,业务报表也可以通过SQL的存储过程来定义.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "BaseLib"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private ResSign As Long
Private ErrInfo As String

'//类属性
'--用户内码
Public Property Let setUserID(ByVal cUserID As Long)
 BaseDllLib.setUserID = cUserID
End Property
Public Property Get getUserID() As Long
 getUserID = BaseDllLib.getUserID
End Property

'--数据类型内码
Public Property Let setClassID(ByVal cItemID As Long)
 BaseDllLib.setClassID = cItemID
End Property
Public Property Get getClassID() As Long
 getClassID = BaseDllLib.getClassID
End Property

Public Property Let setFormID(ByVal FormID As Long)
 BaseDllLib.setFormID = FormID
End Property
Public Property Get getFormID() As Long
 getFormID = BaseDllLib.getFormID
End Property

Public Property Let setParentStr(ByVal ParentStr As String)
 BaseDllLib.setParentStr = ParentStr
End Property
Public Property Get getParentStr() As String
 getParentStr = BaseDllLib.getParentStr
End Property

Public Property Let setTreeValue(ByVal TreeValue As Long)
 SysPara.TreeValue = TreeValue
End Property
Public Property Get getTreeValue() As Long
 getTreeValue = SysPara.TreeValue
End Property

Public Property Let setChooseMulSign(ByVal ChooseMulSign As Boolean)
 SysPara.ChooseMulSign = ChooseMulSign
End Property
Public Property Get getChooseMulSign() As Boolean
 getChooseMulSign = SysPara.ChooseMulSign
End Property

Public Property Get getSignRowRes() As Collection
 Set getSignRowRes = SysPara.RetChoice
End Property
Public Property Get getMulRowRes() As Collection
 Set getMulRowRes = SysPara.RetMulChoice
End Property

'//类方法
Public Function mShow(ByRef ErrInfo As String, ByVal ShowSign As Long) As Long
 On Error GoTo ErrHandle
 '//调用物料类实例得到类参数信息
 BaseClass.FItemClassID = BaseDllLib.getClassID
 Call BaseClass.getItemClassText(ResSign, ErrInfo)
 '//调用窗口信息
 Set SysPara.frmInfoColl = BaseDllLib.getFormInfo(ResSign, ErrInfo, BaseDllLib.getFormID)
 With SysPara.frmInfo
  .FInfoProcName = SysPara.frmInfoColl.Item(1).FInfoProcName
  .FInfoTitleStr = SysPara.frmInfoColl.Item(1).FInfoTitleStr
  .FInfoAlignStr = SysPara.frmInfoColl.Item(1).FInfoAlignStr
  .FInfoShowStr = SysPara.frmInfoColl.Item(1).FInfoShowStr
  .FInfoTypeStr = SysPara.frmInfoColl.Item(1).FInfoTypeStr
  .FInfoDecStr = SysPara.frmInfoColl.Item(1).FInfoDecStr
  .FInfoCols = SysPara.frmInfoColl.Item(1).FInfoCols
  .FInfoWidthStr = BaseClass.FItemWidth
  '//
  .FInfoTitleVar = Split(.FInfoTitleStr, "|")
  .FInfoAlignVar = Split(.FInfoAlignStr, "|")
  .FInfoShowVar = Split(.FInfoShowStr, "|")
  .FInfoTypeVar = Split(.FInfoTypeStr, "|")
  .FInfoDecVar = Split(.FInfoDecStr, "|")
  .FInfoColsVar = Split(.FInfoCols, "|")
  .FInfoWidthVar = Split(.FInfoWidthStr, "|")
  '//
  .FInfoTitleMin = LBound(.FInfoTitleVar)
  .FInfoTitleMax = UBound(.FInfoTitleVar)
  .FInfoAlignMin = LBound(.FInfoAlignVar)
  .FInfoAlignMax = UBound(.FInfoAlignVar)
  .FInfoShowMin = LBound(.FInfoShowVar)
  .FInfoShowMax = UBound(.FInfoShowVar)
  .FInfoTypeMin = LBound(.FInfoTypeVar)
  .FInfoTypeMax = UBound(.FInfoTypeVar)
  .FInfoDecMin = LBound(.FInfoDecVar)
  .FInfoDecMax = UBound(.FInfoDecVar)
  .FInfoColsMin = LBound(.FInfoColsVar)
  .FInfoColsMax = UBound(.FInfoColsVar)
  .FInfoWidthMin = LBound(.FInfoWidthVar)
  .FInfoWidthMax = UBound(.FInfoWidthVar)
  '//判断是否满足启动条件
  If Trim(.FInfoProcName) = "" Or .FInfoTitleMax <> .FInfoAlignMax Or .FInfoAlignMax <> .FInfoShowMax Or .FInfoShowMax <> .FInfoTypeMax Or .FInfoTypeMax <> .FInfoDecMax Or .FInfoDecMax <> .FInfoColsMax Or .FInfoColsMax <> .FInfoWidthMax Then
   MsgBox "启动错误，单据对应的参数不满足启动窗口", vbCritical + vbOKOnly, BaseDllLib.getSysInfo
   mShow = 1
   Exit Function
  End If
 End With
 frmMain.Show ShowSign
 ErrInfo = ""
 mShow = 0
 Exit Function
ErrHandle:
 ErrInfo = "执行错误：" & Chr(13) & "    错误编码：" & Err.Number & Chr(13) & "    错误信息：" & Err.Description
 mShow = 1
End Function


Private Sub Class_Initialize()
 Set BaseDllLib = CreateObject("BaseDllLib.BaseLib")
 Set BaseClass = CreateObject("BaseDllLib.ItemClssText")
 Set BaseItem = CreateObject("BaseDllLib.ItemText")
 With SysPara
  .ResLibIco = App.Path & "\ResLib\Ico\"
 End With
End Sub

Private Sub Class_Terminate()
 Set BaseClass = Nothing
 Set BaseItem = Nothing
 Set TreeData = Nothing
 Set FormInfo = Nothing
 Set ThisCls = Nothing
End Sub