ifix 水处理 工程 实例

Attribute VB_Name = "GlobalSubroutines" Option Explicit '*********General Section************ 'Declarations for Windows API calls Public Declare Function GetFocus Lib "user32" () As Long Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Declare Function GetLocaleInfoA Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Integer) As Integer Public Const LOCALE_SDECIMAL = &HE ' decimal separator Public Const LOCALE_STHOUSAND = &HF ' thousand separator Public Const LOCALE_IDIGITS = &H11 ' number of fractional digits Option Compare Text 'jlk04099 Private Declare Function IsCharAlpha Lib "user32" Alias "IsCharAlphaA" (ByVal cChar As Byte) As Long 'Flag for Disabling Error Handling Public DisableErrorHandling As Boolean 'Flag for DataEntry Form Public blnDataEntryFrmFlag As Boolean 'Public Variables for creating instances of the runtime DataEntry Experts Public Numeric As frmNumericEntry Public Pushbutton As frmPushbuttonEntry Public Ramp As frmRampEntry Public Slider As frmSliderEntry 'Public variable for creating and instance of the Dynamo ColorBy form Public frmDynamoColor As frmDynamoColorBy 'Public collection for the AcknowledgeAllAlarms, GetAllAlarmConnections and GetAllConnections subroutine Public AllConnectionsCollection As New Collection 'Public Declares for Crystal Report routines Public Declare Function PEOpenEngine Lib "crpe32.dll" () As Integer Public Declare Sub PECloseEngine Lib "crpe32.dll" () Public CrystalApplication As Object 'lad 040902 Tracker #2195 - public flag for AcknowledgeAllAlarms, AckAllAlarmSummary Public bAlarmSummaryFlag As Boolean 'Public structure for packaging picture information Type PictureInfo lfTopPct As Double lfLeftPct As Double lfHeightPct As Double lfWidthPct As Double lBkColor As Long szName As String bPixels As Boolean bTitlebar As Boolean bSystemMenu As Boolean bResizable As Boolean bAlwaysOnTop As Boolean bRuntimeVisible As Boolean End Type 'PBH 12/16/2004 enumerated type for the tag status open pic and replace pic functionality Enum TS_PIC_TYPE NONE = -1 TAGSTATUS = 0 QUICKTREND = 1 TAGCONTROLPANEL = 2 End Enum Const ERR_NUM_PICNOTFOUND = 1000 + vbObjectError Const ERR_NUM_PICNOTEXIST = 1010 + vbObjectError Const ERR_NUM_UNDEFINEDDATASOURCE = 1020 + vbObjectError Const ERR_NUM_NOOBJECTSELECTEDFORROUTINE = 1030 + vbObjectError Const ERR_NUM_DATASOURCEINVALIDSYNTAX = 1040 + vbObjectError Const ERR_NUM_DATASOURCEDATATYPEMISMATCH = 1050 + vbObjectError Const ERR_NUM_NOCONNECTIONTODATASOURCE = 1060 + vbObjectError Const ERR_NUM_PICNOTOPEN = 1070 + vbObjectError Const ERR_NUM_CRYSTALREPORTSNOTINSTALLED = 1080 + vbObjectError Const ERR_NUM_CRYSTALREPORTSVERSIONERROR = 1090 + vbObjectError Const ERR_NUM_FIELDVALUESUNKNOWN = 1100 + vbObjectError Const KMEERR_KMENOTSUPRTD = 3001 Public Sub AtStartUp() ' bjm102898 This empty macro is needed to allow the WorkSpace to force VBA ' initialization. Dim r As Integer r = 1 End Sub '**********************Get Decimal Separator************************** 'This function returns the decimal separator set in the machine's Regional Settings. Public Function GetDecimalSeparator(Optional intErrorMode As Integer = 0) Dim intCountChar As Integer Dim lngHolder As Long Dim strDecChar As String On Error GoTo ErrorHandler strDecChar = Space$(255) 'Get the decimal character (strDecChar) and the count of characters for the thousand separator (lngHolder). lngHolder = GetLocaleInfoA(GetUserDefaultLCID(), LOCALE_SDECIMAL, strDecChar, Len(strDecChar) + 1) GetDecimalSeparator = Left$(strDecChar, lngHolder - 1) Exit Function ErrorHandler: HandleError (intErrorMode) End Function '**********************Get Form Dynamo Color By******************************* 'This subroutine assigns the Dynamo ColorBy form a global variable so that it can be accessed 'from Factory Globals by other projects. Public Sub GetFormDynamoColor(DynColor As Object) Set DynColor = New frmDynamoColorBy End Sub '*********************Get Form Numeric**************************************** 'Subroutine that assigns the DataEntry's Numeric Entry form a global variable 'So the form can be accessed from Factory Globals in Runtime by other projects. Public Sub GetFormNumeric() Set Numeric = New frmNumericEntry End Sub '*********************Get Form Ramp********************************************* 'Subroutine that assigns the DataEntry's Ramp Entry form a global variable 'So the form can be accessed from Factory Globals in Runtime by other projects. Public Sub GetFormRamp() Set Ramp = New frmRampEntry End Sub '*********************Get Form Pushbutton********************************************* 'Subroutine that assigns the DataEntry's PushButton Entry form a global variable 'So the form can be accessed from Factory Globals in Runtime by other projects. Public Sub GetFormPushbutton() Set Pushbutton = New frmPushbuttonEntry End Sub '*********************Get Form Slider********************************************* 'Subroutine that assigns the DataEntry's Slider Entry form a global variable 'So the form can be accessed from Factory Globals in Runtime by other projects. Public Sub GetFormSlider() Set Slider = New frmSliderEntry End Sub '**********************Find Data Source******************************************* 'This function finds the Data Source for the object entered in the first parameter. If the user enters 'a property in the second parameter, this function finds the data source connected to that property. 'If the user does not enter a property, it finds the data source for the first property with a connection. Public Function FindDataSource(Object As Object, Optional strProperty As String) As String Dim strProp As String Dim lConnectedCount As Long Dim iNumProperties As Integer Dim strSource As String Dim strFullyQualifiedSource As String Dim vtsourceobjects As Variant Dim bHasConnection As Boolean Dim lIndex As Long Dim lStatus As Long Dim i As Integer Dim strUltimateSource As String 'If the user did not enter a property for finding the connected data source, check how many 'of the object's properties are connected to data sources. If strProperty = "" Then Object.ConnectedPropertyCount lConnectedCount iNumProperties = CInt(lConnectedCount) 'If no properties are connected to a data source, return an empty string and exit the function. If iNumProperties = 0 Then FindDataSource = "" Exit Function End If 'For each connected property, get the connection information For i = 1 To iNumProperties Object.GetConnectionInformation i, strProp, strSource, strFullyQualifiedSource, vtsourceobjects If vtsourceobjects(0).ClassName = "OPCDataItem" Then FindDataSource = vtsourceobjects(0).FullyQualifiedName Exit Function Else Call lUltimateDataSource(vtsour