EVOLUTION-MANAGER
Edit File: PropertiesGet.xba
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <script:module xmlns:script="http://openoffice.org/2000/script" script:name="PropertiesGet" script:language="StarBasic">REM ======================================================================================================================= REM === The Access2Base library is a part of the LibreOffice project. === REM === Full documentation is available on http://www.access2base.com === REM ======================================================================================================================= Option Explicit REM ----------------------------------------------------------------------------------------------------------------------- Public Function getAbsolutePosition(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getAbsolutePosition") getAbsolutePosition = PropertiesGet._getProperty(pvObject, "AbsolutePosition") End Function ' getAbsolutePosition REM ----------------------------------------------------------------------------------------------------------------------- Public Function getAllowAdditions(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getAllowAdditions") getAllowAdditions = PropertiesGet._getProperty(pvObject, "AllowAdditions") End Function ' getAllowAdditions REM ----------------------------------------------------------------------------------------------------------------------- Public Function getAllowDeletions(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getAllowDeletions") getAllowDeletions = PropertiesGet._getProperty(pvObject, "AllowDeletions") End Function ' getAllowDeletions REM ----------------------------------------------------------------------------------------------------------------------- Public Function getAllowEdits(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getAllowEdits") getAllowEdits = PropertiesGet._getProperty(pvObject, "AllowEdits") End Function ' getAllowEdits REM ----------------------------------------------------------------------------------------------------------------------- Public Function getBackColor(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBackColor") getBackColor = PropertiesGet._getProperty(pvObject, "BackColor") End Function ' getBackColor REM ----------------------------------------------------------------------------------------------------------------------- Public Function getBeginGroup(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBeginGroup") getBeginGroup = PropertiesGet._getProperty(pvObject, "BeginGroup") End Function ' getBeginGroup REM ----------------------------------------------------------------------------------------------------------------------- Public Function getBOF(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBOF") getBOF = PropertiesGet._getProperty(pvObject, "BOF") End Function ' getBOF REM ----------------------------------------------------------------------------------------------------------------------- Public Function getBookmark(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBookmark") getBookmark = PropertiesGet._getProperty(pvObject, "Bookmark") End Function ' getBookmark REM ----------------------------------------------------------------------------------------------------------------------- Public Function getBookmarkable(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBookmarkable") getBookmarkable = PropertiesGet._getProperty(pvObject, "Bookmarkable") End Function ' getBookmarkable REM ----------------------------------------------------------------------------------------------------------------------- Public Function getBorderColor(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBorderColor") getBorderColor = PropertiesGet._getProperty(pvObject, "BorderColor") End Function ' getBorderColor REM ----------------------------------------------------------------------------------------------------------------------- Public Function getBorderStyle(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBorderStyle") getBorderStyle = PropertiesGet._getProperty(pvObject, "BorderStyle") End Function ' getBorderStyle REM ----------------------------------------------------------------------------------------------------------------------- Public Function getBuiltIn(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getBuiltIn") getBuiltIn = PropertiesGet._getProperty(pvObject, "BuiltIn") End Function ' getBuiltIn REM ----------------------------------------------------------------------------------------------------------------------- Public Function getButtonLeft(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getButtonLeft") getButtonLeft = PropertiesGet._getProperty(pvObject, "ButtonLeft") End Function ' getButtonLeft REM ----------------------------------------------------------------------------------------------------------------------- Public Function getButtonMiddle(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getButtonMiddle") getButtonMiddle = PropertiesGet._getProperty(pvObject, "ButtonMiddle") End Function ' getButtonMiddle REM ----------------------------------------------------------------------------------------------------------------------- Public Function getButtonRight(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getButtonRight") getButtonRight = PropertiesGet._getProperty(pvObject, "ButtonRight") End Function ' getButtonRight REM ----------------------------------------------------------------------------------------------------------------------- Public Function getCancel(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getCancel") getCancel = PropertiesGet._getProperty(pvObject, "Cancel") End Function ' getCancel REM ----------------------------------------------------------------------------------------------------------------------- Public Function getCaption(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getCaption") getCaption = PropertiesGet._getProperty(pvObject, "Caption") End Function ' getCaption REM ----------------------------------------------------------------------------------------------------------------------- Public Function getClickCount(Optional pvObject As Variant) As Long If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getClickCount") getClickCount = PropertiesGet._getProperty(pvObject, "ClickCount") End Function ' getClickCount REM ----------------------------------------------------------------------------------------------------------------------- Public Function getContextShortcut(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getContextShortcut") getContextShortcut = PropertiesGet._getProperty(pvObject, "ContextShortcut") End Function ' getContextShortcut REM ----------------------------------------------------------------------------------------------------------------------- Public Function getControlSource(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getControlSource") getControlSource = PropertiesGet._getProperty(pvObject, "ControlSource") End Function ' getControlSource REM ----------------------------------------------------------------------------------------------------------------------- Public Function getControlTipText(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getControlTipText") getControlTipText = PropertiesGet._getProperty(pvObject, "ControlTipText") End Function ' getControlTipText REM ----------------------------------------------------------------------------------------------------------------------- Public Function getControlType(Optional pvObject As Variant) As Integer If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getControlType") getControlType = PropertiesGet._getProperty(pvObject, "ControlType") End Function ' getControlType REM ----------------------------------------------------------------------------------------------------------------------- Public Function getCount(Optional pvObject As Variant) As Integer If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getCount") getCount = PropertiesGet._getProperty(pvObject, "Count") End Function ' getCount REM ----------------------------------------------------------------------------------------------------------------------- Public Function getCurrentRecord(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getCurrentRecord") getCurrentRecord = PropertiesGet._getProperty(pvObject, "CurrentRecord") End Function ' getCurrentRecord REM ----------------------------------------------------------------------------------------------------------------------- Public Function getDataType(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getDataType") getDataType = PropertiesGet._getProperty(pvObject, "DataType") End Function ' getDataType REM ----------------------------------------------------------------------------------------------------------------------- Public Function getDbType(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getDbType") getDbType = PropertiesGet._getProperty(pvObject, "DbType") End Function ' getDbType REM ----------------------------------------------------------------------------------------------------------------------- Public Function getDefault(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getDefault") getDefault = PropertiesGet._getProperty(pvObject, "Default") End Function ' getDefault REM ----------------------------------------------------------------------------------------------------------------------- Public Function getDefaultValue(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getDefaultValue") getDefaultValue = PropertiesGet._getProperty(pvObject, "DefaultValue") End Function ' getDefaultValue REM ----------------------------------------------------------------------------------------------------------------------- Public Function getDescription(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getDescription") getDescription = PropertiesGet._getProperty(pvObject, "Description") End Function ' getDescription REM ----------------------------------------------------------------------------------------------------------------------- Public Function getEditMode(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getEditMode") getEditMode = PropertiesGet._getProperty(pvObject, "EditMode") End Function ' getEditMode REM ----------------------------------------------------------------------------------------------------------------------- Public Function getEnabled(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getEnabled") getEnabled = PropertiesGet._getProperty(pvObject, "Enabled") End Function ' getEnabled REM ----------------------------------------------------------------------------------------------------------------------- Public Function getEOF(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getEOF") getEOF = PropertiesGet._getProperty(pvObject, "EOF") End Function ' getEOF REM ----------------------------------------------------------------------------------------------------------------------- Public Function getEventName(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getEventName") getEventName = PropertiesGet._getProperty(pvObject, "EventName") End Function ' getEventName REM ----------------------------------------------------------------------------------------------------------------------- Public Function getEventType(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getEventType") getEventType = PropertiesGet._getProperty(pvObject, "EventType") End Function ' getEventType REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFieldSize(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFieldSize") getFieldSize = PropertiesGet._getProperty(pvObject, "FieldSize") End Function ' getFieldSize REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFilter(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFilter") getFilter = PropertiesGet._getProperty(pvObject, "Filter") End Function ' getFilter REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFilterOn(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFilterOn") getFilterOn = PropertiesGet._getProperty(pvObject, "FilterOn") End Function ' getFilterOn REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFocusChangeTemporary(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFocusChangeTemporary") getFocusChangeTemporary = PropertiesGet._getProperty(pvObject, "FocusChangeTemporary") End Function ' getFocusChangeTemporary REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFontBold(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFontBold") getFontBold = PropertiesGet._getProperty(pvObject, "FontBold") End Function ' getFontBold REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFontItalic(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFontItalic") getFontItalic = PropertiesGet._getProperty(pvObject, "FontItalic") End Function ' getFontItalic REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFontName(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFontName") getFontName = PropertiesGet._getProperty(pvObject, "FontName") End Function ' getFontName REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFontSize(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFontSize") getFontSize = PropertiesGet._getProperty(pvObject, "FontSize") End Function ' getFontSize REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFontUnderline(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFontUnderline") getFontUnderline = PropertiesGet._getProperty(pvObject, "FontUnderline") End Function ' getFontUnderline REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFontWeight(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFontWeight") getFontWeight = PropertiesGet._getProperty(pvObject, "FontWeight") End Function ' getFontWeight REM ----------------------------------------------------------------------------------------------------------------------- Public Function getForm(Optional pvObject As Variant) As Variant ' Return Subform pseudo If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getForm") getForm = PropertiesGet._getProperty(pvObject, "Form") End Function ' getForm REM ----------------------------------------------------------------------------------------------------------------------- Public Function getFormat(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getFormat") getFormat = PropertiesGet._getProperty(pvObject, "Format") End Function ' getFormat REM ----------------------------------------------------------------------------------------------------------------------- Public Function getHeight(Optional pvObject As Variant) As Long If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getHeight") getHeight = PropertiesGet._getProperty(pvObject, "Height") End Function ' getHeight REM ----------------------------------------------------------------------------------------------------------------------- Public Function getForeColor(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getForeColor") getForeColor = PropertiesGet._getProperty(pvObject, "ForeColor") End Function ' getForeColor REM ----------------------------------------------------------------------------------------------------------------------- Public Function getIsLoaded(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getIsLoaded") getIsLoaded = PropertiesGet._getProperty(pvObject, "IsLoaded") End Function ' getIsLoaded REM ----------------------------------------------------------------------------------------------------------------------- Public Function getItemData(Optional pvObject As Variant, ByVal Optional pvIndex As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getItemData") If IsMissing(pvIndex) Then getItemData = PropertiesGet._getProperty(pvObject, "ItemData") Else getItemData = PropertiesGet._getProperty(pvObject, "ItemData", pvIndex) End If End Function ' getItemData REM ----------------------------------------------------------------------------------------------------------------------- Public Function getKeyAlt(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getKeyAlt") getKeyAlt = PropertiesGet._getProperty(pvObject, "KeyAlt") End Function ' getKeyAlt REM ----------------------------------------------------------------------------------------------------------------------- Public Function getKeyChar(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getKeyChar") getKeyChar = PropertiesGet._getProperty(pvObject, "KeyChar") End Function ' getKeyChar REM ----------------------------------------------------------------------------------------------------------------------- Public Function getKeyCode(Optional pvObject As Variant) As Integer If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getKeyCode") getKeyCode = PropertiesGet._getProperty(pvObject, "KeyCode") End Function ' getKeyCode REM ----------------------------------------------------------------------------------------------------------------------- Public Function getKeyCtrl(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getKeyCtrl") getKeyCtrl = PropertiesGet._getProperty(pvObject, "KeyCtrl") End Function ' getKeyCtrl REM ----------------------------------------------------------------------------------------------------------------------- Public Function getKeyFunction(Optional pvObject As Variant) As Integer If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getKeyFunction") getKeyFunction = PropertiesGet._getProperty(pvObject, "KeyFunction") End Function ' getKeyFunction REM ----------------------------------------------------------------------------------------------------------------------- Public Function getKeyShift(pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getKeyShift") getKeyShift = PropertiesGet._getProperty(pvObject, "KeyShift") End Function ' getKeyShift REM ----------------------------------------------------------------------------------------------------------------------- Public Function getLinkChildFields(Optional pvObject As Variant, ByVal Optional pvIndex As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getLinkChildFields") If IsMissing(pvObject) Then getLinkChildFields = PropertiesGet._getProperty(pvObject, "LinkChildFields") Else getLinkChildFields = PropertiesGet._getProperty(pvObject, "LinkChildFields", pvIndex) End If End Function ' getLinkChildFields REM ----------------------------------------------------------------------------------------------------------------------- Public Function getLinkMasterFields(Optional pvObject As Variant, ByVal Optional pvIndex As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getLinkMasterFields") If IsMissing(pvIndex) Then getLinkMasterFields = PropertiesGet._getProperty(pvObject, "LinkMasterFields") Else getLinkMasterFields = PropertiesGet._getProperty(pvObject, "LinkMasterFields", pvIndex) End If End Function ' getLinkMasterFields REM ----------------------------------------------------------------------------------------------------------------------- Public Function getListCount(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getListCount") getListCount = PropertiesGet._getProperty(pvObject, "ListCount") End Function ' getListCount REM ----------------------------------------------------------------------------------------------------------------------- Public Function getListIndex(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getListIndex") getListIndex = PropertiesGet._getProperty(pvObject, "ListIndex") End Function ' getListIndex REM ----------------------------------------------------------------------------------------------------------------------- Public Function getLocked(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getLocked") getLocked = PropertiesGet._getProperty(pvObject, "Locked") End Function ' getLocked REM ----------------------------------------------------------------------------------------------------------------------- Public Function getMultiSelect(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getMultiSelect") getMultiSelect = PropertiesGet._getProperty(pvObject, "MultiSelect") End Function ' getMultiSelect REM ----------------------------------------------------------------------------------------------------------------------- Public Function getName(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getName") getName = PropertiesGet._getProperty(pvObject, "Name") End Function ' getName REM ----------------------------------------------------------------------------------------------------------------------- Public Function getObject(Optional pvShortcut As Variant) As Variant ' Return the object described by pvShortcut ignoring its final property ' Example: "Forms!myForm!myControl.myProperty" => Controls(Forms("myForm"), "myControl")) Const cstEXCLAMATION = "!" Const cstDOT = "." If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "getObject" Utils._SetCalledSub(cstThisSub) If IsMissing(pvShortcut) Then Call _TraceArguments() If Not Utils._CheckArgument(pvShortcut, 1, vbString) Then Goto Exit_Function Dim iCurrentIndex As Integer, vCurrentObject As Variant, sCurrentProperty As String Dim sComponents() As String, sSubComponents() As String, sDialog As String Dim oDoc As Object Set vCurrentObject = Nothing sComponents = Split(Trim(pvShortcut), cstEXCLAMATION) If UBound(sComponents) = 0 Then Goto Trace_Error If Not Utils._InList(UCase(sComponents(0)), Array("FORMS", "DIALOGS", "TEMPVARS")) Then Goto Trace_Error If sComponents(1) = "0" Or Left(sComponents(1), 2) = "0." Then Set oDoc = _A2B_.CurrentDocument() If oDoc.DbConnect = DBCONNECTFORM Then sComponents(1) = oDoc.DbContainers(0).FormName Else Goto Trace_Error End If sSubComponents = Split(sComponents(UBound(sComponents)), cstDOT) sComponents(UBound(sComponents)) = sSubComponents(0) ' Ignore final property, if any Set vCurrentObject = New Collect Select Case UCase(sComponents(0)) Case "FORMS" : vCurrentObject._CollType = COLLFORMS Case "DIALOGS" : vCurrentObject._CollType = COLLALLDIALOGS Case "TEMPVARS" : vCurrentObject._CollType = COLLTEMPVARS End Select For iCurrentIndex = 1 To UBound(sComponents) ' Start parsing ... sSubComponents = Split(sComponents(iCurrentIndex), cstDOT) sComponents(iCurrentIndex) = Utils._Trim(sSubComponents(0)) Select Case UBound(sSubComponents) Case 0 sCurrentProperty = "" Case 1 sCurrentProperty = sSubComponents(1) Case Else Goto Trace_Error End Select Select Case vCurrentObject._Type Case OBJCOLLECTION Select Case vCurrentObject._CollType Case COLLFORMS vCurrentObject = Application.Forms(sComponents(iCurrentIndex)) Case COLLALLDIALOGS sDialog = UCase(sComponents(iCurrentIndex)) vCurrentObject = Application.AllDialogs(sDialog) If Not vCurrentObject.IsLoaded Then Goto Trace_Error Set vCurrentObject.UnoDialog = _A2B_.Dialogs.Item(sDialog) Case COLLTEMPVARS If UBound(sComponents) > 1 Then Goto Trace_Error vCurrentObject = Application.TempVars(sComponents(1)) 'Case Else End Select Case OBJFORM, OBJSUBFORM, OBJCONTROL, OBJDIALOG vCurrentObject = vCurrentObject.Controls(sComponents(iCurrentIndex)) End Select If sCurrentProperty <> "" Then vCurrentObject = PropertiesGet._getProperty(vCurrentObject, sCurrentProperty) Next iCurrentIndex Set getObject = vCurrentObject Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvShortcut)) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function ' getObject V0.9.5 REM ----------------------------------------------------------------------------------------------------------------------- Public Function getObjectType(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getObjectType") getObjectType = PropertiesGet._getProperty(pvObject, "ObjectType") End Function ' getObjectType REM ----------------------------------------------------------------------------------------------------------------------- Public Function getOpenArgs(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getOpenArgs") getOpenArgs = PropertiesGet._getProperty(pvObject, "OpenArgs") End Function ' getOpenArgs REM ----------------------------------------------------------------------------------------------------------------------- Public Function getOptionGroup(Optional pvObject As Variant, pvName As variant) As Variant ' Return an OptionGroup object based on its name Utils._SetCalledSub("getOptionGroup") If IsMissing(pvObject) Or IsMissing(pvName) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function If Not Utils._CheckArgument(pvName, 2, vbString) Then Goto Exit_Function getOptionGroup = pvObject.OptionGroup(pvName) Exit_Function: Utils._ResetCalledSub("getOptionGroup") Exit Function Error_Function: TraceError(TRACEABORT, Err, "getOptionGroup", Erl) GoTo Exit_Function End Function ' getOptionGroup V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function getOptionValue(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getOptionValue") getOptionValue = PropertiesGet._getProperty(pvObject, "OptionValue") End Function ' getOptionValue REM ----------------------------------------------------------------------------------------------------------------------- Public Function getOrderBy(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getOrderBy") getOrderBy = PropertiesGet._getProperty(pvObject, "OrderBy") End Function ' getOrderBy REM ----------------------------------------------------------------------------------------------------------------------- Public Function getOrderByOn(Optional pvObject As Variant) As Boolean If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getOrderByOn") getOrderByOn = PropertiesGet._getProperty(pvObject, "OrderByOn") End Function ' getOrderByOn REM ----------------------------------------------------------------------------------------------------------------------- Public Function getPage(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getPage") getPage = PropertiesGet._getProperty(pvObject, "Page") End Function ' getPage V0.9.1 REM ----------------------------------------------------------------------------------------------------------------------- Public Function getParent(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getParent") getParent = PropertiesGet._getProperty(pvObject, "Parent") End Function ' getParent V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function getProperty(Optional pvItem As Variant, Optional ByVal pvProperty As Variant, ByVal Optional pvIndex As Variant) As Variant ' Return property value of object pvItem, and psProperty property name Utils._SetCalledSub("getProperty") If IsMissing(pvItem) Then Call _TraceArguments() If IsMissing(pvProperty) Then Call _TraceArguments() If IsMissing(pvIndex) Then getProperty = PropertiesGet._getProperty(pvItem, pvProperty) Else getProperty = PropertiesGet._getProperty(pvItem, pvProperty, pvIndex) Utils._ResetCalledSub("getProperty") End Function ' getProperty REM ----------------------------------------------------------------------------------------------------------------------- Public Function getRecommendation(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getRecommendation") getRecommendation = PropertiesGet._getProperty(pvObject, "Recommendation") End Function ' getRecommendation REM ----------------------------------------------------------------------------------------------------------------------- Public Function getRecordCount(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getRecordCount") getRecordCount = PropertiesGet._getProperty(pvObject, "RecordCount") End Function ' getRecordCount REM ----------------------------------------------------------------------------------------------------------------------- Public Function getRecordset(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getRecordset") getRecordset = PropertiesGet._getProperty(pvObject, "Recordset") End Function ' getRecordset V0.9.5 REM ----------------------------------------------------------------------------------------------------------------------- Public Function getRecordSource(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getRecordSource") getRecordSource = PropertiesGet._getProperty(pvObject, "RecordSource") End Function ' getRecordSource REM ----------------------------------------------------------------------------------------------------------------------- Public Function getRequired(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getRequired") getRequired = PropertiesGet._getProperty(pvObject, "Required") End Function ' getRequired REM ----------------------------------------------------------------------------------------------------------------------- Public Function getRowChangeAction(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getRowChangeAction") getRowChangeAction = PropertiesGet._getProperty(pvObject, "RowChangeAction") End Function ' getRowChangeAction REM ----------------------------------------------------------------------------------------------------------------------- Public Function getRowSource(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getRowSource") getRowSource = PropertiesGet._getProperty(pvObject, "RowSource") End Function ' getRowSource REM ----------------------------------------------------------------------------------------------------------------------- Public Function getRowSourceType(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getRowSourceType") getRowSourceType = PropertiesGet._getProperty(pvObject, "RowSourceType") End Function ' getRowSourceType REM ----------------------------------------------------------------------------------------------------------------------- Public Function getSelected(Optional pvObject As Variant, ByVal Optional pvIndex As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getSelected") If IsMissing(pvIndex) Then getSelected = PropertiesGet._getProperty(pvObject, "Selected") Else getSelected = PropertiesGet._getProperty(pvObject, "Selected", pvIndex) End If End Function ' getSelected REM ----------------------------------------------------------------------------------------------------------------------- Public Function getSize(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getSize") getSize = PropertiesGet._getProperty(pvObject, "Size") End Function ' getSize REM ----------------------------------------------------------------------------------------------------------------------- Public Function getSource(Optional pvObject As Variant) As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getSource") getSource = PropertiesGet._getProperty(pvObject, "Source") End Function ' getSource V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function getSourceField(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getSourceField") getSourceField = PropertiesGet._getProperty(pvObject, "SourceField") End Function ' getSourceField REM ----------------------------------------------------------------------------------------------------------------------- Public Function getSourceTable(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getSourceTable") getSourceTable = PropertiesGet._getProperty(pvObject, "SourceTable") End Function ' getSourceTable REM ----------------------------------------------------------------------------------------------------------------------- Public Function getSpecialEffect(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getSpecialEffect") getSpecialEffect = PropertiesGet._getProperty(pvObject, "SpecialEffect") End Function ' getSpecialEffect REM ----------------------------------------------------------------------------------------------------------------------- Public Function getSubType(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getSubType") getSubType = PropertiesGet._getProperty(pvObject, "SubType") End Function ' getSubType REM ----------------------------------------------------------------------------------------------------------------------- Public Function getSubComponentName(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getSubComponentName") getSubComponentName = PropertiesGet._getProperty(pvObject, "SubComponentName") End Function ' getSubComponentName REM ----------------------------------------------------------------------------------------------------------------------- Public Function getSubComponentType(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getSubComponentType") getSubComponentType = PropertiesGet._getProperty(pvObject, "SubComponentType") End Function ' getSubComponentType REM ----------------------------------------------------------------------------------------------------------------------- Public Function getTabIndex(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getTabIndex") getTabIndex = PropertiesGet._getProperty(pvObject, "TabIndex") End Function ' getTabIndex REM ----------------------------------------------------------------------------------------------------------------------- Public Function getTabStop(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getTabStop") getTabStop = PropertiesGet._getProperty(pvObject, "TabStop") End Function ' getTabStop REM ----------------------------------------------------------------------------------------------------------------------- Public Function getTag(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getTag") getTag = PropertiesGet._getProperty(pvObject, "Tag") End Function ' getTag REM ----------------------------------------------------------------------------------------------------------------------- Public Function getText(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getText") getText = PropertiesGet._getProperty(pvObject, "Text") End Function ' getText REM ----------------------------------------------------------------------------------------------------------------------- Public Function getTextAlign(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getTextAlign") getTextAlign = PropertiesGet._getProperty(pvObject, "TextAlign") End Function ' getTextAlign REM ----------------------------------------------------------------------------------------------------------------------- Public Function getTooltipText(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getTooltipText") getTooltipText = PropertiesGet._getProperty(pvObject, "TooltipText") End Function ' getTooltipText REM ----------------------------------------------------------------------------------------------------------------------- Public Function getTripleState(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getTripleState") getTripleState = PropertiesGet._getProperty(pvObject, "TripleState") End Function ' getTripleState REM ----------------------------------------------------------------------------------------------------------------------- Public Function getTypeName(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getTypeName") getTypeName = PropertiesGet._getProperty(pvObject, "TypeName") End Function ' getTypeName REM ----------------------------------------------------------------------------------------------------------------------- Public Function getValue(Optional pvObject As Variant) As Variant ' getValue also interprets shortcut strings !! Dim vItem As Variant, sProperty As String If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getValue") If VarType(pvObject) = vbString Then Utils._SetCalledSub("getValue") Set vItem = getObject(pvObject) sProperty = Utils._FinalProperty(pvObject) If sProperty = "" Then sProperty = "Value" ' Default value if final property in shortcut is absent getValue = PropertiesGet._getProperty(vItem, sProperty) Utils._ResetCalledSub("getValue") Else getValue = PropertiesGet._getProperty(pvObject, "Value") End If End Function ' getValue REM ----------------------------------------------------------------------------------------------------------------------- Public Function getVisible(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getVisible") getVisible = PropertiesGet._getProperty(pvObject, "Visible") End Function ' getVisible REM ----------------------------------------------------------------------------------------------------------------------- Public Function getWidth(Optional pvObject As Variant) As Long If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getWdth") getWidth = PropertiesGet._getProperty(pvObject, "Width") End Function ' getWidth REM ----------------------------------------------------------------------------------------------------------------------- Public Function getXPos(Optional pvObject As Variant) As Long If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getXPos") getXPos = PropertiesGet._getProperty(pvObject, "XPos") End Function ' getXPos REM ----------------------------------------------------------------------------------------------------------------------- Public Function getYPos(Optional pvObject As Variant) As Long If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getYPos") getYPos = PropertiesGet._getProperty(pvObject, "YPos") End Function ' getYPos REM ----------------------------------------------------------------------------------------------------------------------- REM --- PRIVATE FUNCTIONS --- REM ----------------------------------------------------------------------------------------------------------------------- Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVal Optional pvIndex As Variant) As Variant ' Return property value of the psProperty property name within object pvItem If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("get" & psProperty) _getProperty = Nothing 'pvItem must be an object and have the requested property If Not Utils._CheckArgument(pvItem, 1, vbObject) Then Goto Exit_Function If Not PropertiesGet._hasProperty(pvItem._Type, pvItem._PropertiesList(), psProperty) Then Goto Trace_Error 'Check Index argument If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 3, Utils._AddNumeric()) Then Goto Exit_Function End If 'Execute Select Case UCase(psProperty) Case UCase("AbsolutePosition") If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function _getProperty = pvItem.AbsolutePosition Case UCase("AllowAdditions") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function _getProperty = pvItem.AllowAdditions Case UCase("AllowDeletions") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function _getProperty = pvItem.AllowDeletions Case UCase("AllowEdits") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function _getProperty = pvItem.AllowEdits Case UCase("BackColor") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.BackColor Case UCase("BeginGroup") If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function _getProperty = pvItem.BeginGroup Case UCase("BOF") If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function _getProperty = pvItem.BOF Case UCase("Bookmark") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJRECORDSET)) Then Goto Exit_Function _getProperty = pvItem.Bookmark Case UCase("Bookmarkable") If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function _getProperty = pvItem.Bookmarkable Case UCase("BorderColor") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.BorderColor Case UCase("BorderStyle") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.BorderStyle Case UCase("BuiltIn") If Not Utils._CheckArgument(pvItem, 1, Array(OBJCOMMANDBAR, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function _getProperty = pvItem.BuiltIn Case UCase("ButtonLeft") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.ButtonLeft Case UCase("ButtonMiddle") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.ButtonMiddle Case UCase("ButtonRight") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.ButtonRight Case UCase("Cancel") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.Cancel Case UCase("Caption") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function _getProperty = pvItem.Caption Case UCase("ClickCount") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.ClickCount Case UCase("ContextShortcut") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.ContextShortcut Case UCase("ControlSource") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.ControlSource Case UCase("ControlTipText") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.ControlTipText Case UCase("ControlType") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.ControlType Case UCase("Count") If Not Utils._CheckArgument(pvItem, 1, Array(OBJCOLLECTION,OBJOPTIONGROUP)) Then Goto Exit_Function _getProperty = pvItem.Count Case UCase("CurrentRecord") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function _getProperty = pvItem.CurrentRecord Case UCase("DataType") If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function _getProperty = pvItem.DataType Case UCase("DbType") If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function _getProperty = pvItem.DbType Case UCase("Default") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.Default Case UCase("DefaultValue") If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJFIELD)) Then Goto Exit_Function _getProperty = pvItem.DefaultValue Case UCase("Description") If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function _getProperty = pvItem.Description Case UCase("EditMode") If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function _getProperty = pvItem.EditMode Case UCase("Enabled") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.Enabled Case UCase("EOF") If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function _getProperty = pvItem.EOF Case UCase("EventName") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.EventName Case UCase("EventType") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.EventType Case UCase("FieldSize") If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function _getProperty = pvItem.FieldSize Case UCase("Filter") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM, OBJRECORDSET)) Then Goto Exit_Function _getProperty = pvItem.Filter Case UCase("FilterOn") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function _getProperty = pvItem.FilterOn Case UCase("FocusChangeTemporary") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.FocusChangeTemporary Case UCase("FontBold") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.FontBold Case UCase("FontItalic") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.FontItalic Case UCase("FontName") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.FontName Case UCase("FontSize") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.FontSize Case UCase("FontUnderline") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.FontUnderline Case UCase("FontWeight") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.FontWeight Case UCase("ForeColor") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.ForeColor Case UCase("Form") If Not Utils._CheckArgument(pvItem, 1, CTLSUBFORM) Then Goto Exit_Function _getProperty = pvItem.Form Case UCase("Format") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.Format Case UCase("Height") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function _getProperty = pvItem.Height Case UCase("Index") If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function _getProperty = pvItem.Index Case UCase("IsLoaded") If Not Utils._CheckArgument(pvItem, 1, OBJFORM) Then Goto Exit_Function _getProperty = pvItem.IsLoaded Case UCase("ItemData") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function If IsMissing(pvIndex) Then _getProperty = pvItem.ItemData Else _getProperty = pvItem.ItemData(pvIndex) Case UCase("KeyAlt") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.KeyAlt Case UCase("KeyChar") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.KeyChar Case UCase("KeyCode") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.KeyCode Case UCase("KeyCtrl") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.KeyCtrl Case UCase("KeyFunction") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.KeyFunction Case UCase("KeyShift") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.KeyShift Case UCase("LinkChildFields") If Not Utils._CheckArgument(pvItem, 1, OBJSUBFORM) Then Goto Exit_Function If IsMissing(pvIndex) Then _getProperty = pvItem.LinkChildFields Else _getProperty = pvItem.LinkChildFields(pvIndex) Case UCase("LinkMasterFields") If Not Utils._CheckArgument(pvItem, 1, OBJSUBFORM) Then Goto Exit_Function If IsMissing(pvIndex) Then _getProperty = pvItem.LinkMasterFields Else _getProperty = pvItem.LinkMasterFields(pvIndex) Case UCase("ListCount") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.ListCount Case UCase("ListIndex") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.ListIndex Case UCase("Locked") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function If IsNull(pvItem.Locked) Then Goto Trace_Error _ge ExitProperty = pvItem.Locked Case UCase("MultiSelect") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.MultiSelect Case UCase("Name") If Not Utils._CheckArgument(pvItem, 1, _ Array(OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJPROPERTY, OBJDIALOG, OBJTABLEDEF, OBJRECORDSET, OBJFIELD, OBJTEMPVAR, OBJCOMMANDBAR) _ ) Then Goto Exit_Function _getProperty = pvItem.Name Case UCase("ObjectType") If Not Utils._CheckArgument(pvItem, 1, Array(OBJDATABASE, OBJCOLLECTION, OBJFORM, OBJDIALOG, OBJSUBFORM, OBJCONTROL _ , OBJEVENT, OBJOPTIONGROUP, OBJPROPERTY, OBJRECORDSET, OBJTABLEDEF, OBJFIELD, OBJTEMPVAR _ , OBJCOMMANDBAR, OBJCOMMANDBARCONTROL) _ ) Then Goto Exit_Function _getProperty = pvItem.ObjectType Case UCase("OnAction") If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function _getProperty = pvItem.OnAction Case UCase("OpenArgs") If Not Utils._CheckArgument(pvItem, 1, OBJFORM) Then Goto Exit_Function _getProperty = pvItem.OpenArgs Case UCase("OptionValue") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.OptionValue Case UCase("OrderBy") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function _getProperty = pvItem.OrderBy Case UCase("OrderByOn") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function _getProperty = pvItem.OrderByOn Case UCase("Page") If Not Utils._CheckArgument(pvItem, 1, Array(OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function _getProperty = pvItem.Page Case UCase("Parent") If Not Utils._CheckArgument(pvItem, 1, Array(OBJSUBFORM, OBJCONTROL, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function _getProperty = pvItem.Parent Case UCase("Recommendation") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.Recommendation Case UCase("RecordCount") If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function _getProperty = pvItem.RecordCount Case UCase("Recordset") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function _getProperty = pvItem.Recordset Case UCase("RecordSource") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function _getProperty = pvItem.RecordSource Case UCase("Required") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.Required Case UCase("RowChangeAction") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.RowChangeAction Case UCase("RowSource") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.RowSource Case UCase("RowSourceType") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.RowSourceType Case UCase("Selected") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function If IsMissing(pvIndex) Then _getProperty = pvItem.Selected Else _getProperty = pvItem.Selected(pvIndex) Case UCase("Size") If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function _getProperty = pvItem.Size Case UCase("Source") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.Source Case UCase("SourceTable") If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function _getProperty = pvItem.SourceTable Case UCase("SourceField") If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function _getProperty = pvItem.SourceField Case UCase("SpecialEffect") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.SpecialEffect Case UCase("SubComponentName") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.SubComponentName Case UCase("SubComponentType") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function _getProperty = pvItem.SubComponentType Case UCase("SubType") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.SubType Case UCase("TabIndex") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.TabIndex Case UCase("TabStop") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.TabStop Case UCase("Tag") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.Tag Case UCase("Text") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.Text Case UCase("TextAlign") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.TextAlign Case UCase("TooltipText") If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function _getProperty = pvItem.TooltipText Case UCase("TripleState") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function _getProperty = pvItem.TripleState Case UCase("TypeName") If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function _getProperty = pvItem.TypeName Case UCase("Value") If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJOPTIONGROUP, OBJPROPERTY, OBJFIELD, OBJTEMPVAR)) Then Goto Exit_Function _getProperty = pvItem.Value Case UCase("Visible") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL, OBJCOMMANDBAR, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function _getProperty = pvItem.Visible Case UCase("Width") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function _getProperty = pvItem.Width Case UCase("XPos") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function If IsNull(pvItem.XPos) Then Goto Trace_Error _getProperty = pvItem.XPos Case UCase("YPos") If Not Utils._CheckArgument(pvItem, 1, OBJEVENT) Then Goto Exit_Function If IsNull(pvItem.YPos) Then Goto Trace_Error _getProperty = pvItem.YPos Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("get" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _getProperty = Nothing Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty) _getProperty = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "_getProperty", Erl) _getProperty = Nothing GoTo Exit_Function End Function ' _getProperty V0.9.1 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _hasProperty(ByVal psObject As String, ByVal pvPropertiesList() As Variant, ByVal pvProperty As Variant) As Boolean ' Return True if object has a valid property called pvProperty (case-insensitive comparison !) ' Generic hasProperty function called from all class modules Dim sObject As String sObject = Utils._PCase(psObject) Utils._SetCalledSub(sObject & ".hasProperty") If IsMissing(pvProperty) Then Call _TraceArguments() _hasProperty = False If Not Utils._CheckArgument(pvProperty, 1, vbString) Then Goto Exit_Function _hasProperty = Utils._InList(pvProperty, pvPropertiesList(), , True) Exit_Function: Utils._ResetCalledSub(sObject & ".hasProperty") Exit Function End Function ' _hasProperty REM ------------------------------------------------------------------------------------------------------------------------ Public Function _ParentObject(psShortcut As String) As Object ' Return parent object from shortcut as a string Dim sParent As String, vParent() As Variant, iBound As Integer vParent = Split(psShortcut, "!") iBound = UBound(vParent) - 1 ReDim Preserve vParent(0 To iBound) ' Remove last element sParent = Join(vParent, "!") 'Remove ".Form" if present Const cstForm = ".FORM" Set _ParentObject = Nothing If Len(sParent) > Len(cstForm) Then If UCase(Right(sParent, Len(cstForm))) = cstForm Then Set _ParentObject = getValue(sParent) Else Set _ParentObject = getObject(sParent) End If End If End Function ' _ParentObject V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _Properties(ByVal psObject As String _ , ByVal psObjectName As String _ , ByVal pvPropertiesList() As Variant _ , ByVal Optional pvIndex As Variant _ ) As Variant ' Return ' a Collection object if pvIndex absent ' a Property object otherwise ' Generic function called from Properties methods stored in classes Dim vProperties As Variant, oCounter As Object, opProperty As Object Dim iArgNr As Integer, iLen As Integer Utils._SetCalledSub(psObject & ".Properties") vProperties = Null If IsMissing(pvIndex) Then ' Call without index argument prepares a Collection object Set oCounter = New Collect oCounter._CollType = COLLPROPERTIES oCounter._ParentType = UCase(psObject) oCounter._ParentName = psObjectName oCounter._Count = UBound(pvPropertiesList) + 1 Set vProperties = oCounter Else iLen = Len(psObject) + 1 If Len(_A2B_.CalledSub) > iLen Then If Left(_A2B_.CalledSub, iLen) = psObject & "." Then iArgNr = 1 Else iArgNr = 2 End If If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function If pvIndex < LBound(pvPropertiesList) Or pvIndex > UBound(pvPropertiesList) Then TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Else Set opProperty = New Property opProperty._Name = pvPropertiesList(pvIndex) opProperty._Value = Null Set vProperties = opProperty End If End If Exit_Function: Set _Properties = vProperties Utils._ResetCalledSub(psObject & ".Properties") Exit Function End Function ' _Properties REM ----------------------------------------------------------------------------------------------------------------------- Public Function _PropertiesList(pvObject As Variant) As Variant ' Return an array of strings containing the list of valid properties of pvObject Dim vProperties As Variant Dim vPropertiesList As Variant, bPropertiesList() As Boolean, sPropertiesList() As String Dim i As Integer, j As Integer, iCount As Integer Set vProperties = Nothing Select Case pvObject._Type Case OBJCOLLECTION, OBJPROPERTY, OBJFORM, OBJEVENT, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP _ , OBJDATABASE, OBJTABLEDEF, OBJQUERYDEF, OBJDIALOG, OBJFIELD, OBJRECORDSET, OBJTEMPVAR _ , OBJCOMMANDBAR, OBJCOMMANDBARCONTROL vPropertiesList = pvObject._PropertiesList() Case Else End Select Exit_Function: Set _PropertiesList = vPropertiesList Exit Function End Function ' PropertiesList V0.9.0 </script:module>