Option Explicit
Public Type HwConfigType
Command As String
Value As String
Comment As String
End Type
Public Enum CompareMethod
Binary
Text
Database
End Enum
Public Const strDecValueChars = "+-.0123456789"
Private Declare Function SendMessageFind Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As String) As Long
Private Const WM_USER = &H400
'constants for searching the ListBox/ComboBox
Public Const LB_ERR = (-1)
Private Const LB_FINDSTRING = &H18F
Private Const LB_FINDSTRINGEXACT = &H1A2
Private Const CB_FINDSTRING = &H14C
Private Const CB_FINDSTRINGEXACT = &H158
Private Const HasComboCtrl = &H1
Private Const HasTextCtrl = &H2
Public Enum CtrlInfoIndex
ciiTag
ciiText
ciiNameLC
ciiIndexLC
ciiNameTC
ciiIndexTC
ciiCtrlType
ciiCtrlGroup
ciiLblDescription
ciiLblLimits
ciiLblUnits
ciiUnits
ciiSendCmd
ciiMask
End Enum
Public Enum DP5CmdCtrls
ccsNone
ccsCbo
ccsTxt
ccsCboTxt
End Enum
Public Enum DP5CmdLbls
clsNone
clsDescription
clsLimit
clsUnit
End Enum
Public Const LastCCI = CtrlInfoIndex.ciiMask
Public LoadingCfg As Boolean
Public strFindTab As String
Public strFindCtrl As String
Public strFindIdx As String
Public Function SetCboListIdx(frm As Form, varCmdCtrls As Variant, idxCmd As Long, strVal As String) As Long
Dim ListIndex As Long
Dim ctrl As Control
Set ctrl = GetDP5Control(frm, varCmdCtrls, idxCmd, ccsCbo)
ListIndex = FindCboIdxExact(ctrl, strVal)
If (ListIndex = LB_ERR) Then
ListIndex = FindCboIdx(ctrl, strVal)
End If
ctrl.ListIndex = ListIndex
SetCboListIdx = ListIndex
End Function
Public Function SetCboMaskIdx(frm As Form, varCmdCtrls As Variant, idxCmd As Long) As Long
Dim ListIndex As Long
Dim ctrl As Control
Set ctrl = GetDP5Control(frm, varCmdCtrls, idxCmd, ccsCbo)
ListIndex = FindCboMask(ctrl)
ctrl.ListIndex = ListIndex
SetCboMaskIdx = ListIndex
End Function
'TextBox or ComboBox
Public Function GetDP5Control(frm As Form, varCmdCtrls As Variant, idxCmd As Long, CtrlType As DP5CmdCtrls, Optional SetGlobalFind As Boolean = False) As Control
Dim ciiName As CtrlInfoIndex
Dim ciiIndex As CtrlInfoIndex
Dim strName As String
Dim idxCtrl As Long
Select Case CtrlType
Case DP5CmdCtrls.ccsCbo
ciiName = ciiNameLC
ciiIndex = ciiIndexLC
Case DP5CmdCtrls.ccsTxt
ciiName = ciiNameTC
ciiIndex = ciiIndexTC
Case Else
Exit Function
End Select
strName = varCmdCtrls(idxCmd, ciiName)
idxCtrl = varCmdCtrls(idxCmd, ciiIndex)
If (SetGlobalFind) Then
strFindTab = varCmdCtrls(idxCmd, ciiCtrlGroup)
strFindCtrl = strName
strFindIdx = idxCtrl
End If
Set GetDP5Control = frm.Controls(strName)(idxCtrl)
End Function
Public Function FindCboMask(cboCtrl As ComboBox) As Long
Dim idxList As Long
Dim strList As String
FindCboMask = -1
For idxList = 0 To cboCtrl.ListCount - 1
strList = cboCtrl.List(idxList)
If (InStr(strList, "#") > 0) Then
FindCboMask = idxList
Exit For
End If
Next
End Function
Public Function FindCboIdx(cboCtrl As ComboBox, strVal As String) As Long
Dim lRet As Long
lRet = SendMessageFind(cboCtrl.hwnd, CB_FINDSTRING, 0, (strVal))
If lRet = LB_ERR Then
FindCboIdx = -1
Else
FindCboIdx = lRet
End If
End Function
Public Function FindCboIdxExact(cboCtrl As ComboBox, strVal As String) As Long
Dim lRet As Long
lRet = SendMessageFind(cboCtrl.hwnd, CB_FINDSTRINGEXACT, 0, (strVal))
If lRet = LB_ERR Then
FindCboIdxExact = -1
Else
FindCboIdxExact = lRet
End If
End Function
Public Function AddDP5ListCmd(lstDP5Cmds As ListBox, strCmd As String, CtrlType As DP5CmdCtrls) As Long
Dim lRet As Long
Dim idxLst As Long
lRet = SendMessageFind(lstDP5Cmds.hwnd, LB_FINDSTRING, 0, (strCmd))
If lRet = LB_ERR Then
lstDP5Cmds.AddItem strCmd
lstDP5Cmds.ListIndex = lstDP5Cmds.NewIndex
Else
lstDP5Cmds.ListIndex = lRet
End If
idxLst = lstDP5Cmds.ListIndex
lstDP5Cmds.ItemData(idxLst) = lstDP5Cmds.ItemData(idxLst) Or CLng(CtrlType)
AddDP5ListCmd = idxLst
End Function
Public Function GetDP5ListCmd(lstDP5Cmds As ListBox, strCmd As String) As Long
Dim lRet As Long
lRet = SendMessageFind(lstDP5Cmds.hwnd, LB_FINDSTRING, 0, (strCmd))
If lRet = LB_ERR Then
GetDP5ListCmd = -1
Else
GetDP5ListCmd = lRet
End If
End Function
Public Function GetSSTabName(CmdCtrl As Control, SSTab1 As SSTab) As String
Dim idxTab As Long
Dim CtrlFrame As Control
GetSSTabName = ""
If (Len(CmdCtrl.Tag) = 4) Then
If (TypeName(CmdCtrl.Container)) = "Frame" Then
Set CtrlFrame = CmdCtrl.Container
If CtrlFrame.Container.Name = "SSTab1" Then
For idxTab = 0 To SSTab1.Tabs - 1
SSTab1.Tab = idxTab
If (CtrlFrame.Left >= 0) Then
GetSSTabName = SSTab1.TabCaption(idxTab)
Exit For
End If
Next
End If
End If
End If
End Function
Public Sub GetDP5CmdGroups(frm As Form, varCmdCtrls As Variant, SSTab1 As SSTab)
Dim idxCmd As Long
Dim CtrlType As DP5CmdCtrls
Dim CmdCtrl As Control
Dim lTab As Long
lTab = SSTab1.Tab
For idxCmd = 0 To UBound(varCmdCtrls, 1) 'loop through cmd control sets
CtrlType = varCmdCtrls(idxCmd, ciiCtrlType)
Select Case CtrlType
Case DP5CmdCtrls.ccsCbo, DP5CmdCtrls.ccsCboTxt
Set CmdCtrl = GetDP5Control(frm, varCmdCtrls, idxCmd, ccsCbo)
varCmdCtrls(idxCmd, ciiCtrlGroup) = GetSSTabName(CmdCtrl, SSTab1)
Case DP5CmdCtrls.ccsTxt
Set CmdCtrl = GetDP5Control(frm, varCmdCtrls, idxCmd, ccsTxt)
varCmdCtrls(idxCmd, ciiCtrlGroup) = GetSSTabName(CmdCtrl, SSTab1)
End Select
Next
SSTab1.Tab = lTab
End Sub
Public Sub UnPressButtons(Toolbar1 As ComctlLib.Toolbar)
Dim btn As Button
For Each btn In Toolbar1.Buttons
btn.Value = tbrUnpressed
Next btn
End Sub
Public Function DP5CmdLblType(ctrl As Control, ByRef strLabel As String) As Long
Dim strTypeName As String
Dim strCtrlName As String
Dim strCtrlType As String
Dim LblType As DP5CmdLbls
DP5CmdLblType = clsNone
LblType = clsNone
strLabel = ""
strTypeName = TypeName(ctrl)
If (strTypeName = "Label") Then
strCtrlName = ctrl.Name
If (strCtrlName = "lblControlName") Then
LblType = clsDescription
ElseIf (strCtrlName = "lblValueLimits") Then
LblType = clsLimit
ElseIf (strCtrlName = "lblValueUnits") Then
LblType = clsUnit
End If
If (LblType <> clsNone) Then
If (Len(ctrl.Tag) = 4) Then
strLabel = ctrl.Caption
DP5CmdLblType = LblType
End If
End If
End If
End Function
Public Function DP5CmdCtrlType(ctrl As Control) As Long
Dim strTypeName As String
Dim strCtrlType As String
Dim CtrlType As DP5CmdCtrls
DP5CmdCtrlType = ccsNone
CtrlType = ccsNone
strTypeName = TypeName(ctrl)
If (strTypeName = "ComboBox") Then
CtrlType = ccsCbo
ElseIf (strTypeName = "TextBox") Then
CtrlType = ccsTxt
End If
If (CtrlType <> ccsNone) Then
If (Len(ctrl.Tag) = 4) Then
DP5CmdCtrlType = CtrlType
End If
End If
End Function
Public Function GetDP5CmdCtrlInfo(frm As Form, lstDP5Commands As ListBox, varCmdCtrls As Variant, idxCmd As Long) As String
Dim CtrlType As DP5CmdCtrls
Dim strInfo As String
Dim strLimits As String
Dim strUnits As String
Dim strSend As String
Dim bOption As Boolean
Dim strOption As String
If (LoadingCfg) Then Exit Function
GetDP5CmdCtrlInfo = ""
strInfo = ""
If (idxCmd >= 0) Then
bOption = False
strInfo = strInfo & varCmdCtrls(idxCmd, ciiLblDescription) & vbNewLine
strInfo = strInfo & varCmdCtrls(idxCmd, ciiTag) & vbNewLine
strInfo = strInfo & varCmdCtrls(idxCmd, ciiCtrlGroup) & " Tab" & vbNewLine
If (True = lstDP5Commands.Selected(idxCmd)) Then
strSend = "Send selected."
Else
strSend = "Send not selected."
End If
strInfo = strInfo & strSend & vbNewLine
CtrlType = varCmdCtrls(idxCmd, ciiCtrlType)
If ((CtrlType = ccsCbo) Or (CtrlType = ccsCboTxt)) Then
strOption = GetDP5Control(frm, varCmdCtrls, idxCmd, ccsCbo, True).Text 'sets global find option
If (InStr(strOption, "#") > 0) Then
strInfo = strInfo & vbNewLine & vbNewLine
Else
bOption = True
strInfo = strInfo & "Option " & strOption & vbNewLine
End If
End If
If ((CtrlType = ccsTxt) Or (CtrlType = ccsCboTxt) And (Not bOption)) Then
strLimits = varCmdCtrls(idxCmd, ciiLblLimits)
If (Len(strLimits) > 0) Then strInfo = strInfo & strLimits & vbNewLine
strInfo = strInfo & "Value " & GetDP5Control(frm, varCmdCtrls, idxCmd, ccsTxt, True).Text 'sets global find option
strInfo = strInfo & " "
strUnits = varCmdCtrls(idxCmd, ciiLblUnits)
If (Len(strUnits) > 0) Then strInfo = strInfo & strUnits & vbNewLine
strInfo = strInfo & vbNewLine
End If
End If
GetDP5CmdCtrlInfo = strInfo
End Function
Public Function SetupCmdCtrls(frm As Form, lstDP5Commands As ListBox) As Variant
Dim ctrl As Control
Dim strControl() As String
Dim idxIndex As Long
Dim strTypeName As String
Dim CtrlType As DP5CmdCtrls
Dim LblType As DP5CmdLbls
Dim strCmd As String
Dim strLbl As String
For Each ctrl In frm.Controls
CtrlType = DP5CmdCtrlType(ctrl)
If (CtrlType <> ccsNone) Then
strCmd = ctrl.Tag
idxIndex = AddDP5ListCmd(lstDP5Commands, strCmd, CtrlType)
End If
Next
If (lstDP5Commands.ListCount > 0) Then
ReDim strControl(lstDP5Commands.ListCount - 1, LastCCI)
For idxIndex = 0 To lstDP5Commands.ListCount - 1
strControl(idxIndex, ciiTag) = lstDP5Commands.List(idxIndex)
strControl(idxIndex, ciiText) = ""
strControl(idxIndex, ciiNameLC) = ""
strControl(idxIndex, ciiIndexLC) = ""
strControl(idxIndex, ciiNameTC) = ""
strControl(idxIndex, ciiIndexTC) = ""
strControl(idxIndex, ciiCtrlType) = lstDP5Commands.ItemData(idxIndex)
strControl(idxIndex, ciiUnits) = ""
strControl(idxIndex, ciiSendCmd) = ""
strControl(idxIndex, ciiMask) = ""
Next
For Each ctrl In frm.Controls
CtrlType = DP5CmdCtrlType(ctrl)
If ((CtrlType = ccsCbo) Or (CtrlType = ccsTxt)) Then
strCmd = ctrl.Tag
idxIndex = GetDP5ListCmd(lstDP5Commands, strCmd)
If (idxIndex >= 0) Then
If (CtrlType = ccsCbo) Then
strControl(idxIndex, ciiNameLC) = ctrl.Name
strControl(idxIndex, ciiIndexLC) = ctrl.Index
ElseIf (CtrlType = ccsTxt) Then
strControl(idxIndex, ciiNameTC) = ctrl.Name
strControl(idxIndex, ciiIndexTC) = ctrl.Index
End If
End If
Else
LblType = DP5CmdLblType(ctrl, strLbl)
If (LblType <> clsNone) Then
strCmd = ctrl.Tag
idxIndex = GetDP5ListCmd(lstDP5Commands, strCmd)
If (idxIndex >= 0) Then
Select Case LblType
Case clsDescription
strControl(idxIndex, ciiLblDescription) = strLbl
Case clsLimit
strControl(idxIndex, ciiLblLimits) = strLbl
Case clsUnit
strControl(idxIndex, ciiLblUnits) = strLbl
End Select
End If
End If
End If
Next
SetupCmdCtrls = strControl
End If
End Function
Public Sub UpdateDP5TextCtrls(frm As Form, lstDP5Commands As ListBox, varCmdCtrls As Variant, varValues As Variant, varUnitsArray As Variant)
Dim idxSetting As Long
Dim strCmd As String
Dim strVal As String
Dim idxCmd As Long
Dim CtrlType As DP5CmdCtrls
Dim strRetData As String
Dim strUnit As String
If (IsEmpty(varValues)) Then Exit Sub
For idxSetting = 0 To UBound(varValues, 1) 'loop through settings
strCmd = varValues(idxSetting, 0)
strVal = varValues(idxSetting, 1)
idxCmd = GetDP5ListCmd(lstDP5Commands, strCmd) 'find ctrl idx
If (idxCmd >= 0) Then
lstDP5Commands.Selected(idxCmd) = True
CtrlType = varCmdCtrls(idxCmd, ciiCtrlType)
Select Case CtrlType
Case DP5CmdCtrls.ccsTxt, DP5CmdCtrls.ccsCboTxt 'only update the text
'get value (parse for units), set value
If (DP5UnitsFromData(varUnitsArray, strVal, strRetData, strUnit)) Then 'find data
varCmdCtrls(idxCmd, ciiUnits) = strUnit 'if found, update storage data
End If
GetDP5Control(frm, varCmdCtrls, idxCmd, ccsTxt).Text = strRetData
End Select
End If
Next
End Sub
Public Sub UpdateDP5Ctrls(frm As Form, lstDP5Commands As ListBox, varCmdCtrls As Variant, varConfig As Variant, varUnitsArray As Variant)
Dim idxSetting As Long
Dim strCmd As String
Dim strVal As String
Dim idxCmd As Long
Dim CtrlType As DP5CmdCtrls
Dim strRetData As String
Dim strUnit As String
For idxSetting = 0 To UBound(varConfig, 1) 'loop through settings
strCmd = varConfig(idxSetting, 0)
strVal = varConfig(idxSetting, 1)
idxCmd = GetDP5ListCmd(lstDP5Commands, strCmd) 'find ctrl idx
If (idxCmd >= 0) Then
lstDP5Commands.Selected(idxCmd) = True
CtrlType = varCmdCtrls(idxCmd, ciiCtrlType)
Select Case CtrlType
Case DP5CmdCtrls.ccsNone 'do nothing
Case DP5CmdCtrls.ccsCbo 'set idx
If (DP5UnitsFromData(varUnitsArray, strVal, strRetData, strUnit)) Then 'find data
varCmdCtrls(idxCmd, ciiUnits) = strUnit 'if found, update storage data
End If
Call SetCboListIdx(frm, varCmdCtrls, idxCmd, strRetData)
Case DP5CmdCtrls.ccsTxt 'get value (parse for units), set value
If (DP5UnitsFromData(varUnitsArray, strVal, strRetData, strUnit)) Then 'find data
varCmdCtrls(idxCmd, ciiUnits) = strUnit 'if found, update storage data
End If
GetDP5Control(frm, varCmdCtrls, idxCmd, ccsTxt).Text = strRetData
Case DP5CmdCtrls.ccsCboTxt
'check the cbo for list item, if not there select mask, update text
If (SetCboListIdx(frm, varCmdCtrls, idxCmd, strVal) >= 0) Then
' if data in list idx has been set, goto next control
ElseIf (SetCboMaskIdx(frm, varCmdCtrls, idxCmd) >= 0) Then 'find mask ,set to mask value item
' get value (parse for units), set value,exit
If (DP5UnitsFromData(varUnitsArray, strVal, strRetData, strUnit)) Then 'find data
varCmdCtrls(idxCmd, ciiUnits) = strUnit 'if found, update storage data
End If
GetDP5Control(frm, varCmdCtrls, idxCmd, ccsTxt).Text = strRetData
End If
End Select
End If
Next
End Sub
Public Sub ReadDP5Text(frm As Form, lstDP5Commands As ListBox, varCmdCtrls As Variant, ByRef varValues As Variant)
Dim idxSetting As Long
Dim strCmd As String
Dim strVal As String
Dim idxCmd As Long
Dim CtrlType As DP5CmdCtrls
Dim strUnit As String
Dim Table() As String
Dim Table2() As String
'If (IsEmpty(varValues)) Then Exit Sub
If (IsEmpty(varValues)) Then 'try to create table
'create VarValues array
idxSetting = -1
For idxCmd = 0 To UBound(varCmdCtrls, 1) 'loop through settings
CtrlType = varCmdCtrls(idxCmd, ciiCtrlType)
Select Case CtrlType
Case DP5CmdCtrls.ccsTxt, DP5CmdCtrls.ccsCboTxt 'get value (append units), set value
idxSetting = idxSetting + 1
ReDim Preserve Table(1, idxSetting)
Table(0, idxSetting) = varCmdCtrls(idxCmd, ciiTag) 'save the cmd
Table(1, idxSetting) = ""
End Select
Next
If (idxSetting >= 0) Then
ReDim Table2(idxSetting, 1)
For idxCmd = 0 To idxSetting 'swap the table main index
Table2(idxCmd, 0) = Table(0, idxCmd)
Table2(idxCmd, 1) = Table(1, idxCmd)
Next
varValues = Table2 'save the new table
Else
Exit Sub
End If
End If
For idxSetting = 0 To UBound(varValues, 1) 'loop through settings
strCmd = varValues(idxSetting, 0)
idxCmd = GetDP5ListCmd(lstDP5Commands, strCmd) 'find ctrl idx
If (idxCmd >= 0) Then
lstDP5Commands.Selected(idxCmd) = True
CtrlType = varCmdCtrls(idxCmd, ciiCtrlType)
Select Case CtrlType
Case DP5CmdCtrls.ccsNone, DP5CmdCtrls.ccsCbo
'do nothing
Case DP5CmdCtrls.ccsTxt, DP5CmdCtrls.ccsCboTxt 'get value (append units), set value
strVal = Trim(GetDP5Control(frm, varCmdCtrls, idxCmd, ccsTxt).Text)
If (Len(strVal) > 0) Then 'find units
strUnit = varCmdCtrls(idxCmd, ciiUnits) 'if found, update storage data
strUnit = Trim(strUnit)
If (Len(strUnit) > 0) Then 'save units, force to uppercase
strUnit = UCase(strUnit)
strVal = strVal & strUnit
End If
End If
varValues(idxSetting, 1) = strVal
End Select
End If
Next
End Sub
'==========================
' Save Settings
'==========================
Public Sub ReadDP5Settings(frm As Form, lstDP5Commands As ListBox, varCmdCtrls As Variant, varConfig As Variant)
Dim idxSetting As Long
Dim strCmd As String
Dim strVal As String
Dim idxCmd As Long
Dim CtrlType As DP5CmdCtrls
Dim strUnit As String
For idxSetting = 0 To UBound(varConfig, 1) 'loop through settings
strCmd = varConfig(idxSetting, 0)
idxCmd = GetDP5ListCmd(lstDP5Commands, strCmd) 'find ctrl idx
If (idxCmd >= 0) Then
lstDP5Commands.Selected(idxCmd) = True
CtrlType = varCmdCtrls(idxCmd, ciiCtrlType)
Select Case CtrlType
Case DP5CmdCtrls.ccsCbo
strVal = Trim(GetDP5Control(frm, varCmdCtrls, idxCmd, ccsCbo).Text)
If (Len(strVal) > 0) Then 'find units
strUnit = varCmdCtrls(idxCmd, ciiUnits) 'if found, update storage data
strUnit = Trim(strUnit)
If (Len(strUnit) > 0) Then 'save units, force to uppercase
strUnit = UCase(strUnit)
strVal = strVal & strUnit
End If
End If
varConfig(idxSetting, 1) = strVal
Case DP5CmdCtrls.ccsTxt 'get value (append units), set value
strVal = Trim(GetDP5Control(frm, varCmdCtrls, idxCmd, ccsTxt).Text)
If (Len(strVal) > 0) Then 'find units
strUnit = varCmdCtrls(idxCmd, ciiUnits) 'if found, update storage data
strUnit = Trim(strUnit)
If (Len(strUnit) > 0) Then 'save units, force to uppercase
strUnit = UCase(strUnit)
strVal = strVal & strUnit
End If
End If
varConfig(idxSetting, 1) = strVal
Case DP5CmdCtrls.ccsCboTxt
strVal = Trim(GetDP5Control(frm, varCmdCtrls, idxCmd, ccsCbo).Text)
If (InStr(strVal, "#") > 0) Then 'Get the textbox value
strVal = Trim(GetDP5Control(frm, varCmdCtrls, idxCmd, ccsTxt).Text)
If (Len(strVal) > 0) Then 'find units
strUnit = varCmdCtrls(idxCmd, ciiUnits) 'if found, update storage data
strUnit = Trim(strUnit)
If (Len(strUnit) > 0) Then 'save units, force to uppercase
strUnit = UCase(strUnit)
strVal = strVal & strUnit
End If
End If
End If
varConfig(idxSetting, 1) = strVal
End Select
End If
Next
End Sub
Public Function GetTextBoxIndexByTag(varCmdCtrls As Variant, strTag As String) As Long
Dim idxCmd As Long
Dim CtrlType As DP5CmdCtrls
Dim idxCtrlTC As Long
CtrlType = ccsNone
idxCtrlTC = -1
For idxCmd = 0 To UBound(varCmdCtrls, 1) 'loop through settings
If (varCmdCtrls(idxCmd, ciiTag) = strTag) Then
CtrlType = varCmdCtrls(idxCmd, ciiCtrlType)
If (CtrlType = ccsCboTxt) Then
idxCtrlTC = varCmdCtrls(idxCmd, ciiIndexTC)
Exit For
End If
End If
Next
GetTextBoxIndexByTag = idxCtrlTC
End Function
Public Sub SetupStartupCboTxt(frm As Form, varCmdCtrls As Variant)
Dim idxCmd As Long
Dim CtrlType As DP5CmdCtrls
Dim ctrlTC As Control 'TextBox
Dim ctrlLC As Control 'ComboBox
For idxCmd = 0 To UBound(varCmdCtrls, 1) 'loop through settings
CtrlType = varCmdCtrls(idxCmd, ciiCtrlType)
If (CtrlType = ccsCboTxt) Then
Set ctrlTC = GetDP5Control(frm, varCmdCtrls, idxCmd, ccsTxt)
Set ctrlLC = GetDP5Control(frm, varCmdCtrls, idxCmd, ccsCbo)
AlignTextBoxToComboBox ctrlLC, ctrlTC
End If
Next
End Sub
Public Sub CboTxtCtrlVis(frm As Form, strTag As String, isVisible As Boolean)
Dim ctl As Control
Dim FoundUnits As Boolean
Dim FoundLimits As Boolean
FoundUnits = False
FoundLimits = False
For Each ctl In frm.Controls
If TypeOf ctl Is Label Then 'only labels --> Select Case TypeName(ctl) = "Label"
If (ctl.Name = "lblValueUnits") Then
If (ctl.Tag = strTag) Then
ctl.Visible = isVisible
FoundUnits = True
End If
End If
If (ctl.Name = "lblValueLimits") Then
If (ctl.Tag = strTag) Then
ctl.Visible = isVisible
FoundLimits = True
End If
End If
End If
If (FoundUnits And FoundLimits) Then Exit For
Next
End Sub
Public Function GetCtrlIdxByNameTag(frm As Form, strName As String, strTag As String) As Long
Dim ctl As Control
GetCtrlIdxByNameTag = -1
For Each ctl In frm.Controls
If (ctl.Name = strName) Then
If (ctl.Tag = strTag) Then
GetCtrlIdxByNameTag = ctl.Index
End If
End If
Next
End Function
'get cmd:val pair value by cmd
Public Function GetValByCmd(strCmdIn As String, varCmdVal As Variant)
Dim strCmd As String
Dim idxSetting As Long
Dim strCfg As String
GetValByCmd = ""
If IsEmpty(varCmdVal) Then Exit Function
If (Not IsArray(varCmdVal)) Then Exit Function
strCfg = TypeName(varCmdVal) 'test variant data type
If (strCfg <> "String()") Then Exit Function(
For idxSetting = 0 To UBound(varCmdVal, 1) 'loop through settings
strCmd = varCmdVal(idxSetting, 0)
If (strCmd = strCmdIn) Then
GetValByCmd = varCmdVal(idxSetting, 1)
Exit For
End If
Next
End Function
Public Function MakeUnitsArray() As Variant
Dim strUnit(7) As String
Dim idxUnit As Long
strUnit(0) = "%"
strUnit(1) = "CH"
strUnit(2) = "K"
strUnit(3) = "MV"
strUnit(4) = "NS"
strUnit(5) = "S"
strUnit(6) = "US"
strUnit(7) = "V"
MakeUnitsArray = strUnit
End Function
Public Function DP5UnitsFromData(varUnitsArray As Variant, strData As String, ByRef strRetData As String, ByRef strUnit As String) As Boolean
Dim lPos As Long
Dim idxDec As Long
Dim idxUnit As Long
Dim bUnitsOK As Boolean
strRetData = strData
strUnit = ""
DP5UnitsFromData = False
If (Len(strRetData) = 0) Then Exit Function
For idxDec = 1 To Len(strRetData) 'find pos of units if any
If (InStr(strDecValueChars, Mid(strRetData, idxDec, 1)) > 0) Then
lPos = idxDec
Else
Exit For
End If
Next
bUnitsOK = False
If ((lPos > 0) And (lPos < Len(strRetData))) Then
strUnit = Mid(strRetData, lPos + 1)
strRetData = Left(strRetData, lPos)
strUnit = Trim(strUnit)
If (Len(strUnit) > 0) Then
For idxUnit = 0 To UBound(varUnitsArray, 1)
If (strUnit = varUnitsArray(idxUnit)) Then
bUnitsOK = True
Exit For
End If
Next
End If
End If
If (Not bUnitsOK) Then strUnit = ""
DP5UnitsFromData = bUnitsOK
End Function