Access2BaseDev |
acConstants |
vbCr |
Basic |
vbNewLine (Procedure) _Initialize (Procedure) |
3 |
Public Function vbCr() As String : vbCr = Chr(13) : End Function |
Access2BaseDev |
acConstants |
vbLf |
Basic |
vbNewLine (Procedure) _PropValuesToStr (Procedure) Lines (Procedure) _FindPattern (Procedure) _Initialize (Procedure) _LineOfPosition (Procedure) |
1 |
Public Function vbLf() As String : vbLf = Chr(10) : End Function |
Access2BaseDev |
acConstants |
vbNewLine |
Basic |
TraceConsole (Procedure) _ReadAll (Procedure) _FindPattern (Procedure) |
4 |
Public Function vbNewLine() As String Const cstWindows = 1 If GetGuiType() = cstWindows Then vbNewLine = vbCR & vbLF Else vbNewLine = vbLF End Function |
Access2BaseDev |
acConstants |
vbTab |
Basic |
_Trim (Procedure) _FindPattern (Procedure) |
1 |
Public Function vbTab() As String : vbTab = Chr(9) : End Function |
Access2BaseDev |
Application |
_CountOpenForms |
Basic |
Forms (Procedure) |
24 |
Public Function _CountOpenForms(ByVal Optional piCountMax As Integer) As Variant
Dim i As Integer, iCount As Integer, iAllCount As Integer, ofForm As Variant iAllCount = AllForms._Count iCount = 0 If iAllCount > 0 Then For i = 0 To iAllCount - 1 Set ofForm = Application.AllForms(i) If ofForm.IsLoaded Then iCount = iCount + 1 If Not IsMissing(piCountMax) Then If iCount = piCountMax + 1 Then _CountOpenForms = ofForm Exit For End If End If Next i End If
If IsMissing(piCountMax) Then _CountOpenForms = iCount
End Function |
Access2BaseDev |
Application |
_CurrentDb |
Basic |
DAvg (Procedure) DCount (Procedure) DLookup (Procedure) DMax (Procedure) DMin (Procedure) DStDev (Procedure) DStDevP (Procedure) DSum (Procedure) DVar (Procedure) DVarP (Procedure) ApplyFilter (Procedure) mClose (Procedure) CopyObject (Procedure) OpenForm (Procedure) OutputTo (Procedure) Quit (Procedure) SetOrderBy (Procedure) ShowAllrecords (Procedure) _OpenObject (Procedure) Delete (Procedure) mClose (Procedure) CurrentDb (Procedure) _Initialize (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _PropertySet (Procedure) |
17 |
Public Function _CurrentDb(ByVal Optional piDocEntry As Integer, ByVal Optional piDbEntry As Integer) As Variant
Dim oCurrentDb As Object If IsEmpty(_A2B_) Then GoTo Trace_Error If IsMissing(piDocEntry) Then Set oCurrentDb = Application.CurrentDb() _ Else Set oCurrentDb = _A2B_._CurrentDb(piDocEntry, piDbEntry) If IsNull(oCurrentDb) Then Goto Trace_Error Else Set _CurrentDb = oCurrentDb
Exit_Function: Exit Function Trace_Error: TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1) Goto Exit_Function End Function |
Access2BaseDev |
Application |
_NewBar |
Basic |
SysCmd (Procedure) |
34 |
Private Function _NewBar() As Object
Dim vBar As Variant, vWindow As Variant, vController As Object On Local Error Resume Next Set _NewBar = Nothing
Set vBar = _A2B_.StatusBar If Not IsNull(vBar) Then If Utils._hasUNOMethod(vBar, "end") Then vBar.end() Set _A2B_.StatusBar = Nothing End If Set vBar = Nothing Set vWindow = _SelectWindow() If IsNull(vWindow.Frame) Then Exit Function Select Case vWindow.WindowType Case acForm, acReport, acBasicIDE, acDocument Case Else Exit Function End Select If Utils._hasUNOMethod(vWindow.Frame, "getCurrentController") Then Set vController = vWindow.Frame.getCurrentController() ElseIf Utils._hasUNOMethod(vWindow.Frame, "getController") Then Set vController = vWindow.Frame.getController() End If If Utils._hasUNOMethod(vController, "getStatusIndicator") Then vBar = vController.getStatusIndicator() Set _A2B_.StatusBar = vBar Set _NewBar = vBar Exit Function End Function |
Access2BaseDev |
Application |
_NewCommandBar |
Basic |
CommandBars (Procedure) |
28 |
Private Function _NewCommandBar(psModule As String _ , psToolbarName As String _ , psToolbarFullName As String _ , piBuiltin As Integer _ ) As Object
Dim oObject As Object Set oObject = New CommandBar With oObject ._Type = OBJCOMMANDBAR ._Name = psToolbarName ._ResourceURL = psToolbarFullName ._Module = psModule ._BarBuiltin = piBuiltin Select Case UCase(Split(psToolbarFullName, "/")(1)) Case "MENUBAR" : ._BarType = msoBarTypeMenuBar Case "STATUSBAR" : ._BarType = msoBarTypeStatusBar Case "TOOLBAR" : ._BarType = msoBarTypeNormal Case "POPUP" : ._BarType = msoBarTypePopup Case "FLOATER" : ._BarType = msoBarTypeFloater Case Else : ._BarType = -1 End Select End With Set _NewCommandBar = oObject Exit Function
End Function |
Access2BaseDev |
Application |
_RootInit |
Basic |
OpenConnection (Procedure) OpenDatabase (Procedure) ProductCode (Procedure) TraceError (Procedure) _ErrorHandler (Procedure) _ResetCalledSub (Procedure) _SetCalledSub (Procedure) |
8 |
Public Sub _RootInit(Optional ByVal pbForce As Boolean)
If IsMissing(pbForce) Then pbForce = False If IsEmpty(_A2B_) Or pbForce Then _A2B_ = New Root_ End Sub |
Access2BaseDev |
Application |
AllDialogs |
Basic |
Item (Procedure) getObject (Procedure) |
132 |
Public Function AllDialogs(ByVal Optional pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "AllDialogs" Utils._SetCalledSub(cstThisSub)
Dim iMode As Integer, vDialogs() As Variant, i As Integer, j As Integer, iCount As Integer Dim oMacLibraries As Object, vAllDialogs As Variant, oLibrary As Object, vNames() As Variant, bFound As Boolean Dim oLibDialog As Object, sLibrary As String, oDocLibraries As Object, bLocalStorage As Boolean Dim vLibraries() As Variant, vMacLibraries() As Variant, vDocLibraries() As Variant, oDocMacLib As Object Dim vCurrentDocument As Variant Const cstCount = 0 Const cstByIndex = 1 Const cstByName = 2 Const cstSepar = "!"
If IsMissing(pvIndex) Then iMode = cstCount Else If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function If VarType(pvIndex) = vbString Then iMode = cstByName Else iMode = cstByIndex End If
Set vAllDialogs = Nothing
Set vCurrentDocument = _A2B_.CurrentDocument If IsNull(vCurrentDocument) Then Set oDocLibraries = Nothing vDocLibraries = Array() Else Set oDocLibraries = _A2B_.CurrentDocument.Document.DialogLibraries vDocLibraries = oDocLibraries.getElementNames() End If Set oMacLibraries = DialogLibraries vMacLibraries = oMacLibraries.getElementNames() If _A2B_.ExcludeA2B Then For i = 0 To UBound(vMacLibraries) If Left(vMacLibraries(i), 11) = "Access2Base" Then vMacLibraries(i) = "" Next i End If vMacLibraries = Utils._TrimArray(vMacLibraries)
If UBound(vDocLibraries) + UBound(vMacLibraries) < 0 Then Set vAllDialogs = New Collect vAllDialogs._CollType = COLLALLDIALOGS vAllDialogs._ParentType = OBJAPPLICATION vAllDialogs._ParentName = "" vAllDialogs._Count = 0 Goto Exit_Function End If vNames = Array() iCount = 0 For i = 0 To UBound(vDocLibraries) + UBound(vMacLibraries) + 1 bFound = False If i <= UBound(vDocLibraries) Then sLibrary = vDocLibraries(i) bLocalStorage = True Set oDocMacLib = oDocLibraries If Not oDocMacLib.IsLibraryLoaded(sLibrary) Then oDocMacLib.loadLibrary(sLibrary) Else sLibrary = vMacLibraries(i - UBound(vDocLibraries) - 1) bLocalStorage = False Set oDocMacLib = oMacLibraries End If If oDocMacLib.IsLibraryLoaded(sLibrary) Then Set oLibrary = oDocMacLib.getByName(sLibrary) If oLibrary.hasElements() Then vDialogs = oLibrary.getElementNames() Select Case iMode Case cstCount iCount = iCount + UBound(vDialogs) + 1 Case cstByIndex, cstByName For j = 0 To UBound(vDialogs) If iMode = cstByIndex Then If pvIndex = iCount Then bFound = True iCount = iCount + 1 Else If UCase(pvIndex) = UCase(vDialogs(j)) Then bFound = True End If If bFound Then Set oLibDialog = oLibrary.getByName(vDialogs(j)) Exit For End If Next j End Select End If End If If bFound Then Exit For Next i If iMode = cstCount Then Set vAllDialogs = New Collect vAllDialogs._CollType = COLLALLDIALOGS vAllDialogs._ParentType = OBJAPPLICATION vAllDialogs._ParentName = "" vAllDialogs._Count = iCount Else If Not bFound Then If iMode = cstByIndex Then Goto Trace_Error_Index Else Goto Trace_Not_Found End If Set vAllDialogs = New Dialog With vAllDialogs ._Name = vDialogs(j) ._Shortcut = "Dialogs!" & vDialogs(j) Set ._Dialog = oLibDialog ._Library = sLibrary ._Storage = Iif(bLocalStorage, "DOCUMENT", "GLOBAL") End With End If
Exit_Function: Set AllDialogs = vAllDialogs Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Not_Found: TraceError(TRACEFATAL, ERRDIALOGNOTFOUND, Utils._CalledSub(), 0, , pvIndex) Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set vDialogs = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) Set vDialogs = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
Application |
AllForms |
Basic |
Forms (Procedure) _CountOpenForms (Procedure) OpenForm (Procedure) Item (Procedure) |
101 |
Public Function AllForms(ByVal Optional pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "AllForms" Utils._SetCalledSub(cstThisSub) Dim iIndex As Integer, vAllForms As Variant Set vAllForms = Nothing If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function Select Case VarType(pvIndex) Case vbString iIndex = -1 Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal iIndex = pvIndex End Select End If
Dim iCurrentDoc As Integer, vCurrentDoc As Variant, oForms As Variant, oCounter As Variant, oFormsCollection As Object iCurrentDoc = _A2B_.CurrentDocIndex() If iCurrentDoc >= 0 Then vCurrentDoc = _A2B_.CurrentDocument(iCurrentDoc) Else Goto Exit_Function End If If vCurrentDoc.DbConnect = DBCONNECTBASE Then Set oForms = vCurrentDoc.Document.getFormDocuments() If IsMissing(pvIndex) Then Set oCounter = New Collect oCounter._CollType = COLLALLFORMS oCounter._ParentType = OBJAPPLICATION oCounter._ParentName = "" If vCurrentDoc.DbConnect = DBCONNECTFORM Then oCounter._Count = UBound(vCurrentDoc.DbContainers) + 1 Else oCounter._Count = oForms.getCount() Set vAllForms = oCounter Goto Exit_Function End If Dim ofForm As Object Set ofForm = New Form Dim sAllForms As Variant, i As Integer, vName As Variant, oDatabase As Object, bFound As Boolean Select Case vCurrentDoc.DbConnect Case DBCONNECTBASE sAllForms() = oForms.getElementNames() ofForm._DocEntry = 0 ofForm._DbEntry = 0 If iIndex= -1 Then vName = Utils._InList(Utils._Trim(pvIndex), sAllForms, True) If vName = False Then Goto Trace_Not_Found ofForm._Initialize(vName) Else If iIndex + 1 > oForms.getCount() Or iIndex < 0 Then Goto Trace_Error_Index ofForm._Initialize(sAllForms(iIndex)) End If Case DBCONNECTFORM With vCurrentDoc If iIndex = -1 Then bFound = False For i = 0 To UBound(vCurrentDoc.DbContainers) Set oDatabase = vCurrentDoc.DbContainers(i).Database If UCase(Utils._Trim(pvIndex)) = UCase(oDatabase.FormName) Then bFound = True ofForm._DbEntry = i Exit For End If Next i If Not bFound Then Goto Trace_Not_Found ElseIf iIndex < 0 Or iIndex > UBound(vCurrentDoc.DbContainers) Then Goto Trace_Error_Index Else ofForm._DbEntry = iIndex Set oDatabase = vCurrentDoc.DbContainers(iIndex).Database End If End With vName = oDatabase.FormName ofForm._DocEntry = iCurrentDoc ofForm._Initialize(vName) End Select Set vAllForms = ofForm Exit_Function: Set AllForms = vAllForms Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Not_Found: TraceError(TRACEFATAL, ERRFORMNOTFOUND, Utils._CalledSub(), 0, , pvIndex) Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set vAllForms = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) Set vAllForms = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
Application |
AllModules |
Basic |
Item (Procedure) |
142 |
Public Function AllModules(ByVal Optional pvIndex As Variant, ByVal Optional pbAllModules As Boolean) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "AllModules" Utils._SetCalledSub(cstThisSub)
Dim iMode As Integer, vModules() As Variant, i As Integer, j As Integer, iCount As Integer Dim oMacLibraries As Object, vAllModules As Variant, oLibrary As Object, vNames() As Variant, bFound As Boolean Dim sScript As String, sLibrary As String, oDocLibraries As Object, sStorage As String Dim vLibraries() As Variant, vMacLibraries() As Variant, vDocLibraries() As Variant, oDocMacLib As Object Const cstCount = 0, cstByIndex = 1, cstByName = 2 Const cstDot = "."
If IsMissing(pvIndex) Then iMode = cstCount Else If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function If VarType(pvIndex) = vbString Then iMode = cstByName vNames = Split(pvIndex, cstDot) If UBound(vNames) = 2 Then ElseIf UBound(vNames) = 1 Then pvIndex = MODDOCUMENT & cstDot & pvIndex ElseIf UBound(vNames) = 0 Then pvIndex = MODDOCUMENT & cstDot & "STANDARD" & cstDot & pvIndex Else GoTo Trace_Not_Found End If Else iMode = cstByIndex End If End If
If IsMissing(pbAllModules) Then pbAllModules = True If Not Utils._CheckArgument(pbAllModules, 2, vbBoolean) Then Goto Exit_Function
Set vAllModules = Nothing
Set oDocLibraries = _A2B_.CurrentDocument.Document.BasicLibraries vDocLibraries = oDocLibraries.getElementNames() If pbAllModules Then Set oMacLibraries = GlobalScope.BasicLibraries vMacLibraries = oMacLibraries.getElementNames() If _A2B_.ExcludeA2B Then For i = 0 To UBound(vMacLibraries) Next i End If vMacLibraries = Utils._TrimArray(vMacLibraries) End If
If UBound(vDocLibraries) + UBound(vMacLibraries) < 0 Then Set vAllModules = New Collect vAllModules._CollType = COLLALLMODULES vAllModules._ParentType = OBJAPPLICATION vAllModules._ParentName = "" vAllModules._Count = 0 Goto Exit_Function End If iCount = 0 For i = 0 To UBound(vDocLibraries) + UBound(vMacLibraries) + 1 bFound = False If i <= UBound(vDocLibraries) Then sLibrary = vDocLibraries(i) sStorage = MODDOCUMENT Set oDocMacLib = oDocLibraries If Not oDocMacLib.IsLibraryLoaded(sLibrary) Then oDocMacLib.loadLibrary(sLibrary) Else sLibrary = vMacLibraries(i - UBound(vDocLibraries) - 1) sStorage = MODGLOBAL Set oDocMacLib = oMacLibraries End If If oDocMacLib.IsLibraryLoaded(sLibrary) Then Set oLibrary = oDocMacLib.getByName(sLibrary) If oLibrary.hasElements() Then vModules = oLibrary.getElementNames() Select Case iMode Case cstCount iCount = iCount + UBound(vModules) + 1 Case cstByIndex, cstByName For j = 0 To UBound(vModules) If iMode = cstByIndex Then If pvIndex = iCount Then bFound = True iCount = iCount + 1 Else If UCase(pvIndex) = UCase(sStorage & cstDot & sLibrary & cstDot & vModules(j)) Then bFound = True End If If bFound Then sScript = oLibrary.getByName(vModules(j)) iCount = i Exit For End If Next j End Select End If End If If bFound Then Exit For Next i If iMode = cstCount Then Set vAllModules = New Collect vAllModules._CollType = COLLALLMODULES vAllModules._ParentType = OBJAPPLICATION vAllModules._ParentName = "" vAllModules._Count = iCount Else If Not bFound Then If iMode = cstByIndex Then Goto Trace_Error_Index Else Goto Trace_Not_Found End If Set vAllModules = New Module vAllModules._Name = vModules(j) vAllModules._LibraryName = sLibrary Set vAllModules._Library = oLibrary vAllModules._Storage = sStorage vAllModules._Script = sScript vAllModules._Initialize() End If
Exit_Function: Set AllModules = vAllModules Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Not_Found: TraceError(TRACEFATAL, ERRMODULENOTFOUND, Utils._CalledSub(), 0, , pvIndex) Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set vModules = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) Set vModules = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
Application |
CloseConnection |
Basic |
|
18 |
Public Sub CloseConnection ()
If IsEmpty(_A2B_) Then Goto Exit_Sub Const cstThisSub = "CloseConnection" Utils._SetCalledSub(cstThisSub)
Call _A2B_.CloseConnection() Exit_Sub: Utils._ResetCalledSub(cstThisSub) Exit Sub End Sub |
Access2BaseDev |
Application |
CommandBars |
Basic |
Item (Procedure) _PropertyGet (Procedure) |
155 |
Public Function CommandBars(Optional ByVal pvIndex As Variant, Optional ByRef poWindow As Object) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "CommandBars" Utils._SetCalledSub(cstThisSub)
Dim iObjectsCount As Integer, sObjectName As String, oObject As Object Dim oWindow As Object, iWindowType As Integer Dim i As Integer, j As Integer, k As Integer, bFound As Boolean Dim sSupportedModules() As Variant, vModules() As Variant, oModuleUI As Object Dim oToolbar As Object, sToolbarName As String, vUIElements() As Variant, sToolbarFullName As String, iBuiltin As Integer
Const cstCustom = "CUSTOM"
Set oObject = Nothing If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End If iObjectsCount = 0 bFound = False
If IsMissing(poWindow) Then Set oWindow = _SelectWindow() Else Set oWindow = poWindow If IsNull(oWindow.Frame) Then Goto Trace_WindowError
vModules = CreateUnoService("com.sun.star.frame.ModuleManager").getElementNames() iWindowType = oWindow.WindowType Select Case iWindowType Case acForm sSupportedModules = Array( "com.sun.star.sdb.FormDesign" ) Case acBasicIDE sSupportedModules = Array( "com.sun.star.script.BasicIDE" ) Case acDatabaseWindow sSupportedModules = Array( "com.sun.star.sdb.OfficeDatabaseDocument" ) Case acReport sSupportedModules = Array( "com.sun.star.sdb.TextReportDesign" ) Case acDocument Select Case oWindow.DocumentType Case docCalc : sSupportedModules = Array( "com.sun.star.sheet.SpreadsheetDocument" ) Case docWriter : sSupportedModules = Array( "com.sun.star.text.TextDocument" ) Case docImpress : sSupportedModules = Array( "com.sun.star.presentation.PresentationDocument" ) Case docDraw : sSupportedModules = Array( "com.sun.star.drawing.DrawingDocument" ) Case docMath : sSupportedModules = Array( "com.sun.star.formula.FormulaProperties" ) Case Else : sSupportedModules = Array() End Select Case acTable, acQuery sSupportedModules = Array( "com.sun.star.sdb.DataSourceBrowser" _ , "com.sun.star.sdb.TableDataView" _ ) Case acDiagram sSupportedModules = Array( "com.sun.star.sdb.RelationDesign" ) Case acWelcome sSupportedModules = Array( "com.sun.star.frame.StartModule" ) Case Else sSupportedModules = Array() End Select
Set oModuleUI = CreateUnoService("com.sun.star.ui.ModuleUIConfigurationManagerSupplier") For k = 0 To UBound(vModules) For j = 0 To UBound(sSupportedModules) iBuiltin = 1 If vModules(k) = sSupportedModules(j) Then Set oToolbar = oModuleUI.getUIConfigurationManager(vModules(k)) vUIElements() = oToolbar.getUIElementsInfo(0) For i = 0 To UBound(vUIElements) sToolbarFullName = _GetPropertyValue(vUIElements(i), "ResourceURL") sToolbarName = Split(sToolbarFullName, "/")(2) If _IsLeft(UCase(sToolbarName), UCase(cstCustom)) Then sToolbarName = _GetPropertyValue(vUIElements(i), "UIName") iBuiltin = 2 End If
iObjectsCount = iObjectsCount + 1 Select Case True Case IsMissing(pvIndex) Case VarType(pvIndex) = vbString If UCase(pvIndex) = UCase(sToolbarName) Then bFound = True Case Else If pvIndex < 0 Then Goto Trace_IndexError If pvIndex = iObjectsCount - 1 Then bFound = True End Select
If bFound Then Set oObject = _NewCommandBar(vModules(k), sToolbarName, sToolbarFullName, iBuiltin) Set oObject._Window = oWindow.Frame Set oObject._Toolbar = oToolbar Goto Exit_Function End If Next i End If Next j Next k
iBuiltin = 3 Set oToolbar = oWindow.Frame.Controller.Model.getUIConfigurationManager vUIElements() = oToolbar.getUIElementsInfo(0) For i = 0 To UBound(vUIElements) sToolbarFullName = _GetPropertyValue(vUIElements(i), "ResourceURL") sToolbarName = _GetPropertyValue(vUIElements(i), "UIName") iObjectsCount = iObjectsCount + 1 Select Case True Case IsMissing(pvIndex) Case VarType(pvIndex) = vbString If UCase(pvIndex) = UCase(sToolbarName) Then bFound = True Case Else If pvIndex = iObjectsCount - 1 Then bFound = True End Select If bFound Then Set oObject = _NewCommandBar("", sToolbarName, sToolbarFullName, iBuiltin) Set oObject._Window = oWindow.Frame Set oObject._Toolbar = oToolbar Goto Exit_Function End If Next i
Select Case True Case IsMissing(pvIndex) Set oObject = New Collect oObject._CollType = COLLCOMMANDBARS oObject._ParentType = OBJAPPLICATION oObject._Count = iObjectsCount Case VarType(pvIndex) = vbString Goto Trace_NotFound Case Else Goto Trace_IndexError End Select
Exit_Function: Set CommandBars = oObject Set oObject = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("COMMANDBAR"), pvIndex)) Goto Exit_Function Trace_IndexError: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0) Goto Exit_Function Trace_WindowError: TraceError(TRACEFATAL, ERRWINDOW, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
Application |
Controls |
Basic |
GetRows (Procedure) |
43 |
Public Function Controls(ByVal Optional pvObject As Variant, Optional ByVal pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Dim vObject As Object Const cstThisSub = "Controls" Utils._SetCalledSub(cstThisSub)
If IsMissing(pvObject) Then Call _TraceArguments() If IsNull(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments() Controls = EMPTY
If VarType(pvObject) = vbString Then Set vObject = Forms(pvObject) If IsNull(vObject) Then Goto Exit_Function Else If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJSUBFORM, OBJOPTIONGROUP, CTLGRIDCONTROL)) Then Goto Exit_Function Set vObject = pvObject End If If IsMissing(pvIndex) Then Controls = vObject.Controls() Else If Not Utils._CheckArgument(pvIndex, 2, Utils._AddNumeric(vbString)) Then Goto Exit_Function Controls = vObject.Controls(pvIndex) End If Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEERROR, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Application |
CurrentDb |
Basic |
_CurrentDb (Procedure) TraceError (Procedure) |
15 |
Public Function CurrentDb() As Object
Const cstThisSub = "CurrentDb" Utils._SetCalledSub(cstThisSub)
Set CurrentDb = Nothing If IsEmpty(_A2B_) Then GoTo Exit_Function Set CurrentDb = _A2B_.CurrentDb()
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Application |
CurrentUser |
Basic |
|
15 |
Public Function CurrentUser() As String
Const cstWindows = 1 Const cstUnix = 4 Select Case GetGuiType() Case cstWindows CurrentUser = Environ("USERNAME") Case cstUnix CurrentUser = Environ("USER") Case Else CurrentUser = "" End Select
End Function |
Access2BaseDev |
Application |
DAvg |
Basic |
|
13 |
Public Function DAvg( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "DAvg" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DAvg = Application._CurrentDb()._DFunction("AVG", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Application |
DCount |
Basic |
|
13 |
Public Function DCount( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "DCount" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DCount = Application._CurrentDb()._DFunction("COUNT", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Application |
DLookup |
Basic |
|
30 |
Public Function DLookup( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ , ByVal Optional pvOrderClause As Variant _ ) As Variant
Const cstThisSub = "DLookup" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DLookup = Application._CurrentDb()._DFunction("", psExpr, psDomain _ , Iif(IsMissing(pvCriteria), "", pvCriteria) _ , Iif(IsMissing(pvOrderClause), "", pvOrderClause) _ ) Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Application |
DMax |
Basic |
|
13 |
Public Function DMax( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "DMax" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DMax = Application._CurrentDb()._DFunction("MAX", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Application |
DMin |
Basic |
|
13 |
Public Function DMin( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "DMin" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DMin = Application._CurrentDb()._DFunction("MIN", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Application |
DStDev |
Basic |
|
13 |
Public Function DStDev( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "DStDev" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DStDev = Application._CurrentDb()._DFunction("STDDEV_SAMP", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Application |
DStDevP |
Basic |
|
13 |
Public Function DStDevP( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "DStDevP" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DStDevP = Application._CurrentDb()._DFunction("STDDEV_POP", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Application |
DSum |
Basic |
|
13 |
Public Function DSum( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "DSum" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DSum = Application._CurrentDb()._DFunction("SUM", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Application |
DVar |
Basic |
|
13 |
Public Function DVar( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "DVar" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DVar = Application._CurrentDb()._DFunction("VAR_SAMP", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Application |
DVarP |
Basic |
|
13 |
Public Function DVarP( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "DVarP" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DVarP = Application._CurrentDb()._DFunction("VAR_POP", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Application |
Events |
Basic |
|
31 |
Public Function Events(Optional poEvent As Variant) As Variant
Dim vEvent As Variant If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "Events" Utils._SetCalledSub(cstThisSub) Set vEvent = Nothing If IsMissing(poEvent) Then Goto Exit_Function If IsNull(poEvent) Then Goto Exit_Function
If Not Utils._CheckArgument(poEvent, 1, vbObject, , False) Then Goto Exit_Function If Not Utils._hasUNOProperty(poEvent, "Source") Then Goto Trace_Error Set vEvent = New Event vEvent._Initialize(poEvent)
Exit_Function: Set Events = vEvent Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEWARNING, Err, cstThisSub, Erl) GoTo Exit_Function Trace_Error: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, False, Array(1, Utils._CStr(poEvent))) Set vEvent = Nothing Goto Exit_Function End Function |
Access2BaseDev |
Application |
Forms |
Basic |
Controls (Procedure) FindRecord (Procedure) GoToControl (Procedure) GoToRecord (Procedure) OutputTo (Procedure) _DatabaseForm (Procedure) Item (Procedure) getObject (Procedure) |
62 |
Public Function Forms(ByVal Optional pvIndex As Variant) As Variant
Const cstThisSub = "Forms" Utils._SetCalledSub(cstThisSub) If _ErrorHandler() Then On Local Error Goto Error_Function
Dim ofForm As Object, oCounter As Variant, vForms As Variant, oIndex As Object Set vForms = Nothing
Dim iCount As Integer If IsMissing(pvIndex) Then iCount = Application._CountOpenForms() Set oCounter = New Collect oCounter._CollType = COLLFORMS oCounter._ParentType = OBJAPPLICATION oCounter._ParentName = "" oCounter._Count = iCount Forms = oCounter Exit Function Else If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End If Select Case VarType(pvIndex) Case vbString Set ofForm = Application.AllForms(Utils._Trim(pvIndex)) Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal iCount = Application._CountOpenForms() If iCount <= pvIndex Then Goto Trace_Error_Index Set ofForm = Application._CountOpenForms(pvIndex) Case Else End Select
If IsNull(ofForm) Then Goto Trace_Error If ofForm.IsLoaded Then Set vForms = ofForm Else Set vForms = Nothing TraceError(TRACEFATAL, ERRFORMNOTOPEN, Utils._CalledSub(), 0, , ofForm._Name) Goto Exit_Function End If
Exit_Function: Set Forms = vForms Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvIndex)) Set vForms = Nothing Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set vForms = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Application |
HtmlEncode |
Basic |
|
33 |
Function HtmlEncode(ByVal pvString As Variant, ByVal Optional pvLength As Variant) As String
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "HtmlEncode" Utils._SetCalledSub(cstThisSub)
HtmlEncode = ""
Dim sOutput As String, l As Long, lLength As Long If IsMissing(pvLength) Then pvLength = 0 If Not Utils._CheckArgument(pvString, 1, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvLength, 1, _AddNumeric()) Then Goto Exit_Function
sOutput = "" lLength = CLng(pvLength) If Len(pvString) > 0 Then For l = 1 To Len(pvString) If lLength > 0 And Len(sOutput) > lLength Then Exit For sOutput = sOutput & Utils._UTF8Encode(Mid(pvString, l, 1)) Next l End If
HtmlEncode = sOutput
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Application |
OpenConnection |
Basic |
|
174 |
Public Function OpenConnection ( _ Optional pvComponent As Variant _ , ByVal Optional pvUser As Variant _ , ByVal Optional pvPassword As Variant _ ) As Object
Dim oComponent As Object, oForms As Object, iCurrent As Integer Dim i As Integer, bFound As Boolean Dim vCurrentDoc() As Variant Dim oBaseContext As Object, sDbNames() As String, oBaseSource As Object Dim sDatabaseURL As String, oHandler As Object Dim vDbContainer As Variant, vDbContainers() As Variant, vDocContainer As Variant Dim sFormName As String
If IsEmpty(_A2B_) Then Call Application._RootInit() Set OpenConnection = Nothing If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "OpenConnection" Utils._SetCalledSub(cstThisSub) If IsMissing(pvComponent) Then Call _TraceArguments() If Not Utils._CheckArgument(pvComponent, 1, vbObject) Then Goto Exit_Function Set oComponent = pvComponent If Not Utils._hasUNOProperty(oComponent, "ImplementationName") Then TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(1, oComponent)) Exit Function End If If IsMissing(pvUser) Then pvUser = "" If IsMissing(pvPassword) Then pvPassword = "" If Not Utils._CheckArgument(pvUser, 2, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvPassword, 3, vbString) Then Goto Exit_Function
If Not IsArray(_A2B_.CurrentDoc) Then vCurrentDoc() = Array() Redim vCurrentDoc(0 To 0) Else vCurrentDoc() = _A2B_.CurrentDoc() End If
With oComponent Select Case .ImplementationName Case "com.sun.star.comp.dba.ODatabaseDocument" iCurrent = 0 Case Else If UBound(vCurrentDoc) <= 0 Then iCurrent = 1 Else bFound = False For i = 1 To UBound(vCurrentDoc) If Not IsEmpty(vCurrentDoc(i)) Then If vCurrentDoc(i).Active And vCurrentDoc(i).URL = .URL Then iCurrent = i bFound = True Exit For End If End If Next i End If If Not bFound Then iCurrent = UBound(vCurrentDoc) + 1 ReDim Preserve vCurrentDoc(0 To iCurrent) End If End Select End With
Set vDocContainer = New DocContainer Set vDocContainer.Document = oComponent vDocContainer.Active = True vDocContainer.URL = oComponent.URL vDbContainers() = Array() TraceLog(TRACEANY, Utils._GetProductName() & " - " & Application.ProductCode(), False) Select Case oComponent.ImplementationName Case "com.sun.star.comp.dba.ODatabaseDocument" vDbContainer = New DbContainer vDbContainer.FormName = "" Set vDbContainer.Database = New Database Set vDbContainer.Database._This = vDbContainer.Database With vDbContainer.Database If Not oComponent.CurrentController.IsConnected Then Set oHandler = createUnoService("com.sun.star.sdb.InteractionHandler") Set .Connection = oComponent.DataSource.connectWithCompletion(oHandler) oComponent.CurrentController.connect() Else Set .Connection = oComponent.CurrentController.ActiveConnection End If vDocContainer.DbConnect = DBCONNECTBASE ._DbConnect = DBCONNECTBASE Set .MetaData = .Connection.MetaData ._LoadMetadata() If .MetaData.DatabaseProductName = "MySQL" Then ._ReadOnly = .MetaData.isReadOnly() Else ._ReadOnly = .Connection.isReadOnly() End If Set .Document = oComponent .Title = oComponent.Title .URL = vDocContainer.URL ReDim vDbContainers(0 To 0) Set vDbContainers(0) = vDbContainer TraceLog(TRACEANY, .Version, False) TraceLog(TRACEANY, UCase(cstThisSub) & " " & .URL, False) End With Case Else Set oForms = oComponent.CurrentController.Model.DrawPage.Forms If oForms.Count < 1 Then Goto Error_MainForm ReDim vDbContainers(0 To oForms.Count - 1) For i = 0 To oForms.Count - 1 vDbContainer = New DbContainer sFormName = oForms.ElementNames(i) Set vDbContainer.Database = New Database Set vDbContainer.Database._This = vDbContainer.Database With vDbContainer.Database .FormName = sFormName vDbContainer.FormName = sFormName Set .Form = oForms.getByName(sFormName) Set .Connection = .Form.ActiveConnection If Not IsNull(.Connection) Then Set .MetaData = .Connection.MetaData ._LoadMetadata() ._ReadOnly = .Connection.isReadOnly() TraceLog(TRACEANY, .MetaData.getDatabaseProductName() & " " & .MetaData.getDatabaseProductVersion, False) End If Set .Document = oComponent .Title = oComponent.Title .URL = .Form.DataSourceName ._DbConnect = DBCONNECTFORM Set vDbContainers(i) = vDbContainer vDbContainers(i).FormName = sFormName TraceLog(TRACEANY, UCase(cstThisSub) & " " & .URL & " Form=" & vDbContainer.FormName, False) End With Next i vDocContainer.DbConnect = DBCONNECTFORM End Select vDocContainer.DbContainers() = vDbContainers() Set vCurrentDoc(iCurrent) = vDocContainer
_A2B_.CurrentDoc = vCurrentDoc Set OpenConnection = vDbContainers(0).Database Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) Set _A2B_.CurrentDoc = Array() GoTo Exit_Function Error_MainForm: TraceError(TRACEFATAL, ERRMAINFORM, Utils._CalledSub(), False, ,oComponent.Title) Set _A2B_.CurrentDoc = Array() GoTo Exit_Function Trace_Error: TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0,1) Goto Exit_Function End Function |
Access2BaseDev |
Application |
OpenDatabase |
Basic |
CopyObject (Procedure) |
89 |
Public Function OpenDatabase ( _ ByVal Optional pvDatabaseURL As Variant _ , ByVal Optional pvUser As Variant _ , ByVal Optional pvPassword As Variant _ , ByVal Optional pvReadOnly As Variant _ ) As Object
Dim odbDatabase As Variant, oBaseContext As Object, sDbNames() As String, oBaseSource As Object Dim i As Integer, bFound As Boolean Dim sDatabaseURL As String
If IsEmpty(_A2B_) Then Call Application._RootInit() TraceLog(TRACEANY, Utils._GetProductName() & " - " & Application.ProductCode(), False) End If Set OpenDatabase = Nothing If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "OpenDatabase" Utils._SetCalledSub(cstThisSub) If pvDatabaseURL = "" Then Call _TraceArguments() If Not Utils._CheckArgument(pvDatabaseURL, 1, vbString) Then Goto Exit_Function If IsMissing(pvUser) Then pvUser = "" If IsMissing(pvPassword) Then pvPassword = "" If Not Utils._CheckArgument(pvUser, 2, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvPassword, 3, vbString) Then Goto Exit_Function If IsMissing(pvReadOnly) Then pvReadOnly = False If Not Utils._CheckArgument(pvReadOnly, 3, vbBoolean) Then Goto Exit_Function Set odbDatabase = New Database Set odbDatabase._This = odbDatabase odbDatabase._DbConnect = DBCONNECTANY
Set oBaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") sDbNames() = oBaseContext.getElementNames() bFound = False For i = 0 To UBound(sDbNames()) If UCase(sDbNames(i)) = UCase(pvDatabaseURL) Then sDatabaseURL = sDbNames(i) Set oBaseSource = oBaseContext.getByName(sDatabaseURL) bFound = True Exit For End If Next i If Not bFound Then sDatabaseURL = ConvertToURL(pvDatabaseURL) If UCase(Right(sDatabaseURL, 4)) <> ".ODB" Then Goto Trace_Error If Not FileExists(sDatabaseURL) Then Goto Trace_Error Set oBaseSource = oBaseContext.getByName(sDatabaseURL) End If
Set odbDatabase.Connection = oBaseSource.getConnection(pvUser, pvPassword) If Not IsNull(odbDatabase.Connection) Then Set odbDatabase.MetaData = odbDatabase.Connection.MetaData odbDatabase._LoadMetadata() Else Goto Trace_Error End If
odbDatabase.URL = sDatabaseURL If pvReadOnly Then odbDatabase.Connection.isReadOnly = True odbDatabase._ReadOnly = True End If
Set OpenDatabase = odbDatabase TraceLog(TRACEANY, odbDatabase.MetaData.getDatabaseProductName() & " " & odbDatabase.MetaData.getDatabaseProductVersion, False) TraceLog(TRACEANY, UCase(cstThisSub) & " " & odbDatabase.URL, False) Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Trace_Error: TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0,1) Goto Exit_Function End Function |
Access2BaseDev |
Application |
ProductCode |
Basic |
OpenConnection (Procedure) OpenDatabase (Procedure) |
5 |
Public Function ProductCode() If IsEmpty(_A2B_) Then Call Application._RootInit() ProductCode = "Access2Base " & _A2B_.VersionNumber End Function |
Access2BaseDev |
Application |
SysCmd |
Basic |
CopyObject (Procedure) |
91 |
Public Function SysCmd(Optional pvAction As Variant _ , Optional pvText As Variant _ , Optional pvValue As Variant _ ) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "SysCmd" Utils._SetCalledSub(cstThisSub) SysCmd = False
Const cstMissing = -1 Const cstBarLength = 350 If IsMissing(pvAction) Then Call _TraceArguments() If Not Utils._CheckArgument(pvAction, 1, Utils._AddNumeric(), Array( _ acSysCmdAccessDir _ , acSysCmdAccessVer _ , acSysCmdClearHelpTopic _ , acSysCmdClearStatus _ , acSysCmdGetObjectState _ , acSysCmdGetWorkgroupFile _ , acSysCmdIniFile _ , acSysCmdInitMeter _ , acSysCmdProfile _ , acSysCmdRemoveMeter _ , acSysCmdRuntime _ , acSysCmdSetStatus _ , acSysCmdUpdateMeter _ )) Then Goto Exit_Function If IsMissing(pvValue) Then pvValue = cstMissing If Not Utils._CheckArgument(pvAction, 1, Utils._AddNumeric()) Then Goto Exit_Function Select Case pvAction Case acSysCmdInitMeter, acSysCmdUpdateMeter, acSysCmdSetStatus If IsMissing(pvText) Then Call _TraceArguments() If Not Utils._CheckArgument(pvText, 2, vbString) Then Goto Exit_Function Case Else End Select If Not Utils._CheckArgument(pvValue, 3, Utils._AddNumeric()) Then Goto Exit_Function Dim vBar As Variant, iLen As Integer Set vBar = _A2B_.StatusBar Select Case pvAction Case acSysCmdAccessVer SysCmd = Application.Version() Goto Exit_Function Case acSysCmdSetStatus If pvValue <> cstMissing Then Goto Error_Arg iLen = Len(pvText) vBar = _NewBar() If Not IsNull(vBar) Then vBar.start(Iif(iLen >= cstBarLength, pvText, pvText & Space(cstBarLength - iLen)), 0) Case acSysCmdClearStatus If pvValue <> cstMissing Then Goto Error_Arg If Not IsNull(vBar) Then vBar.end() Set _A2B_.StatusBar = Nothing End If Case acSysCmdInitMeter If pvValue = cstMissing Then Call _TraceArguments() vBar = _NewBar() If Not IsNull(vBar) Then vBar.start(pvText, pvValue) Case acSysCmdUpdateMeter If pvValue = cstMissing Then Call _TraceArguments() If Not IsNull(vBar) Then vBar.setValue(pvValue) If Len(pvText) > 0 Then vBar.setText(pvText) End If Case acSysCmdRemoveMeter If Not IsNull(vBar) Then vBar.end() Set _A2B_.StatusBar = Nothing End If Case acSysCmdRuntime SysCmd = False Goto Exit_Function Case Else End Select SysCmd = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_Arg: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(3, pvValue)) Goto Exit_Function End Function |
Access2BaseDev |
Application |
TempVars |
Basic |
Item (Procedure) getObject (Procedure) Class_Initialize (Procedure) |
53 |
Public Function TempVars(ByVal Optional pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "TempVars" Utils._SetCalledSub(cstThisSub)
Dim iMode As Integer, vTempVars As Variant, bFound As Boolean Const cstCount = 0 Const cstByIndex = 1 Const cstByName = 2
If IsMissing(pvIndex) Then iMode = cstCount Else If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function If VarType(pvIndex) = vbString Then iMode = cstByName Else iMode = cstByIndex End If
Set vTempVars = Nothing Select Case iMode Case cstCount Set vTempVars = New Collect With vTempVars ._CollType = COLLTEMPVARS ._Count = _A2B_.TempVars.Count End With Case cstByIndex If pvIndex < 0 Or pvIndex >= _A2B_.TempVars.Count Then Goto Trace_Error_Index Set vTempVars = _A2B_.TempVars.Item(pvIndex + 1) Case cstByName bFound = _A2B_.hasItem(COLLTEMPVARS, pvIndex) If Not bFound Then Goto Trace_NotFound vTempVars = _A2B_.TempVars.Item(UCase(pvIndex)) End Select
Set TempVars = vTempVars
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set vTempVars = Nothing Goto Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("TEMPVAR"), pvIndex)) Goto Exit_Function End Function |
Access2BaseDev |
Application |
Version |
Basic |
SysCmd (Procedure) |
4 |
Public Function Version() As String Version = Utils._GetProductName() End Function |
Access2BaseDev |
Collect |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
6 |
Private Function _PropertiesList() As Variant _PropertiesList = Array("Count", "Item", "ObjectType") End Function |
Access2BaseDev |
Collect |
_PropertyGet |
Basic |
Count (Procedure) ObjectType (Procedure) Properties (Procedure) getProperty (Procedure) |
30 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Collection.get" & psProperty) _PropertyGet = Nothing Select Case UCase(psProperty) Case UCase("Count") _PropertyGet = _Count Case UCase("Item") Case UCase("ObjectType") _PropertyGet = _Type Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("Collection.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertyGet = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Collection._PropertyGet", Erl) _PropertyGet = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
Collect |
Add |
Basic |
|
65 |
Public Function Add(Optional pvNew As Variant, Optional pvValue As Variant) As Boolean
Const cstThisSub = "Collection.Add" Utils._SetCalledSub(cstThisSub) If _ErrorHandler() Then On Local Error Goto Error_Function Dim odbDatabase As Object, oConnection As Object, oTables As Object, oTable As Object Dim vObject As Variant, oTempVar As Object Add = False If IsMissing(pvNew) Then Call _TraceArguments()
Select Case _CollType Case COLLTABLEDEFS If Not Utils._CheckArgument(pvNew, 1, vbObject) Then Goto Exit_Function Set vObject = pvNew With vObject Set odbDatabase = ._ParentDatabase If odbDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable Set oConnection = odbDatabase.Connection If IsNull(.TableDescriptor) Or .TableFieldsCount = 0 Then Goto Error_Sequence Set oTables = oConnection.getTables() oTables.appendByDescriptor(.TableDescriptor) Set .Table = oTables.getByName(._Name) .CatalogName = .Table.CatalogName .SchemaName = .Table.SchemaName .TableName = .Table.Name .TableDescriptor.dispose() Set .TableDescriptor = Nothing .TableFieldsCount = 0 .TableKeysCount = 0 End With Case COLLTEMPVARS If Not Utils._CheckArgument(pvNew, 1, vbString) Then Goto Exit_Function If pvNew = "" Then Goto Error_Name If IsMissing(pvValue) Then Call _TraceArguments() If _A2B_.hasItem(COLLTEMPVARS, pvNew) Then Goto Error_Name Set oTempVar = New TempVar oTempVar._Name = pvNew oTempVar._Value = pvValue _A2B_.TempVars.Add(oTempVar, UCase(pvNew)) Case Else Goto Error_NotApplicable End Select
_Count = _Count + 1 Add = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_Sequence: TraceError(TRACEFATAL, ERRTABLECREATION, Utils._CalledSub(), 0, 1, vObject._Name) Goto Exit_Function Error_Name: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvNew)) AddItem = False Goto Exit_Function End Function |
Access2BaseDev |
Collect |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
11 |
Private Sub Class_Initialize() _Type = OBJCOLLECTION _CollType = "" _ParentType = "" _ParentName = "" Set _ParentDatabase = Nothing _Count = 0 End Sub |
Access2BaseDev |
Collect |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
Collect |
Count |
Basic |
|
3 |
Property Get Count() As Long Count = _PropertyGet("Count") End Property |
Access2BaseDev |
Collect |
Delete |
Basic |
|
46 |
Public Function Delete(ByVal Optional pvName As Variant) As Boolean
Const cstThisSub = "Collection.Delete" Utils._SetCalledSub(cstThisSub) If _ErrorHandler() Then On Local Error Goto Error_Function Dim odbDatabase As Object, oColl As Object, vName As Variant Delete = False If IsMissing(pvName) Then pvName = "" If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function If pvName = "" Then Call _TraceArguments()
Select Case _CollType Case COLLTABLEDEFS, COLLQUERYDEFS If _A2B_.CurrentDocIndex() <> 0 Then Goto Error_NotApplicable Set odbDatabase = Application._CurrentDb() If odbDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable If _CollType = COLLTABLEDEFS Then Set oColl = odbDatabase.Connection.getTables() Else Set oColl = odbDatabase.Connection.getQueries() With oColl vName = _InList(pvName, .getElementNames(), True) If vName = False Then Goto trace_NotFound .dropByName(vName) End With odbDatabase.Document.store() Case Else Goto Error_NotApplicable End Select
_Count = _Count - 1 Delete = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(Left(_CollType, 5)), pvName)) Goto Exit_Function End Function |
Access2BaseDev |
Collect |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
Collect |
getProperty |
Basic |
|
10 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("Collection.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("Collection.getProperty") End Function |
Access2BaseDev |
Collect |
hasProperty |
Basic |
|
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
Collect |
Item |
Basic |
|
101 |
Property Get Item(ByVal Optional pvItem As Variant) As Variant
Const cstThisSub = "Collection.getItem" Utils._SetCalledSub(cstThisSub) If IsMissing(pvItem) Then Goto Exit_Function Select Case _CollType Case COLLCOMMANDBARCONTROLS If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric()) Then Goto Exit_Function Case Else If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End Select
Dim vNames() As Variant, oProperty As Object
Set Item = Nothing Select Case _CollType Case COLLALLDIALOGS Set Item = Application.AllDialogs(pvItem) Case COLLALLFORMS Set Item = Application.AllForms(pvItem) Case COLLALLMODULES Set Item = Application.AllModules(pvItem) Case COLLCOMMANDBARS Set Item = Application.CommandBars(pvItem) Case COLLCOMMANDBARCONTROLS Set Item = Application.CommandBars(_ParentName).CommandBarControls(pvItem) Case COLLCONTROLS Select Case _ParentType Case OBJCONTROL, OBJSUBFORM Set Item = getObject(_ParentName).Controls(pvItem) Case OBJDIALOG Set Item = Application.AllDialogs(_ParentName).Controls(pvItem) Case OBJFORM Set Item = Application.Forms(_ParentName).Controls(pvItem) Case OBJOPTIONGROUP End Select Case COLLFORMS Set Item = Application.Forms(pvItem) Case COLLFIELDS Select Case _ParentType Case OBJQUERYDEF Set Item = _ParentDatabase.QueryDefs(_ParentName).Fields(pvItem) Case OBJRECORDSET Set Item = _ParentDatabase.Recordsets(_ParentName).Fields(pvItem) Case OBJTABLEDEF Set Item = _ParentDatabase.TableDefs(_ParentName).Fields(pvItem) End Select Case COLLPROPERTIES Select Case _ParentType Case OBJCONTROL Set Item = getObject(_ParentName).Properties(pvItem) Case OBJSUBFORM Set Item = getValue(_ParentName).Properties(pvItem) Case OBJDATABASE Set Item = _ParentDatabase.Properties(pvItem) Case OBJDIALOG Set Item = Application.AllDialogs(_ParentName).Properties(pvItem) Case OBJFIELD vNames() = Split(_ParentName, "/") Select Case vNames(0) Case OBJQUERYDEF Set Item = _ParentDatabase.QueryDefs(vNames(1)).Fields(vNames(2)).Properties(pvItem) Case OBJRECORDSET Set Item = _ParentDatabase.Recordsets(vNames(1)).Fields(vNames(2)).Properties(pvItem) Case OBJTABLEDEF Set Item = _ParentDatabase.TableDefs(vNames(1)).Fields(vNames(2)).Properties(pvItem) End Select Case OBJFORM Set Item = Application.Forms(_ParentName).Properties(pvItem) Case OBJQUERYDEF Set Item = _ParentDatabase.QueryDefs(_ParentName).Properties(pvItem) Case OBJRECORDSET Set Item = _ParentDatabase.Recordsets(_ParentName).Properties(pvItem) Case OBJTABLEDEF Set Item = _ParentDatabase.TableDefs(_ParentName).Properties(pvItem) Case OBJCOLLECTION, OBJEVENT, OBJOPTIONGROUP, OBJPROPERTY End Select Case COLLQUERYDEFS Set Item = _ParentDatabase.QueryDefs(pvItem) Case COLLRECORDSETS Set Item = _ParentDatabase.Recordsets(pvItem) Case COLLTABLEDEFS Set Item = _ParentDatabase.TableDefs(pvItem) Case COLLTEMPVARS Set Item = Application.TempVars(pvItem) Case Else End Select
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Property Error_Function: TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl) Set Item = Nothing GoTo Exit_Function End Property |
Access2BaseDev |
Collect |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
Collect |
Properties |
Basic |
|
20 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _ParentName, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _ParentName, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Exit Function End Function |
Access2BaseDev |
Collect |
Remove |
Basic |
|
39 |
Public Function Remove(ByVal Optional pvName As Variant) As Boolean
Const cstThisSub = "Collection.Remove" Utils._SetCalledSub(cstThisSub) If _ErrorHandler() Then On Local Error Goto Error_Function Dim oColl As Object, vName As Variant Remove = False If IsMissing(pvName) Then pvName = "" If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function If pvName = "" Then Call _TraceArguments()
Select Case _CollType Case COLLTEMPVARS If Not _A2B_.hasItem(COLLTEMPVARS, pvName) Then Goto Error_Name _A2B_.TempVars.Remove(UCase(pvName)) Case Else Goto Error_NotApplicable End Select
_Count = _Count - 1 Remove = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_Name: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvName)) AddItem = False Goto Exit_Function End Function |
Access2BaseDev |
Collect |
RemoveAll |
Basic |
|
26 |
Public Function RemoveAll() As Boolean
Const cstThisSub = "Collection.Remove" Utils._SetCalledSub(cstThisSub) If _ErrorHandler() Then On Local Error Goto Error_Function
Select Case _CollType Case COLLTEMPVARS Set _A2B_.TempVars = New Collection _Count = 0 Case Else Goto Error_NotApplicable End Select
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function End Function |
Access2BaseDev |
CommandBar |
_FindElement |
Basic |
CommandBarControls (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) |
17 |
Private Function _FindElement(pvElements As Variant) As Integer
Dim i As Integer
_FindElement = -1 If Not IsArray(pvElements) Then Exit Function
For i = 0 To UBound(pvElements) If _ResourceURL = pvElements(i).ResourceURL Then _FindElement = i Exit Function End If Next i
End Function |
Access2BaseDev |
CommandBar |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
4 |
Private Function _PropertiesList() As Variant _PropertiesList = Array("BuiltIn", "Name", "ObjectType", "Visible") End Function |
Access2BaseDev |
CommandBar |
_PropertyGet |
Basic |
BuiltIn (Procedure) Name (Procedure) pName (Procedure) ObjectType (Procedure) Properties (Procedure) Visible (Procedure) getProperty (Procedure) |
39 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = "CommandBar.get" & psProperty Utils._SetCalledSub(cstThisSub) _PropertyGet = Nothing
Dim oLayout As Object, iElementIndex As Integer Select Case UCase(psProperty) Case UCase("BuiltIn") _PropertyGet = ( _BarBuiltin = 1 ) Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("Visible") Set oLayout = _Window.LayoutManager iElementIndex = _FindElement(oLayout.getElements()) If iElementIndex < 0 Then _PropertyGet = False Else _PropertyGet = oLayout.isElementVisible(_ResourceURL) Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl) _PropertyGet = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
CommandBar |
_PropertySet |
Basic |
Visible (Procedure) |
58 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = "CommandBar.set" & psProperty Utils._SetCalledSub(cstThisSub) _PropertySet = True Dim iArgNr As Integer Dim oLayout As Object, iElementIndex As Integer
Select Case UCase(_A2B_.CalledSub) Case UCase("setProperty") : iArgNr = 3 Case UCase("CommandBar.setProperty") : iArgNr = 2 Case UCase(cstThisSub) : iArgNr = 1 End Select If Not hasProperty(psProperty) Then Goto Trace_Error
Select Case UCase(psProperty) Case UCase("Visible") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value Set oLayout = _Window.LayoutManager With oLayout iElementIndex = _FindElement(.getElements()) If iElementIndex < 0 Then If pvValue Then .createElement(_ResourceURL) .showElement(_ResourceURL) End If Else If pvValue <> .isElementVisible(_ResourceURL) Then If pvValue Then .showElement(_ResourceURL) Else .hideElement(_ResourceURL) End If End If End With Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
CommandBar |
BuiltIn |
Basic |
|
4 |
Property Get BuiltIn() As Boolean BuiltIn = _PropertyGet("BuiltIn") End Property |
Access2BaseDev |
CommandBar |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
13 |
Private Sub Class_Initialize() _Type = OBJCOMMANDBAR _Name = "" _ResourceURL = "" Set _Window = Nothing _Module = "" Set _Toolbar = Nothing _BarBuiltin = 0 _BarType = -1 End Sub |
Access2BaseDev |
CommandBar |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
CommandBar |
CommandBarControls |
Basic |
Controls (Procedure) |
87 |
Public Function CommandBarControls(Optional ByVal pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "CommandBar.CommandBarControls" Utils._SetCalledSub(cstThisSub)
Dim oLayout As Object, vElements() As Variant, iIndexToolbar As Integer, oToolbar As Object Dim i As Integer, iItemsCount As Integer, oSettings As Object, vItem() As Variant, bSeparator As Boolean Dim oObject As Object
Set oObject = Nothing If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric()) Then Goto Exit_Function If pvIndex < 0 Then Goto Trace_IndexError End If
Select Case _BarType Case msoBarTypeNormal, msoBarTypeMenuBar Case Else : Goto Error_NotApplicable End Select
Set oLayout = _Window.LayoutManager vElements = oLayout.getElements() iIndexToolbar = _FindElement(vElements()) If iIndexToolbar < 0 Then Goto Error_NotApplicable Set oToolbar = vElements(iIndexToolbar)
iItemsCount = 0 Set oSettings = oToolbar.getSettings(False)
bSeparator = False For i = 0 To oSettings.getCount() - 1 Set vItem() = oSettings.getByIndex(i) If _GetPropertyValue(vItem, "Type", 1) <> 1 Then iItemsCount = iItemsCount + 1 If Not IsMissing(pvIndex) Then If pvIndex = iItemsCount - 1 Then Set oObject = New CommandBarControl With oObject ._ParentCommandBarName = _Name ._ParentCommandBar = oToolbar ._ParentBuiltin = ( _BarBuiltin = 1 ) ._Element = vItem() ._InternalIndex = i ._Index = iItemsCount ._BeginGroup = bSeparator End With End If bSeparator = False End If Else bSeparator = True End If Next i
If IsNull(oObject) Then Select Case True Case IsMissing(pvIndex) Set oObject = New Collect oObject._CollType = COLLCOMMANDBARCONTROLS oObject._ParentType = OBJCOMMANDBAR oObject._ParentName = _Name oObject._Count = iItemsCount Case Else Goto Trace_IndexError End Select End If
Exit_Function: Set CommandBarControls = oObject Set oObject = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Trace_IndexError: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0) Goto Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function End Function |
Access2BaseDev |
CommandBar |
Controls |
Basic |
|
21 |
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "CommandBar.Controls" Utils._SetCalledSub(cstThisSub)
Dim oObject As Object
If IsMissing(pvIndex) Then Set oObject = CommandBarControls() Else Set oObject = CommandBarControls(pvIndex)
Exit_Function: Set Controls = oObject Set oObject = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
CommandBar |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
CommandBar |
getProperty |
Basic |
|
10 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("CommandBar.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("CommandBar.getProperty") End Function |
Access2BaseDev |
CommandBar |
hasProperty |
Basic |
_PropertySet (Procedure) |
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
CommandBar |
Name |
Basic |
|
4 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
CommandBar |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
CommandBar |
pName |
Basic |
|
3 |
Public Function pName() As String pName = _PropertyGet("Name") End Function |
Access2BaseDev |
CommandBar |
Properties |
Basic |
|
20 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Exit Function End Function |
Access2BaseDev |
CommandBar |
Reset |
Basic |
|
19 |
Public Function Reset() As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "CommandBar.Reset" Utils._SetCalledSub(cstThisSub)
_Toolbar.reload()
Exit_Function: Reset = True Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) Reset = False GoTo Exit_Function End Function |
Access2BaseDev |
CommandBar |
Visible |
Basic |
|
7 |
Property Get Visible() As Variant Visible = _PropertyGet("Visible") End Property
Property Let Visible(ByVal pvValue As Variant) Call _PropertySet("Visible", pvValue) End Property |
Access2BaseDev |
CommandBarControl |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
7 |
Private Function _PropertiesList() As Variant _PropertiesList = Array("BeginGroup", "BuiltIn", "Caption", "Index" _ , "ObjectType", "OnAction", "Parent" _ , "TooltipText", "Type", "Visible" _ ) End Function |
Access2BaseDev |
CommandBarControl |
_PropertyGet |
Basic |
BeginGroup (Procedure) BuiltIn (Procedure) Caption (Procedure) Index (Procedure) ObjectType (Procedure) OnAction (Procedure) Parent (Procedure) Properties (Procedure) TooltipText (Procedure) pType (Procedure) Visible (Procedure) getProperty (Procedure) |
53 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = "CommandBarControl.get" & psProperty Utils._SetCalledSub(cstThisSub) _PropertyGet = Null
Dim oLayout As Object, iElementIndex As Integer Dim sValue As String Const cstUnoPrefix = ".uno:" Select Case UCase(psProperty) Case UCase("BeginGroup") _PropertyGet = _BeginGroup Case UCase("BuiltIn") sValue = _GetPropertyValue(_Element, "CommandURL", "") _PropertyGet = ( _IsLeft(sValue, cstUnoPrefix) ) Case UCase("Caption") _PropertyGet = _GetPropertyValue(_Element, "Label", "") Case UCase("Index") _PropertyGet = _Index Case UCase("ObjectType") _PropertyGet = _Type Case UCase("OnAction") _PropertyGet = _GetPropertyValue(_Element, "CommandURL", "") Case UCase("Parent") Set _PropertyGet = Application.CommandBars(_ParentCommandBarName) Case UCase("TooltipText") sValue = _GetPropertyValue(_Element, "Tooltip", "") If sValue <> "" Then _PropertyGet = sValue Else _PropertyGet = _GetPropertyValue(_Element, "Label", "") Case UCase("Type") _PropertyGet = msoControlButton Case UCase("Visible") _PropertyGet = _GetPropertyValue(_Element, "IsVisible", "") Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl) _PropertyGet = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
CommandBarControl |
_PropertySet |
Basic |
Caption (Procedure) OnAction (Procedure) TooltipText (Procedure) Visible (Procedure) |
70 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = "CommandBarControl.set" & psProperty Utils._SetCalledSub(cstThisSub) _PropertySet = True Dim iArgNr As Integer Dim oSettings As Object, sValue As String
Select Case UCase(_A2B_.CalledSub) Case UCase("setProperty") : iArgNr = 3 Case UCase("CommandBar.setProperty") : iArgNr = 2 Case UCase(cstThisSub) : iArgNr = 1 End Select If Not hasProperty(psProperty) Then Goto Trace_Error If _ParentBuiltin Then Goto Trace_Error Const cstUnoPrefix = ".uno:" Const cstScript = "vnd.sun.star.script:"
Set oSettings = _ParentCommandBar.getSettings(True) Select Case UCase(psProperty) Case UCase("OnAction") If Not Utils._CheckArgument(pvValue, iArgNr, _AddNumeric(vbString), , False) Then Goto Trace_Error_Value Select Case VarType(pvValue) Case vbString If _IsLeft(pvValue, cstUnoPrefix) Then sValue = pvValue ElseIf _IsLeft(pvValue, cstScript) Then sValue = pvValue Else sValue = DoCmd.RunCommand(pvValue, True) End If Case Else sValue = DoCmd.RunCommand(pvValue, True) End Select _SetPropertyValue(_Element, "CommandURL", sValue) Case UCase("TooltipText") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value _SetPropertyValue(_Element, "Tooltip", pvValue) Case UCase("Visible") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value _SetPropertyValue(_Element, "IsVisible", pvValue) Case Else Goto Trace_Error End Select oSettings.replaceByIndex(_InternalIndex, _Element) _ParentCommandBar.setSettings(oSettings) Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
CommandBarControl |
BeginGroup |
Basic |
|
4 |
Property Get BeginGroup() As Boolean BeginGroup = _PropertyGet("BeginGroup") End Property |
Access2BaseDev |
CommandBarControl |
BuiltIn |
Basic |
|
4 |
Property Get BuiltIn() As Boolean BuiltIn = _PropertyGet("BuiltIn") End Property |
Access2BaseDev |
CommandBarControl |
Caption |
Basic |
|
7 |
Property Get Caption() As Variant Caption = _PropertyGet("Caption") End Property
Property Let Caption(ByVal pvValue As Variant) Call _PropertySet("Caption", pvValue) End Property |
Access2BaseDev |
CommandBarControl |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
12 |
Private Sub Class_Initialize() _Type = OBJCOMMANDBARCONTROL _Index = -1 _ParentCommandBarName = "" Set _ParentCommandBar = Nothing _ParentBuiltin = False _Element = Array() _BeginGroup = False End Sub |
Access2BaseDev |
CommandBarControl |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
CommandBarControl |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
CommandBarControl |
Execute |
Basic |
|
30 |
Public Function Execute()
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "CommandBarControl.Execute" Utils._SetCalledSub(cstThisSub)
Dim sExecute As String
Execute = True sExecute = _GetPropertyValue(_Element, "CommandURL", "")
Select Case True Case sExecute = "" : Execute = False Case _IsLeft(sExecute, ".uno:") Execute = DoCmd.RunCommand(sExecute) Case _IsLeft(sExecute, "vnd.sun.star.script:") Execute = Utils._RunScript(sExecute, Array(Nothing)) Case Else End Select Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) Execute = False GoTo Exit_Function End Function |
Access2BaseDev |
CommandBarControl |
getProperty |
Basic |
|
10 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("CommandBarControl.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("CommandBar.getProperty") End Function |
Access2BaseDev |
CommandBarControl |
hasProperty |
Basic |
_PropertySet (Procedure) |
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
CommandBarControl |
Index |
Basic |
|
4 |
Property Get Index() As Integer Index = _PropertyGet("Index") End Property |
Access2BaseDev |
CommandBarControl |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
CommandBarControl |
OnAction |
Basic |
|
7 |
Property Get OnAction() As Variant OnAction = _PropertyGet("OnAction") End Property
Property Let OnAction(ByVal pvValue As Variant) Call _PropertySet("OnAction", pvValue) End Property |
Access2BaseDev |
CommandBarControl |
Parent |
Basic |
|
4 |
Property Get Parent() As Object Parent = _PropertyGet("Parent") End Property |
Access2BaseDev |
CommandBarControl |
Properties |
Basic |
|
20 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Exit Function End Function |
Access2BaseDev |
CommandBarControl |
pType |
Basic |
|
4 |
Public Function pType() As Integer pType = _PropertyGet("Type") End Function |
Access2BaseDev |
CommandBarControl |
TooltipText |
Basic |
|
7 |
Property Get TooltipText() As Variant TooltipText = _PropertyGet("TooltipText") End Property
Property Let TooltipText(ByVal pvValue As Variant) Call _PropertySet("TooltipText", pvValue) End Property |
Access2BaseDev |
CommandBarControl |
Visible |
Basic |
|
7 |
Property Get Visible() As Variant Visible = _PropertyGet("Visible") End Property
Property Let Visible(ByVal pvValue As Variant) Call _PropertySet("Visible", pvValue) End Property |
Access2BaseDev |
Compatible |
DebugPrint |
Basic |
Dump (Procedure) |
37 |
Public Sub DebugPrint(ParamArray pvArgs() As Variant)
Dim vVarTypes() As Variant, i As Integer Const cstTab = 5 On Local Error Goto Exit_Sub Utils._SetCalledSub("DebugPrint") vVarTypes = Utils._AddNumeric(Array(vbEmpty, vbNull, vbDate, vbString, vbBoolean, vbObject, vbVariant, vbByte, vbArray + vbByte)) If UBound(pvArgs) >= 0 Then For i = 0 To UBound(pvArgs) If Not Utils._CheckArgument(pvArgs(i), i + 1, vVarTypes(), , False) Then pvArgs(i) = "[TYPE?]" Next i End If
Dim sOutput As String, sArg As String sOutput = "" For i = 0 To UBound(pvArgs) sArg = Replace(Utils._CStr(pvArgs(i), _A2B_.DebugPrintShort), "\;", ";") If i = 0 Then sOutput = sArg Else sOutput = sOutput & Space(cstTab - (Len(sOutput) Mod cstTab)) & sArg End If Next i TraceLog(TRACEANY, sOutput, False) Exit_Sub: Utils._ResetCalledSub("DebugPrint") Exit Sub End Sub |
Access2BaseDev |
Control |
_Formats |
Basic |
_PropertyGet (Procedure) _PropertySet (Procedure) |
37 |
Private Function _Formats(ByVal psControlType As String) As Variant
Dim vFormats() As Variant Select Case psControlType Case CTLDATEFIELD vFormats = Array( _ "Standard (short)" _ , "Standard (short YY)" _ , "Standard (short YYYY)" _ , "Standard (long)" _ , "DD/MM/YY" _ , "MM/DD/YY" _ , "YY/MM/DD" _ , "DD/MM/YYYY" _ , "MM/DD/YYYY" _ , "YYYY/MM/DD" _ , "YY-MM-DD" _ , "YYYY-MM-DD" _ ) Case CTLTIMEFIELD vFormats = Array( _ "24h short" _ , "24h long" _ , "12h short" _ , "12h long" _ ) Case Else vFormats = Array() End Select _Formats = vFormats
End Function |
Access2BaseDev |
Control |
_GetListener |
Basic |
_PropertyGet (Procedure) _PropertySet (Procedure) |
34 |
Private Function _GetListener(ByVal psProperty As String) As String
Select Case UCase(psProperty) Case UCase("OnActionPerformed") _GetListener = "XActionListener" Case UCase("OnAdjustmentValueChanged") _GetListener = "XAdjustmentListener" Case UCase("OnApproveAction") _GetListener = "XApproveActionListener" Case UCase("OnApproveReset"), UCase("OnResetted") _GetListener = "XResetListener" Case UCase("OnApproveUpdate"), UCase("OnUpdated") _GetListener = "XUpdateListener" Case UCase("OnChanged") _GetListener = "XChangeListener" Case UCase("OnErrorOccurred") _GetListener = "XErrorListener" Case UCase("OnFocusGained"), UCase("OnFocusLost") _GetListener = "XFocusListener" Case UCase("OnItemStateChanged") _GetListener = "XItemListener" Case UCase("OnKeyPressed"), UCase("OnKeyReleased") _GetListener = "XKeyListener" Case UCase("OnMouseDragged"), UCase("OnMouseMoved") _GetListener = "XMouseMotionListener" Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased") _GetListener = "XMouseListener" Case UCase("OnTextChanged") _GetListener = "XTextListener" End Select End Function |
Access2BaseDev |
Control |
_Initialize |
Basic |
|
80 |
Public Sub _Initialize()
Dim sControlTypes() As Variant, i As Integer, vSplit() As Variant, sTrailer As String sControlTypes = array( CTLCONTROL _ , CTLCOMMANDBUTTON _ , CTLRADIOBUTTON _ , CTLIMAGEBUTTON _ , CTLCHECKBOX _ , CTLLISTBOX _ , CTLCOMBOBOX _ , CTLGROUPBOX _ , CTLTEXTFIELD _ , CTLFIXEDTEXT _ , CTLGRIDCONTROL _ , CTLFILECONTROL _ , CTLHIDDENCONTROL _ , CTLIMAGECONTROL _ , CTLDATEFIELD _ , CTLTIMEFIELD _ , CTLNUMERICFIELD _ , CTLCURRENCYFIELD _ , CTLPATTERNFIELD _ , CTLSCROLLBAR _ , CTLSPINBUTTON _ , CTLNAVIGATIONBAR _ , CTLPROGRESSBAR _ , CTLFIXEDLINE _ )
Select Case _ParentType Case CTLPARENTISDIALOG vSplit = Split(ControlModel.getServiceName(), ".") sTrailer = UCase(vSplit(UBound(vSplit))) Select Case sTrailer Case "BUTTON" : sTrailer = CTLCOMMANDBUTTON Case "EDIT" : sTrailer = CTLTEXTFIELD Case Else End Select If sTrailer <> CTLFORMATTEDFIELD Then For i = 0 To UBound(sControlTypes) If sControlTypes(i) = sTrailer Then _ClassId = i + 1 _SubType = sTrailer _ControlType = _ClassId Exit For End If Next i Else _ClassId = acFormattedField _SubType = CTLFORMATTEDFIELD _ControlType = _ClassId End If Case Else If _ClassId > 0 Then _SubType = sControlTypes(_ClassId - 1) _ControlType = _ClassId If _SubType = CTLTEXTFIELD Then If _ImplementationName = "com.sun.star.comp.forms.OFormattedFieldWrapper" _ Or _ImplementationName = "com.sun.star.comp.forms.OFormattedFieldWrapper_ForcedFormatted" _ Or _ImplementationName = "com.sun.star.form.component.FormattedField" Then _SubType = CTLFORMATTEDFIELD _ControlType = acFormattedField End If End If Else If ControlModel.ImplementationName = "com.sun.star.comp.forms.ODatabaseForm" Then _SubType = CTLSUBFORM _ControlType = acSubform End If End If End Select
End Sub |
Access2BaseDev |
Control |
_ListboxBound |
Basic |
_PropertyGet (Procedure) _PropertySet (Procedure) |
35 |
Public Function _ListboxBound() As Boolean
Dim bListboxBound As Boolean, j As Integer Dim vValue() As variant, vString As Variant
bListboxBound = False
If Not IsNull(ControlModel.ValueItemList) _ And ControlModel.DataField <> "" _ And Not IsNull(ControlModel.BoundField) _ And Utils._InList(ControlModel.ListSourceType, Array( _ com.sun.star.form.ListSourceType.TABLE _ , com.sun.star.form.ListSourceType.QUERY _ , com.sun.star.form.ListSourceType.SQL _ , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _ )) Then If IsArray(ControlModel.ValueItemList) Then vValue = ControlModel.ValueItemList vString = ControlModel.StringItemList For j = 0 To UBound(vValue) If VarType(vValue(j)) <> VarType(vString(j)) Then bListboxBound = True ElseIf vValue(j) <> vString(j) Then bListboxBound = True End If If bListboxBound Then Exit For Next j End If End If _ListboxBound = bListboxBound
End Function |
Access2BaseDev |
Control |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
162 |
Private Function _PropertiesList() As Variant
Dim vFullPropertiesList() As Variant
If UBound(_ThisProperties) > -1 Then _PropertiesList = _ThisProperties Exit Function End If
vFullPropertiesList = Array( _ "BackColor" _ , "BorderColor" _ , "BorderStyle" _ , "Cancel" _ , "Caption" _ , "ControlSource" _ , "ControlTipText" _ , "ControlType" _ , "Default" _ , "DefaultValue" _ , "Enabled" _ , "FontBold" _ , "FontItalic" _ , "FontName" _ , "FontSize" _ , "FontUnderline" _ , "FontWeight" _ , "ForeColor" _ , "Form" _ , "Format" _ , "ItemData" _ , "LinkChildFields" _ , "LinkMasterFields" _ , "ListCount" _ , "ListIndex" _ , "Locked" _ , "MultiSelect" _ , "Name" _ , "ObjectType" _ , "OnActionPerformed" _ , "OnAdjustmentValueChanged" _ , "OnApproveAction" _ , "OnApproveReset" _ , "OnApproveUpdate" _ , "OnChanged" _ , "OnErrorOccurred" _ , "OnFocusGained" _ , "OnFocusLost" _ , "OnItemStateChanged" _ , "OnKeyPressed" _ , "OnKeyReleased" _ , "OnMouseDragged" _ , "OnMouseEntered" _ , "OnMouseExited" _ , "OnMouseMoved" _ , "OnMousePressed" _ , "OnMouseReleased" _ , "OnResetted" _ , "OnTextChanged" _ , "OnUpdated" _ , "OptionValue" _ , "Page" _ , "Parent" _ , "Picture" _ , "Required" _ , "RowSource" _ , "RowSourceType" _ , "Selected" _ , "SelLength" _ , "SelStart" _ , "Seltext" _ , "SpecialEffect" _ , "SubType" _ , "TabIndex" _ , "TabStop" _ , "Tag" _ , "Text" _ , "TextAlign" _ , "TripleState" _ , "Value" _ , "Visible" _ ) Dim vPropertiesMatrix(25) As Variant Select Case _ParentType Case CTLPARENTISFORM, CTLPARENTISSUBFORM vPropertiesMatrix(acCheckBox) = Array(0,4,5,6,7,9,10,11,12,13,14,15,16,17,27,28,29,32,36,37,38,39,40,41,42,43,44,45,46,47,52,54,61,62,63,64,65,67,68,69,70) vPropertiesMatrix(acComboBox) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,20,23,24,25,27,28,29,32,33,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,52,54,55,56,62,63,64,65,66,67,69,70) vPropertiesMatrix(acCommandButton) = Array(0,3,4,6,7,8,10,11,12,13,14,15,16,17,27,28,29,31,32,36,37,38,39,40,41,42,43,44,45,46,47,52,53,62,63,64,65,67,69,70) vPropertiesMatrix(acCurrencyField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,63,64,65,67,69,70) vPropertiesMatrix(acDateField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,19,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,63,64,65,66,67,69,70) vPropertiesMatrix(acFileControl) = Array(0,1,2,6,7,9,10,11,12,13,14,15,16,17,25,27,28,32,36,37,39,40,41,42,43,44,45,46,47,48,52,62,63,64,65,66,69,70) vPropertiesMatrix(acFixedText) = Array(0,1,2,4,6,7,10,11,12,13,14,15,16,17,27,28,36,37,39,40,41,42,43,44,45,46,52,62,65,67,70) vPropertiesMatrix(acFormattedField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,19,25,27,28,32,33,35,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,63,64,65,66,67,69,70) vPropertiesMatrix(acGridControl) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,27,28,32,33,35,36,37,39,40,41,42,43,44,45,46,47,49,52,62,63,64,65,70) vPropertiesMatrix(acGroupBox) = Array(4,6,7,10,11,12,13,14,15,16,17,27,28,32,36,37,39,40,41,42,43,44,45,46,47,52,62,65,70) vPropertiesMatrix(acHiddenControl) = Array(7,27,28,52,62,65,69,70) vPropertiesMatrix(acImageButton) = Array(0,1,2,6,7,10,27,28,31,36,37,39,40,41,42,43,44,45,46,52,53,62,63,64,65,70) vPropertiesMatrix(acImageControl) = Array(0,1,2,5,6,7,10,25,27,28,32,36,37,39,40,41,42,43,44,45,46,47,52,53,54,62,63,64,65,70) vPropertiesMatrix(acListBox) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,20,23,24,25,26,27,28,29,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,49,52,54,55,56,57,62,63,64,65,67,69,70) vPropertiesMatrix(acNavigationBar) = Array(0,2,6,7,10,11,12,13,14,15,16,17,27,28,36,37,39,40,41,42,43,44,45,46,52,62,63,64,65,70) vPropertiesMatrix(acNumericField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,63,64,65,67,69,70) vPropertiesMatrix(acPatternField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,58,59,60,62,63,64,65,66,67,69,70) vPropertiesMatrix(acRadioButton) = Array(0,4,5,6,7,9,10,11,12,13,14,15,16,17,27,28,29,32,36,37,38,39,40,41,42,43,44,45,46,47,50,52,54,61,62,63,64,65,67,69,70) vPropertiesMatrix(acScrollBar) = Array(0,1,2,6,7,10,27,28,30,32,33,36,37,39,40,41,42,43,44,45,46,47,49,52,62,63,64,65,69,70) vPropertiesMatrix(acSpinButton) = Array(0,1,2,6,7,9,10,27,28,30,32,33,36,37,39,40,41,42,43,44,45,46,47,49,52,62,63,64,65,69,70) vPropertiesMatrix(0) = Array(7,18,21,22,27,28,52,62) vPropertiesMatrix(acTextField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,25,27,28,32,33,34,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,58,59,60,62,63,64,65,66,67,69,70) vPropertiesMatrix(acTimeField) = Array(0,1,2,5,6,7,9,10,11,12,13,14,15,16,17,19,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,63,64,65,66,67,69,70) Case CTLPARENTISGROUP vPropertiesMatrix(acRadioButton) = Array(0,4,5,6,7,9,10,11,12,13,14,15,16,17,27,28,29,32,36,37,38,39,40,41,42,43,44,45,46,47,50,52,54,61,62,63,64,65,67,69,70) Case CTLPARENTISGRID vPropertiesMatrix(acCheckBox) = Array(4,5,6,7,9,10,27,28,29,32,36,37,38,39,40,41,42,43,44,45,46,47,52,54,61,62,65,67,68,69) vPropertiesMatrix(acComboBox) = Array(4,5,6,7,9,10,20,23,24,25,27,28,32,33,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,52,54,55,56,62,65,66,67,69) vPropertiesMatrix(acCurrencyField) = Array(4,5,6,7,9,10,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,65,67,69) vPropertiesMatrix(acDateField) = Array(4,5,6,7,9,10,19,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,65,66,67,69) vPropertiesMatrix(acFormattedField) = Array(4,5,6,7,9,10,19,25,27,28,32,33,35,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,65,66,67,69) vPropertiesMatrix(acListBox) = Array(4,5,6,7,9,10,20,23,24,25,26,27,28,32,33,35,36,37,38,39,40,41,42,43,44,45,46,47,49,52,54,55,56,57,62,65,67,69) vPropertiesMatrix(acNumericField) = Array(4,5,6,7,9,10,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,65,67,69) vPropertiesMatrix(acPatternField) = Array(4,5,6,7,9,10,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,58,59,60,62,65,66,67,69) vPropertiesMatrix(acTextField) = Array(4,5,6,7,9,10,25,27,28,32,33,34,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,58,59,60,62,65,66,67,69) vPropertiesMatrix(acTimeField) = Array(4,5,6,7,9,10,19,25,27,28,32,33,36,37,39,40,41,42,43,44,45,46,47,48,49,52,54,62,65,66,67,69) Case CTLPARENTISDIALOG vPropertiesMatrix(acCheckBox) = Array(0,4,6,7,10,11,12,13,14,15,16,17,27,28,29,36,37,38,39,40,41,42,43,44,45,46,51,52,61,62,63,64,65,67,68,69,70) vPropertiesMatrix(acComboBox) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,20,23,24,25,27,28,29,36,37,38,39,40,41,42,43,44,45,46,48,51,52,55,62,63,64,65,66,67,69,70) vPropertiesMatrix(acCommandButton) = Array(0,3,4,6,7,8,10,11,12,13,14,15,16,17,27,28,29,36,37,38,39,40,41,42,43,44,45,46,51,52,53,62,63,64,65,67,70) vPropertiesMatrix(acCurrencyField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,67,69,70) vPropertiesMatrix(acDateField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,66,67,69,70) vPropertiesMatrix(acFileControl) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,66,67,69,70) vPropertiesMatrix(acFixedLine) = Array(0,4,6,7,10,11,12,13,14,15,16,17,27,28,36,37,39,40,41,42,43,44,45,46,51,52,62,63,65,70) vPropertiesMatrix(acFixedText) = Array(0,1,2,4,6,7,10,11,12,13,14,15,16,17,27,28,36,37,39,40,41,42,43,44,45,46,51,52,62,63,64,65,67,70) vPropertiesMatrix(acFormattedField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,66,67,69,70) vPropertiesMatrix(acGroupBox) = Array(4,6,7,10,11,12,13,14,15,16,17,27,28,36,37,39,40,41,42,43,44,45,46,51,52,62,63,65,70) vPropertiesMatrix(acImageControl) = Array(0,1,2,6,7,10,27,28,36,37,39,40,41,42,43,44,45,46,51,52,53,62,63,64,65,70) vPropertiesMatrix(acListBox) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,20,23,24,25,26,27,28,29,36,37,38,39,40,41,42,43,44,45,46,51,52,55,57,62,63,64,65,67,69,70) vPropertiesMatrix(acNavigationBar) = Array(36,37,39,40,41,42,43,44,45,46) vPropertiesMatrix(acNumericField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,67,69,70) vPropertiesMatrix(acPatternField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,58,59,60,62,63,64,65,66,67,69,70) vPropertiesMatrix(acProgressBar) = Array(0,1,2,6,7,10,27,28,36,37,39,40,41,42,43,44,45,46,51,52,62,63,65,69,70) vPropertiesMatrix(acRadioButton) = Array(0,4,6,7,10,11,12,13,14,15,16,17,27,28,29,36,37,38,39,40,41,42,43,44,45,46,50,51,52,61,62,63,64,65,67,69,70) vPropertiesMatrix(acScrollBar) = Array(0,1,2,6,7,10,27,28,30,36,37,39,40,41,42,43,44,45,46,51,52,62,63,64,65,69,70) vPropertiesMatrix(acTextField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,58,59,60,62,63,64,65,66,67,69,70) vPropertiesMatrix(acTimeField) = Array(0,1,2,6,7,10,11,12,13,14,15,16,17,19,25,27,28,36,37,39,40,41,42,43,44,45,46,48,51,52,62,63,64,65,66,67,69,70) End Select Dim i As Integer, iIndex As Integer If _ControlType = acSubForm Then iIndex = 0 Else iIndex = _ControlType If IsEmpty(vPropertiesMatrix(iIndex)) Then _ThisProperties = Array() Else ReDim _ThisProperties(0 To UBound(vPropertiesMatrix(iIndex))) For i = 0 To UBound(_ThisProperties) _ThisProperties(i) = vFullPropertiesList(vPropertiesMatrix(iIndex)(i)) Next i End If
_PropertiesList = _ThisProperties()
End Function |
Access2BaseDev |
Control |
_PropertyGet |
Basic |
BackColor (Procedure) BorderColor (Procedure) BorderStyle (Procedure) Cancel (Procedure) Caption (Procedure) ControlSource (Procedure) ControlTipText (Procedure) ControlType (Procedure) Default (Procedure) DefaultValue (Procedure) Enabled (Procedure) FontBold (Procedure) FontItalic (Procedure) FontName (Procedure) FontSize (Procedure) FontUnderline (Procedure) FontWeight (Procedure) ForeColor (Procedure) Form (Procedure) Format (Procedure) ItemData (Procedure) ListCount (Procedure) ListIndex (Procedure) Locked (Procedure) MultiSelect (Procedure) Name (Procedure) pName (Procedure) ObjectType (Procedure) OnActionPerformed (Procedure) OnAdjustmentValueChanged (Procedure) OnApproveAction (Procedure) OnApproveReset (Procedure) OnApproveUpdate (Procedure) OnChanged (Procedure) OnErrorOccurred (Procedure) OnFocusGained (Procedure) OnFocusLost (Procedure) OnItemStateChanged (Procedure) OnKeyPressed (Procedure) OnKeyReleased (Procedure) OnMouseDragged (Procedure) OnMouseEntered (Procedure) OnMouseExited (Procedure) OnMouseMoved (Procedure) OnMousePressed (Procedure) OnMouseReleased (Procedure) OnResetted (Procedure) OnTextChanged (Procedure) OnUpdated (Procedure) OptionValue (Procedure) Page (Procedure) Parent (Procedure) Picture (Procedure) Properties (Procedure) Required (Procedure) RowSource (Procedure) RowSourceType (Procedure) Selected (Procedure) SelLength (Procedure) SelStart (Procedure) SelText (Procedure) SpecialEffect (Procedure) SubType (Procedure) TabIndex (Procedure) TabStop (Procedure) Tag (Procedure) Text (Procedure) pText (Procedure) TextAlign (Procedure) TripleState (Procedure) Value (Procedure) Visible (Procedure) getProperty (Procedure) |
485 |
Private Function _PropertyGet(ByVal psProperty As String, ByVal Optional pvIndex As Variant) As Variant
Dim iArg As Integer If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Control.get" & psProperty) _PropertyGet = EMPTY
Dim iArgNr As Integer If Not IsMissing(pvIndex) Then Select Case UCase(_A2B_.CalledSub) Case UCase("getProperty") : iArgNr = 3 Case UCase("Control.getProperty") : iArgNr = 2 Case UCase("Control.get" & psProperty) : iArgNr = 1 End Select If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function End If
Dim vDefaultValue As Variant, oDefaultValue As Object, vValue As Variant, oValue As Object, iIndex As Integer Dim lListIndex As Long, i As Integer, j As Integer, vCurrentValue As Variant, lListCount As Long Dim vListboxValue As Variant, vListSource, bSelected() As Boolean, bListboxBound As Boolean Dim vGet As Variant, vDate As Variant Dim ofSubForm As Object Dim vFormats() As Variant Dim vSelection As Variant, sSelectedText As String Dim oControlEvents As Object, sEventName As String If Not hasProperty(psProperty) Then Goto Trace_Error
Select Case UCase(psProperty) Case UCase("BackColor") If Utils._hasUNOProperty(ControlModel, "BackgroundColor") Then _PropertyGet = ControlModel.BackgroundColor Case UCase("BorderColor") If Utils._hasUNOProperty(ControlModel, "BorderColor") Then _PropertyGet = ControlModel.BorderColor Case UCase("BorderStyle") If Utils._hasUNOProperty(ControlModel, "Border") Then _PropertyGet = ControlModel.Border Case UCase("Cancel") If Utils._hasUNOProperty(ControlModel, "PushButtonType") Then _PropertyGet = ( ControlModel.PushButtonType = com.sun.star.awt.PushButtonType.CANCEL ) Case UCase("Caption") If Utils._hasUNOProperty(ControlModel, "Label") Then _PropertyGet = ControlModel.Label Case UCase("ControlSource") If Utils._hasUNOProperty(ControlModel, "DataField") Then _PropertyGet = ControlModel.DataField Case UCase("ControlTipText") If Utils._hasUNOProperty(ControlModel, "HelpText") Then _PropertyGet = ControlModel.HelpText Case UCase("ControlType") _PropertyGet = _ControlType Case UCase("Default") If Utils._hasUNOProperty(ControlModel, "DefaultButton") Then _PropertyGet = ControlModel.DefaultButton Case UCase("DefaultValue") Select Case _SubType Case CTLCHECKBOX, CTLRADIOBUTTON If Utils._hasUNOProperty(ControlModel, "DefaultState") Then _PropertyGet = ControlModel.DefaultState Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD If Utils._hasUNOProperty(ControlModel, "DefaultText") Then _PropertyGet = ControlModel.DefaultText Case CTLCURRENCYFIELD, CTLNUMERICFIELD If Utils._hasUNOProperty(ControlModel, "DefaultValue") Then _PropertyGet = ControlModel.DefaultValue Case CTLDATEFIELD If Utils._hasUNOProperty(ControlModel, "DefaultDate") Then Select Case VarType(ControlModel.DefaultDate) Case vbLong vDefaultValue = ControlModel.DefaultDate vGet = DateSerial(Left(vDefaultValue, 4), Mid(vDefaultValue, 5, 2), Right(vDefaultValue, 2)) Case vbObject Set oDefaultValue = ControlModel.DefaultDate vGet = DateSerial(oDefaultValue.Year,oDefaultValue.Month, oDefaultValue.Day) Case vbEmpty End Select End If Case CTLFORMATTEDFIELD If Utils._hasUNOProperty(ControlModel, "EffectiveDefault") Then _PropertyGet = ControlModel.EffectiveDefault Case CTLLISTBOX If Utils._hasUNOProperty(ControlModel, "DefaultSelection") And Utils._hasUNOProperty(ControlModel, "StringItemList") Then vDefaultValue = ControlModel.DefaultSelection If IsArray(vDefaultValue) Then If UBound(vDefaultValue) >= LBound(vDefaultValue) Then iIndex = UBound(ControlModel.StringItemList) If vDefaultValue(0) >= 0 And vDefaultValue(0) <= iIndex Then _PropertyGet = ControlModel.StringItemList(vDefaultValue(0)) End If End If End If Case CTLSPINBUTTON If Utils._hasUNOProperty(ControlModel, "DefaultSpinValue") Then _PropertyGet = ControlModel.DefaultSpinValue Case CTLTIMEFIELD If Utils._hasUNOProperty(ControlModel, "DefaultTime") Then Select Case VarType(ControlModel.DefaultTime) Case vbLong _PropertyGet = ControlModel.DefaultTime Case vbObject Set oDefaultValue = ControlModel.DefaultTime _PropertyGet = TimeSerial(oDefaultValue.Hours, oDefaultValue.Minutes, oDefaultValue.Seconds) Case vbEmpty End Select End If Case Else Goto Trace_Error End Select Case UCase("Enabled") If Utils._hasUNOProperty(ControlModel, "Enabled") Then _PropertyGet = ControlModel.Enabled Case UCase("FontBold") If Utils._hasUNOProperty(ControlModel, "FontWeight") Then _PropertyGet = ( ControlModel.FontWeight >= com.sun.star.awt.FontWeight.BOLD ) Case UCase("FontItalic") If Utils._hasUNOProperty(ControlModel, "FontSlant") Then _PropertyGet = ( ControlModel.FontSlant = com.sun.star.awt.FontSlant.ITALIC ) Case UCase("FontName") If Utils._hasUNOProperty(ControlModel, "FontName") Then _PropertyGet = ControlModel.FontName Case UCase("FontSize") If Utils._hasUNOProperty(ControlModel, "FontHeight") Then _PropertyGet = ControlModel.FontHeight Case UCase("FontUnderline") If Utils._hasUNOProperty(ControlModel, "FontUnderline") Then _PropertyGet = _ Not ( ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.NONE _ Or ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.DONTKNOW ) Case UCase("FontWeight") If Utils._hasUNOProperty(ControlModel, "FontWeight") Then _PropertyGet = ControlModel.FontWeight Case UCase("ForeColor") If Utils._hasUNOProperty(ControlModel, "TextColor") Then _PropertyGet = ControlModel.TextColor Case UCase("Form") Set ofSubForm = New SubForm With ofSubForm Set .DatabaseForm = ControlModel ._Name = _Name ._Shortcut = _Shortcut & ".Form" ._MainForm = _MainForm .ParentComponent = _FormComponent ._DocEntry = _DocEntry ._DbEntry = _DbEntry ._OrderBy = ControlModel.Order End With set _PropertyGet = ofSubForm Case UCase("Format") vFormats = _Formats(_Subtype) Select Case _SubType Case CTLDATEFIELD If Utils._hasUNOProperty(ControlModel, "DateFormat") Then If ControlModel.DateFormat <= UBound(vFormats) Then _PropertyGet = vFormats(ControlModel.DateFormat) End If Case CTLTIMEFIELD If Utils._hasUNOProperty(ControlModel, "TimeFormat") Then If ControlModel.TimeFormat <= UBound(vFormats) Then _PropertyGet = vFormats(ControlModel.TimeFormat) End If Case Else If Utils._hasUNOProperty(ControlModel, "FormatKey") Then If Utils._hasUNOProperty(ControlModel, "FormatsSupplier") Then _PropertyGet = ControlModel.FormatsSupplier.getNumberFormats.getByKey(ControlModel.FormatKey).FormatString End If End If End Select Case UCase("ItemData") If Utils._hasUNOProperty(ControlModel, "StringItemList") Then If IsMissing(pvIndex) Then _PropertyGet = ControlModel.StringItemList Else If pvIndex < 0 Or pvIndex > UBound(ControlModel.StringItemList) Then Goto Trace_Error_Index _PropertyGet = ControlModel.StringItemList(pvIndex) End If End If Case UCase("ListCount") If Utils._hasUNOProperty(ControlModel, "StringItemList") Then _PropertyGet = UBound(ControlModel.StringItemList) + 1 Case UCase("ListIndex") If Utils._hasUNOProperty(ControlModel, "StringItemList") Then lListIndex = -1 Select Case _SubType Case CTLCOMBOBOX If Not Utils._hasUNOProperty(ControlModel, "Text") Then Goto Trace_Error iIndex = 0 If ControlModel.Text <> "" Then For j = 0 To UBound(ControlModel.StringItemList) If ControlModel.StringItemList(j) = ControlModel.Text Then lListIndex = j iIndex = iIndex + 1 End If Next j If iIndex <> 1 Then lListIndex = -1 End If Case CTLLISTBOX If Not Utils._hasUNOProperty(ControlModel, "SelectedItems") Then Goto Trace_Error If UBound(ControlModel.SelectedItems) > 0 Then Else If _ParentType <> CTLPARENTISDIALOG Then vCurrentValue = ControlModel.getCurrentValue() If IsArray(vCurrentValue) Then vListboxValue = "" If UBound(vCurrentValue) = 0 Then vListboxValue = vCurrentValue(0) Else vListboxValue = vCurrentValue End If If vListboxValue <> "" Then If Ubound(ControlModel.SelectedItems) >= 0 Then lListIndex = Controlmodel.Selecteditems(0) End If Else If Ubound(ControlModel.SelectedItems) >= 0 Then lListIndex = Controlmodel.Selecteditems(0) End If End If End Select _PropertyGet = lListIndex End If Case UCase("Locked") If Utils._hasUNOProperty(ControlModel, "ReadOnly") Then _PropertyGet = ControlModel.ReadOnly Case UCase("MultiSelect") If Utils._hasUNOProperty(ControlModel, "MultiSelection") Then _PropertyGet = ControlModel.MultiSelection ElseIf Utils._hasUNOProperty(ControlModel, "MultiSelectionSimpleMode") Then _PropertyGet = ControlModel.MultiSelectionSimpleMode Else _PropertyGet = False End If Case UCase("Name") _PropertyGet = _Name Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnApproveAction"), UCase("OnApproveReset") _ , UCase("OnApproveUpdate"), UCase("OnChanged"), UCase("OnErrorOccurred"), UCase("OnFocusGained") _ , UCase("OnFocusLost"), UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _ , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted"), UCase("OnTextChanged") _ , UCase("OnUpdated") Select Case _ParentType Case CTLPARENTISDIALOG Set oControlEvents = ControlModel.getEvents() sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & Utils._GetEventName(psProperty) If oControlEvents.hasByName(sEventName) Then _PropertyGet = oControlEvents.getByName(sEventName).ScriptCode Else _PropertyGet = "" End If Case Else _PropertyGet = Utils._GetEventScriptCode(ControlModel, psProperty, _Name) End Select Case UCase("OptionValue") If Utils._hasUNOProperty(ControlModel, "RefValue") Then If ControlModel.RefValue <> "" Then _PropertyGet = ControlModel.RefValue ElseIf Utils._hasUNOProperty(ControlModel, "Label") Then _PropertyGet = ControlModel.Label End If End If Case UCase("ObjectType") _PropertyGet = _Type Case UCase("Page") If Utils._hasUNOProperty(ControlModel, "Step") Then _PropertyGet = ControlModel.Step Case UCase("Parent") Set _PropertyGet = PropertiesGet._ParentObject(_Shortcut) Case UCase("Picture") _PropertyGet = ConvertToUrl(ControlModel.ImageURL) Case UCase("Required") If Utils._hasUNOProperty(ControlModel, "InputRequired") Then _PropertyGet = ControlModel.InputRequired Case UCase("RowSource") Select Case _ParentType Case CTLPARENTISDIALOG If Utils._hasUNOProperty(ControlModel, "StringItemList") Then If IsArray(ControlModel.StringItemList) Then vListSource = ControlModel.StringItemList Else vListSource = Array(ControlModel.StringItemList) _PropertyGet = Join(vListSource, ";") End If Case Else If Utils._hasUNOProperty(ControlModel, "ListSource") Then Select Case ControlModel.ListSourceType Case com.sun.star.form.ListSourceType.VALUELIST _ , com.sun.star.form.ListSourceType.TABLEFIELDS If IsArray(ControlModel.StringItemList) Then vListSource = ControlModel.StringItemList Else vListSource = Array(ControlModel.StringItemList) Case com.sun.star.form.ListSourceType.TABLE _ , com.sun.star.form.ListSourceType.QUERY _ , com.sun.star.form.ListSourceType.SQL _ , com.sun.star.form.ListSourceType.SQLPASSTHROUGH If IsArray(ControlModel.ListSource) Then vListSource = ControlModel.ListSource Else vListSource = Array(ControlModel.ListSource) End Select _PropertyGet = Join(vListSource, ";") End If End Select Case UCase("RowSourceType") If Utils._hasUNOProperty(ControlModel, "ListSourceType") Then _PropertyGet = ControlModel.ListSourceType Case UCase("Selected") If Utils._hasUNOProperty(ControlModel, "StringItemList") Then lListIndex = UBound(ControlModel.StringItemList) If Not IsMissing(pvIndex) Then If pvIndex < 0 Or pvIndex > lListIndex Then Goto Trace_Error_Index End If If lListIndex < 0 Then _PropertyGet = Array() Else Redim bSelected(0 To lListIndex) For j = 0 To lListIndex bSelected(j) = False Next j For j = 0 To UBound(ControlModel.SelectedItems) iIndex = ControlModel.SelectedItems(j) If iIndex >= 0 And iIndex <= lListIndex Then bSelected(iIndex) = True Next j If IsMissing(pvIndex) Then _PropertyGet = bSelected Else _PropertyGet = bSelected(pvIndex) End If End If Case UCase("SelLength") If Utils._hasUNOProperty(ControlView, "Selection") Then vSelection = ControlView.getSelection() If vSelection.Max >= vSelection.Min Then _PropertyGet = vSelection.Max - vSelection.Min Else _PropertyGet = 0 End If Else _PropertyGet = 0 End If Case UCase("SelStart") If Utils._hasUNOProperty(ControlView, "Selection") Then vSelection = ControlView.getSelection() If vSelection.Max >= vSelection.Min Then _PropertyGet = vSelection.Min + 1 Else _PropertyGet = 1 End If Else _PropertyGet = 1 End If Case UCase("SelText") If Utils._hasUNOProperty(ControlView, "SelectedText") Then _PropertyGet = ControlView.getSelectedText() Else _PropertyGet = "" End If Case UCase("SpecialEffect") If Utils._hasUNOProperty(ControlModel, "VisualEffect") Then _PropertyGet = ControlModel.VisualEffect Case UCase("SubType") _PropertyGet = _SubType Case UCase("TabIndex") If Utils._hasUNOProperty(ControlModel, "TabIndex") Then _PropertyGet = ControlModel.TabIndex Case UCase("TabStop") If Utils._hasUNOProperty(ControlModel, "TabStop") Then _PropertyGet = ControlModel.TabStop Case UCase("Tag") If Utils._hasUNOProperty(ControlModel, "Tag") Then _PropertyGet = ControlModel.Tag Case UCase("Text") Select Case _SubType Case CTLDATEFIELD If Utils._hasUNOProperty(ControlModel, "Date") Then If Utils._hasUNOProperty(ControlModel, "FormatKey") Then If Utils._hasUNOProperty(ControlModel, "FormatsSupplier") Then Select Case VarType(ControlModel.Date) Case vbLong vDate = DateSerial(Left(ControlModel.Date, 4), Mid(ControlModel.Date, 5, 2), Right(ControlModel.Date, 2)) Case vbObject vDate = DateSerial(ControlModel.Date.Year, ControlModel.Date.Month, ControlModel.Date.Day) Case vbEmpty End Select _PropertyGet = Format(vDate, ControlModel.FormatsSupplier.getNumberFormats.getByKey(ControlModel.FormatKey).FormatString) End If End If End If Case CTLTIMEFIELD If Utils._hasUNOProperty(ControlModel, "Text") Then Select Case VarType(ControlModel.Time) Case vbLong _PropertyGet = Format(ControlModel.Time, "HH:MM:SS") Case vbObject Set oValue = ControlModel.Time _PropertyGet = Format(TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds), "HH:MM:SS") Case vbEmpty End Select End If Case Else If Utils._hasUNOProperty(ControlModel, "Text") Then _PropertyGet = ControlModel.Text End Select Case UCase("TextAlign") If Utils._hasUNOProperty(ControlModel, "Tag") Then _PropertyGet = ControlModel.Tag Case UCase("TripleState") If Utils._hasUNOProperty(ControlModel, "TriState") Then _PropertyGet = ControlModel.TriState Case UCase("Value") Select Case _SubType Case CTLCHECKBOX If Utils._hasUNOProperty(ControlModel, "State") Then vGet = ControlModel.State Case CTLCOMMANDBUTTON vGet = False If Utils._hasUNOProperty(ControlModel, "Toggle") Then If Utils._hasUNOProperty(ControlModel, "State") Then vGet = ( ControlModel.State = 1 ) End If Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD If Utils._hasUNOProperty(ControlModel, "Text") Then vGet = ControlModel.Text Case CTLCURRENCYFIELD If Utils._hasUNOProperty(ControlModel, "Value") Then vGet = ControlModel.Value Case CTLDATEFIELD If Utils._hasUNOProperty(ControlModel, "Date") Then Select Case VarType(ControlModel.Date) Case vbLong vValue = ControlModel.Date vGet = DateSerial(Left(vValue, 4), Mid(vValue, 5, 2), Right(vValue, 2)) Case vbObject Set oValue = ControlModel.Date vGet = DateSerial(oValue.Year, oValue.Month, oValue.Day) Case vbEmpty End Select End If Case CTLFORMATTEDFIELD If Utils._hasUNOProperty(ControlModel, "EffectiveValue") Then vGet = ControlModel.EffectiveValue Case CTLHIDDENCONTROL If Utils._hasUNOProperty(ControlModel, "HiddenValue") Then vGet = ControlModel.HiddenValue Case CTLLISTBOX If Not Utils._hasUNOProperty(ControlModel, "StringItemList") Then Goto Trace_Error If Not Utils._hasUNOProperty(ControlModel, "SelectedItems") Then Goto Trace_Error If UBound(ControlModel.SelectedItems) > 0 Then vGet = EMPTY Else Select Case _ParentType Case CTLPARENTISDIALOG If Ubound(ControlModel.SelectedItems) >= 0 Then lListIndex = Controlmodel.Selecteditems(0) If lListIndex > -1 And lListIndex <= UBound(ControlModel.StringItemList) Then vGet = ControlModel.StringItemList(lListIndex) Else vGet = EMPTY End If End If Case Else vCurrentValue = ControlModel.getCurrentValue() If IsArray(vCurrentValue) Then If UBound(vCurrentValue) >= LBound(vCurrentValue) Then vListboxValue = vCurrentValue(0) Else vListboxValue = "" End If Else vListboxValue = vCurrentValue End If lListIndex = -1 If vListboxValue <> "" Then If Ubound(ControlModel.SelectedItems) >= 0 Then lListIndex = Controlmodel.Selecteditems(0) End If bListboxBound = _ListboxBound() If bListboxBound Then If lListIndex > -1 Then vGet = ControlModel.ValueItemList(lListIndex) Else vGet = vListboxValue End If End Select End If Case CTLNUMERICFIELD If Utils._hasUNOProperty(ControlModel, "Value") Then vGet = ControlModel.Value Case CTLPROGRESSBAR If Utils._hasUNOProperty(ControlModel, "ProgressValue") Then vGet = ControlModel.ProgressValue Case CTLSCROLLBAR If Utils._hasUNOProperty(ControlModel, "ScrollValue") Then vGet = ControlModel.ScrollValue Case CTLSPINBUTTON If Utils._hasUNOProperty(ControlModel, "SpinValue") Then vGet = ControlModel.SpinValue Case CTLTIMEFIELD If Utils._hasUNOProperty(ControlModel, "Time") Then Select Case VarType(ControlModel.Time) Case vbLong vGet = ControlModel.Time Case vbObject Set oValue = ControlModel.Time vGet = TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds) Case vbEmpty End Select End If Case Else End Select If _SubType <> CTLLISTBOX Then If IsEmpty(vGet) And Utils._hasUNOMethod(ControlModel, "getCurrentValue") Then vGet = ControlModel.getCurrentValue() End If _PropertyGet = vGet Case UCase("Visible") Select Case _SubType Case CTLHIDDENCONTROL _PropertyGet = False Case Else If Utils._hasUNOMethod(ControlView, "isVisible") Then _PropertyGet = CBool(ControlView.isVisible()) End Select Case Else Goto Trace_Error End Select If IsEmpty(_PropertyGet) Then TraceError(TRACEINFO, ERRPROPERTYINIT, Utils._CalledSub(), 0, , psProperty) Exit_Function: Utils._ResetCalledSub("Control.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertyGet = EMPTY Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = EMPTY Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Control._PropertyGet", Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function |
Access2BaseDev |
Control |
_PropertySet |
Basic |
BackColor (Procedure) BorderColor (Procedure) BorderStyle (Procedure) Cancel (Procedure) Caption (Procedure) ControlTipText (Procedure) Default (Procedure) DefaultValue (Procedure) Enabled (Procedure) FontBold (Procedure) FontItalic (Procedure) FontName (Procedure) FontSize (Procedure) FontUnderline (Procedure) FontWeight (Procedure) ForeColor (Procedure) Format (Procedure) ListIndex (Procedure) Locked (Procedure) MultiSelect (Procedure) OnActionPerformed (Procedure) OnAdjustmentValueChanged (Procedure) OnApproveAction (Procedure) OnApproveReset (Procedure) OnApproveUpdate (Procedure) OnChanged (Procedure) OnErrorOccurred (Procedure) OnFocusGained (Procedure) OnFocusLost (Procedure) OnItemStateChanged (Procedure) OnKeyPressed (Procedure) OnKeyReleased (Procedure) OnMouseDragged (Procedure) OnMouseEntered (Procedure) OnMouseExited (Procedure) OnMouseMoved (Procedure) OnMousePressed (Procedure) OnMouseReleased (Procedure) OnResetted (Procedure) OnTextChanged (Procedure) OnUpdated (Procedure) OptionValue (Procedure) Page (Procedure) Picture (Procedure) Required (Procedure) RowSource (Procedure) RowSourceType (Procedure) Selected (Procedure) SelectedI (Procedure) SelLength (Procedure) SelStart (Procedure) SelText (Procedure) SpecialEffect (Procedure) TabIndex (Procedure) TabStop (Procedure) Tag (Procedure) TextAlign (Procedure) TripleState (Procedure) Value (Procedure) Visible (Procedure) setProperty (Procedure) |
611 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Control.set" & psProperty) _PropertySet = True
If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric()) Then Goto Exit_Function End If Dim iArgNr As Integer, vButton As Variant, i As Integer Dim odbDatabase As Object, vNames() As Variant, bFound As Boolean, sName As String Dim bMultiSelect As Boolean, iCount As Integer, iSelectedItems() As Integer, lListCount As Long, bSelected() As Boolean Dim vItemList() As Variant, vFormats() As Variant Dim oStruct As Object, sValue As String Dim vSelection As Variant, sText As String, lStart As long Dim oControlEvents As Object, sListener As String, sEvent As String, sEventName As String, oEvent As Object
_PropertySet = True Select Case UCase(_A2B_.CalledSub) Case UCase("setProperty") : iArgNr = 3 Case UCase("Control.setProperty") : iArgNr = 2 Case UCase("Control.set" & psProperty) : iArgNr = 1 End Select If Not hasProperty(psProperty) Then Goto Trace_Error
Select Case UCase(psProperty) Case UCase("BackColor") If Not Utils._hasUNOProperty(ControlModel, "BackgroundColor") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value ControlModel.BackgroundColor = CLng(pvValue) Case UCase("BorderColor") If Not Utils._hasUNOProperty(ControlModel, "BorderColor") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value ControlModel.BorderColor = CLng(pvValue) Case UCase("BorderStyle") If Not Utils._hasUNOProperty(ControlModel, "BorderColor") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 0 Or pvValue > 2 Then Goto Trace_Error_Value ControlModel.Border = CLng(pvValue) Case UCase("Cancel") If Not Utils._hasUNOProperty(ControlModel, "PushButtonType") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If pvValue Then vButton = com.sun.star.awt.PushButtonType.CANCEL Else vButton = com.sun.star.awt.PushButtonType.STANDARD ControlModel.PushButtonType = vButton Case UCase("Caption") If Not Utils._hasUNOProperty(ControlModel, "Label") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value ControlModel.Label = pvValue Case UCase("ControlTipText") If Not Utils._hasUNOProperty(ControlModel, "HelpText") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value ControlModel.HelpText = pvValue Case UCase("Default") If Not Utils._hasUNOProperty(ControlModel, "DefaultButton") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value ControlModel.DefaultButton = pvValue Case UCase("DefaultValue") Select Case _SubType Case CTLDATEFIELD If Not Utils._hasUNOProperty(ControlModel, "DefaultDate") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value Select Case VarType(ControlModel.DefaultDate) Case vbEmpty, vbLong ControlModel.DefaultDate = Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue) Case vbObject ControlModel.DefaultDate.Year = Year(pvValue) ControlModel.DefaultDate.Month = Month(pvValue) ControlModel.DefaultDate.Day = Day(pvValue) End Select Case CTLLISTBOX If Not Utils._hasUNOProperty(ControlModel, "DefaultSelection") Or Not Utils._hasUNOProperty(ControlModel, "StringItemList") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value For i = 0 To UBound(ControlModel.StringItemList) If UCase(pvValue) = UCase(ControlModel.StringItemList(i)) Then ControlModel.DefaultSelection = Array(i) Exit For End If Next i Case CTLSPINBUTTON If Not Utils._hasUNOProperty(ControlModel, "DefaultSpinValue") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value ControlModel.DefaultSpinValue = pvValue Case CTLCHECKBOX If Not Utils._hasUNOProperty(ControlModel, "DefaultState") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 0 Or pvValue > 2 Then Goto Trace_Error_Value ControlModel.DefaultState = pvValue Case CTLRADIOBUTTON If Not Utils._hasUNOProperty(ControlModel, "DefaultState") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 0 Or pvValue > 1 Then Goto Trace_Error_Value ControlModel.DefaultState = pvValue Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD If Not Utils._hasUNOProperty(ControlModel, "DefaultText") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value ControlModel.DefaultText = pvValue Case CTLTIMEFIELD If Not Utils._hasUNOProperty(ControlModel, "DefaultTime") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue >= 0 And pvValue <= 23595999 Then Select Case VarType(ControlModel.DefaultTime) Case vbEmpty, vbLong ControlModel.DefaultTime = pvValue Case vbObject ControlModel.DefaultDate.Hours = Hour(pvValue) ControlModel.DefaultDate.Minutes = Minute(pvValue) ControlModel.DefaultDate.Seconds = Second(pvValue) End Select Else Goto Trace_Error_Value End If Case CTLCURRENCYFIELD, CTLNUMERICFIELD If Not Utils._hasUNOProperty(ControlModel, "DefaultValue") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value ControlModel.DefaultValue = pvValue Case CTLFORMATTEDFIELD If Not Utils._hasUNOProperty(ControlModel, "EffectiveDefault") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value ControlModel.EffectiveDefault = pvValue Case Else Goto Trace_Error End Select Case UCase("Enabled") If Not Utils._hasUNOProperty(ControlModel, "Enabled") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value ControlModel.Enabled = pvValue Case UCase("FontBold") If Not Utils._hasUNOProperty(ControlModel, "FontWeight") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If pvValue Then ControlModel.FontWeight = com.sun.star.awt.FontWeight.BOLD Else ControlModel.FontWeight = com.sun.star.awt.FontWeight.NORMAL End If Case UCase("FontItalic") If Not Utils._hasUNOProperty(ControlModel, "FontSlant") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If pvValue Then ControlModel.FontSlant = com.sun.star.awt.FontSlant.ITALIC Else ControlModel.FontSlant = com.sun.star.awt.FontSlant.NONE End If Case UCase("FontName") If Not Utils._hasUNOProperty(ControlModel, "FontName") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value ControlModel.FontName = pvValue Case UCase("FontSize") If Not Utils._hasUNOProperty(ControlModel, "FontHeight") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 1 Or pvValue > 127 Then Goto Trace_Error_Value ControlModel.FontHeight = pvValue Case UCase("FontUnderline") If Not Utils._hasUNOProperty(ControlModel, "FontUnderline") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If pvValue Then ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.SINGLE Else ControlModel.FontUnderline = com.sun.star.awt.FontUnderline.NONE End If Case UCase("FontWeight") If Not Utils._hasUNOProperty(ControlModel, "FontWeight") Then Goto Trace_Error If Not Utils._IsScalar(CSng(pvValue), vbSingle, Array( _ com.sun.star.awt.FontWeight.THIN _ , com.sun.star.awt.FontWeight.ULTRALIGHT _ , com.sun.star.awt.FontWeight.LIGHT _ , com.sun.star.awt.FontWeight.SEMILIGHT _ , com.sun.star.awt.FontWeight.NORMAL _ , com.sun.star.awt.FontWeight.SEMIBOLD _ , com.sun.star.awt.FontWeight.BOLD _ , com.sun.star.awt.FontWeight.ULTRABOLD _ , com.sun.star.awt.FontWeight.BLACK _ )) Then Goto Trace_Error_Value ControlModel.FontWeight = pvValue Case UCase("Format") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value vFormats = _Formats(_SubType) Select Case _SubType Case CTLDATEFIELD, CTLTIMEFIELD bFound = False For i = 0 To UBound(vFormats) If UCase(pvValue) = UCase(vFormats(i)) Then If _SubType = CTLDATEFIELD Then If Utils._hasUNOProperty(ControlModel, "DateFormat") Then ControlModel.DateFormat = i Else Goto Trace_Error Else If Utils._hasUNOProperty(ControlModel, "TimeFormat") Then ControlModel.TimeFormat = i Else Goto Trace_Error End If bFound = True Exit For End If Next i If Not bFound Then Goto Trace_Error_Value Case Else Goto Trace_Error End Select Case UCase("ForeColor") If Not Utils._hasUNOProperty(ControlModel, "TextColor") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value ControlModel.TextColor = CLng(pvValue) Case UCase("ListIndex") If Not Utils._hasUNOProperty(ControlModel, "StringItemList") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 0 Or pvValue > UBound(ControlModel.StringItemList) Then Goto Trace_Error_Value Select Case _SubType Case CTLCOMBOBOX ControlModel.Text = ControlModel.StringItemList(pvValue) Case CTLLISTBOX ControlModel.SelectedItems = Array(pvValue) End Select Case UCase("Locked") If Not Utils._hasUNOProperty(ControlModel, "ReadOnly") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value ControlModel.ReadOnly = pvValue Case UCase("MultiSelect") If Not Utils._hasUNOProperty(ControlModel, "MultiSelection") And Not Utils._hasUNOProperty(ControlModel, "MultiSelectionSimpleMode") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If Utils._hasUNOProperty(ControlModel, "MultiSelection") Then ControlModel.MultiSelection = pvValue ElseIf Utils._hasUNOProperty(ControlModel, "MultiSelectionSimpleMode") Then ControlModel.MultiSelectionSimpleMode = pvValue End If If Not pvValue Then ControlModel.SelectedItems = Array() Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnApproveAction"), UCase("OnApproveReset") _ , UCase("OnApproveUpdate"), UCase("OnChanged"), UCase("OnErrorOccurred"), UCase("OnFocusGained") _ , UCase("OnFocusLost"), UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _ , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnResetted"), UCase("OnTextChanged") _ , UCase("OnUpdated") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value Select Case _ParentType Case CTLPARENTISDIALOG If Not Utils._RegisterDialogEventScript(ControlModel _ , psProperty _ , _GetListener(psProperty) _ , pvValue _ ) Then GoTo Trace_Error Case Else If Not Utils._RegisterEventScript(ControlModel _ , psProperty _ , _GetListener(psProperty) _ , pvValue _ , _Name _ ) Then GoTo Trace_Error End Select Case UCase("OptionValue") If Not Utils._hasUNOProperty(ControlModel, "RefValue") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Not Utils._hasUNOProperty(ControlModel, "Label") Then If pvValue = "" Then Goto Trace_Error_Value If ControlModel.RefValue <> "" Then ControlModel.RefValue = pvValue Else ControlModel.Label = pvValue End If Case UCase("Page") If Not Utils._hasUNOProperty(ControlModel, "Step") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 0 Then Goto Trace_Error_Value ControlModel.Step = pvValue Case UCase("Picture") If Not Utils._hasUNOProperty(ControlModel, "ImageURL") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value ControlModel.ImageURL = ConvertToUrl(pvValue) Case UCase("Required") If Not Utils._hasUNOProperty(ControlModel, "InputRequired") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value ControlModel.InputRequired = pvValue Case UCase("RowSource") Select Case _ParentType Case CTLPARENTISDIALOG If Not Utils._hasUNOProperty(ControlModel, "StringItemList") Then Goto Trace_Error ControlModel.StringItemList = Split(pvValue, ";") Case Else If Not Utils._hasUNOProperty(ControlModel, "ListSource") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value Select Case ControlModel.ListSourceType Case com.sun.star.form.ListSourceType.QUERY _ , com.sun.star.form.ListSourceType.TABLE _ , com.sun.star.form.ListSourceType.TABLEFIELDS Set odbDatabase = Application._CurrentDb(_DocEntry, _DbEntry) If ControlModel.ListSourceType = com.sun.star.form.ListSourceType.QUERY Then vNames = odbDatabase.Connection.getQueries.GetElementNames _ Else vNames = odbDatabase.Connection.getTables.GetElementNames bFound = False For i = 0 To UBound(vNames) If UCase(vNames(i)) = UCase(pvValue) Then bFound = True sName = vNames(i) Exit For End If Next i If Not bFound Then Goto Trace_Error_Value If _SubType = CTLCOMBOBOX Then ControlModel.ListSource = sName Else ControlModel.ListSource = Array(sName) ControlModel.refresh() Case com.sun.star.form.ListSourceType.SQL Set odbDatabase = Application._CurrentDb(_DocEntry, _DbEntry) If _SubType = CTLCOMBOBOX Then ControlModel.ListSource = odbDatabase._ReplaceSquareBrackets(pvValue) Else ControlModel.ListSource = Array(odbDatabase._ReplaceSquareBrackets(pvValue)) ControlModel.refresh() Case com.sun.star.form.ListSourceType.VALUELIST If _SubType = CTLCOMBOBOX Then Goto Trace_Error ControlModel.ListSource = Split(pvValue, ";") ControlModel.StringItemList = ControlModel.ListSource Case com.sun.star.form.ListSourceType.SQLPASSTHROUGH If _SubType = CTLCOMBOBOX Then ControlModel.ListSource = pvValue Else ControlModel.ListSource = Array(pvValue) ControlModel.refresh() End Select End Select If _SubType = CTLLISTBOX Then ControlModel.SelectedItems = Array() Case UCase("RowSourceType") If Not Utils._hasUNOProperty(ControlModel, "ListSourceType") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If Not Utils._IsScalar(pvValue, Utils._AddNumeric(), Array( _ com.sun.star.form.ListSourceType.VALUELIST _ , com.sun.star.form.ListSourceType.TABLE _ , com.sun.star.form.ListSourceType.QUERY _ , com.sun.star.form.ListSourceType.SQL _ , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _ , com.sun.star.form.ListSourceType.TABLEFIELDS _ )) Then Goto Trace_Error_Value ControlModel.ListSourceType = pvValue Case UCase("Selected") If Not Utils._hasUNOProperty(ControlModel, "SelectedItems") Then Goto Trace_Error If Not Utils._hasUNOProperty(ControlModel, "StringItemList") Then Goto Trace_Error If Utils._hasUNOProperty(ControlModel, "MultiSelection") Then bMultiSelect = ControlModel.MultiSelection ElseIf Utils._hasUNOProperty(ControlModel, "MultiSelectionSimpleMode") Then bMultiSelect = ControlModel.MultiSelectionSimpleMode Else: Goto Trace_Error End If lListCount = UBound(ControlModel.StringItemList) + 1 If IsMissing(pvIndex) Then If Not IsArray(pvValue) Then Goto Trace_Error_Array If LBound(pvValue) <> 0 Or UBound(pvValue) < 0 Then Goto Trace_Error_Array If Not Utils._CheckArgument(pvValue(0), iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If UBound(pvValue) <> lListCount - 1 Then Goto Trace_Error_Index iCount = 0 For i = 0 To UBound(pvValue) If pvValue(i) Then iCount = iCount + 1 Next i If iCount > 0 Then Redim iSelectedItems(0 To iCount - 1) iCount = 0 For i = 0 To UBound(pvValue) If pvValue(i) Then iSelectedItems(iCount) = i iCount = iCount + 1 End If Next i ControlModel.SelectedItems = iSelectedItems Else ControlModel.SelectedItems = Array() End If Else If Not Utils._CheckArgument(pvIndex, iArgNr + 1, Utils._AddNumeric()) Then Goto Exit_Function If pvIndex < 0 Or pvIndex >= lListCount Then Goto Trace_Error_Index If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value ReDim bSelected(0 To lListCount - 1) If Not bMultiSelect Then For i = 0 To lListCount - 1 If i = pvIndex Then bSelected(i) = pvValue Else bSelected(i) = False End If Next i Else For i = 0 To lListCount - 1 bSelected(i) = False Next i iSelectedItems = ControlModel.SelectedItems iCount = UBound(iSelectedItems) For i = 0 To iCount bSelected(iSelectedItems(i)) = True Next i bSelected(pvIndex) = pvValue End If iCount = 0 For i = 0 To lListCount - 1 If bSelected(i) Then iCount = iCount + 1 Next i If iCount > 0 Then Redim iSelectedItems(0 To iCount - 1) iCount = 0 For i = 0 To lListCount - 1 If bSelected(i) Then iSelectedItems(iCount) = i iCount = iCount + 1 End If Next i ControlModel.SelectedItems = iSelectedItems Else ControlModel.SelectedItems = Array() End If End If Case UCase("SelLength") If Not Utils._hasUNOProperty(ControlView, "Selection") Then Goto trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 0 Then Goto Trace_Error_Value vSelection = ControlView.getSelection() vSelection.Max = vSelection.Min + pvValue ControlView.setSelection(vSelection) Case UCase("SelStart") If Not Utils._hasUNOProperty(ControlView, "Selection") Then Goto trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 1 Or pvValue > Len(ControlModel.Text) + 1 Then Goto Trace_Error_Value vSelection = ControlView.getSelection() vSelection.Min = pvValue - 1 vSelection.Max = pvValue - 1 ControlView.setSelection(vSelection) Case UCase("SelText") If Not Utils._hasUNOProperty(ControlView, "Selection") Then Goto trace_Error If Not Utils._hasUNOProperty(ControlModel, "Text") Then Goto trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Len(pvValue) > 0 Then vSelection = ControlView.getSelection() sText = ControlModel.Text lStart = InStr(1, sText, pvValue, 0) If lStart > 0 Then vSelection.Min = lStart - 1 vSelection.Max = lStart + Len(pvValue) - 1 ControlView.setSelection(vSelection) End If End If Case UCase("SpecialEffect") If Not Utils._hasUNOProperty(ControlModel, "VisualEffect") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 0 Or pvValue > 2 Then Goto Trace_Error_Value ControlModel.VisualEffect = pvValue Case UCase("TabIndex") If Not Utils._hasUNOProperty(ControlModel, "TabIndex") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < -1 Then Goto Trace_Error_Value ControlModel.TabIndex = pvValue Case UCase("TabStop") If Not Utils._hasUNOProperty(ControlModel, "Tabstop") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value ControlModel.Tabstop = pvValue Case UCase("Tag") If Not Utils._hasUNOProperty(ControlModel, "Tag") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value ControlModel.Tag = pvValue Case UCase("TextAlign") If Not Utils._hasUNOProperty(ControlModel, "Align") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 0 Or pvValue > 2 Then Goto Trace_Error_Value ControlModel.Align = pvValue Case UCase("TripleState") If Not Utils._hasUNOProperty(ControlModel, "TriState") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value ControlModel.TriState = pvValue Case UCase("Value") Select Case _SubType Case CTLCHECKBOX If Not Utils._hasUNOProperty(ControlModel, "State") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(vbBoolean), , False) Then Goto Trace_Error_Value If VarType(pvValue) = vbBoolean Then pvValue = Iif(pvValue, 1, 0) If pvValue < 0 Or pvValue > 2 Then Goto Trace_Error_Value ControlModel.State = pvValue Case CTLCOMMANDBUTTON If Not Utils._hasUNOProperty(ControlModel, "State") Then Goto Trace_Error If Not Utils._hasUNOProperty(ControlModel, "Toggle") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If pvValue Then ControlModel.State = 1 Else ControlModel.State = 0 Case CTLCOMBOBOX If Not Utils._hasUNOProperty(ControlModel, "Text") Or Not Utils._hasUNOProperty(ControlModel, "StringItemList") _ Then Goto Trace_Error If pvValue <> "" Then If Not Utils._CheckArgument(pvValue, iArgNr, vbString, ControlModel.StringItemList, False) Then Goto Trace_Error_Value End If ControlModel.Text = pvValue Case CTLCURRENCYFIELD, CTLNUMERICFIELD If Not Utils._hasUNOProperty(ControlModel, "Value") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value ControlModel.Value = pvValue Case CTLDATEFIELD If Not Utils._hasUNOProperty(ControlModel, "Date") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value Select Case _InspectPropertyType(ControlModel, "Date") Case "long" ControlModel.setPropertyValue("Date", Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue)) Case "com.sun.star.util.Date" Set oStruct = CreateUnoStruct("com.sun.star.util.Date") oStruct.Year = Year(pvValue) oStruct.Month = Month(pvValue) oStruct.Day = Day(pvValue) Set ControlModel.Date = oStruct End Select Case CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD If Not Utils._hasUNOProperty(ControlModel, "Text") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value ControlModel.Text = pvValue Case CTLFORMATTEDFIELD If Not Utils._hasUNOProperty(ControlModel, "EffectiveValue") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(vbString), , False) Then Goto Trace_Error_Value ControlModel.EffectiveValue = pvValue Case CTLHIDDENCONTROL If Not Utils._hasUNOProperty(ControlModel, "HiddenValue") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(Array(vbString, vbBoolean, vbDate)), , False) Then Goto Trace_Error_Value ControlModel.HiddenValue = pvValue Case CTLLISTBOX If Not Utils._hasUNOProperty(ControlModel, "SelectedItems") Or Not Utils._hasUNOProperty(ControlModel, "StringItemList") _ Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(Array(vbString, vbDate)), , False) Then Goto Trace_Error_Value If IsArray(pvValue) Then Goto Trace_Error_Value bFound = False Select Case _ParentType Case CTLPARENTISDIALOG vItemList = ControlModel.StringItemList Case Else If _ListboxBound() Then If Not Utils._hasUNOProperty(ControlModel, "ValueItemList") Then Goto Trace_Error vItemList = ControlModel.ValueItemList Else vItemList = ControlModel.StringItemList End If End Select For i = 0 To UBound(vItemList) If pvValue = vItemList(i) Then bFound = True Exit For End If Next i If bFound Then ControlModel.SelectedItems = Array(i) Else Goto Trace_Error_Value Case CTLPROGRESSBAR If Not Utils._hasUNOProperty(ControlModel, "ProgressValue") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If Utils._hasUNOProperty(ControlModel, "ProgressValueMin") Then If pvValue < ControlModel.ProgressValueMin Then Goto Trace_Error_Value End If If Utils._hasUNOProperty(ControlModel, "ProgressValueMax") Then If pvValue > ControlModel.ProgressValueMax Then Goto Trace_Error_Value End If ControlModel.ProgressValue = pvValue Case CTLSCROLLBAR If Not Utils._hasUNOProperty(ControlModel, "ScrollValue") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If Utils._hasUNOProperty(ControlModel, "ScrollValueMin") Then If pvValue < ControlModel.ScrollValueMin Then Goto Trace_Error_Value End If If Utils._hasUNOProperty(ControlModel, "ScrollValueMax") Then If pvValue > ControlModel.ScrollValueMax Then Goto Trace_Error_Value End If ControlModel.ScrollValue = pvValue Case CTLSPINBUTTON If Not Utils._hasUNOProperty(ControlModel, "SpinValue") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If Utils._hasUNOProperty(ControlModel, "SpinValueMin") Then If pvValue < ControlModel.SpinValueMin Then Goto Trace_Error_Value End If If Utils._hasUNOProperty(ControlModel, "SpinValueMax") Then If pvValue > ControlModel.SpinValueMax Then Goto Trace_Error_Value End If ControlModel.SpinValue = pvValue Case CTLTIMEFIELD If Not Utils._hasUNOProperty(ControlModel, "Time") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value Select Case _InspectPropertyType(ControlModel, "Time") Case "long" ControlModel.Time = CLng(pvValue) Case "com.sun.star.util.Time" Set oStruct = CreateUnoStruct("com.sun.star.util.Time") sValue = Right("00000000" & Str(CLng(pvValue)), 8) oStruct.Hours = Val(Left(sValue, 2)) oStruct.Minutes = Val(Mid(sValue, 3, 2)) oStruct.Seconds = Val(Mid(sValue, 5, 2)) Set ControlModel.Time = oStruct End Select Case Else Goto Trace_Error End Select If Utils._hasUNOMethod(ControlModel, "commit") Then ControlModel.commit() Case UCase("Visible") If _SubType = CTLHIDDENCONTROL Then Goto Trace_Error If Not Utils._hasUNOMethod(ControlView, "setVisible") Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If pvValue Then ControlModel.EnableVisible = True ControlView.setVisible(pvValue) Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("Control.set" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Array: TraceError(TRACEFATAL, ERRPROPERTYNOTARRAY, Utils._CalledSub(), 0, 1, iArgNr) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Control._PropertySet", Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
Control |
AddItem |
Basic |
|
56 |
Public Function AddItem(ByVal Optional pvItem As Variant, ByVal Optional pvIndex) As Boolean
Utils._SetCalledSub("Control.AddItem") AddItem = False If _ErrorHandler() Then On Local Error Goto Error_Function If IsMissing(pvItem) Then Call _TraceArguments() If IsMissing(pvIndex) Then pvIndex = -1
Dim iArgNr As Integer Select Case UCase(_A2B_.CalledSub) Case UCase("AddItem") : iArgNr = 1 Case UCase("Control.AddItem") : iArgNr = 0 End Select
If Not Utils._CheckArgument(pvItem, iArgNr + 1, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvIndex, iArgNr + 2, Utils._AddNumeric()) Then Goto Exit_Function If _SubType <> CTLLISTBOX Then Goto Error_Control If _ParentType <> CTLPARENTISDIALOG Then If ControlModel.ListSourceType <> com.sun.star.form.ListSourceType.VALUELIST Then Goto Error_Control End If Dim vRowSource() As Variant, iCount As Integer, i As Integer If IsArray(ControlModel.StringItemList) Then vRowSource = ControlModel.StringItemList Else vRowSource = Array(ControlModel.StringItemList) iCount = UBound(vRowSource) If pvIndex < -1 Or pvIndex > iCount + 1 Then Goto Error_Index ReDim Preserve vRowSource(0 To iCount + 1) If pvIndex = -1 Then pvIndex = iCount + 1 For i = iCount + 1 To pvIndex + 1 Step -1 vRowSource(i) = vRowSource(i - 1) Next i vRowSource(pvIndex) = pvItem If _ParentType <> CTLPARENTISDIALOG Then ControlModel.ListSource = vRowSource() End If ControlModel.StringItemList = vRowSource() AddItem = True
Exit_Function: Utils._ResetCalledSub("Control.AddItem") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Control.AddItem", Erl) AddItem = False GoTo Exit_Function Error_Control: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , "Control.AddItem") AddItem = False Goto Exit_Function Error_Index: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(iArgNr + 2,pvIndex)) AddItem = False Goto Exit_Function End Function |
Access2BaseDev |
Control |
BackColor |
Basic |
|
6 |
Property Get BackColor() As Variant BackColor = _PropertyGet("BackColor") End Property
Property Let BackColor(ByVal pvValue As Variant) Call _PropertySet("BackColor", pvValue) End Property |
Access2BaseDev |
Control |
BorderColor |
Basic |
|
7 |
Property Get BorderColor() As Variant BorderColor = _PropertyGet("BorderColor") End Property
Property Let BorderColor(ByVal pvValue As Variant) Call _PropertySet("BorderColor", pvValue) End Property |
Access2BaseDev |
Control |
BorderStyle |
Basic |
|
7 |
Property Get BorderStyle() As Variant BorderStyle = _PropertyGet("BorderStyle") End Property
Property Let BorderStyle(ByVal pvValue As Variant) Call _PropertySet("BorderStyle", pvValue) End Property |
Access2BaseDev |
Control |
Cancel |
Basic |
|
7 |
Property Get Cancel() As Variant Cancel = _PropertyGet("Cancel") End Property
Property Let Cancel(ByVal pvValue As Variant) Call _PropertySet("Cancel", pvValue) End Property |
Access2BaseDev |
Control |
Caption |
Basic |
|
7 |
Property Get Caption() As Variant Caption = _PropertyGet("Caption") End Property
Property Let Caption(ByVal pvValue As Variant) Call _PropertySet("Caption", pvValue) End Property |
Access2BaseDev |
Control |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
21 |
Private Sub Class_Initialize() _Type = OBJCONTROL _ClassId = -1 _ParentType = "" _Shortcut = "" _Name = "" Set _FormComponent = Nothing _MainForm = "" _DocEntry = -1 _DbEntry = -1 _ThisProperties = Array() _SubType = "" Set ControlModel = Nothing Set ControlView = Nothing Set BoundField = Nothing Set LabelControl = Nothing
End Sub |
Access2BaseDev |
Control |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
Control |
Controls |
Basic |
|
97 |
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
Const cstThisSub = "Control.Controls" If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub(cstThisSub)
Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String Dim j As Integer, oView As Object
If _SubType <> CTLGRIDCONTROL Then Goto Trace_Error_Context Set ocControl = Nothing iControlCount = ControlModel.getCount() If IsMissing(pvIndex) Then Set oCounter = New Collect oCounter._CollType = COLLCONTROLS oCounter._ParentType = OBJCONTROL oCounter._ParentName = _Shortcut oCounter._Count = iControlCount Set Controls = oCounter Goto Exit_Function End If If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function Set ocControl = New Control ocControl._ParentType = CTLPARENTISGRID sParentShortcut = _Shortcut sControls() = ControlModel.getElementNames() Select Case VarType(pvIndex) Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index ocControl._Name = sControls(pvIndex) Case vbString bFound = False sIndex = UCase(Utils._Trim(pvIndex)) For i = 0 To iControlCount - 1 If UCase(sControls(i)) = sIndex Then bFound = True Exit For End If Next i If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound End Select
With ocControl ._Shortcut = sParentShortcut & "!" & Utils._Surround(._Name) Set .ControlModel = ControlModel.getByName(._Name) ._ImplementationName = .ControlModel.ColumnServiceName ._FormComponent = ParentComponent ._MainForm = _MainForm If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId If Not IsNull(ControlView) Then For i = 0 to ControlView.getCount() - 1 Set oView = ControlView.GetByIndex(i) If Not IsNull(oView) Then If oView.getModel.Name = ._Name Then Set .ControlView = oView Exit For End If End If Next i End If
._Initialize() ._DocEntry = _DocEntry ._DbEntry = _DbEntry End With Set Controls = ocControl Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set Controls = Nothing Goto Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, _Name)) Set Controls = Nothing Goto Exit_Function Trace_Error_Context: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , "Grid.Controls") Set Controls = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) Set Controls = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
Control |
ControlSource |
Basic |
|
4 |
Property Get ControlSource() As Variant ControlSource = _PropertyGet("ControlSource") End Property |
Access2BaseDev |
Control |
ControlTipText |
Basic |
|
7 |
Property Get ControlTipText() As Variant ControlTipText = _PropertyGet("ControlTipText") End Property
Property Let ControlTipText(ByVal pvValue As Variant) Call _PropertySet("ControlTipText", pvValue) End Property |
Access2BaseDev |
Control |
ControlType |
Basic |
|
4 |
Property Get ControlType() As Variant ControlType = _PropertyGet("ControlType") End Property |
Access2BaseDev |
Control |
Default |
Basic |
|
7 |
Property Get Default() As Variant Default = _PropertyGet("Default") End Property
Property Let Default(ByVal pvValue As Variant) Call _PropertySet("Default", pvValue) End Property |
Access2BaseDev |
Control |
DefaultValue |
Basic |
|
7 |
Property Get DefaultValue() As Variant DefaultValue = _PropertyGet("DefaultValue") End Property
Property Let DefaultValue(ByVal pvValue As Variant) Call _PropertySet("DefaultValue", pvValue) End Property |
Access2BaseDev |
Control |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
Control |
Enabled |
Basic |
|
7 |
Property Get Enabled() As Variant Enabled = _PropertyGet("Enabled") End Property
Property Let Enabled(ByVal pvValue As Variant) Call _PropertySet("Enabled", pvValue) End Property |
Access2BaseDev |
Control |
FontBold |
Basic |
|
7 |
Property Get FontBold() As Variant FontBold = _PropertyGet("FontBold") End Property
Property Let FontBold(ByVal pvValue As Variant) Call _PropertySet("FontBold", pvValue) End Property |
Access2BaseDev |
Control |
FontItalic |
Basic |
|
7 |
Property Get FontItalic() As Variant FontItalic = _PropertyGet("FontItalic") End Property
Property Let FontItalic(ByVal pvValue As Variant) Call _PropertySet("FontItalic", pvValue) End Property |
Access2BaseDev |
Control |
FontName |
Basic |
|
7 |
Property Get FontName() As Variant FontName = _PropertyGet("FontName") End Property
Property Let FontName(ByVal pvValue As Variant) Call _PropertySet("FontName", pvValue) End Property |
Access2BaseDev |
Control |
FontSize |
Basic |
|
7 |
Property Get FontSize() As Variant FontSize = _PropertyGet("FontSize") End Property
Property Let FontSize(ByVal pvValue As Variant) Call _PropertySet("FontSize", pvValue) End Property |
Access2BaseDev |
Control |
FontUnderline |
Basic |
|
7 |
Property Get FontUnderline() As Variant FontUnderline = _PropertyGet("FontUnderline") End Property
Property Let FontUnderline(ByVal pvValue As Variant) Call _PropertySet("FontUnderline", pvValue) End Property |
Access2BaseDev |
Control |
FontWeight |
Basic |
|
7 |
Property Get FontWeight() As Variant FontWeight = _PropertyGet("FontWeight") End Property
Property Let FontWeight(ByVal pvValue As Variant) Call _PropertySet("FontWeight", pvValue) End Property |
Access2BaseDev |
Control |
ForeColor |
Basic |
|
7 |
Property Get ForeColor() As Variant ForeColor = _PropertyGet("ForeColor") End Property
Property Let ForeColor(ByVal pvValue As Variant) Call _PropertySet("ForeColor", pvValue) End Property |
Access2BaseDev |
Control |
Form |
Basic |
|
4 |
Property Get Form() As Variant Form = _PropertyGet("Form") End Property |
Access2BaseDev |
Control |
Format |
Basic |
|
7 |
Property Get Format() As Variant Format = _PropertyGet("Format") End Property
Property Let Format(ByVal pvValue As Variant) Call _PropertySet("Format", pvValue) End Property |
Access2BaseDev |
Control |
getProperty |
Basic |
|
14 |
Public Function getProperty(Optional ByVal pvProperty As Variant, ByVal Optional pvIndex As Variant) As Variant
Utils._SetCalledSub("Control.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() If IsMissing(pvIndex) Then getProperty = _PropertyGet(pvProperty) Else getProperty = _PropertyGet(pvProperty, pvIndex) End If Utils._ResetCalledSub("Control.getProperty") End Function |
Access2BaseDev |
Control |
hasProperty |
Basic |
_PropertyGet (Procedure) _PropertySet (Procedure) |
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
Control |
ItemData |
Basic |
|
4 |
Property Get ItemData(ByVal Optional pvIndex As Variant) As Variant If IsMissing(pvIndex) Then ItemData = _PropertyGet("ItemData") Else ItemData = _PropertyGet("ItemData", pvIndex) End Property |
Access2BaseDev |
Control |
ListCount |
Basic |
|
4 |
Property Get ListCount() As Variant ListCount = _PropertyGet("ListCount") End Property |
Access2BaseDev |
Control |
ListIndex |
Basic |
|
7 |
Property Get ListIndex() As Variant ListIndex = _PropertyGet("ListIndex") End Property
Property Let ListIndex(ByVal pvValue As Variant) Call _PropertySet("ListIndex", pvValue) End Property |
Access2BaseDev |
Control |
Locked |
Basic |
|
7 |
Property Get Locked() As Variant Locked = _PropertyGet("Locked") End Property
Property Let Locked(ByVal pvValue As Variant) Call _PropertySet("Locked", pvValue) End Property |
Access2BaseDev |
Control |
MultiSelect |
Basic |
|
7 |
Property Get MultiSelect() As Variant MultiSelect = _PropertyGet("MultiSelect") End Property
Property Let MultiSelect(ByVal pvValue As Variant) Call _PropertySet("MultiSelect", pvValue) End Property |
Access2BaseDev |
Control |
Name |
Basic |
|
4 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
Control |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
Control |
OnActionPerformed |
Basic |
|
7 |
Property Get OnActionPerformed() As Variant OnActionPerformed = _PropertyGet("OnActionPerformed") End Property
Property Let OnActionPerformed(ByVal pvValue As Variant) Call _PropertySet("OnActionPerformed", pvValue) End Property |
Access2BaseDev |
Control |
OnAdjustmentValueChanged |
Basic |
|
7 |
Property Get OnAdjustmentValueChanged() As Variant OnAdjustmentValueChanged = _PropertyGet("OnAdjustmentValueChanged") End Property
Property Let OnAdjustmentValueChanged(ByVal pvValue As Variant) Call _PropertySet("OnAdjustmentValueChanged", pvValue) End Property |
Access2BaseDev |
Control |
OnApproveAction |
Basic |
|
7 |
Property Get OnApproveAction() As Variant OnApproveAction = _PropertyGet("OnApproveAction") End Property
Property Let OnApproveAction(ByVal pvValue As Variant) Call _PropertySet("OnApproveAction", pvValue) End Property |
Access2BaseDev |
Control |
OnApproveReset |
Basic |
|
7 |
Property Get OnApproveReset() As Variant OnApproveReset = _PropertyGet("OnApproveReset") End Property
Property Let OnApproveReset(ByVal pvValue As Variant) Call _PropertySet("OnApproveReset", pvValue) End Property |
Access2BaseDev |
Control |
OnApproveUpdate |
Basic |
|
7 |
Property Get OnApproveUpdate() As Variant OnApproveUpdate = _PropertyGet("OnApproveUpdate") End Property
Property Let OnApproveUpdate(ByVal pvValue As Variant) Call _PropertySet("OnApproveUpdate", pvValue) End Property |
Access2BaseDev |
Control |
OnChanged |
Basic |
|
7 |
Property Get OnChanged() As Variant OnChanged = _PropertyGet("OnChanged") End Property
Property Let OnChanged(ByVal pvValue As Variant) Call _PropertySet("OnChanged", pvValue) End Property |
Access2BaseDev |
Control |
OnErrorOccurred |
Basic |
|
7 |
Property Get OnErrorOccurred() As Variant OnErrorOccurred = _PropertyGet("OnErrorOccurred") End Property
Property Let OnErrorOccurred(ByVal pvValue As Variant) Call _PropertySet("OnErrorOccurred", pvValue) End Property |
Access2BaseDev |
Control |
OnFocusGained |
Basic |
|
7 |
Property Get OnFocusGained() As Variant OnFocusGained = _PropertyGet("OnFocusGained") End Property
Property Let OnFocusGained(ByVal pvValue As Variant) Call _PropertySet("OnFocusGained", pvValue) End Property |
Access2BaseDev |
Control |
OnFocusLost |
Basic |
|
7 |
Property Get OnFocusLost() As Variant OnFocusLost = _PropertyGet("OnFocusLost") End Property
Property Let OnFocusLost(ByVal pvValue As Variant) Call _PropertySet("OnFocusLost", pvValue) End Property |
Access2BaseDev |
Control |
OnItemStateChanged |
Basic |
|
7 |
Property Get OnItemStateChanged() As Variant OnItemStateChanged = _PropertyGet("OnItemStateChanged") End Property
Property Let OnItemStateChanged(ByVal pvValue As Variant) Call _PropertySet("OnItemStateChanged", pvValue) End Property |
Access2BaseDev |
Control |
OnKeyPressed |
Basic |
|
7 |
Property Get OnKeyPressed() As Variant OnKeyPressed = _PropertyGet("OnKeyPressed") End Property
Property Let OnKeyPressed(ByVal pvValue As Variant) Call _PropertySet("OnKeyPressed", pvValue) End Property |
Access2BaseDev |
Control |
OnKeyReleased |
Basic |
|
7 |
Property Get OnKeyReleased() As Variant OnKeyReleased = _PropertyGet("OnKeyReleased") End Property
Property Let OnKeyReleased(ByVal pvValue As Variant) Call _PropertySet("OnKeyReleased", pvValue) End Property |
Access2BaseDev |
Control |
OnMouseDragged |
Basic |
|
7 |
Property Get OnMouseDragged() As Variant OnMouseDragged = _PropertyGet("OnMouseDragged") End Property
Property Let OnMouseDragged(ByVal pvValue As Variant) Call _PropertySet("OnMouseDragged", pvValue) End Property |
Access2BaseDev |
Control |
OnMouseEntered |
Basic |
|
7 |
Property Get OnMouseEntered() As Variant OnMouseEntered = _PropertyGet("OnMouseEntered") End Property
Property Let OnMouseEntered(ByVal pvValue As Variant) Call _PropertySet("OnMouseEntered", pvValue) End Property |
Access2BaseDev |
Control |
OnMouseExited |
Basic |
|
7 |
Property Get OnMouseExited() As Variant OnMouseExited = _PropertyGet("OnMouseExited") End Property
Property Let OnMouseExited(ByVal pvValue As Variant) Call _PropertySet("OnMouseExited", pvValue) End Property |
Access2BaseDev |
Control |
OnMouseMoved |
Basic |
|
7 |
Property Get OnMouseMoved() As Variant OnMouseMoved = _PropertyGet("OnMouseMoved") End Property
Property Let OnMouseMoved(ByVal pvValue As Variant) Call _PropertySet("OnMouseMoved", pvValue) End Property |
Access2BaseDev |
Control |
OnMousePressed |
Basic |
|
7 |
Property Get OnMousePressed() As Variant OnMousePressed = _PropertyGet("OnMousePressed") End Property
Property Let OnMousePressed(ByVal pvValue As Variant) Call _PropertySet("OnMousePressed", pvValue) End Property |
Access2BaseDev |
Control |
OnMouseReleased |
Basic |
|
7 |
Property Get OnMouseReleased() As Variant OnMouseReleased = _PropertyGet("OnMouseReleased") End Property
Property Let OnMouseReleased(ByVal pvValue As Variant) Call _PropertySet("OnMouseReleased", pvValue) End Property |
Access2BaseDev |
Control |
OnResetted |
Basic |
|
7 |
Property Get OnResetted() As Variant OnResetted = _PropertyGet("OnResetted") End Property
Property Let OnResetted(ByVal pvValue As Variant) Call _PropertySet("OnResetted", pvValue) End Property |
Access2BaseDev |
Control |
OnTextChanged |
Basic |
|
7 |
Property Get OnTextChanged() As Variant OnTextChanged = _PropertyGet("OnTextChanged") End Property
Property Let OnTextChanged(ByVal pvValue As Variant) Call _PropertySet("OnTextChanged", pvValue) End Property |
Access2BaseDev |
Control |
OnUpdated |
Basic |
|
7 |
Property Get OnUpdated() As Variant OnUpdated = _PropertyGet("OnUpdated") End Property
Property Let OnUpdated(ByVal pvValue As Variant) Call _PropertySet("OnUpdated", pvValue) End Property |
Access2BaseDev |
Control |
OptionValue |
Basic |
|
7 |
Property Get OptionValue() As Variant OptionValue = _PropertyGet("OptionValue") End Property
Property Let OptionValue(ByVal pvValue As Variant) Call _PropertySet("OptionValue", pvValue) End Property |
Access2BaseDev |
Control |
Page |
Basic |
|
7 |
Property Get Page() As Variant Page = _PropertyGet("Page") End Property
Property Let Page(ByVal pvValue As Variant) Call _PropertySet("Page", pvValue) End Property |
Access2BaseDev |
Control |
Parent |
Basic |
|
4 |
Public Function Parent() As Object Parent = _PropertyGet("Parent") End Function |
Access2BaseDev |
Control |
Picture |
Basic |
|
7 |
Property Get Picture() As Variant Picture = _PropertyGet("Picture") End Property
Property Let Picture(ByVal pvValue As Variant) Call _PropertySet("Picture", pvValue) End Property |
Access2BaseDev |
Control |
pName |
Basic |
|
3 |
Public Function pName() As String pName = _PropertyGet("Name") End Function |
Access2BaseDev |
Control |
Properties |
Basic |
|
22 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Utils._SetCalledSub("Control.Properties") Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Shortcut, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Shortcut, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Utils._ResetCalledSub("Control.Properties") Exit Function End Function |
Access2BaseDev |
Control |
pText |
Basic |
|
3 |
Public Function pText() As variant pText = _PropertyGet("Text") End Function |
Access2BaseDev |
Control |
RemoveItem |
Basic |
|
75 |
Public Function RemoveItem(ByVal Optional pvIndex) As Boolean
Utils._SetCalledSub("Control.RemoveItem") If _ErrorHandler() Then On Local Error Goto Error_Function If IsMissing(pvIndex) Then Call _TraceArguments() Dim iArgNr As Integer Select Case UCase(_A2B_.CalledSub) Case UCase("RemoveItem") : iArgNr = 1 Case UCase("Control.RemoveItem") : iArgNr = 0 End Select If Not Utils._CheckArgument(pvIndex, iArgNr + 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function If _SubType <> CTLLISTBOX Then Goto Error_Control If _ParentType <> CTLPARENTISDIALOG Then If ControlModel.ListSourceType <> com.sun.star.form.ListSourceType.VALUELIST Then Goto Error_Control End If Dim vRowSource() As Variant, iCount As Integer, i As Integer, j As integer, bFound As Boolean If IsArray(ControlModel.StringItemList) Then vRowSource = ControlModel.StringItemList Else vRowSource = Array(ControlModel.StringItemList) iCount = UBound(vRowSource) Select Case VarType(pvIndex) Case vbString bFound = False For i = 0 To iCount If vRowSource(i) = pvIndex Then For j = i To iCount - 1 vRowSource(j) = vRowSource(j + 1) Next j bFound = True Exit For End If Next i Case Else If pvIndex < 0 Or pvIndex > iCount Then Goto Error_Index For i = pvIndex To iCount - 1 vRowSource(i) = vRowSource(i + 1) Next i bFound = True End Select If bFound Then If iCount > 0 Then ReDim Preserve vRowSource(0 To iCount - 1) Else vRowSource = Array() End If If _ParentType <> CTLPARENTISDIALOG Then ControlModel.ListSource = vRowSource() End If ControlModel.StringItemList = vRowSource() RemoveItem = True Else RemoveItem = False End If
Exit_Function: Utils._ResetCalledSub("Control.RemoveItem") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Control.RemoveItem", Erl) RemoveItem = False GoTo Exit_Function Error_Control: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, "Control.RemoveItem") RemoveItem = False Goto Exit_Function Error_Index: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(2, pvIndex)) RemoveItem = False Goto Exit_Function End Function |
Access2BaseDev |
Control |
Requery |
Basic |
|
34 |
Public Function Requery() As Boolean Utils._SetCalledSub("Control.Requery") If _ErrorHandler() Then On Local Error Goto Error_Function Requery = False Select Case _SubType Case CTLCOMBOBOX, CTLLISTBOX If Utils._InList(ControlModel.ListSourceType, Array( _ com.sun.star.form.ListSourceType.QUERY _ , com.sun.star.form.ListSourceType.TABLE _ , com.sun.star.form.ListSourceType.TABLEFIELDS _ , com.sun.star.form.ListSourceType.SQL _ , com.sun.star.form.ListSourceType.SQLPASSTHROUGH _ )) Then ControlModel.refresh() End If Case Else Goto Error_Control End Select Requery = True
Exit_Function: Utils._ResetCalledSub("Control.Requery") Exit Function Error_Control: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, "Control.Requery") Requery = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Control.Requery", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Control |
Required |
Basic |
|
7 |
Property Get Required() As Variant Required = _PropertyGet("Required") End Property
Property Let Required(ByVal pvValue As Variant) Call _PropertySet("Required", pvValue) End Property |
Access2BaseDev |
Control |
RowSource |
Basic |
|
7 |
Property Get RowSource() As Variant RowSource = _PropertyGet("RowSource") End Property
Property Let RowSource(ByVal pvValue As Variant) Call _PropertySet("RowSource", pvValue) End Property |
Access2BaseDev |
Control |
RowSourceType |
Basic |
|
7 |
Property Get RowSourceType() As Variant RowSourceType = _PropertyGet("RowSourceType") End Property
Property Let RowSourceType(ByVal pvValue As Variant) Call _PropertySet("RowSourceType", pvValue) End Property |
Access2BaseDev |
Control |
Selected |
Basic |
|
8 |
Property Get Selected(ByVal Optional pvIndex As Variant) As Variant If IsMissing(pvIndex) Then Selected = _PropertyGet("Selected") Else Selected = _PropertyGet("Selected", pvIndex) End Property
Property Let Selected(ByVal pvValue As Variant) Call _PropertySet("Selected", pvValue) End Property |
Access2BaseDev |
Control |
SelectedI |
Basic |
|
3 |
Public Function SelectedI(ByVal pvValue As variant, ByVal pvIndex As Variant) Call _PropertySet("Selected", pvValue, pvIndex) End Function |
Access2BaseDev |
Control |
SelLength |
Basic |
|
7 |
Property Get SelLength() As Variant SelLength = _PropertyGet("SelLength") End Property
Property Let SelLength(ByVal pvValue As Variant) Call _PropertySet("SelLength", pvValue) End Property |
Access2BaseDev |
Control |
SelStart |
Basic |
|
7 |
Property Get SelStart() As Variant SelStart = _PropertyGet("SelStart") End Property
Property Let SelStart(ByVal pvValue As Variant) Call _PropertySet("SelStart", pvValue) End Property |
Access2BaseDev |
Control |
SelText |
Basic |
|
7 |
Property Get SelText() As Variant SelText = _PropertyGet("SelText") End Property
Property Let SelText(ByVal pvValue As Variant) Call _PropertySet("SelText", pvValue) End Property |
Access2BaseDev |
Control |
setFocus |
Basic |
|
46 |
Public Function setFocus() As Boolean Utils._SetCalledSub("Control.setFocus") If _ErrorHandler() Then On Local Error Goto Error_Function setFocus = False
Dim i As Integer, j As Integer, iColPosition As Integer Dim ocControl As Object, ocGrid As Variant, oGridModel As Object
If IsNull(ControlView) Then GoTo Exit_Function If _ParentType = CTLPARENTISGRID Then iColPosition = -1 ocGrid = getObject(_getUpperShortcut(_Shortcut, _Name)) Set oGridModel = ocGrid.ControlModel j = -1 For i = 0 To oGridModel.Count - 1 Set ocControl = oGridModel.GetByIndex(i) If Not ocControl.Hidden Then j = j + 1 If oGridModel.GetByIndex(i).Name = _Name Then iColPosition = j Exit For End If Next i If iColPosition >= 0 Then ocGrid.ControlView.setFocus() ocGrid.ControlView.setCurrentColumnPosition(iColPosition) Else Goto Error_Grid End If Else ControlView.setFocus() End If setFocus = True Exit_Function: Utils._ResetCalledSub("Control.setFocus") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Control.setFocus", Erl) Goto Exit_Function Error_Grid: TraceError(TRACEFATAL, ERRFOCUSINGRID, Utils._CalledSub(), 0, 1, Array(_Name, ocGrid._Name)) Goto Exit_Function End Function |
Access2BaseDev |
Control |
setProperty |
Basic |
|
11 |
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean Utils._SetCalledSub("Control.setProperty") If IsMissing(pvIndex) Then setProperty = _PropertySet(psProperty, pvValue) Else setProperty = _PropertySet(psProperty, pvValue, pvIndex) End If Utils._ResetCalledSub("Control.setProperty") End Function |
Access2BaseDev |
Control |
SpecialEffect |
Basic |
|
7 |
Property Get SpecialEffect() As Variant SpecialEffect = _PropertyGet("SpecialEffect") End Property
Property Let SpecialEffect(ByVal pvValue As Variant) Call _PropertySet("SpecialEffect", pvValue) End Property |
Access2BaseDev |
Control |
SubType |
Basic |
|
4 |
Property Get SubType() As Variant SubType = _PropertyGet("SubType") End Property |
Access2BaseDev |
Control |
TabIndex |
Basic |
|
7 |
Property Get TabIndex() As Variant TabIndex = _PropertyGet("TabIndex") End Property
Property Let TabIndex(ByVal pvValue As Variant) Call _PropertySet("TabIndex", pvValue) End Property |
Access2BaseDev |
Control |
TabStop |
Basic |
|
7 |
Property Get TabStop() As Variant TabStop = _PropertyGet("TabStop") End Property
Property Let TabStop(ByVal pvValue As Variant) Call _PropertySet("TabStop", pvValue) End Property |
Access2BaseDev |
Control |
Tag |
Basic |
|
7 |
Property Get Tag() As Variant Tag = _PropertyGet("Tag") End Property
Property Let Tag(ByVal pvValue As Variant) Call _PropertySet("Tag", pvValue) End Property |
Access2BaseDev |
Control |
Text |
Basic |
|
4 |
Property Get Text() As Variant Text = _PropertyGet("Text") End Property |
Access2BaseDev |
Control |
TextAlign |
Basic |
|
7 |
Property Get TextAlign() As Variant TextAlign = _PropertyGet("TextAlign") End Property
Property Let TextAlign(ByVal pvValue As Variant) Call _PropertySet("TextAlign", pvValue) End Property |
Access2BaseDev |
Control |
TripleState |
Basic |
|
7 |
Property Get TripleState() As Variant TripleState = _PropertyGet("TripleState") End Property
Property Let TripleState(ByVal pvValue As Variant) Call _PropertySet("TripleState", pvValue) End Property |
Access2BaseDev |
Control |
Value |
Basic |
|
7 |
Property Get Value() As Variant Value = _PropertyGet("Value") End Property
Property Let Value(ByVal pvValue As Variant) Call _PropertySet("Value", pvValue) End Property |
Access2BaseDev |
Control |
Visible |
Basic |
|
7 |
Property Get Visible() As Variant Visible = _PropertyGet("Visible") End Property
Property Let Visible(ByVal pvValue As Variant) Call _PropertySet("Visible", pvValue) End Property |
Access2BaseDev |
Database |
_DFunction |
Basic |
DAvg (Procedure) DCount (Procedure) DLookup (Procedure) DMax (Procedure) DMin (Procedure) DStDev (Procedure) DStDevP (Procedure) DSum (Procedure) DVar (Procedure) DVarP (Procedure) |
70 |
Private Function _DFunction(ByVal psFunction As String _ , ByVal psExpr As String _ , ByVal psDomain As String _ , ByVal pvCriteria As Variant _ , ByVal Optional pvOrderClause As Variant _ ) As Variant If _ErrorHandler() Then On Local Error GoTo Error_Function
Dim oResult As Object Dim vResult As Variant Dim sSql As String Dim oStatement As Object Dim sExpr As String Dim sTempField As String Dim sTarget as String, sWhere As String, sOrderBy As String, sLimit As String
vResult = Null
Randomize 2^14-1 sTempField = "[TEMP" & Right("00000" & Int(100000 * Rnd), 5) & "]" If pvCriteria <> "" Then sWhere = " WHERE " & pvCriteria Else sWhere = "" If pvOrderClause <> "" Then sOrderBy = " ORDER BY " & pvOrderClause Else sOrderBy = "" sLimit = ""
Select Case UCase(MetaData.getDatabaseProductName()) Case "MYSQL", "SQLITE" If psFunction = "" Then sTarget = psExpr sLimit = " LIMIT 1" Else sTarget = UCase(psFunction) & "(" & psExpr & ")" End If sSql = "SELECT " & sTarget & " AS " & sTempField & " FROM " & psDomain & sWhere & sOrderBy & sLimit Case Else If psFunction = "" Then sTarget = "TOP 1 " & psExpr Else sTarget = UCase(psFunction) & "(" & psExpr & ")" sSql = "SELECT " & sTarget & " AS " & sTempField & " FROM " & psDomain & sWhere & sOrderBy End Select
Set oStatement = Connection.createStatement() With oStatement .ResultSetType = com.sun.star.sdbc.ResultSetType.FORWARD_ONLY .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY .EscapeProcessing = False sSql = _ReplaceSquareBrackets(sSql) Set oResult = .executeQuery(sSql) If Not IsNull(oResult) And Not IsEmpty(oResult) Then If Not oResult.next() Then Goto Exit_Function vResult = Utils._getResultSetColumnValue(oResult, 1, True) End If End With
Exit_Function: _DFunction = vResult Set oResult = Nothing Set oStatement = Nothing Exit Function Error_Function: TraceError(TRACEABORT, ERRDFUNCTION, _A2B_.CalledSub, 0, , sSQL) Goto Exit_Function End Function |
Access2BaseDev |
Database |
_FilterOptionsDefault |
Basic |
_OutputToCalc (Procedure) |
15 |
Private Function _FilterOptionsDefault(ByVal plEncoding As Long) As String
Dim sFieldSeparator as string Const cstComma = "," Const cstTextDelimitor = """"
If _DecimalPoint() = "," Then sFieldSeparator = ";" Else sFieldSeparator = cstComma _FilteroptionsDefault = Trim(Str(Asc(sFieldSeparator))) _ & cstComma & Trim(Str(Asc(cstTextDelimitor))) _ & cstComma & Trim(Str(plEncoding)) _ & cstComma & "1"
End Function |
Access2BaseDev |
Database |
_hasRecordset |
Basic |
Recordsets (Procedure) |
15 |
Public Function _hasRecordset(ByVal psName As String) As Boolean
Dim oRecordset As Object If _ErrorHandler() Then On Local Error Goto Error_Function Set oRecordset = RecordsetsColl.Item(psName) _hasRecordset = True
Exit_Function: Exit Function Error_Function: _hasRecordset = False GoTo Exit_Function End Function |
Access2BaseDev |
Database |
_LoadMetadata |
Basic |
|
117 |
Private Sub _LoadMetadata()
Dim sProduct As String Dim iInfo As Integer, oTypeInfo As Object, sName As String, lType As Integer
Const cstMaxInfo = 40 ReDim _ColumnTypes(0 To cstMaxInfo) ReDim _ColumnTypeNames(0 To cstMaxInfo) ReDim _ColumnPrecisions(0 To cstMaxInfo) Const cstHSQLDB1 = "HSQL Database Engine 1." Const cstHSQLDB2 = "HSQL Database Engine 2." Const cstFirebird = "sdbc:embedded:firebird" Const cstMSAccess2003 = "MS Jet 0" Const cstMSAccess2007 = "MS Jet 04." Const cstMYSQL = "MySQL" Const cstPOSTGRES = "PostgreSQL" Const cstSQLITE = "SQLite"
With com.sun.star.sdbc.DataType _ColumnTypesReference = Array( _ .ARRAY _ , .BIGINT _ , .BINARY _ , .BIT _ , .BLOB _ , .BOOLEAN _ , .CHAR _ , .CLOB _ , .DATE _ , .DECIMAL _ , .DISTINCT _ , .DOUBLE _ , .FLOAT _ , .INTEGER _ , .LONGVARBINARY _ , .LONGVARCHAR _ , .NUMERIC _ , .OBJECT _ , .OTHER _ , .REAL _ , .REF _ , .SMALLINT _ , .SQLNULL _ , .STRUCT _ , .TIME _ , .TIMESTAMP _ , .TINYINT _ , .VARBINARY _ , .VARCHAR _ ) End With
With Metadata sProduct = .getDatabaseProductName() & " " & .getDatabaseProductVersion Select Case True Case Len(sProduct) > Len(cstHSQLDB1) And Left(sProduct, Len(cstHSQLDB1)) = cstHSQLDB1 _RDBMS = DBMS_HSQLDB1 _ColumnTypesAlias = Array(0, -5, -2, 16, -4, 16, 1, -1, 91, 3, 0, 8, 6, 4, -4, -1, 2, 0, 0, 7, 0, 5, 0, 0, 92, 93, -6, -3, 12) _BinaryStream = True Case Len(sProduct) > Len(cstHSQLDB2) And Left(sProduct, Len(cstHSQLDB2)) = cstHSQLDB2 _RDBMS = DBMS_HSQLDB2 _ColumnTypesAlias = Array(0, -5, -3, -7, 2004, 16, 1, 2005, 91, 3, 0, 8, 8, 4, -3, 12, 2, 0, 0, 8, 0, 5, 0, 0, 92, 93, -6, -3, 12) _BinaryStream = True Case .URL = cstFirebird _RDBMS = DBMS_FIREBIRD _ColumnTypesAlias = Array(0, -5, 2004, 16, 2004, 16, 1, 12, 91, 8, 0, 8, 6, 4, 2004, 12, 8, 0, 0, 8, 0, 5, 0, 0, 92, 93, 4, 2004, 12) _BinaryStream = True Case Len(sProduct) > Len(cstMSAccess2007) And Left(sProduct, Len(cstMSAccess2007)) = cstMSAccess2007 _RDBMS = DBMS_MSACCESS2007 _ColumnTypesAlias = Array(0, 4, -2, 16, -2, 16, 12, 12, 93, 8, 0, 8, 6, 4, -3, 12, 2, 0, 0, 8, 0, 5, 0, 0, 93, 93, -6, -2, 12) _BinaryStream = True Case Len(sProduct) > Len(cstMSAccess2003) And Left(sProduct, Len(cstMSAccess2003)) = cstMSAccess2003 _RDBMS = DBMS_MSACCESS2003 _ColumnTypesAlias = Array(0, 4, -2, 16, -2, 16, 12, 12, 93, 8, 0, 8, 6, 4, -3, 12, 2, 0, 0, 8, 0, 5, 0, 0, 93, 93, -6, -2, 12) _BinaryStream = True Case Len(sProduct) > Len(cstMYSQL) And Left(sProduct, Len(cstMYSQL)) = cstMYSQL _RDBMS = DBMS_MYSQL _ColumnTypesAlias = Array(0, -5, -2, -7, -4, -7, 1, -1, 91, 3, 0, 8, 8, 4, -4, -1, 2, 0, 0, 7, 0, 5, 0, 0, 92, 93, -6, -3, -1) _BinaryStream = False Case Len(sProduct) > Len(cstPOSTGRES) And Left(sProduct, Len(cstPOSTGRES)) = cstPOSTGRES _RDBMS = DBMS_POSTGRES _ColumnTypesAlias = Array(0, -5, -3, 16, -3, 16, 1, 12, 91, 8, 0, 8, 8, 4, -3, 12, 2, 0, 0, 7, 0, 5, 0, 0, 92, 93, 4, -3, 12) _BinaryStream = True Case Len(sProduct) > Len(cstSQLITE) And Left(sProduct, Len(cstSQLITE)) = cstSQLITE _RDBMS = DBMS_SQLITE _ColumnTypesAlias = Array(0, -5, -4, -7, -4, -7, 1, -1, 91, 8, 0, 8, 6, 4, -4, -1, 8, 0, 0, 8, 0, 5, 0, 0, 92, 93, -6, -4, 12) _BinaryStream = True Case Else _RDBMS = DBMS_UNKNOWN _BinaryStream = True End Select
iInfo = -1 Set oTypeInfo = MetaData.getTypeInfo() With oTypeInfo .next() Do While Not .isAfterLast() And iInfo < cstMaxInfo sName = .getString(1) lType = .getLong(2) If _RDBMS = DBMS_POSTGRES And (Left(sName, 1) <> "_" Or lType <> -1) Then Else iInfo = iInfo + 1 _ColumnTypeNames(iInfo) = sName _ColumnTypes(iInfo) = lType _ColumnPrecisions(iInfo) = CLng(.getLong(3)) End If .next() Loop End With ReDim Preserve _ColumnTypes(0 To iInfo) ReDim Preserve _ColumnTypeNames(0 To iInfo) ReDim Preserve _ColumnPrecisions(0 To iInfo) End With
End Sub |
Access2BaseDev |
Database |
_OutputBinaryToHTML |
Basic |
_OutputDataToHTML (Procedure) |
7 |
Private Function _OutputBinaryToHTML() As String
_OutputBinaryToHTML = " "
End Function |
Access2BaseDev |
Database |
_OutputBooleanToHTML |
Basic |
_OutputDataToHTML (Procedure) |
7 |
Private Function _OutputBooleanToHTML(ByVal pbBool As Boolean) As String
_OutputBooleanToHTML = Iif(pbBool, "✔", "✖") End Function |
Access2BaseDev |
Database |
_OutputClassToHTML |
Basic |
_OutputDataToHTML (Procedure) |
13 |
Private Function _OutputClassToHTML(ByVal pvArray As variant) As String
If Not IsArray(pvArray) Then _OutputClassToHTML = "" ElseIf UBound(pvArray) < LBound(pvArray) Then _OutputClassToHTML = "" Else _OutputClassToHTML = " class=""" & Join(pvArray, " ") & """" End If
End Function |
Access2BaseDev |
Database |
_OutputDataToHTML |
Basic |
_OutputToHTML (Procedure) |
126 |
Private Function _OutputDataToHTML(ByRef pvTable As Variant, ByVal pvName As String, ByVal piFile As Integer _ , ByRef Optional pvHeaders As Variant _ , ByRef Optional pvData As Variant _ ) As Boolean
Dim oTableRS As Object, vData() As Variant, i As Integer, j As Integer Dim vFieldsBin() As Variant, iDataType As Integer, iNumRows As Integer, iNumFields As Integer, vDataCell As Variant Dim bDataArray As Boolean, sHeader As String Dim vTrClass() As Variant, vTdClass As Variant, iCountRows As Integer, iLastRow As Integer Const cstMaxRows = 200 On Local Error GoTo Error_Function
bDataArray = IsNull(pvTable) Print #piFile, " <table class=""dbdatatable"">" Print #piFile, " <caption>" & pvName & "</caption>"
vFieldsBin() = Array() If bDataArray Then Set oTableRS = Nothing iNumFields = UBound(pvHeaders) + 1 ReDim vFieldsBin(0 To iNumFields - 1) For i = 0 To iNumFields - 1 vFieldsBin(i) = False Next i Else Set oTableRS = pvTable.OpenRecordset( , , dbReadOnly) iNumFields = oTableRS.Fields.Count ReDim vFieldsBin(0 To iNumFields - 1) With com.sun.star.sdbc.DataType For i = 0 To iNumFields - 1 iDataType = oTableRS.Fields(i).DataType vFieldsBin(i) = Utils._IsBinaryType(iDataType) Next i End With End If
With oTableRS Print #piFile, " <thead>" Print #piFile, " <tr>" For i = 0 To iNumFields - 1 If bDataArray Then sHeader = pvHeaders(i) Else sHeader = .Fields(i)._Name Print #piFile, " <th scope=""col"">" & sHeader & "</th>" Next i Print #piFile, " </tr>" Print #piFile, " </thead>" Print #piFile, " <tfoot>" Print #piFile, " </tfoot>"
Print #piFile, " <tbody>" If bDataArray Then iLastRow = UBound(pvData, 2) + 1 Else .MoveLast iLastRow = .RecordCount .MoveFirst End If iCountRows = 0 Do While iCountRows < iLastRow If bDataArray Then iNumRows = iLastRow Else vData() = .GetRows(cstMaxRows) iNumRows = UBound(vData, 2) + 1 End If For j = 0 To iNumRows - 1 iCountRows = iCountRows + 1 vTrClass() = Array() If iCountRows = 1 Then vTrClass() = _AddArray(vTrClass, "firstrow") If iCountRows = iLastRow Then vTrClass() = _AddArray(vTrClass, "lastrow") If (iCountRows Mod 2) = 0 Then vTrClass() = _AddArray(vTrClass, "even") Else vTrClass() = _AddArray(vTrClass, "odd") Print #piFile, " <tr" & _OutputClassToHTML(vTrClass) & ">" For i = 0 To iNumFields - 1 vTdClass() = Array() If i = 0 Then vTdClass() = _AddArray(vTdClass, "firstcol") If i = iNumFields - 1 Then vTdClass() = _AddArray(vTdClass, "lastcol") If Not vFieldsBin(i) Then If bDataArray Then vDataCell = pvData(i, j) Else vDataCell = vData(i, j) If vDataCell Is Nothing Then vDataCell = Null If IsDate(vDataCell) And VarType(vDataCell) = vbString Then vDataCell = CDate(vDataCell) Select Case VarType(vDataCell) Case vbEmpty, vbNull vTdClass() = _AddArray(vTdClass, "null") Print #piFile, " <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputNullToHTML() & "</td>" Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal, vbUShort, vbULong, vbBigInt vTdClass() = _AddArray(vTdClass, "numeric") If vDataCell < 0 Then vTdClass() = _AddArray(vTdClass, "negative") Print #piFile, " <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputNumberToHTML(vDataCell) & "</td>" Case vbBoolean vTdClass() = _AddArray(vTdClass, "bool") If vDataCell = False Then vTdClass() = _AddArray(vTdClass, "false") Print #piFile, " <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputBooleanToHTML(vDataCell) & "</td>" Case vbDate vTdClass() = _AddArray(vTdClass, "date") Print #piFile, " <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputDateToHTML(vDataCell) & "</td>" Case vbString vTdClass() = _AddArray(vTdClass, "char") Print #piFile, " <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputStringToHTML(vDataCell) & "</td>" Case Else Print #piFile, " <td" & _OutputClassToHTML(vTdClass) & ">" & _CStr(vDataCell) & "</td>" End Select Else Print #piFile, " <td" & _OutputClassToHTML(vTdClass) & ">" & _OutputBinaryToHTML() & "</td>" End If Next i Print #piFile, " </tr>" Next j Loop
If Not bDataArray Then .mClose() End With Set oTableRS = Nothing
Print #piFile, " </tbody>" Print #piFile, " </table>" _OutputDataToHTML = True
Exit_Function: Exit Function Error_Function: TraceError(TRACEWARNING, Err, "_OutputDataToHTML", Erl) _OutputDataToHTML = False Resume Exit_Function End Function |
Access2BaseDev |
Database |
_OutputDateToHTML |
Basic |
_OutputDataToHTML (Procedure) |
7 |
Private Function _OutputDateToHTML(ByVal psDate As Date) As String
_OutputDateToHTML = Format(psDate) End Function |
Access2BaseDev |
Database |
_OutputNullToHTML |
Basic |
_OutputDataToHTML (Procedure) |
7 |
Private Function _OutputNullToHTML() As String
_OutputNullToHTML = " "
End Function |
Access2BaseDev |
Database |
_OutputNumberToHTML |
Basic |
_OutputDataToHTML (Procedure) |
14 |
Private Function _OutputNumberToHTML(ByVal pvNumber As Variant, ByVal Optional piPrecision As Integer) As String
Dim vNumber As Variant If IsMissing(piPrecision) Then piPrecision = -1 If pvNumber = Int(pvNumber) Then vNumber = Int(pvNumber) Else If piPrecision >= 0 Then vNumber = (Int(pvNumber * 10 ^ piPrecision + 0.5)) / 10 ^ piPrecision Else vNumber = pvNumber End If _OutputNumberToHTML = Format(vNumber)
End Function |
Access2BaseDev |
Database |
_OutputStringToHTML |
Basic |
_OutputDataToHTML (Procedure) |
90 |
Private Function _OutputStringToHTML(ByVal psString As String) As String
Dim vPatterns As Variant Dim lCurrentChar as Long, lPattern As Long, lNextPattern As Long, sPattern As String Dim sOutput As String, sChar As String Dim sUrl As String, lNextQuote As Long, lUrl As Long, bQuote As Boolean, bTagEnd As Boolean Dim i As Integer, l As Long
vPatterns = Array( _ """, "&", "'", "<", ">", " " _ , "" , " ", " " _ , "<a href=""", "<a id=""", "", "<img src=""" _ , "<span class=""", "" _ , "", "", "", "", "", "" _ )
lCurrentChar = 1 sOutput = "" Do While lCurrentChar <= Len(psString) lPattern = Len(psString) + 1 sPattern = "" For i = 0 To UBound(vPatterns) lNextPattern = InStr(lCurrentChar, psString, vPatterns(i), 1) If lNextPattern > 0 And lNextPattern < lPattern Then lPattern = lNextPattern sPattern = Mid(psString, lPattern, Len(vPatterns(i))) End If Next i For l = lCurrentChar To lPattern - 1 sChar = Mid(psString, l, 1) sOutput = sOutput & Utils._UTF8Encode(sChar) Next l If Len(sPattern) > 0 Then Select Case LCase(sPattern) Case "<a href=""", "<a id=""", "<img src=""", "<span class=""" lNextQuote = 0 lUrl = lPattern + Len(sPattern) lNextQuote = InStr(lUrl, psString, """", 1) If lNextQuote = 0 Then lNextQuote = Len(psString) sUrl = Mid(psString, lUrl, lNextQuote - lUrl) sOutput = sOutput & sPattern & sUrl & """" lCurrentChar = lNextQuote + 1 bQuote = False bTagEnd = False Do sChar = Mid(psString, lCurrentChar, 1) Select Case sChar Case """" bQuote = Not bQuote sOutput = sOutput & sChar Case ">" If Not bQuote Then bTagEnd = True sOutput = sOutput & sChar Else sOutput = sOutput & _UTF8Encode(sChar) End If Case Else sOutput = sOutput & _UTF8Encode(sChar) End Select lCurrentChar = lCurrentChar + 1 If lCurrentChar > Len(psString) Then bTagEnd = True Loop Until bTagEnd Case Else sOutput = sOutput & sPattern lCurrentChar = lPattern + Len(sPattern) End Select Else lCurrentChar = Len(psString) + 1 End If Loop _OutputStringToHTML = sOutput
End Function |
Access2BaseDev |
Database |
_OutputToCalc |
Basic |
OutputTo (Procedure) |
79 |
Private Function _OutputToCalc(poData As Object _ , ByVal psOutputFile As String _ , ByVal psFilter As String _ , Optional ByVal plEncoding As Long _ ) As Boolean
Dim oCalcDoc As Object, oSheet As Object, vWin As Variant Dim vImportDesc() As Variant, iSource As Integer Dim oRange As Object, i As Integer, iCol As Integer, oColumns As Object
If _ErrorHandler() Then On Local Error Goto Error_Function _OutputToCalc = False If IsMissing(plEncoding) Then plEncoding = acUTF8Encoding Set oCalcDoc = StarDesktop.LoadComponentFromURL( _ "private:factory/scalc" _ , "_default" ,0, Array() _ )
Set oSheet = oCalcDoc.Sheets(0)
With poData If ._Type = "TABLEDEF" Then iSource = com.sun.star.sheet.DataImportMode.TABLE Else iSource = com.sun.star.sheet.DataImportMode.QUERY End If vImportDesc = Array( _ _MakePropertyValue("DatabaseName", URL) _ , _MakePropertyValue("SourceType", iSource) _ , _MakePropertyValue("SourceObject", ._Name) _ ) oSheet.Name = ._Name End With
oSheet.getCellByPosition(0, 0).doImport(vImportDesc())
Select Case psFilter Case acFormatODS, acFormatXLS, acFormatXLSX iCol = poData.Fields().Count Set oRange = oSheet.getCellRangeByPosition(0, 0, iCol - 1, 0) oRange.CharWeight = com.sun.star.awt.FontWeight.BOLD oRange.CellBackColor = RGB(200, 200, 200) oRange.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER Set oColumns = oRange.getColumns() For i = 0 To iCol - 1 oColumns.getByIndex(i).OptimalWidth = True Next i oCalcDoc.storeAsUrl(psOutputFile, Array( _ _MakePropertyValue("FilterName", psFilter) _ , _MakePropertyValue("Overwrite", True) _ )) Case Else oCalcDoc.storeAsUrl(psOutputFile, Array( _ _MakePropertyValue("FilterName", psFilter) _ , _MakePropertyValue("FilterOptions", _FilterOptionsDefault(plEncoding)) _ , _MakePropertyValue("Overwrite", True) _ )) End Select oCalcDoc.close(False) _OutputToCalc = True
Exit_Function: Set oColumns = Nothing Set oRange = Nothing Set oSheet = Nothing Set oCalcDoc = Nothing Exit Function Error_Function: TraceError(TRACEABORT, ERRDFUNCTION, _A2B_.CalledSub, 0, , sSQL) Goto Exit_Function End Function |
Access2BaseDev |
Database |
_OutputToHTML |
Basic |
OutputTo (Procedure) |
65 |
Public Function _OutputToHTML(ByRef pvTable As Variant, ByVal pvName As String, ByVal psOutputFile As String, ByVal psTemplateFile As String _ , ByRef Optional pvHeaders As Variant _ , ByRef Optional pvData As Variant _ ) As Boolean
Dim bDataArray As Boolean Dim vMinimalTemplate As Variant, vTemplate As Variant Dim iFile As Integer, i As Integer, sLine As String, lBody As Long Const cstTitle = "<!--Template_Title-->", cstBody = "<!--Template_Body-->" Const cstTitleAlt = "<!--AccessTemplate_Title-->", cstBodyAlt = "<!--AccessTemplate_Body-->"
On Local Error GoTo Error_Function vMinimalTemplate = Array( _ "<!DOCTYPE html>" _ , "<html>" _ , " <head>" _ , " <title>" & cstTitle & "</title>" _ , " </head>" _ , " <body>" _ , " " & cstBody _ , " </body>" _ , "</html>" _ )
vTemplate = _ReadFileIntoArray(psTemplateFile) If LBound(vTemplate) > UBound(vTemplate) Then vTemplate() = vMinimalTemplate() bDataArray = IsNull(pvTable)
iFile = FreeFile() Open psOutputFile For Output Access Write Lock Read Write As #iFile For i = 0 To UBound(vTemplate) sLine = vTemplate(i) sLine = Join(Split(sLine, cstTitleAlt), cstTitle) sLine = Join(Split(sLine, cstBodyAlt), cstBody) Select Case True Case InStr(sLine, cstTitle) > 0 sLine = Join(Split(sLine, cstTitle), pvName) Print #iFile, sLine Case InStr(sLine, cstBody) > 0 lBody = InStr(sLine, cstBody) If lBody > 1 Then Print #iFile, Left(sLine, lBody - 1) If bDataArray Then _OutputDataToHTML(pvTable, pvName, iFile, pvHeaders, pvData) Else _OutputDataToHTML(pvTable, pvName, iFile) End If If Len(sLine) > lBody + Len(cstBody) - 1 Then Print #iFile, Right(sLine, Len(sLine) - lBody + Len(cstBody) + 1) Case Else Print #iFile, sLine End Select Next i Close #iFile
_OutputToHTML = True
Exit_Function: Exit Function Error_Function: _OutputToHTML = False GoTo Exit_Function End Function |
Access2BaseDev |
Database |
_PropertiesList |
Basic |
hasProperty (Procedure) Properties (Procedure) |
13 |
Private Function _PropertiesList() As Variant
_PropertiesList = Array("Connect", "Name", "ObjectType" _ , "OnCreate", "OnFocus", "OnLoad", "OnLoadFinished", "OnModifyChanged" _ , "OnNew", "OnPrepareUnload", "OnPrepareViewClosing", "OnSave", "OnSaveAs" _ , "OnSaveAsDone", "OnSaveAsFailed", "OnSaveDone", "OnSaveFailed", "OnSaveTo" _ , "OnSaveToDone", "OnSaveToFailed", "OnSubComponentClosed", "OnSubComponentOpened" _ , "OnTitleChanged", "OnUnfocus", "OnUnload", "OnViewClosed", "OnViewCreated" _ , "Version" _ )
End Function |
Access2BaseDev |
Database |
_PropertyGet |
Basic |
Connect (Procedure) Name (Procedure) ObjectType (Procedure) OnCreate (Procedure) OnFocus (Procedure) OnLoad (Procedure) OnLoadFinished (Procedure) OnModifyChanged (Procedure) OnNew (Procedure) OnPrepareUnload (Procedure) OnPrepareViewClosing (Procedure) OnSave (Procedure) OnSaveAs (Procedure) OnSaveAsDone (Procedure) OnSaveAsFailed (Procedure) OnSaveDone (Procedure) OnSaveFailed (Procedure) OnSubComponentClosed (Procedure) OnSubComponentOpened (Procedure) OnTitleChanged (Procedure) OnUnfocus (Procedure) OnUnload (Procedure) OnViewClosed (Procedure) OnViewCreated (Procedure) Version (Procedure) getProperty (Procedure) Properties (Procedure) |
63 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
Dim i As Integer, vEvents As Variant, sEvent As String, vEvent As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Database.get" & psProperty)
_PropertyGet = EMPTY Select Case UCase(psProperty) Case UCase("Connect") _PropertyGet = Document.Datasource.URL Case UCase("Name") _PropertyGet = Title Case UCase("ObjectType") _PropertyGet = _Type Case UCase("OnCreate"), UCase("OnFocus"), UCase("OnLoad"), UCase("OnLoadFinished"), UCase("OnModifyChanged") _ , UCase("OnNew"), UCase("OnPrepareUnload"), UCase("OnPrepareViewClosing"), UCase("OnSave"), UCase("OnSaveAs") _ , UCase("OnSaveAsDone"), UCase("OnSaveAsFailed"), UCase("OnSaveDone"), UCase("OnSaveFailed"), UCase("OnSaveTo") _ , UCase("OnSaveToDone"), UCase("OnSaveToFailed"), UCase("OnSubComponentClosed"), UCase("OnSubComponentOpened") _ , UCase("OnTitleChanged"), UCase("OnUnfocus"), UCase("OnUnload"), UCase("OnViewClosed"), UCase("OnViewCreated") sEvent = "" vEvents = Document.getEvents().ElementNames For i = 0 To UBound(vEvents) If UCase(vEvents(i)) = UCase(psProperty) Then sEvent = vEvents(i) Exit For End If Next i If sEvent = "" Then _PropertyGet = "" Else vEvent = Document.getEvents().getByName(sEvent) If IsEmpty(vEvent) Then _PropertyGet = "" ElseIf vEvent(0).Value <> "Script" Then _PropertyGet = "" Else _PropertyGet = vEvent(1).Value End If End If Case UCase("Version") _PropertyGet = MetaData.getDatabaseProductName() & " " & MetaData.getDatabaseProductVersion Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("Database.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertyGet = EMPTY Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Database._PropertyGet", Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function |
Access2BaseDev |
Database |
_ReplaceSquareBrackets |
Basic |
CreateQueryDef (Procedure) OpenRecordset (Procedure) OpenSQL (Procedure) RunSQL (Procedure) _DFunction (Procedure) |
25 |
Public Function _ReplaceSquareBrackets(ByVal psSql As String) As String
Dim sQuote As String Dim vSubStrings() As Variant, i As Integer Const cstSingleQuote = "'" sQuote = MetaData.IdentifierQuoteString If sQuote = " " Then _ReplaceSquareBrackets = Trim(psSql) Exit Function End If vSubStrings() = Split(psSql, cstSingleQuote) For i = 0 To UBound(vSubStrings) If (i Mod 2) = 0 Or (i = UBound(vSubStrings)) Then vSubStrings(i) = Join(Split(vSubStrings(i), "["), sQuote) vSubStrings(i) = Join(Split(vSubStrings(i), "]"), sQuote) End If Next i _ReplaceSquareBrackets = Trim(Join(vSubStrings, cstSingleQuote)) End Function |
Access2BaseDev |
Database |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
25 |
Private Sub Class_Initialize() _Type = OBJDATABASE Set _This = Nothing _DbConnect = 0 Title = "" Set Document = Nothing Set Connection = Nothing URL = "" _ReadOnly = False Set MetaData = Nothing _RDBMS = DBMS_UNKNOWN _ColumnTypes = Array() _ColumnTypeNames = Array() _ColumnPrecisions = Array() _ColumnTypesReference = Array() _ColumnTypesAlias() = Array() _BinaryStream = False Set Form = Nothing FormName = "" RecordsetMax = 0 Set RecordsetsColl = New Collection End Sub |
Access2BaseDev |
Database |
Class_Terminate |
Basic |
Dispose (Procedure) |
15 |
Private Sub Class_Terminate() On Local Error Resume Next Call CloseAllRecordsets() If _DbConnect <> DBCONNECTANY Then If Not IsNull(Connection) Then Connection.close() Connection.dispose() Set Connection = Nothing End If Else mClose() End If Call Class_Initialize() End Sub |
Access2BaseDev |
Database |
CloseAllRecordsets |
Basic |
Class_Terminate (Procedure) |
19 |
Public Sub CloseAllRecordsets()
Dim sRecordsets() As String, i As Integer, oRecordset As Object On Local Error Goto Exit_Sub
If IsNull(RecordsetsColl) Then Exit Sub If RecordsetsColl.Count < 1 Then Exit Sub For i = 1 To RecordsetsColl.Count Set oRecordset = RecordsetsColl.Item(i) oRecordset.mClose(False) Next i Set RecordsetsColl = New Collection RecordsetMax = 0
Exit_Sub: Exit Sub End Sub |
Access2BaseDev |
Database |
Connect |
Basic |
|
3 |
Property Get Connect() As String Connect = _PropertyGet("Connect") End Property |
Access2BaseDev |
Database |
CreateQueryDef |
Basic |
|
60 |
Public Function CreateQueryDef(ByVal Optional pvQueryName As Variant _ , ByVal Optional pvSql As Variant _ , ByVal Optional pvOption As Variant _ ) As Object Const cstThisSub = "Database.CreateQueryDef" Utils._SetCalledSub(cstThisSub)
Const cstNull = -1 Dim oQuery As Object, oQueries As Object, i As Integer, sQueryName As String
If _ErrorHandler() Then On Local Error Goto Error_Function
Set CreateQueryDef = Nothing If _DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable If IsMissing(pvQueryName) Then Call _TraceArguments() If IsMissing(pvSql) Then Call _TraceArguments() If IsMissing(pvOption) Then pvOption = cstNull
If Not Utils._CheckArgument(pvQueryName, 1, vbString) Then Goto Exit_Function If pvQueryName = "" Then Call _TraceArguments() If Not Utils._CheckArgument(pvSql, 2, vbString) Then Goto Exit_Function If pvSql = "" Then Call _TraceArguments() If Not Utils._CheckArgument(pvOption, 3, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function If _ReadOnly Then Goto Error_NoUpdate Set oQuery = CreateUnoService("com.sun.star.sdb.QueryDefinition") oQuery.rename(pvQueryName) oQuery.Command = _ReplaceSquareBrackets(pvSql) oQuery.EscapeProcessing = Not ( pvOption = dbSQLPassThrough ) Set oQueries = Document.DataSource.getQueryDefinitions() With oQueries For i = 0 To .getCount() - 1 sQueryName = .getByIndex(i).Name If UCase(sQueryName) = UCase(pvQueryName) Then TraceError(TRACEWARNING, ERRQUERYDEFDELETED, Utils._CalledSub(), 0, False, sQueryName) .removeByName(sQueryName) Exit For End If Next i .insertByName(pvQueryName, oQuery) End With Set CreateQueryDef = QueryDefs(pvQueryName)
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_NoUpdate: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Database |
CreateTableDef |
Basic |
|
64 |
Public Function CreateTableDef(ByVal Optional pvTableName As Variant) As Object Const cstThisSub = "Database.CreateTableDef" Utils._SetCalledSub(cstThisSub)
Dim oTable As Object, oTables As Object, sTables() As String Dim i As Integer, sTableName As String, oNewTable As Object Dim vNameComponents() As Variant, iNames As Integer
If _ErrorHandler() Then On Local Error Goto Error_Function
Set CreateTableDef = Nothing If _DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable If IsMissing(pvTableName) Then Call _TraceArguments()
If Not Utils._CheckArgument(pvTableName, 1, vbString) Then Goto Exit_Function If pvTableName = "" Then Call _TraceArguments() If _ReadOnly Then Goto Error_NoUpdate Set oTables = Connection.getTables With oTables sTables = .ElementNames() For i = 0 To UBound(sTables) If UCase(pvTableName) = UCase(sTables(i)) Then sTableName = sTables(i) TraceError(TRACEWARNING, ERRTABLEDEFDELETED, Utils._CalledSub(), 0, False, sTableName) .dropByName(sTableName) Exit For End If Next i Set oNewTable = New DataDef oNewTable._Type = OBJTABLEDEF oNewTable._Name = pvTableName vNameComponents = Split(pvTableName, ".") iNames = UBound(vNameComponents) If iNames >= 2 Then oNewtable.CatalogName = vNameComponents(iNames - 2) Else oNewTable.CatalogName = "" If iNames >= 1 Then oNewtable.SchemaName = vNameComponents(iNames - 1) Else oNewTable.SchemaName = "" oNewtable.TableName = vNameComponents(iNames) Set oNewTable._ParentDatabase = _This Set oNewTable.TableDescriptor = .createDataDescriptor() oNewTable.TableDescriptor.CatalogName = oNewTable.CatalogName oNewTable.TableDescriptor.SchemaName = oNewTable.SchemaName oNewTable.TableDescriptor.Name = oNewTable.TableName oNewTable.TableDescriptor.Type = "TABLE" End With
Set CreateTabledef = oNewTable
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_NoUpdate: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Database |
DAvg |
Basic |
|
13 |
Public Function DAvg( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "Database.DAvg" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DAvg = _DFunction("AVG", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Database |
DCount |
Basic |
|
13 |
Public Function DCount( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "Database.DCount" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DCount = _DFunction("COUNT", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Database |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
Database |
DLookup |
Basic |
|
30 |
Public Function DLookup( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ , ByVal Optional pvOrderClause As Variant _ ) As Variant
Const cstThisSub = "Database.DLookup" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DLookup = _DFunction("", psExpr, psDomain _ , Iif(IsMissing(pvCriteria), "", pvCriteria) _ , Iif(IsMissing(pvOrderClause), "", pvOrderClause) _ ) Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Database |
DMax |
Basic |
|
13 |
Public Function DMax( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "Database.DMax" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DMax = _DFunction("MAX", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Database |
DMin |
Basic |
|
13 |
Public Function DMin( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "Database.DMin" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DMin = _DFunction("MIN", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Database |
DStDev |
Basic |
|
13 |
Public Function DStDev( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "Database.DStDev" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DStDev = _DFunction("STDDEV_SAMP", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Database |
DStDevP |
Basic |
|
13 |
Public Function DStDevP( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "Database.DStDevP" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DStDevP = _DFunction("STDDEV_POP", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Database |
DSum |
Basic |
|
13 |
Public Function DSum( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "Database.DSum" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DSum = _DFunction("SUM", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Database |
DVar |
Basic |
|
13 |
Public Function DVar( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "Database.DVar" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DVar = _DFunction("VAR_SAMP", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Database |
DVarP |
Basic |
|
13 |
Public Function DVarP( _ ByVal Optional psExpr As String _ , ByVal Optional psDomain As String _ , ByVal Optional pvCriteria As Variant _ ) As Variant Const cstThisSub = "Database.DVarP" Utils._SetCalledSub(cstThisSub) If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments() DVarP = _DFunction("VAR_POP", psExpr, psDomain, Iif(IsMissing(pvCriteria), "", pvCriteria), "") Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Database |
getProperty |
Basic |
|
10 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("Database.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("Database.getProperty") End Function |
Access2BaseDev |
Database |
hasProperty |
Basic |
|
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
Database |
mClose |
Basic |
Class_Terminate (Procedure) |
25 |
Public Function mClose() As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "Database.Close" Utils._SetCalledSub(cstThisSub) mClose = False If _DbConnect <> DBCONNECTANY Then Goto Error_NotApplicable
Connection.close() Connection.dispose() Set Connection = Nothing mClose = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Database |
Name |
Basic |
|
4 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
Database |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
Database |
OnCreate |
Basic |
|
4 |
Property Get OnCreate() As String OnCreate = _PropertyGet("OnCreate") End Property |
Access2BaseDev |
Database |
OnFocus |
Basic |
|
4 |
Property Get OnFocus() As String OnFocus = _PropertyGet("OnFocus") End Property |
Access2BaseDev |
Database |
OnLoad |
Basic |
|
4 |
Property Get OnLoad() As String OnLoad = _PropertyGet("OnLoad") End Property |
Access2BaseDev |
Database |
OnLoadFinished |
Basic |
|
4 |
Property Get OnLoadFinished() As String OnLoadFinished = _PropertyGet("OnLoadFinished") End Property |
Access2BaseDev |
Database |
OnModifyChanged |
Basic |
|
4 |
Property Get OnModifyChanged() As String OnModifyChanged = _PropertyGet("OnModifyChanged") End Property |
Access2BaseDev |
Database |
OnNew |
Basic |
|
4 |
Property Get OnNew() As String OnNew = _PropertyGet("OnNew") End Property |
Access2BaseDev |
Database |
OnPrepareUnload |
Basic |
|
4 |
Property Get OnPrepareUnload() As String OnPrepareUnload = _PropertyGet("OnPrepareUnload") End Property |
Access2BaseDev |
Database |
OnPrepareViewClosing |
Basic |
|
4 |
Property Get OnPrepareViewClosing() As String OnPrepareViewClosing = _PropertyGet("OnPrepareViewClosing") End Property |
Access2BaseDev |
Database |
OnSave |
Basic |
|
4 |
Property Get OnSave() As String OnSave = _PropertyGet("OnSave") End Property |
Access2BaseDev |
Database |
OnSaveAs |
Basic |
|
4 |
Property Get OnSaveAs() As String OnSaveAs = _PropertyGet("OnSaveAs") End Property |
Access2BaseDev |
Database |
OnSaveAsDone |
Basic |
|
4 |
Property Get OnSaveAsDone() As String OnSaveAsDone = _PropertyGet("OnSaveAsDone") End Property |
Access2BaseDev |
Database |
OnSaveAsFailed |
Basic |
|
4 |
Property Get OnSaveAsFailed() As String OnSaveAsFailed = _PropertyGet("OnSaveAsFailed") End Property |
Access2BaseDev |
Database |
OnSaveDone |
Basic |
|
4 |
Property Get OnSaveDone() As String OnSaveDone = _PropertyGet("OnSaveDone") End Property |
Access2BaseDev |
Database |
OnSaveFailed |
Basic |
|
4 |
Property Get OnSaveFailed() As String OnSaveFailed = _PropertyGet("OnSaveFailed") End Property |
Access2BaseDev |
Database |
OnSubComponentClosed |
Basic |
|
4 |
Property Get OnSubComponentClosed() As String OnSubComponentClosed = _PropertyGet("OnSubComponentClosed") End Property |
Access2BaseDev |
Database |
OnSubComponentOpened |
Basic |
|
4 |
Property Get OnSubComponentOpened() As String OnSubComponentOpened = _PropertyGet("OnSubComponentOpened") End Property |
Access2BaseDev |
Database |
OnTitleChanged |
Basic |
|
4 |
Property Get OnTitleChanged() As String OnTitleChanged = _PropertyGet("OnTitleChanged") End Property |
Access2BaseDev |
Database |
OnUnfocus |
Basic |
|
4 |
Property Get OnUnfocus() As String OnUnfocus = _PropertyGet("OnUnfocus") End Property |
Access2BaseDev |
Database |
OnUnload |
Basic |
|
4 |
Property Get OnUnload() As String OnUnload = _PropertyGet("OnUnload") End Property |
Access2BaseDev |
Database |
OnViewClosed |
Basic |
|
4 |
Property Get OnViewClosed() As String OnViewClosed = _PropertyGet("OnViewClosed") End Property |
Access2BaseDev |
Database |
OnViewCreated |
Basic |
|
4 |
Property Get OnViewCreated() As String OnViewCreated = _PropertyGet("OnViewCreated") End Property |
Access2BaseDev |
Database |
OpenRecordset |
Basic |
|
103 |
Public Function OpenRecordset(ByVal Optional pvSource As Variant _ , ByVal Optional pvType As Variant _ , ByVal Optional pvOptions As Variant _ , ByVal Optional pvLockEdit As Variant _ ) As Object
Const cstThisSub = "Database.OpenRecordset" Utils._SetCalledSub(cstThisSub) Const cstNull = -1
Dim lCommandType As Long, sCommand As String, oObject As Object Dim sSource As String, i As Integer, iCount As Integer Dim sObjects() As String, bFound As Boolean, oTables As Object, oQueries As Object
If _ErrorHandler() Then On Local Error Goto Error_Function Set oObject = Nothing If IsMissing(pvSource) Then Call _TraceArguments() If pvSource = "" Then Call _TraceArguments() If IsMissing(pvType) Then pvType = cstNull Else If Not Utils._CheckArgument(pvType, 2, Utils._AddNumeric(), dbOpenForwardOnly) Then Goto Exit_Function End If If IsMissing(pvOptions) Then pvOptions = cstNull Else If Not Utils._CheckArgument(pvOptions, 3, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function End If If IsMissing(pvLockEdit) Then pvLockEdit = cstNull Else If Not Utils._CheckArgument(pvLockEdit, 4, Utils._AddNumeric(), dbReadOnly) Then Goto Exit_Function End If
sSource = Split(UCase(Trim(pvSource)), " ")(0) Select Case True Case sSource = "SELECT" lCommandType = com.sun.star.sdb.CommandType.COMMAND sCommand = _ReplaceSquareBrackets(pvSource) Case Else sSource = UCase(Trim(pvSource)) Set oTables = Connection.getTables sObjects = oTables.ElementNames() bFound = False For i = 0 To UBound(sObjects) If sSource = UCase(sObjects(i)) Then sCommand = sObjects(i) bFound = True Exit For End If Next i If bFound Then lCommandType = com.sun.star.sdb.CommandType.TABLE Else Set oQueries = Connection.getQueries sObjects = oQueries.ElementNames() For i = 0 To UBound(sObjects) If sSource = UCase(sObjects(i)) Then sCommand = sObjects(i) bFound = True Exit For End If Next i If Not bFound Then Goto Trace_NotFound lCommandType = com.sun.star.sdb.CommandType.QUERY End If End Select Set oObject = New Recordset With oObject ._CommandType = lCommandType ._Command = sCommand ._ParentName = Title ._ParentType = _Type ._ForwardOnly = ( pvType = dbOpenForwardOnly ) ._PassThrough = ( pvOptions = dbSQLPassThrough ) ._ReadOnly = ( (pvLockEdit = dbReadOnly) Or _ReadOnly ) Set ._This = oObject Set ._ParentDatabase = _This Call ._Initialize() RecordsetMax = RecordsetMax + 1 ._Name = Format(RecordsetMax, "0000000") RecordsetsColl.Add(oObject, UCase(._Name)) End With
If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst() Exit_Function: Set OpenRecordset = oObject Set oObject = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("TABLE") & "/" & _GetLabel("QUERY"), pvSource)) Goto Exit_Function End Function |
Access2BaseDev |
Database |
OpenSQL |
Basic |
|
55 |
Public Function OpenSQL(Optional ByVal pvSQL As Variant _ , Optional ByVal pvOption As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "Database.OpenSQL" Utils._SetCalledSub(cstThisSub) OpenSQL = False If IsMissing(pvSQL) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function Const cstNull = -1 If IsMissing(pvOption) Then pvOption = cstNull Else If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), Array(dbSQLPassThrough, cstNull)) Then Goto Exit_Function End If If _DbConnect <> DBCONNECTBASE And _DbConnect <> DBCONNECTFORM Then Goto Error_NotApplicable
Dim oURL As New com.sun.star.util.URL, oDispatch As Object Dim vArgs(8) as New com.sun.star.beans.PropertyValue
oURL.Complete = ".component:DB/DataSourceBrowser" oDispatch = StarDesktop.queryDispatch(oURL, "_Blank", 8)
vArgs(0).Name = "ActiveConnection" : vArgs(0).Value = Connection vArgs(1).Name = "CommandType" : vArgs(1).Value = com.sun.star.sdb.CommandType.COMMAND vArgs(2).Name = "Command" : vArgs(2).Value = _ReplaceSquareBrackets(pvSQL) vArgs(3).Name = "ShowMenu" : vArgs(3).Value = True vArgs(4).Name = "ShowTreeView" : vArgs(4).Value = False vArgs(5).Name = "ShowTreeViewButton" : vArgs(5).Value = False vArgs(6).Name = "Filter" : vArgs(6).Value = "" vArgs(7).Name = "ApplyFilter" : vArgs(7).Value = False vArgs(8).Name = "EscapeProcessing" : vArgs(8).Value = CBool(Not ( pvOption = dbSQLPassThrough ))
oDispatch.dispatch(oURL, vArgs) OpenSQL = True
Exit_Function: Exit Function Error_Function: TraceError(TRACEABORT, Err, "OpenSQL", Erl) GoTo Exit_Function SQL_Error: TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , pvSQL) Goto Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function End Function |
Access2BaseDev |
Database |
OutputTo |
Basic |
|
130 |
Public Function OutputTo(ByVal pvObjectType As Variant _ , ByVal Optional pvObjectName As Variant _ , ByVal Optional pvOutputFormat As Variant _ , ByVal Optional pvOutputFile As Variant _ , ByVal Optional pvAutoStart As Variant _ , ByVal Optional pvTemplateFile As Variant _ , ByVal Optional pvEncoding As Variant _ , ByVal Optional pvQuality As Variant _ , ByRef Optional pvHeaders As Variant _ , ByRef Optional pvData As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "Database.OutputTo" Utils._SetCalledSub(cstThisSub)
OutputTo = False If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery, acOutputArray)) Then Goto Exit_Function If IsMissing(pvObjectName) Then Call _TraceArguments() If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function If IsMissing(pvOutputFormat) Then pvOutputFormat = "" If Not Utils._CheckArgument(pvOutputFormat, 3, vbString) Then Goto Exit_Function If pvOutputFormat <> "" Then If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _ UCase(acFormatHTML), "HTML" _ , UCase(acFormatODS), "ODS" _ , UCase(acFormatXLS), "XLS" _ , UCase(acFormatXLSX), "XLSX" _ , UCase(acFormatTXT), "TXT", "CSV" _ , "")) _ Then Goto Exit_Function End If If IsMissing(pvOutputFile) Then pvOutputFile = "" If Not Utils._CheckArgument(pvOutputFile, 4, vbString) Then Goto Exit_Function If IsMissing(pvAutoStart) Then pvAutoStart = False If Not Utils._CheckArgument(pvAutoStart, 5, vbBoolean) Then Goto Exit_Function If IsMissing(pvTemplateFile) Then pvTemplateFile = "" If Not Utils._CheckArgument(pvTemplateFile, 6, vbString) Then Goto Exit_Function If IsMissing(pvEncoding) Then pvEncoding = 0 If Not Utils._CheckArgument(pvEncoding, 7, _AddNumeric()) Then Goto Exit_Function If IsMissing(pvQuality) Then pvQuality = acExportQualityPrint If Not Utils._CheckArgument(pvQuality, 7, _AddNumeric(), Array(acExportQualityPrint, acExportQualityScreen)) Then Goto Exit_Function If pvObjectType = acOutputArray Then If IsMissing(pvHeaders) Or IsMissing(pvData) Then Call _TraceArguments() pvOutputFormat = "HTML" End If
Dim sOutputFile As String, oTable As Object Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutput As Boolean, sSuffix As String
If pvObjectType = acOutputArray Then Set oTable = Nothing Else If pvObjectType = acOutputTable Then Set oTable = TableDefs(pvObjectName, True) Else Set oTable = Querydefs(pvObjectName, True) If IsNull(oTable) Then Goto Error_NotFound End If If pvOutputFormat = "" Then sOutputFormat = _PromptFormat(Array("HTML", "ODS", "XLS", "XLSX", "TXT")) If sOutputFormat = "" Then Goto Exit_Function Else sOutputFormat = UCase(pvOutputFormat) End If
If pvOutputFile = "" Then Select Case sOutputFormat Case UCase(acFormatHTML), "HTML" : sSuffix = "html" Case UCase(acFormatODS), "ODS" : sSuffix = "ods" Case UCase(acFormatXLS), "XLS" : sSuffix = "xls" Case UCase(acFormatXLSX), "XLSX" : sSuffix = "xlsx" Case UCase(acFormatTXT), "TXT", "CSV" : sSuffix = "txt" End Select sOutputFile = _PromptFilePicker(sSuffix) If sOutputFile = "" Then Goto Exit_Function Else sOutputFile = pvOutputFile End If sOutputFile = ConvertToURL(sOutputFile)
Select Case sOutputFormat Case UCase(acFormatHTML), "HTML" If pvObjectType = acOutputArray Then bOutput = _OutputToHTML(Nothing, pvObjectName, sOutputFile, pvTemplateFile, pvHeaders, pvData) Else bOutput = _OutputToHTML(oTable, pvObjectName, sOutputFile, pvTemplateFile) End If Case UCase(acFormatODS), "ODS" bOutput = _OutputToCalc(oTable, sOutputFile, acFormatODS) Case UCase(acFormatXLS), "XLS" bOutput = _OutputToCalc(oTable, sOutputFile, acFormatXLS) Case UCase(acFormatXLS), "XLSX" bOutput = _OutputToCalc(oTable, sOutputFile, acFormatXLSX) Case UCase(acFormatTXT), "TXT", "CSV" bOutput = _OutputToCalc(oTable, sOutputFile, acFormatTXT, pvEncoding) End Select If bOutput Then If pvAutoStart Then Call _ShellExecute(sOutputFile) Else GoTo Error_File End If
OutputTo = True Exit_Function: If Not IsNull(oTable) Then oTable.Dispose() Set oTable = Nothing End If Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName)) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_File: TraceError(TRACEFATAL, ERRFILENOTCREATED, Utils._CalledSub(), 0, , sOutputFile) GoTo Exit_Function End Function |
Access2BaseDev |
Database |
Properties |
Basic |
|
23 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Utils._SetCalledSub("Database.Properties") Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, "", vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, "", vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Set vProperty._ParentDatabase = _This Exit_Function: Set Properties = vProperty Utils._ResetCalledSub("Database.Properties") Exit Function End Function |
Access2BaseDev |
Database |
QueryDefs |
Basic |
CreateQueryDef (Procedure) OutputTo (Procedure) |
65 |
Public Function QueryDefs(ByVal Optional pvIndex As Variant, ByVal Optional pbCheck As Boolean) As Object
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Database.QueryDefs") If IsMissing(pbCheck) Then pbCheck = False
Dim sObjects() As String, sObjectName As String, oObject As Object Dim i As Integer, bFound As Boolean, oQueries As Object Set oObject = Nothing If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End If Set oQueries = Connection.getQueries sObjects = oQueries.ElementNames() Select Case True Case IsMissing(pvIndex) Set oObject = New Collect oObject._CollType = COLLQUERYDEFS oObject._ParentType = OBJDATABASE oObject._ParentName = "" Set oObject._ParentDatabase = _This oObject._Count = UBound(sObjects) + 1 Goto Exit_Function Case VarType(pvIndex) = vbString bFound = False For i = 0 To UBound(sObjects) If UCase(pvIndex) = UCase(sObjects(i)) Then sObjectName = sObjects(i) bFound = True Exit For End If Next i If Not bFound Then Goto Trace_NotFound Case Else If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError sObjectName = sObjects(pvIndex) End Select
Set oObject = New DataDef oObject._Type = OBJQUERYDEF oObject._Name = sObjectName Set oObject._ParentDatabase = _This oObject._readOnly = _ReadOnly Set oObject.Query = oQueries.getByName(sObjectName)
Exit_Function: Set QueryDefs = oObject Set oObject = Nothing Utils._ResetCalledSub("Database.QueryDefs") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Database.QueryDefs", Erl) GoTo Exit_Function Trace_NotFound: If Not pbCheck Then TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("QUERY"), pvIndex)) Goto Exit_Function Trace_IndexError: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
Database |
Recordsets |
Basic |
|
47 |
Public Function Recordsets(ByVal Optional pvIndex As Variant) As Object
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Database.Recordsets")
Set Recordsets = Nothing If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End If Dim sObjects() As String, sObjectName As String, oObject As Object Dim i As Integer, bFound As Boolean, oTables As Object
Select Case True Case IsMissing(pvIndex) Set oObject = New Collect oObject._CollType = COLLRECORDSETS oObject._ParentType = OBJDATABASE oObject._ParentName = "" Set oObject._ParentDatabase = _This oObject._Count = RecordsetsColl.Count Case VarType(pvIndex) = vbString bFound = _hasRecordset(pvIndex) If Not bFound Then Goto Trace_NotFound Set oObject = RecordsetsColl.Item(pvIndex) Case Else If pvIndex < 0 Or pvIndex >= RecordsetsColl.Count Then Goto Trace_IndexError Set oObject = RecordsetsColl.Item(pvIndex + 1) End Select
Exit_Function: Set Recordsets = oObject Set oObject = Nothing Utils._ResetCalledSub("Database.Recordsets") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Database.Recordsets", Erl) GoTo Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("RECORDSET"), pvIndex)) Goto Exit_Function Trace_IndexError: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
Database |
RunSQL |
Basic |
|
40 |
Public Function RunSQL(Optional ByVal pvSQL As Variant _ , Optional ByVal pvOption As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "Database.RunSQL" Utils._SetCalledSub(cstThisSub) RunSQL = False If IsMissing(pvSQL) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function Const cstNull = -1 If IsMissing(pvOption) Then pvOption = cstNull Else If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function End If
Dim oStatement As Object, vResult As Variant Set oStatement = Connection.createStatement() oStatement.EscapeProcessing = Not ( pvOption = dbSQLPassThrough ) On Local Error Goto SQL_Error vResult = oStatement.execute(_ReplaceSquareBrackets(pvSQL)) On Local Error Goto Error_Function RunSQL = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function SQL_Error: TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , pvSQL) Goto Exit_Function End Function |
Access2BaseDev |
Database |
TableDefs |
Basic |
OutputTo (Procedure) |
71 |
Public Function TableDefs(ByVal Optional pvIndex As Variant, ByVal Optional pbCheck As Boolean) As Object
Const cstThisSub = "Database.TableDefs" If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub(cstThisSub) If IsMissing(pbCheck) Then pbCheck = False
Dim sObjects() As String, sObjectName As String, oObject As Object Dim i As Integer, bFound As Boolean, oTables As Object Set oObject = Nothing If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End If Set oTables = Connection.getTables sObjects = oTables.ElementNames() Select Case True Case IsMissing(pvIndex) Set oObject = New Collect oObject._CollType = COLLTABLEDEFS oObject._ParentType = OBJDATABASE oObject._ParentName = "" Set oObject._ParentDatabase = _This oObject._Count = UBound(sObjects) + 1 Goto Exit_Function Case VarType(pvIndex) = vbString bFound = False For i = 0 To UBound(sObjects) If UCase(pvIndex) = UCase(sObjects(i)) Then sObjectName = sObjects(i) bFound = True Exit For End If Next i If Not bFound Then Goto Trace_NotFound Case Else If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError sObjectName = sObjects(pvIndex) End Select
Set oObject = New DataDef With oObject ._Type = OBJTABLEDEF ._Name = sObjectName Set ._ParentDatabase = _This ._ReadOnly = _ReadOnly Set .Table = oTables.getByName(sObjectName) .CatalogName = .Table.CatalogName .SchemaName = .Table.SchemaName .TableName = .Table.Name End With
Exit_Function: Set TableDefs = oObject Set oObject = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Trace_NotFound: If Not pbCheck Then TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("TABLE"), pvIndex)) Goto Exit_Function Trace_IndexError: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
Database |
Version |
Basic |
|
4 |
Property Get Version() As String Version = _PropertyGet("Version") End Property |
Access2BaseDev |
DataDef |
_PropertiesList |
Basic |
hasProperty (Procedure) Properties (Procedure) |
12 |
Private Function _PropertiesList() As Variant
Select Case _Type Case OBJTABLEDEF _PropertiesList = Array("Name", "ObjectType") Case OBJQUERYDEF _PropertiesList = Array("Name", "ObjectType", "SQL", "Type") Case Else End Select
End Function |
Access2BaseDev |
DataDef |
_PropertyGet |
Basic |
Name (Procedure) ObjectType (Procedure) SQL (Procedure) pType (Procedure) getProperty (Procedure) Properties (Procedure) |
57 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) Utils._SetCalledSub(cstThisSub & ".get" & psProperty) Dim sSql As String, sVerb As String, iType As Integer _PropertyGet = EMPTY If Not hasProperty(psProperty) Then Goto Trace_Error Select Case UCase(psProperty) Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("SQL") _PropertyGet = Query.Command Case UCase("Type") iType = 0 sSql = Utils._Trim(UCase(Query.Command)) sVerb = Split(sSql, " ")(0) If sVerb = "SELECT" Then iType = iType + dbQSelect If sVerb = "SELECT" And InStr(sSql, " INTO ") > 0 _ Or sVerb = "CREATE" And InStr(sSql, " TABLE ") > 0 _ Then iType = iType + dbQMakeTable If sVerb = "SELECT" And InStr(sSql, " UNION ") > 0 Then iType = iType + dbQSetOperation If Not Query.EscapeProcessing Then iType = iType + dbQSQLPassThrough If sVerb = "INSERT" Then iType = iType + dbQAppend If sVerb = "DELETE" Then iType = iType + dbQDelete If sVerb = "UPDATE" Then iType = iType + dbQUpdate If sVerb = "CREATE" _ Or sVerb = "ALTER" _ Or sVerb = "DROP" _ Or sVerb = "RENAME" _ Or sVerb = "TRUNCATE" _ Then iType = iType + dbQDDL _PropertyGet = iType Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub(cstThisSub & ".get" & psProperty) Exit Function Trace_Error: TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertyGet = EMPTY Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub & "._PropertyGet", Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function |
Access2BaseDev |
DataDef |
_PropertySet |
Basic |
SQL (Procedure) setProperty (Procedure) |
50 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) Utils._SetCalledSub(cstThisSub & ".set" & psProperty)
Dim iArgNr As Integer
_PropertySet = True Select Case UCase(_A2B_.CalledSub) Case UCase("setProperty") : iArgNr = 3 Case UCase(cstThisSub & ".setProperty") : iArgNr = 2 Case UCase(cstThisSub & ".set" & psProperty) : iArgNr = 1 End Select If Not hasProperty(psProperty) Then Goto Trace_Error If _ReadOnly Then Goto Error_NoUpdate
Select Case UCase(psProperty) Case UCase("SQL") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value Query.Command = pvValue Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub(cstThisSub & ".set" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Error_NoUpdate: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub & "._PropertySet", Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
DataDef |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
17 |
Private Sub Class_Initialize() _Type = "" _Name = "" Set _ParentDatabase = Nothing _ReadOnly = False Set Table = Nothing CatalogName = "" SchemaName = "" TableName = "" Set Query = Nothing Set TableDescriptor = Nothing TableFieldsCount = 0 TableKeysCount = 0 End Sub |
Access2BaseDev |
DataDef |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
DataDef |
CreateField |
Basic |
|
116 |
Public Function CreateField(ByVal Optional pvFieldName As Variant _ , ByVal optional pvType As Variant _ , ByVal optional pvSize As Variant _ , ByVal optional pvAttributes As variant _ ) As Object Const cstThisSub = "TableDef.CreateField" Utils._SetCalledSub(cstThisSub)
If _ErrorHandler() Then On Local Error Goto Error_Function
Dim oTable As Object, oNewField As Object, oKeys As Object, oPrimaryKey As Object, oColumn As Object Const cstMaxKeyLength = 30
CreateField = Nothing If _ParentDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable If IsMissing(pvFieldName) Then Call _TraceArguments() If Not Utils._CheckArgument(pvFieldName, 1, vbString) Then Goto Exit_Function If pvFieldName = "" Then Call _TraceArguments() If IsMissing(pvType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric( _ dbInteger, dbLong, dbBigInt, dbFloat, vbSingle, dbDouble _ , dbNumeric, dbDecimal, dbText, dbChar, dbMemo _ , dbDate, dbTime, dbTimeStamp _ , dbBinary, dbVarBinary, dbLongBinary, dbBoolean _ )) Then Goto Exit_Function If IsMissing(pvSize) Then pvSize = 0 If pvSize < 0 Then pvSize = 0 If Not Utils._CheckArgument(pvSize, 1, Utils._AddNumeric()) Then Goto Exit_Function If IsMissing(pvAttributes) Then pvAttributes = 0 If Not Utils._CheckArgument(pvAttributes, 1, Utils._AddNumeric(), Array(0, dbAutoIncrField)) Then Goto Exit_Function
If _Type <> OBJTABLEDEF Then Goto Error_NotApplicable If IsNull(Table) And IsNull(TableDescriptor) Then Goto Error_NotApplicable If _ReadOnly Then Goto Error_NoUpdate
Set oNewField = New Field With oNewField ._Name = pvFieldName ._ParentName = _Name ._ParentType = OBJTABLEDEF If IsNull(Table) Then Set oTable = TableDescriptor Else Set oTable = Table Set .Column = oTable.Columns.createDataDescriptor() End With With oNewField.Column .Name = pvFieldName Select Case pvType Case dbInteger : .Type = com.sun.star.sdbc.DataType.TINYINT Case dbLong : .Type = com.sun.star.sdbc.DataType.INTEGER Case dbBigInt : .Type = com.sun.star.sdbc.DataType.BIGINT Case dbFloat : .Type = com.sun.star.sdbc.DataType.FLOAT Case dbSingle : .Type = com.sun.star.sdbc.DataType.REAL Case dbDouble : .Type = com.sun.star.sdbc.DataType.DOUBLE Case dbNumeric, dbCurrency : .Type = com.sun.star.sdbc.DataType.NUMERIC Case dbDecimal : .Type = com.sun.star.sdbc.DataType.DECIMAL Case dbText : .Type = com.sun.star.sdbc.DataType.CHAR Case dbChar : .Type = com.sun.star.sdbc.DataType.VARCHAR Case dbMemo : .Type = com.sun.star.sdbc.DataType.LONGVARCHAR Case dbDate : .Type = com.sun.star.sdbc.DataType.DATE Case dbTime : .Type = com.sun.star.sdbc.DataType.TIME Case dbTimeStamp : .Type = com.sun.star.sdbc.DataType.TIMESTAMP Case dbBinary : .Type = com.sun.star.sdbc.DataType.BINARY Case dbVarBinary : .Type = com.sun.star.sdbc.DataType.VARBINARY Case dbLongBinary : .Type = com.sun.star.sdbc.DataType.LONGVARBINARY Case dbBoolean : .Type = com.sun.star.sdbc.DataType.BOOLEAN End Select .Precision = Int(pvSize) If pvType = dbNumeric Or pvType = dbDecimal Or pvType = dbCurrency Then .Scale = Int(pvSize * 10) - Int(pvSize) * 10 .IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE If Utils._hasUNOProperty(oNewField.Column, "CatalogName") Then .CatalogName = CatalogName If Utils._hasUNOProperty(oNewField.Column, "SchemaName") Then .SchemaName = SchemaName If Utils._hasUNOProperty(oNewField.Column, "TableName") Then .TableName = TableName If Not IsNull(TableDescriptor) Then TableFieldsCount = TableFieldsCount + 1 If pvAttributes = dbAutoIncrField Then If Not IsNull(Table) Then Goto Error_Sequence Set oKeys = oTable.Keys Set oPrimaryKey = oKeys.createDataDescriptor() Set oColumn = oPrimaryKey.Columns.createDataDescriptor() oColumn.Name = pvFieldName oColumn.CatalogName = CatalogName oColumn.SchemaName = SchemaName oColumn.TableName = TableName oColumn.IsAutoIncrement = True oColumn.IsNullable = com.sun.star.sdbc.ColumnValue.NO_NULLS oPrimaryKey.Columns.appendByDescriptor(oColumn) oPrimaryKey.Name = Left("PK_" & Join(Split(TableName, " "), "_") & "_" & Join(Split(pvFieldName, " "), "_"), cstMaxKeyLength) oPrimaryKey.Type = com.sun.star.sdbcx.KeyType.PRIMARY oKeys.appendByDescriptor(oPrimaryKey) .IsAutoIncrement = True .IsNullable = com.sun.star.sdbc.ColumnValue.NO_NULLS oColumn.dispose() Else .IsAutoIncrement = False End If End With oTable.Columns.appendByDescriptor(oNewfield.Column) Set CreateField = oNewField
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_Sequence: TraceError(TRACEFATAL, ERRFIELDCREATION, Utils._CalledSub(), 0, 1, pvFieldName) Goto Exit_Function Error_NoUpdate: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
DataDef |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
DataDef |
Execute |
Basic |
|
50 |
Public Function Execute(ByVal Optional pvOptions As Variant) As Boolean
Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) & ".Execute" Utils._SetCalledSub(cstThisSub) On Local Error Goto Error_Function Const cstNull = -1 Execute = False If _Type <> OBJQUERYDEF Then Goto Trace_Method If IsMissing(pvOptions) Then pvOptions = cstNull Else If Not Utils._CheckArgument(pvOptions, 1, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function End If Dim oStatement As Object, vResult As Variant Dim iType As Integer, sSql As String iType = pType If ( (iType And DBQAction) = 0 ) And ( (iType And DBQDDL) = 0 ) Then Goto Trace_Action
Set oStatement = _ParentDatabase.Connection.createStatement() sSql = Query.Command If pvOptions = dbSQLPassThrough Then oStatement.EscapeProcessing = False _ Else oStatement.EscapeProcessing = Query.EscapeProcessing On Local Error Goto SQL_Error vResult = oStatement.executeUpdate(_ParentDatabase._ReplaceSquareBrackets(sSql)) On Local Error Goto Error_Function Execute = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Method: TraceError(TRACEFATAL, ERRMETHOD, cstThisSub, 0, , cstThisSub) Goto Exit_Function Trace_Action: TraceError(TRACEFATAL, ERRNOTACTIONQUERY, cstThisSub, 0, , _Name) Goto Exit_Function SQL_Error: TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , sSql) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DataDef |
Fields |
Basic |
|
65 |
Public Function Fields(ByVal Optional pvIndex As variant) As Object
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) & ".Fields" Utils._SetCalledSub(cstThisSub)
Set Fields = Nothing If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End If Dim sObjects() As String, sObjectName As String, oObject As Object Dim i As Integer, bFound As Boolean, oFields As Object
If _Type = OBJTABLEDEF Then Set oFields = Table.getColumns() Else Set oFields = Query.getColumns() sObjects = oFields.ElementNames() Select Case True Case IsMissing(pvIndex) Set oObject = New Collect oObject._CollType = COLLFIELDS oObject._ParentType = _Type oObject._ParentName = _Name Set oObject._ParentDatabase = _ParentDatabase oObject._Count = UBound(sObjects) + 1 Goto Exit_Function Case VarType(pvIndex) = vbString bFound = False For i = 0 To UBound(sObjects) If UCase(pvIndex) = UCase(sObjects(i)) Then sObjectName = sObjects(i) bFound = True Exit For End If Next i If Not bFound Then Goto Trace_NotFound Case Else If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError sObjectName = sObjects(pvIndex) End Select
Set oObject = New Field oObject._Name = sObjectName Set oObject.Column = oFields.getByName(sObjectName) oObject._ParentName = _Name oObject._ParentType = _Type Set oObject._ParentDatabase = _ParentDatabase
Exit_Function: Set Fields = oObject Set oObject = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("FIELD"), pvIndex)) Goto Exit_Function Trace_IndexError: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
DataDef |
getProperty |
Basic |
|
12 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) & ".getProperty" Utils._SetCalledSub(cstThisSub) If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
DataDef |
hasProperty |
Basic |
_PropertyGet (Procedure) _PropertySet (Procedure) |
12 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) & ".hasProperty" Utils._SetCalledSub(cstThisSub) If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
DataDef |
Name |
Basic |
|
3 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
DataDef |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
DataDef |
OpenRecordset |
Basic |
|
68 |
Public Function OpenRecordset(ByVal Optional pvType As Variant, ByVal Optional pvOptions As Variant, ByVal Optional pvLockEdit As Variant) As Object
Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) & ".OpenRecordset" Utils._SetCalledSub(cstThisSub) Const cstNull = -1 Dim lCommandType As Long, sCommand As String, oObject As Object,bPassThrough As Boolean
Set oObject = Nothing If IsMissing(pvType) Then pvType = cstNull Else If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric(), dbOpenForwardOnly) Then Goto Exit_Function End If If IsMissing(pvOptions) Then pvOptions = cstNull Else If Not Utils._CheckArgument(pvOptions, 2, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function End If If IsMissing(pvLockEdit) Then pvLockEdit = cstNull Else If Not Utils._CheckArgument(pvLockEdit, 3, Utils._AddNumeric(), dbReadOnly) Then Goto Exit_Function End If
Select Case _Type Case OBJTABLEDEF lCommandType = com.sun.star.sdb.CommandType.TABLE sCommand = _Name Case OBJQUERYDEF lCommandType = com.sun.star.sdb.CommandType.QUERY sCommand = _Name If pvOptions = dbSQLPassThrough Then bPassThrough = True Else bPassThrough = Not Query.EscapeProcessing End Select Set oObject = New Recordset With oObject ._CommandType = lCommandType ._Command = sCommand ._ParentName = _Name ._ParentType = _Type ._ForwardOnly = ( pvType = dbOpenForwardOnly ) ._PassThrough = bPassThrough ._ReadOnly = ( (pvLockEdit = dbReadOnly) Or _ReadOnly ) Set ._ParentDatabase = _ParentDatabase Set ._This = oObject Call ._Initialize() End With With _ParentDatabase .RecordsetMax = .RecordsetMax + 1 oObject._Name = Format(.RecordsetMax, "0000000") .RecordsetsColl.Add(oObject, UCase(oObject._Name)) End With If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst() Exit_Function: Set OpenRecordset = oObject Set oObject = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) Set oObject = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
DataDef |
Properties |
Basic |
|
25 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) & ".Properties" Utils._SetCalledSub(cstThisSub) vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Set vProperty._ParentDatabase = _ParentDatabase Exit_Function: Set Properties = vProperty Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
DataDef |
pType |
Basic |
Execute (Procedure) |
4 |
Public Function pType() As Integer pType = _PropertyGet("Type") End Function |
Access2BaseDev |
DataDef |
setProperty |
Basic |
|
9 |
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) & ".getProperty" Utils._SetCalledSub(cstThisSub) setProperty = _PropertySet(psProperty, pvValue) Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
DataDef |
SQL |
Basic |
|
7 |
Property Get SQL() As Variant SQL = _PropertyGet("SQL") End Property
Property Let SQL(ByVal pvValue As Variant) Call _PropertySet("SQL", pvValue) End Property |
Access2BaseDev |
Dialog |
_GetListener |
Basic |
_PropertyGet (Procedure) _PropertySet (Procedure) |
16 |
Private Function _GetListener(ByVal psProperty As String) As String
Select Case UCase(psProperty) Case UCase("OnFocusGained"), UCase("OnFocusLost") _GetListener = "XFocusListener" Case UCase("OnKeyPressed"), UCase("OnKeyReleased") _GetListener = "XKeyListener" Case UCase("OnMouseDragged"), UCase("OnMouseMoved") _GetListener = "XMouseMotionListener" Case UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMousePressed"), UCase("OnMouseReleased") _GetListener = "XMouseListener" End Select End Function |
Access2BaseDev |
Dialog |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
15 |
Private Function _PropertiesList() As Variant
If IsLoaded Then _PropertiesList = Array("Caption", "Height", "IsLoaded", "Name" _ , "OnFocusGained", "OnFocusLost", "OnKeyPressed", "OnKeyReleased", "OnMouseDragged" _ , "OnMouseEntered", "OnMouseExited", "OnMouseMoved", "OnMousePressed", "OnMouseReleased" _ , "ObjectType", "Page", "Visible", "Width" _ ) Else _PropertiesList = Array("IsLoaded", "Name" _ ) End If End Function |
Access2BaseDev |
Dialog |
_PropertyGet |
Basic |
Caption (Procedure) Height (Procedure) IsLoaded (Procedure) Name (Procedure) pName (Procedure) ObjectType (Procedure) OnFocusGained (Procedure) OnFocusLost (Procedure) OnKeyPressed (Procedure) OnKeyReleased (Procedure) OnMouseDragged (Procedure) OnMouseEntered (Procedure) OnMouseExited (Procedure) OnMouseMoved (Procedure) OnMousePressed (Procedure) OnMouseReleased (Procedure) Page (Procedure) Properties (Procedure) Visible (Procedure) Width (Procedure) getProperty (Procedure) |
64 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Dialog.get" & psProperty)
Dim oDialogEvents As Object, sEventName As String
_PropertyGet = EMPTY
Select Case UCase(psProperty) Case UCase("Name"), UCase("IsLoaded") Case Else If IsNull(UnoDialog) Then Goto Trace_Error_Dialog End Select Select Case UCase(psProperty) Case UCase("Caption") _PropertyGet = UnoDialog.getTitle() Case UCase("Height") _PropertyGet = UnoDialog.getPosSize().Height Case UCase("IsLoaded") _PropertyGet = _A2B_.hasItem(COLLALLDIALOGS, _Name) Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _ , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ , UCase("OnMousePressed"), UCase("OnMouseReleased") Set oDialogEvents = unoDialog.Model.getEvents() sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & Utils._GetEventName(psProperty) If oDialogEvents.hasByName(sEventName) Then _PropertyGet = oDialogEvents.getByName(sEventName).ScriptCode Else _PropertyGet = "" End If Case UCase("Page") _PropertyGet = UnoDialog.Model.Step Case UCase("Visible") _PropertyGet = UnoDialog.IsVisible() Case UCase("Width") _PropertyGet = UnoDialog.getPosSize().Width Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("Dialog.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = EMPTY Goto Exit_Function Trace_Error_Dialog: TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name) _PropertyGet = EMPTY Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Dialog._PropertyGet", Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function |
Access2BaseDev |
Dialog |
_PropertySet |
Basic |
Caption (Procedure) Height (Procedure) OnFocusGained (Procedure) OnFocusLost (Procedure) OnKeyPressed (Procedure) OnKeyReleased (Procedure) OnMouseDragged (Procedure) OnMouseEntered (Procedure) OnMouseExited (Procedure) OnMouseMoved (Procedure) OnMousePressed (Procedure) OnMouseReleased (Procedure) Page (Procedure) Visible (Procedure) Width (Procedure) setProperty (Procedure) |
64 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
Utils._SetCalledSub("Dialog.set" & psProperty) If _ErrorHandler() Then On Local Error Goto Error_Function _PropertySet = True
Dim oDialogEvents As Object, sEventName As String, oEvent As Object, sListener As String, sEvent As String
Dim iArgNr As Integer
If _IsLeft(_A2B_.CalledSub, "Dialog.") Then iArgNr = 1 Else iArgNr = 2 If IsNull(UnoDialog) Then Goto Trace_Error_Dialog Select Case UCase(psProperty) Case UCase("Caption") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value UnoDialog.setTitle(pvValue) Case UCase("Height") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value UnoDialog.setPosSize(0, 0, 0, pvValue, com.sun.star.awt.PosSize.HEIGHT) Case UCase("OnFocusGained"), UCase("OnFocusLost"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _ , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _ , UCase("OnMousePressed"), UCase("OnMouseReleased") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Not Utils._RegisterDialogEventScript(UnoDialog.Model _ , psProperty _ , _GetListener(psProperty) _ , pvValue _ ) Then GoTo Trace_Error_Dialog Case UCase("Page") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 0 Then Goto Trace_Error_Value UnoDialog.Model.Step = pvValue Case UCase("Visible") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value UnoDialog.setVisible(pvValue) Case UCase("Width") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric()) Then Goto Trace_Error_Value UnoDialog.setPosSize(0, 0, pvValue, 0, com.sun.star.awt.PosSize.WIDTH) Case Else Goto Trace_Error End Select
Exit_Function: Utils._ResetCalledSub("Dialog.set" & psProperty) Exit Function Trace_Error_Dialog: TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name) _PropertySet = False Goto Exit_Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Dialog._PropertySet", Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
Dialog |
Caption |
Basic |
|
10 |
Property Get Caption() As Variant Caption = _PropertyGet("Caption") End Property
Property Let Caption(ByVal pvValue As Variant) Call _PropertySet("Caption", pvValue) End Property |
Access2BaseDev |
Dialog |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
11 |
Private Sub Class_Initialize() _Type = OBJDIALOG _Name = "" Set _Dialog = Nothing _Storage = "" _Library = "" Set UnoDialog = Nothing End Sub |
Access2BaseDev |
Dialog |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
Dialog |
Controls |
Basic |
OptionGroup (Procedure) |
80 |
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Dialog.Controls")
Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String Dim j As Integer
Set ocControl = Nothing If Not IsLoaded Then Goto Trace_Error_NotOpen Set ocControl = New Control ocControl._ParentType = CTLPARENTISDIALOG sParentShortcut = _Shortcut sControls() = UnoDialog.Model.getElementNames() iControlCount = UBound(sControls) + 1 If IsMissing(pvIndex) Then Set oCounter = New Collect oCounter._CollType = COLLCONTROLS oCounter._Count = iControlCount Set Controls = oCounter Goto Exit_Function End If If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function Select Case VarType(pvIndex) Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index ocControl._Name = sControls(pvIndex) Case vbString bFound = False sIndex = UCase(Utils._Trim(pvIndex)) For i = 0 To iControlCount - 1 If UCase(sControls(i)) = sIndex Then bFound = True Exit For End If Next i If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound End Select
ocControl._Shortcut = sParentShortcut & "!" & Utils._Surround(ocControl._Name) Set ocControl.ControlModel = UnoDialog.Model.getByName(ocControl._Name) Set ocControl.ControlView = UnoDialog.getControl(ocControl._Name) ocControl._ImplementationName = ocControl.ControlModel.getImplementationName() ocControl._FormComponent = UnoDialog
ocControl._Initialize() Set Controls = ocControl Exit_Function: Utils._ResetCalledSub("Dialog.Controls") Exit Function Trace_Error: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(iArg, pvIndex)) Set Controls = Nothing Goto Exit_Function Trace_Error_NotOpen: TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, , _Name) Set Controls = Nothing Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set Controls = Nothing Goto Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, pvIndex)) Set Controls = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Dialog.Controls", Erl) Set Controls = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
Dialog |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
Dialog |
EndExecute |
Basic |
|
32 |
Public Sub EndExecute(ByVal Optional pvReturn As Variant)
If _ErrorHandler() Then On Local Error Goto Error_Sub Utils._SetCalledSub("Dialog.endExecute")
If IsMissing(pvReturn) Then pvReturn = 0 If Not Utils._CheckArgument(pvReturn, 1, Utils._AddNumeric(), , False) Then Goto Trace_Error Dim lExecute As Long lExecute = CLng(pvReturn) If IsNull(_Dialog) Then Goto Error_Execute If IsNull(UnoDialog) Then Goto Error_Not_Started Call UnoDialog.endDialog(lExecute)
Exit_Sub: Utils._ResetCalledSub("Dialog.endExecute") Exit Sub Trace_Error: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array("1", Utils._CStr(pvReturn))) Goto Exit_Sub Error_Execute: TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0) Goto Exit_Sub Error_Not_Started: TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name) Goto Exit_Sub Error_Sub: TraceError(TRACEABORT, Err, "Dialog.endExecute", Erl) GoTo Exit_Sub End Sub |
Access2BaseDev |
Dialog |
Execute |
Basic |
|
32 |
Public Function Execute() As Long
Utils._SetCalledSub("Dialog.Execute")
Dim lExecute As Long If IsNull(_Dialog) Then Goto Error_Execute If IsNull(UnoDialog) Then Goto Error_Not_Started lExecute = UnoDialog.execute()
Select Case lExecute Case 1 : Execute = dlgOK Case 0 : Execute = dlgCancel Case Else : Execute = lExecute End Select
Exit_Function: Utils._ResetCalledSub("Dialog.Execute") Exit Function Error_Execute: TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0) Goto Exit_Function Error_Not_Started: TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Dialog.Execute", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Dialog |
getProperty |
Basic |
|
10 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("Dialog.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("Dialog.getProperty") End Function |
Access2BaseDev |
Dialog |
hasProperty |
Basic |
|
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
Dialog |
Height |
Basic |
|
7 |
Property Get Height() As Variant Height = _PropertyGet("Height") End Property
Property Let Height(ByVal pvValue As Variant) Call _PropertySet("Height", pvValue) End Property |
Access2BaseDev |
Dialog |
IsLoaded |
Basic |
|
4 |
Property Get IsLoaded() As Boolean IsLoaded = _PropertyGet("IsLoaded") End Property |
Access2BaseDev |
Dialog |
Move |
Basic |
|
57 |
Public Function Move( ByVal Optional pvLeft As Variant _ , ByVal Optional pvTop As Variant _ , ByVal Optional pvWidth As Variant _ , ByVal Optional pvHeight As Variant _ ) As Variant Utils._SetCalledSub("Dialog.Move") If IsMissing(pvLeft) Then Call _TraceArguments() On Local Error Goto Error_Function Move = False Dim iArgNr As Integer Select Case UCase(_A2B_.CalledSub) Case UCase("Move") : iArgNr = 1 Case UCase("Dialog.Move") : iArgNr = 0 End Select If IsMissing(pvLeft) Then Call _TraceArguments() If IsMissing(pvTop) Then pvTop = -1 If IsMissing(pvWidth) Then pvWidth = -1 If IsMissing(pvHeight) Then pvHeight = -1 If Not Utils._CheckArgument(pvLeft, iArgNr + 1, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvTop, iArgNr + 2, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvWidth, iArgNr + 3, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvHeight, iArgNr + 4, Utils._AddNumeric()) Then Goto Exit_Function Dim iArg As Integer, iWrong As Integer iArg = 0 If pvHeight < -1 Then iArg = 4 : iWrong = pvHeight ElseIf pvWidth < -1 Then iArg = 3 : iWrong = pvWidth ElseIf pvTop < -1 Then iArg = 2 : iWrong = pvTop ElseIf pvLeft < -1 Then iArg = 1 : iWrong = pvLeft End If If iArg > 0 Then TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(iArgNr + iArg, iWrong)) Goto Exit_Function End If Dim iPosSize As Integer iPosSize = 0 If pvLeft >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X If pvTop >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y If pvWidth > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH If pvHeight > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT If iPosSize > 0 Then UnoDialog.setPosSize(pvLeft, pvTop, pvWidth, pvHeight, iPosSize) Move = True Exit_Function: Utils._ResetCalledSub("Dialog.Move") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Dialog.Move", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Dialog |
Name |
Basic |
|
4 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
Dialog |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
Dialog |
OnFocusGained |
Basic |
|
7 |
Property Get OnFocusGained() As Variant OnFocusGained = _PropertyGet("OnFocusGained") End Property
Property Let OnFocusGained(ByVal pvValue As Variant) Call _PropertySet("OnFocusGained", pvValue) End Property |
Access2BaseDev |
Dialog |
OnFocusLost |
Basic |
|
7 |
Property Get OnFocusLost() As Variant OnFocusLost = _PropertyGet("OnFocusLost") End Property
Property Let OnFocusLost(ByVal pvValue As Variant) Call _PropertySet("OnFocusLost", pvValue) End Property |
Access2BaseDev |
Dialog |
OnKeyPressed |
Basic |
|
7 |
Property Get OnKeyPressed() As Variant OnKeyPressed = _PropertyGet("OnKeyPressed") End Property
Property Let OnKeyPressed(ByVal pvValue As Variant) Call _PropertySet("OnKeyPressed", pvValue) End Property |
Access2BaseDev |
Dialog |
OnKeyReleased |
Basic |
|
7 |
Property Get OnKeyReleased() As Variant OnKeyReleased = _PropertyGet("OnKeyReleased") End Property
Property Let OnKeyReleased(ByVal pvValue As Variant) Call _PropertySet("OnKeyReleased", pvValue) End Property |
Access2BaseDev |
Dialog |
OnMouseDragged |
Basic |
|
7 |
Property Get OnMouseDragged() As Variant OnMouseDragged = _PropertyGet("OnMouseDragged") End Property
Property Let OnMouseDragged(ByVal pvValue As Variant) Call _PropertySet("OnMouseDragged", pvValue) End Property |
Access2BaseDev |
Dialog |
OnMouseEntered |
Basic |
|
7 |
Property Get OnMouseEntered() As Variant OnMouseEntered = _PropertyGet("OnMouseEntered") End Property
Property Let OnMouseEntered(ByVal pvValue As Variant) Call _PropertySet("OnMouseEntered", pvValue) End Property |
Access2BaseDev |
Dialog |
OnMouseExited |
Basic |
|
7 |
Property Get OnMouseExited() As Variant OnMouseExited = _PropertyGet("OnMouseExited") End Property
Property Let OnMouseExited(ByVal pvValue As Variant) Call _PropertySet("OnMouseExited", pvValue) End Property |
Access2BaseDev |
Dialog |
OnMouseMoved |
Basic |
|
7 |
Property Get OnMouseMoved() As Variant OnMouseMoved = _PropertyGet("OnMouseMoved") End Property
Property Let OnMouseMoved(ByVal pvValue As Variant) Call _PropertySet("OnMouseMoved", pvValue) End Property |
Access2BaseDev |
Dialog |
OnMousePressed |
Basic |
|
7 |
Property Get OnMousePressed() As Variant OnMousePressed = _PropertyGet("OnMousePressed") End Property
Property Let OnMousePressed(ByVal pvValue As Variant) Call _PropertySet("OnMousePressed", pvValue) End Property |
Access2BaseDev |
Dialog |
OnMouseReleased |
Basic |
|
7 |
Property Get OnMouseReleased() As Variant OnMouseReleased = _PropertyGet("OnMouseReleased") End Property
Property Let OnMouseReleased(ByVal pvValue As Variant) Call _PropertySet("OnMouseReleased", pvValue) End Property |
Access2BaseDev |
Dialog |
OptionGroup |
Basic |
|
102 |
Public Function OptionGroup(ByVal Optional pvGroupName As Variant) As Variant
Utils._SetCalledSub("Dialog.OptionGroup") If IsMissing(pvGroupName) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function
Set OptionGroup = Nothing If Not Utils._CheckArgument(pvGroupName, 1, vbString) Then Goto Exit_Function
Dim iAllCount As Integer, iRadioLast As Integer, iGroupCount As Integer, iBegin As Integer, iEnd As Integer Dim oRadios() As Object, sGroupName As String Dim i As Integer, j As Integer, bFound As Boolean, ocControl As Object, oRadio As Object, iTabIndex As Integer Dim ogGroup As Object, vGroup() As Variant, vIndex() As Variant iAllCount = Controls.Count If iAllCount > 0 Then iRadioLast = -1 ReDim oRadios(0 To iAllCount - 1) For i = 0 To iAllCount - 1 Set ocControl = Controls(i) If ocControl._SubType = CTLRADIOBUTTON Then iRadioLast = iRadioLast + 1 Set oRadios(iRadioLast) = ocControl End If Next i Else Goto Error_Arg End If If iRadioLast < 0 then Goto Error_Arg If iRadioLast > 0 Then For i = 0 To iRadioLast - 1 For j = i + 1 To iRadioLast If oRadios(i).TabIndex > oRadios(j).TabIndex Then Set oRadio = oRadios(i) Set oRadios(i) = oRadios(j) Set oRadios(j) = oRadio End If Next j Next i End If bFound = False For i = 0 To iRadioLast If UCase(oRadios(i)._Name) = UCase(pvGroupName) Then Select Case i Case 0 : bFound = True Case Else If oRadios(i).TabIndex > oRadios(i - 1).TabIndex + 1 Then bFound = True Else Goto Error_Arg End If End Select If bFound Then iBegin = i iEnd = i sGroupName = oRadios(i)._Name End If ElseIf bFound Then If oRadios(i).TabIndex = oRadios(i - 1).TabIndex + 1 Then iEnd = i End If Next i
If bFound Then iGroupCount = iEnd - iBegin + 1 Set ogGroup = New OptionGroup ReDim vGroup(0 To iGroupCount - 1) ReDim vIndex(0 To iGroupCount - 1) With ogGroup ._Name = sGroupName ._Count = iGroupCount ._ButtonsGroup = vGroup ._ButtonsIndex = vIndex For i = 0 To iGroupCount - 1 Set ._ButtonsGroup(i) = oRadios(iBegin + i).ControlModel ._ButtonsIndex(i) = i Next i ._ParentType = CTLPARENTISDIALOG ._ParentComponent = UnoDialog End With Else Goto Error_Arg End If Set OptionGroup = ogGroup Exit_Function: Utils._ResetCalledSub("Dialog.OptionGroup") Exit Function Error_Arg: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvGroupName)) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Dialog.OptionGroup", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Dialog |
Page |
Basic |
|
7 |
Property Get Page() As Variant Page = _PropertyGet("Page") End Property
Property Let Page(ByVal pvValue As Variant) Call _PropertySet("Page", pvValue) End Property |
Access2BaseDev |
Dialog |
pName |
Basic |
|
3 |
Public Function pName() As String pName = _PropertyGet("Name") End Function |
Access2BaseDev |
Dialog |
Properties |
Basic |
|
25 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Const cstThisSub = "Dialog.Properties" Utils._SetCalledSub(cstThisSub)
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Dialog |
setProperty |
Basic |
|
7 |
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean Utils._SetCalledSub("Dialog.setProperty") setProperty = _PropertySet(psProperty, pvValue) Utils._ResetCalledSub("Dialog.setProperty") End Function |
Access2BaseDev |
Dialog |
Start |
Basic |
|
36 |
Public Function Start() As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Dialog.Start")
Dim oStart As Object Start = False If IsNull(_Dialog) Then Goto Error_Start If Not IsNull(UnoDialog) Then Goto Error_Yet_Started Set oStart = CreateUnoDialog(_Dialog) If IsNull(oStart) Then Goto Error_Start Else Start = True Set UnoDialog = oStart With _A2B_ If .hasItem(COLLALLDIALOGS, _Name) Then .Dialogs.Remove(_Name) .Dialogs.Add(UnoDialog, UCase(_Name)) End With End If
Exit_Function: Utils._ResetCalledSub("Dialog.Start") Exit Function Error_Start: TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0) Goto Exit_Function Error_Yet_Started: TraceError(TRACEWARNING, ERRDIALOGSTARTED, Utils._CalledSub(), 0) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Dialog.Start", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Dialog |
Terminate |
Basic |
|
28 |
Public Function Terminate() As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Dialog.Terminate")
Terminate = False If IsNull(_Dialog) Then Goto Error_Terminate If IsNull(UnoDialog) Then Goto Error_Not_Started UnoDialog.Dispose() Set UnoDialog = Nothing _A2B_.Dialogs.Remove(_Name) Terminate = True
Exit_Function: Utils._ResetCalledSub("Dialog.Terminate") Exit Function Error_Terminate: TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0) Goto Exit_Function Error_Not_Started: TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Dialog.Terminate", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Dialog |
Visible |
Basic |
|
7 |
Property Get Visible() As Variant Visible = _PropertyGet("Visible") End Property
Property Let Visible(ByVal pvValue As Variant) Call _PropertySet("Visible", pvValue) End Property |
Access2BaseDev |
Dialog |
Width |
Basic |
|
7 |
Property Get Width() As Variant Width = _PropertyGet("Width") End Property
Property Let Width(ByVal pvValue As Variant) Call _PropertySet("Width", pvValue) End Property |
Access2BaseDev |
DoCmd |
_CheckColumnType |
Basic |
FindRecord (Procedure) |
24 |
Private Function _CheckColumnType(pvFindWhat As Variant, vDataField As Variant) As Boolean
Dim bFound As Boolean bFound = False With com.sun.star.sdbc.DataType Select Case vDataField.Type Case .DATE, .TIME, .TIMESTAMP If VarType(pvFindWhat) = vbDate Then bFound = True Case .TINYINT, .SMALLINT, .INTEGER, .BIGINT, .FLOAT, .REAL, .DOUBLE, .NUMERIC, .DECIMAL If Utils._InList(VarType(pvFindWhat), Utils._AddNumeric()) Then bFound = True Case .CHAR, .VARCHAR, .LONGVARCHAR If VarType(pvFindWhat) = vbString Then bFound = True Case Else End Select End With
_CheckColumnType = bFound End Function |
Access2BaseDev |
DoCmd |
_ConvertDataDescriptor |
Basic |
CopyObject (Procedure) |
82 |
Sub _ConvertDataDescriptor( ByRef poSource As Object _ , ByVal piSourceRDBMS As Integer _ , ByRef poTarget As Object _ , ByRef poDatabase As Object _ , ByVal Optional pbKey As Boolean _ )
Dim vTypesReference() As Variant, vTypes() As Variant, vTypeNames() As Variant Dim i As Integer, iType As Integer, iTypeAlias As Integer Dim iNbTypes As Integer, iBestFit As Integer, lFitPrecision As Long, lPrecision As Long
On Local Error Goto Error_Sub If IsMissing(pbKey) Then pbKey = False
poTarget.Name = poSource.Name poTarget.Description = poSource.Description If Not pbKey Then poTarget.ControlDefault = poSource.ControlDefault poTarget.FormatKey = poSource.FormatKey poTarget.HelpText = poSource.HelpText poTarget.Hidden = poSource.Hidden End If poTarget.IsCurrency = poSource.IsCurrency poTarget.IsNullable = poSource.IsNullable poTarget.Scale = poSource.Scale If piSourceRDBMS = poDatabase._RDBMS Or poDatabase._RDBMS = DBMS_UNKNOWN Then poTarget.Type = poSource.Type poTarget.Precision = poSource.Precision poTarget.TypeName = poSource.TypeName Goto Exit_Sub End If
With poDatabase iType = -1 For i = 0 To UBound(._ColumnTypesReference) If ._ColumnTypesReference(i) = poSource.Type Then iType = i Exit For End If Next i If iType = -1 Then Goto Error_Compatibility iTypeAlias = ._ColumnTypesAlias(iType) iNbTypes = UBound(._ColumnTypes) iBestFit = -1 lFitPrecision = -2 For i = 0 To iNbTypes If ._ColumnTypes(i) = iTypeAlias Then lPrecision = ._ColumnPrecisions(i) If iBestFit = -1 _ Or (iBestFit > -1 And poSource.Precision > 0 And lPrecision >= poSource.Precision And lPrecision < lFitPrecision) _ Or (iBestFit > -1 And poSource.Precision = 0 And lPrecision > lFitPrecision) Then iBestFit = i lFitPrecision = lPrecision End If End If Next i If iBestFit = -1 Then Goto Error_Compatibility poTarget.Type = iTypeAlias poTarget.Precision = lFitPrecision poTarget.TypeName = ._ColumnTypeNames(iBestFit) End With
Exit_Sub: Exit Sub Error_Compatibility: TraceError(TRACEFATAL, ERRCOMPATIBILITY, Utils._CalledSub(), 0, 1, poSource.Name) Goto Exit_Sub Error_Sub: TraceError(TRACEABORT, Err, "_ConvertDataDescriptor", Erl) Goto Exit_Sub End Sub |
Access2BaseDev |
DoCmd |
_DatabaseForm |
Basic |
ApplyFilter (Procedure) GoToRecord (Procedure) SetOrderBy (Procedure) |
41 |
Private Function _DatabaseForm(psForm As String, psControl As String)
Dim oForm As Object, oControl As Object, sControls() As String, iControlCount As Integer Dim bFound As Boolean, i As Integer, sName As String
Set oForm = Application.Forms(psForm) If psControl <> "" Then With oForm.DatabaseForm iControlCount = .getCount() bFound = False If iControlCount > 0 Then sControls() = .getElementNames() sName = UCase(Utils._Trim(psControl)) For i = 0 To iControlCount - 1 If UCase(sControls(i)) = sName Then bFound = True Exit For End If Next i End If End With If bFound Then sName = sControls(i) Else Goto Trace_NotFound Set oControl = oForm.Controls(sName) If oControl._SubType <> CTLSUBFORM Then Goto Trace_SubFormNotFound Set _DatabaseForm = oControl.Form.DatabaseForm Else Set _DatabaseForm = oForm.DatabaseForm End If
Exit_Function: Exit Function Trace_NotFound: TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(psControl, psForm)) Goto Exit_Function Trace_SubFormNotFound: TraceError(TRACEFATAL, ERRSUBFORMNOTFOUND, Utils._CalledSub(), 0, , Array(psControl, psForm)) Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
_DispatchCommand |
Basic |
RunCommand (Procedure) |
13 |
Private Sub _DispatchCommand(ByVal psCommand As String) Dim oDocument As Object, oDispatcher As Object, oArgs() As new com.sun.star.beans.PropertyValue, sTargetFrameName As String Dim oResult As Variant Dim sCommand As String
Set oDocument = _SelectWindow().Frame Set oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper") sTargetFrameName = "" oResult = oDispatcher.executeDispatch(oDocument, psCommand, sTargetFrameName, 0, oArgs())
End Sub |
Access2BaseDev |
DoCmd |
_getUpperShortcut |
Basic |
FindRecord (Procedure) setFocus (Procedure) |
11 |
Public Function _getUpperShortcut(ByVal psShortcut As String, ByVal psLastComponent As String) As String
If Len(psShortcut) > Len(psLastComponent) Then _getUpperShortcut = Split(psShortcut, "!" & Utils._Surround(psLastComponent))(0) Else _getUpperShortcut = psShortcut End If End Function |
Access2BaseDev |
DoCmd |
_OpenObject |
Basic |
OpenQuery (Procedure) OpenReport (Procedure) OpenTable (Procedure) |
72 |
Private Function _OpenObject(ByVal psObjectType As String _ , ByVal pvObjectName As Variant _ , ByVal pvView As Variant _ , ByVal pvDataMode As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function
_OpenObject = False If Not (Utils._CheckArgument(pvObjectName, 1, vbString) _ And Utils._CheckArgument(pvView, 2, Utils._AddNumeric(), Array(acViewNormal, acViewPreview, acViewDesign)) _ And Utils._CheckArgument(pvDataMode, 3, Utils._AddNumeric(), Array(acEdit)) _ ) Then Goto Exit_Function Dim oDatabase As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable Dim sObjects() As String, sObjectName As String, oController As Object, oObject As Object Dim i As Integer, bFound As Boolean, lComponent As Long, oQuery As Object Select Case psObjectType Case "Table" sObjects = oDatabase.Connection.getTables.ElementNames() lComponent = com.sun.star.sdb.application.DatabaseObject.TABLE Case "Query" sObjects = oDatabase.Connection.getQueries.ElementNames() lComponent = com.sun.star.sdb.application.DatabaseObject.QUERY Case "Report" sObjects = oDatabase.Document.getReportDocuments.ElementNames() lComponent = com.sun.star.sdb.application.DatabaseObject.REPORT End Select bFound = False For i = 0 To UBound(sObjects) If UCase(pvObjectName) = UCase(sObjects(i)) Then sObjectName = sObjects(i) bFound = True Exit For End If Next i If Not bFound Then Goto Trace_NotFound
If psObjectType = "Query" Then Set oQuery = Application._CurrentDb().QueryDefs(pvObjectName) If oQuery.pType <> dbQSelect Then _OpenObject = oQuery.Execute() GoTo Exit_Function End If End If Set oController = oDatabase.Document.CurrentController Set oObject = oController.loadComponent(lComponent, sObjectName, ( pvView = acViewDesign )) _OpenObject = True
Exit_Function: Set oObject = Nothing Set oQuery = Nothing Set oController = Nothing Exit Function Error_Function: TraceError(TRACEABORT, Err, "OpenObject", Erl) GoTo Exit_Function Trace_Error: TraceError(TRACEFATAL, ERROPENOBJECT, Utils._CalledSub(), 0, , Array(_GetLabel(psObjectType), pvObjectName)) Goto Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1) Goto Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(psObjectType), pvObjectName)) Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
_PromptFormat |
Basic |
OutputTo (Procedure) SendObject (Procedure) OutputTo (Procedure) |
44 |
Private Function _PromptFormat(ByVal pvList As Variant) As String
Dim oDialog As Object, iOKCancel As Integer, oControl As Object
Set oDialog = CreateUnoDialog(Utils._GetDialogLib().dlgFormat) oDialog.Title = _GetLabel("DLGFORMAT_TITLE")
Set oControl = oDialog.Model.getByName("lblFormat") oControl.Label = _GetLabel("DLGFORMAT_LBLFORMAT_LABEL") oControl.HelpText = _GetLabel("DLGFORMAT_LBLFORMAT_HELP")
Set oControl = oDialog.Model.getByName("cboFormat") oControl.HelpText = _GetLabel("DLGFORMAT_LBLFORMAT_HELP")
Set oControl = oDialog.Model.getByName("cmdOK") oControl.Label = _GetLabel("DLGFORMAT_CMDOK_LABEL") oControl.HelpText = _GetLabel("DLGFORMAT_CMDOK_HELP")
Set oControl = oDialog.Model.getByName("cmdCancel") oControl.Label = _GetLabel("DLGFORMAT_CMDCANCEL_LABEL") oControl.HelpText = _GetLabel("DLGFORMAT_CMDCANCEL_HELP")
Set oControl = oDialog.Model.getByName("cboFormat") If UBound(pvList) >= 0 Then oControl.Text = pvList(0) oControl.StringItemList = pvList Else oControl.Text = "" oControl.StringItemList = Array() End If iOKCancel = oDialog.Execute() Select Case iOKCancel Case 1 _PromptFormat = oControl.Text Case 0 _PromptFormat = "" Case Else End Select oDialog.Dispose()
End Function |
Access2BaseDev |
DoCmd |
_SelectWindow |
Basic |
CommandBars (Procedure) _NewBar (Procedure) ApplyFilter (Procedure) GetHiddenAttribute (Procedure) GoToControl (Procedure) GoToRecord (Procedure) Maximize (Procedure) Minimize (Procedure) MoveSize (Procedure) OutputTo (Procedure) SelectObject (Procedure) SendObject (Procedure) SetHiddenAttribute (Procedure) SetOrderBy (Procedure) ShowAllrecords (Procedure) _DispatchCommand (Procedure) |
151 |
Public Function _SelectWindow(Optional ByVal piWindowType As Integer, Optional ByVal psWindow As String) As Object
Dim oEnum As Object, oDesk As Object, oComp As Object, oFrame As Object, i As Integer Dim bFound As Boolean, bActive As Boolean, sName As String, iType As Integer, sDocumentType As String Dim sImplementation As String, vLocation() As Variant Dim oWindow As _Window
If _ErrorHandler() Then On Local Error Goto Error_Function
bActive = IsMissing(piWindowType) If IsMissing(psWindow) Then psWindow = "" Set oWindow.Frame = Nothing oWindow.DocumentType = "" If bActive Then oWindow.WindowType = acDefault oWindow._Name = "" Else oWindow.WindowType = piWindowType Select Case piWindowType Case acBasicIDE, acDatabaseWindow : oWindow._Name = "" Case Else : oWindow._Name = psWindow End Select End If iType = acDefault sDocumentType = ""
Set oDesk = CreateUnoService("com.sun.star.frame.Desktop") Set oEnum = oDesk.Components().createEnumeration Do While oEnum.hasMoreElements Set oComp = oEnum.nextElement If Utils._hasUNOProperty(oComp, "ImplementationName") Then sImplementation = oComp.ImplementationName Else sImplementation = "" Select Case sImplementation Case "com.sun.star.comp.basic.BasicIDE" Set oFrame = oComp.CurrentController.Frame iType = acBasicIDE sName = "" Case "com.sun.star.comp.dba.ODatabaseDocument" Set oFrame = oComp.CurrentController.Frame iType = acDatabaseWindow sName = "" Case "SwXTextDocument" If HasUnoInterfaces(oComp, "com.sun.star.frame.XModule") Then Select Case oComp.Identifier Case "com.sun.star.sdb.FormDesign" iType = acForm Case "com.sun.star.sdb.TextReportDesign" iType = acReport Case "com.sun.star.text.TextDocument" vLocation = Split(oComp.getLocation(), "/") If UBound(vLocation) >= 0 Then sName = Join(Split(vLocation(UBound(vLocation)), "%20"), " ") Else sName = "" iType = acDocument sDocumentType = docWriter End Select If iType = acForm Or iType = acReport Then For i = 0 To UBound(oComp.Args()) If oComp.Args(i).Name = "DocumentTitle" Then sName = oComp.Args(i).Value Exit For End If Next i End If Set oFrame = oComp.CurrentController.Frame End If Case "org.openoffice.comp.dbu.ODatasourceBrowser" Set oFrame = oComp.Frame If Not IsEmpty(oComp.Selection) Then For i = 0 To UBound(oComp.Selection()) If oComp.Selection(i).Name = "Command" Then sName = oComp.Selection(i).Value ElseIf oComp.Selection(i).Name = "CommandType" Then Select Case oComp.selection(i).Value Case com.sun.star.sdb.CommandType.TABLE iType = acTable Case com.sun.star.sdb.CommandType.QUERY iType = acQuery Case com.sun.star.sdb.CommandType.COMMAND iType = acQuery End Select End If Next i End If Case "org.openoffice.comp.dbu.OTableDesign", "org.openoffice.comp.dbu.OQueryDesign" If Not bActive Then If UCase(Right(oComp.Title, Len(psWindow))) = UCase(psWindow) Then Set oFrame = oComp.Frame Select Case sImplementation Case "org.openoffice.comp.dbu.OTableDesign" : iType = acTable Case "org.openoffice.comp.dbu.OQueryDesign" : iType = acQuery End Select sName = Right(oComp.Title, Len(psWindow)) End If Else Set oFrame = Nothing End If Case "org.openoffice.comp.dbu.ORelationDesign" Set oFrame = oComp.Frame iType = acDiagram sName = "" Case "com.sun.star.comp.sfx2.BackingComp" Set oFrame = oComp.Frame iType = acWelcome sName = "" Case Else If Utils._hasUNOProperty(oComp, "Location") Then vLocation = Split(oComp.getLocation(), "/") If UBound(vLocation) >= 0 Then sName = Join(Split(vLocation(UBound(vLocation)), "%20"), " ") Else sName = "" iType = acDocument If Utils._hasUNOProperty(oComp, "Identifier") Then Select Case oComp.Identifier Case "com.sun.star.sheet.SpreadsheetDocument" : sDocumentType = docCalc Case "com.sun.star.presentation.PresentationDocument" : sDocumentType = docImpress Case "com.sun.star.drawing.DrawingDocument" : sDocumentType = docDraw Case "com.sun.star.formula.FormulaProperties" : sDocumentType = docMath Case Else : sDocumentType = "" End Select End If Set oFrame = oComp.CurrentController.Frame End If End Select If bActive And Not IsNull(oFrame) Then If oFrame.ContainerWindow.IsActive() Then bFound = True Exit Do End If ElseIf iType = piWindowType And UCase(sName) = UCase(psWindow) Then bFound = True Exit Do End If Loop If bFound Then Set oWindow.Frame = oFrame oWindow._Name = sName oWindow.WindowType = iType oWindow.DocumentType = sDocumentType Else Set oWindow.Frame = Nothing End If Exit_Function: Set _SelectWindow = oWindow Exit Function Error_Function: TraceError(TRACEABORT, Err, "SelectWindow", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
_SendWithAttachment |
Basic |
SendObject (Procedure) |
105 |
Private Function _SendWithAttachment( _ ByVal pvRecipients() As Variant _ , ByVal pvCcRecipients() As Variant _ , ByVal pvBccRecipients() As Variant _ , ByVal psSubject As String _ , ByVal pvAttachments() As Variant _ , ByVal pvBody As String _ , ByVal pbEditMessage As Boolean _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function _SendWithAttachment = False Const cstWindows = 1 Const cstLinux = 4 Const cstSemiColon = ";" Dim oServiceMail as Object, oMail As Object, oMessage As Object, vFlag As Variant Dim vCc() As Variant, i As Integer, iOS As Integer, sProduct As String, bMailProvider As Boolean
sProduct = UCase(Utils._GetProductName()) bMailProvider = ( Left(sProduct, 4) = "OPEN" And Left(_GetProductName("VERSION"), 3) >= "4.0" )
iOS = GetGuiType() Select Case iOS Case cstLinux oServiceMail = createUnoService("com.sun.star.system.SimpleCommandMail") Case cstWindows If bMailProvider Then oServiceMail = createUnoService("com.sun.star.system.SystemMailProvider") _ Else oServiceMail = createUnoService("com.sun.star.system.SimpleSystemMail") Case Else Goto Error_Mail End Select
If bMailProvider Then Set oMail = oServiceMail.queryMailClient() _ Else Set oMail = oServiceMail.querySimpleMailClient() If IsNull(oMail) Then Goto Error_Mail
If UBound(pvRecipients) <= 0 Then If UBound(pvCcRecipients) >= 0 Then vCc = pvCcRecipients Else ReDim vCc(0 To UBound(pvRecipients) - 1 + UBound(pvCcRecipients) + 1) For i = 0 To UBound(pvRecipients) - 1 vCc(i) = pvRecipients(i + 1) Next i For i = UBound(pvRecipients) To UBound(vCc) vCc(i) = pvCcRecipients(i - UBound(pvRecipients)) Next i End If
If bMailProvider Then Set oMessage = oMail.createMailMessage() If UBound(pvRecipients) >= 0 Then oMessage.Recipient = pvRecipients(0) If psSubject <> "" Then oMessage.Subject = psSubject Select Case iOS Case cstLinux If UBound(vCc) >= 0 Then oMessage.CcRecipient = Array(Join(vCc, cstSemiColon)) If UBound(pvBccRecipients) >= 0 Then oMessage.BccRecipient = Array(Join(pvBccRecipients, cstSemiColon)) Case cstWindows If UBound(vCc) >= 0 Then oMessage.CcRecipient = vCc If UBound(pvBccRecipients) >= 0 Then oMessage.BccRecipient = pvBccRecipients End Select If UBound(pvAttachments) >= 0 Then oMessage.Attachement = pvAttachments If pvBody <> "" Then oMessage.Body = pvBody If pbEditMessage Then vFlag = com.sun.star.system.MailClientFlags.DEFAULTS Else vFlag = com.sun.star.system.MailClientFlags.NO_USER_INTERFACE End If oMail.sendMailMessage(oMessage, vFlag) Else Set oMessage = oMail.createSimpleMailMessage() If UBound(pvRecipients) >= 0 Then oMessage.setRecipient(pvRecipients(0)) If psSubject <> "" Then oMessage.setSubject(psSubject) Select Case iOS Case cstLinux If UBound(vCc) >= 0 Then oMessage.setCcRecipient(Array(Join(vCc, cstSemiColon))) If UBound(pvBccRecipients) >= 0 Then oMessage.setBccRecipient(Array(Join(pvBccRecipients, cstSemiColon))) Case cstWindows If UBound(vCc) >= 0 Then oMessage.setCcRecipient(vCc) If UBound(pvBccRecipients) >= 0 Then oMessage.setBccRecipient(pvBccRecipients) End Select If UBound(pvAttachments) >= 0 Then oMessage.setAttachement(pvAttachments) If pbEditMessage Then vFlag = com.sun.star.system.SimpleMailClientFlags.DEFAULTS Else vFlag = com.sun.star.system.SimpleMailClientFlags.NO_USER_INTERFACE End If oMail.sendSimpleMailMessage(oMessage, vFlag) End If
_SendWithAttachment = True Exit_Function: Exit Function Error_Function: TraceError(TRACEABORT, Err, "_SendWithAttachment", Erl) Goto Exit_Function Error_Mail: TraceError(TRACEFATAL, ERRSENDMAIL, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
_SendWithoutAttachment |
Basic |
SendObject (Procedure) |
38 |
Private Function _SendWithoutAttachment(ByVal pvTo As Variant _ , ByVal pvCc As Variant _ , ByVal pvBcc As Variant _ , ByVal psSubject As String _ , ByVal psBody As String _ ) As Boolean Dim sMailTo As String, sTo As String, sCc As String, sBcc As String, oDispatch As Object Const cstComma = ","
If _ErrorHandler() Then On Local Error Goto Error_Function
If UBound(pvTo) >= 0 Then sTo = Trim(Join(pvTo, cstComma)) Else sTo = "" If UBound(pvCc) >= 0 Then sCc = Trim(Join(pvCc, cstComma)) Else sCc = "" If UBound(pvBcc) >= 0 Then sBcc = Trim(Join(pvBcc, cstComma)) Else sBcc = "" sMailTo = "mailto:" _ & sTo & "?" _ & Iif(sCc = "", "", "cc=" & sCc & "&") _ & Iif(sBcc = "", "", "bcc=" & sBcc & "&") _ & Iif(psSubject = "", "", "subject=" & psSubject & "&") _ & Iif(psBody = "", "", "body=" & psBody & "&") If Right(sMailTo, 1) = "&" Or Right(sMailTo, 1) = "?" Then sMailTo = Left(sMailTo, Len(sMailTo) - 1) sMailTo = ConvertToUrl(sMailTo) oDispatch = createUnoService( "com.sun.star.frame.DispatchHelper") oDispatch.executeDispatch(StarDesktop, sMailTo, "", 0, Array())
_SendWithoutAttachment = True
Exit_Function: Exit Function Error_Function: TraceError(TRACEABORT, Err, "_SendWithoutAttachments", Erl) _SendWithoutAttachment = False Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
_ShellExecute |
Basic |
OpenHelpFile (Procedure) OutputTo (Procedure) RunApp (Procedure) OutputTo (Procedure) |
9 |
Private Sub _ShellExecute(sCommand As String)
Dim oShell As Object Set oShell = createUnoService("com.sun.star.system.SystemShellExecute") oShell.execute(sCommand, "" , com.sun.star.system.SystemShellExecuteFlags.DEFAULTS)
End Sub |
Access2BaseDev |
DoCmd |
ApplyFilter |
Basic |
|
61 |
Public Function ApplyFilter( _ ByVal Optional pvFilter As Variant _ , ByVal Optional pvSQL As Variant _ , ByVal Optional pvControlName As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "ApplyFilter" Utils._SetCalledSub(cstThisSub) ApplyFilter = False If IsMissing(pvFilter) And IsMissing(pvSQL) Then Call _TraceArguments() If IsMissing(pvFilter) Then pvFilter = "" If Not Utils._CheckArgument(pvFilter, 1, vbString) Then Goto Exit_Function If IsMissing(pvSQL) Then pvSQL = "" If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function If IsMissing(pvControlName) Then pvControlName = "" If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function
Dim sFilter As String, oWindow As Object, oDatabase As Object, oTarget As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
If pvSQL <> "" _ Then sFilter = oDatabase._ReplaceSquareBrackets(pvSQL) _ Else sFilter = oDatabase._ReplaceSquareBrackets(pvFilter)
Set oWindow = _SelectWindow() With oWindow Select Case .WindowType Case acForm Set oTarget = _DatabaseForm(._Name, pvControlName) Case acQuery, acTable If pvControlName <> "" Then Goto Exit_Function If IsNull(.Frame.Controller.FormOperations) Then Goto Error_NotApplicable Set oTarget = .Frame.Controller.FormOperations.Cursor Case Else Goto Exit_Function End Select End With
With oTarget .Filter = sFilter .ApplyFilter = True .reload() End With ApplyFilter = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotApplicable: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
CopyObject |
Basic |
|
237 |
Public Function CopyObject(ByVal Optional pvSourceDatabase As Variant _ , ByVal Optional pvNewName As Variant _ , ByVal Optional pvSourceType As Variant _ , ByVal Optional pvSourceName As Variant _ ) As Boolean If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "CopyObject" Utils._SetCalledSub(cstThisSub) CopyObject = False
If IsMissing(pvSourceDatabase) Then pvSourceDatabase = "" If VarType(pvSourceDatabase) <> vbString Then If Not Utils._CheckArgument(pvSourceDatabase, 1, OBJDATABASE) Then Goto Exit_Function End If If IsMissing(pvNewName) Then Call _TraceArguments() If Not Utils._CheckArgument(pvNewName, 2, vbString) Then Goto Exit_Function If IsMissing(pvSourceType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSourceType, 1, Utils._AddNumeric(), Array(acQuery, acTable) _ ) Then Goto Exit_Function If IsMissing(pvSourceName) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSourceName, 2, vbString) Then Goto Exit_Function Dim oSource As Object, oSourceDatabase As Object, oTarget As Object, oDatabase As Object, bSameDatabase As Boolean Dim oSourceTable As Object, oSourceColumns As Object, oSourceCol As Object, oTargetCol As Object, iRDBMS As Integer Dim oSourceKeys As Object, oSourceKey As Object, oTargetKey As Object Dim i As Integer, j As Integer, sSql As String, vPrimaryKeys() As Variant Dim vNameComponents() As Variant, iNames As Integer, sSurround As String Dim vInputField As Variant, vFieldBinary() As Variant, vOutputField As Variant Dim oInput as Object, oOutput As Object, iNbFields As Integer, vValue As Variant Dim vBinary As Variant, lInputSize As Long, lOutputSize As Long Dim lInputRecs As Long, lInputMax As Long, vField As Variant, bProgressMeter As Boolean, sFile As String
Const cstMaxBinlength = 2 * 65535 Const cstChunkSize = 2 * 65535 Const cstProgressMeterLimit = 100
Set oDatabase = Application._CurrentDb() bSameDatabase = False If VarType(pvSourceDatabase) = vbString Then If pvSourceDatabase = "" Then Set oSourceDatabase = oDatabase bSameDatabase = True Else Set oSourceDatabase = Application.OpenDatabase(ConvertToUrl(pvSourceDatabase), , , True) If IsNull(oSourceDatabase) Then Goto Exit_Function End If Else Set oSourceDatabase = pvSourceDatabase End If With oDatabase iRDBMS = ._RDBMS If ._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable Select Case pvSourceType
Case acQuery Set oSource = oSourceDatabase.QueryDefs(pvSourceName, True) If IsNull(oSource) Then Goto Error_NotFound Set oTarget = .QueryDefs(pvNewName, True) If Not IsNull(oTarget) Then .Connection.getQueries.dropByName(oTarget.Name) If oSource.Query.EscapeProcessing Then Set oTarget = .CreateQueryDef(pvNewName, oSource.SQL) Else Set oTarget = .CreateQueryDef(pvNewName, oSource.SQL, dbSQLPassThrough) End If .Document.store()
Case acTable Set oSource = oSourceDatabase.TableDefs(pvSourceName, True) If IsNull(oSource) Then Goto Error_NotFound Set oTarget = .TableDefs(pvNewName, True) If Not IsNull(oTarget) Then .Connection.getTables.dropByName(oTarget.Name) Set oSourceTable = oSource.Table Set oTarget = .Connection.getTables.createDataDescriptor oTarget.Description = oSourceTable.Description vNameComponents = Split(pvNewName, ".") iNames = UBound(vNameComponents) If iNames >= 2 Then oTarget.CatalogName = vNameComponents(iNames - 2) Else oTarget.CatalogName = "" If iNames >= 1 Then oTarget.SchemaName = vNameComponents(iNames - 1) Else oTarget.SchemaName = "" oTarget.Name = vNameComponents(iNames) oTarget.Type = oSourceTable.Type Set oSourceColumns = oSourceTable.Columns Set oTargetCol = oTarget.Columns.createDataDescriptor For i = 0 To oSourceColumns.getCount() - 1 Set oSourceCol = oSourceColumns.getByIndex(i) _ConvertDataDescriptor oSourceCol, oSourceDatabase._RDBMS, oTargetCol, oDatabase oTarget.Columns.appendByDescriptor(oTargetCol) Next i Set oSourceKeys = oSourceTable.Keys Set oTargetKey = oTarget.Keys.createDataDescriptor() For i = 0 To oSourceKeys.getCount() - 1 Set oSourceKey = oSourceKeys.getByIndex(i) oTargetKey.DeleteRule = oSourceKey.DeleteRule oTargetKey.Name = oSourceKey.Name oTargetKey.ReferencedTable = oSourceKey.ReferencedTable oTargetKey.Type = oSourceKey.Type oTargetKey.UpdateRule = oSourceKey.UpdateRule Set oTargetCol = oTargetKey.Columns.createDataDescriptor() For j = 0 To oSourceKey.Columns.getCount() - 1 Set oSourceCol = oSourceKey.Columns.getByIndex(j) _ConvertDataDescriptor oSourceCol, oSourceDatabase._RDBMS, oTargetCol, oDatabase, True oTargetKey.Columns.appendByDescriptor(oTargetCol) Next j oTarget.Keys.appendByDescriptor(oTargetKey) Next i .Connection.getTables.appendByDescriptor(oTarget)
Select Case bSameDatabase Case True sSurround = Utils._Surround(oSource.Name) sSql = "INSERT INTO " & Utils._Surround(pvNewName) & " SELECT " & sSurround & ".* FROM " & sSurround DoCmd.RunSQL(sSql) Case False Set oInput = oSourceDatabase.OpenRecordset(oSource.Name, , , dbReadOnly) Set oOutput = .Openrecordset(pvNewName)
With oInput If Not ( ._BOF And ._EOF ) Then .MoveLast lInputMax = .RecordCount lInputRecs = 0 .MoveFirst bProgressMeter = ( lInputMax > cstProgressMeterLimit )
iNbFields = .Fields().Count - 1 vFieldBinary = Array() ReDim vFieldBinary(0 To iNbFields) For i = 0 To iNbFields vFieldBinary(i) = Utils._IsBinaryType(.Fields(i).Column.Type) Next i Else bProgressMeter = False End If If bProgressMeter Then Application.SysCmd acSysCmdInitMeter, pvNewName & " 0 %", lInputMax Do While Not .EOF() oOutput.RowSet.moveToInsertRow() oOutput._EditMode = dbEditAdd For i = 0 To iNbFields Set vInputField = .Fields(i) Set vOutputField = oOutput.Fields(i) If vFieldBinary(i) Then lInputSize = vInputField.FieldSize If lInputSize <= cstMaxBinlength Then vField = Utils._getResultSetColumnValue(.RowSet, i + 1, True) Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField) ElseIf oDatabase._BinaryStream Then If lInputSize > vOutputField._Precision Then TraceError(TRACEWARNING, ERRPRECISION, Utils._CalledSub(), 0, 1, Array(vOutputField._Name, lInputRecs + 1)) Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, Null) Else sFile = Utils._GetRandomFileName("BINARY") vInputField._WriteAll(sFile, "WriteAllBytes") vOutputField._ReadAll(sFile, "ReadAllBytes") Kill ConvertToUrl(sFile) End If End If Else vField = Utils._getResultSetColumnValue(.RowSet, i + 1) If VarType(vField) = vbString Then If Len(vField) > vOutputField._Precision Then TraceError(TRACEWARNING, ERRPRECISION, Utils._CalledSub(), 0, 1, Array(vOutputField._Name, lInputRecs + 1)) End If End If Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField) End If Next i If oOutput.RowSet.IsNew And oOutput.RowSet.IsModified Then oOutput.RowSet.insertRow() oOutput._EditMode = dbEditNone lInputRecs = lInputRecs + 1 If bProgressMeter Then If lInputRecs Mod (lInputMax / 100) = 0 Then Application.SysCmd acSysCmdUpdateMeter, pvNewName & " " & CStr(CLng(lInputRecs * 100 / lInputMax)) & "%", lInputRecs End If End If .MoveNext Loop End With
oOutput.mClose() Set oOutput = Nothing oInput.mClose() Set oInput = Nothing if bProgressMeter Then Application.SysCmd acSysCmdClearStatus End Select Case Else End Select End With CopyObject = True Exit_Function: If VarType(pvSourceDatabase) = vbString And Not bSameDatabase Then If Not IsNull(oSourceDatabase) Then oSourceDatabase.mClose() End If Set oSourceDatabase = Nothing If Not IsNull(oOutput) Then oOutput.mClose() Set oOutput = Nothing If Not IsNull(oInput) Then oInput.mClose() Set oInput = Nothing Set oSourceCol = Nothing Set oSourceKey = Nothing Set oSourceKeys = Nothing Set oSource = Nothing Set oSourceTable = Nothing Set oSourceColumns = Nothing Set oTargetCol = Nothing Set oTargetKey = Nothing Set oTarget = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(Iif(pvSourceType = acQuery, _GetLabel("QUERY"), _GetLabel("TABLE")), pvSourceName)) Goto Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
FindNext |
Basic |
FindRecord (Procedure) |
124 |
Public Function FindNext() As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function FindNext = False Utils._SetCalledSub("FindNext")
Dim ofForm As Object, ocGrid As Object Dim i As Integer, lInitialRow As Long, lFindRow As Long Dim bFound As Boolean, b2ndRound As Boolean, bStop As Boolean Dim vFindValue As Variant, oFindrecord As Object
Set oFindRecord = _A2B_.FindRecord If IsNull(oFindRecord) Then GoTo Error_FindRecord With oFindRecord
If .FindRecord = 0 Then Goto Error_FindRecord .FindRecord = 0 Set ofForm = getObject(.Form) If ofForm._Type = OBJCONTROL Then Set ofForm = ofForm.Form Set ocGrid = getObject(.GridControl)
If ofForm.DatabaseForm.RowCount <= 0 then Goto Exit_Function lInitialRow = .LastRow bFound = False lFindRow = .LastRow b2ndRound = False Do If .LastColumn >= UBound(.ColumnNames) Then bStop = False If ofForm.DatabaseForm.isAfterLast() And .Search = acUp Then ofForm.DatabaseForm.last() ElseIf ofForm.DatabaseForm.isLast() And .Search = acSearchAll Then ofForm.DatabaseForm.first() b2ndRound = True ElseIf ofForm.DatabaseForm.isBeforeFirst() And (.Search = acDown Or .Search = acSearchAll) Then ofForm.DatabaseForm.first() ElseIf ofForm.DatabaseForm.isFirst() And .search = acUp Then ofForm.DatabaseForm.beforeFirst() bStop = True ElseIf ofForm.DatabaseForm.isLast() And .search = acDown Then ofForm.DatabaseForm.afterLast() bStop = True ElseIf .Search = acUp Then ofForm.DatabaseForm.previous() Else ofForm.DatabaseForm.next() End If lFindRow = ofForm.DatabaseForm.getRow() If bStop Or (.Search = acSearchAll And lFindRow >= lInitialRow And b2ndRound) Then ofForm.DatabaseForm.absolute(lInitialRow) Exit Do End If .LastColumn = 0 Else .LastColumn = .LastColumn + 1 End If If .LastColumn <= UBound(.ColumnNames) Then For i = .LastColumn To UBound(.ColumnNames) vFindValue = Utils._getResultSetColumnValue(ofForm.DatabaseForm.createResultSet(), .ResultSetIndex(i)) Select Case VarType(.FindWhat) Case vbDate, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal bFound = ( .FindWhat = vFindValue ) Case vbString If VarType(vFindValue) = vbString Then Select Case .Match Case acStart If .MatchCase Then bFound = ( Left(.FindWhat, Len(.FindWhat)) = vFindValue ) Else bFound = ( UCase(Left(.FindWhat, Len(.FindWhat))) = UCase(vFindValue) ) End If Case acAnyWhere If .MatchCase Then bFound = ( InStr(1, vFindValue, .FindWhat, 0) > 0 ) Else bFound = ( InStr(vFindValue, .FindWhat) > 0 ) End If Case acEntire If .MatchCase Then bFound = ( .FindWhat = vFindValue ) Else bFound = ( UCase(.FindWhat) = UCase(vFindValue) ) End If End Select Else bFound = False End If End Select If bFound Then .LastColumn = i Exit For End If Next i End If Loop While Not bFound
.LastRow = lFindRow If bFound Then ocGrid.Controls(.ColumnNames(.LastColumn)).setFocus() .FindRecord = 1 FindNext = True End If
End With Exit_Function: Utils._ResetCalledSub("FindNext") Exit Function Error_Function: TraceError(TRACEABORT, Err, "FindNext", Erl) GoTo Exit_Function Error_FindRecord: TraceError(TRACEERRORS, ERRFINDRECORD, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
FindRecord |
Basic |
Class_Initialize (Procedure) |
233 |
Public Function FindRecord(Optional ByVal pvFindWhat As Variant _ , Optional ByVal pvMatch As Variant _ , Optional ByVal pvMatchCase As Variant _ , Optional ByVal pvSearch As Variant _ , Optional ByVal pvSearchAsFormatted As Variant _ , Optional ByVal pvTargetedField As Variant _ , Optional ByVal pvFindFirst As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function FindRecord = False Utils._SetCalledSub("FindRecord") If IsMissing(pvFindWhat) Or pvFindWhat = "" Then Call _TraceArguments() If IsMissing(pvMatch) Then pvMatch = acEntire If IsMissing(pvMatchCase) Then pvMatchCase = False If IsMissing(pvSearch) Then pvSearch = acSearchAll If IsMissing(pvSearchAsFormatted) Then pvSearchAsFormatted = False If IsMissing(pvTargetedField) Then pvTargetedField = acCurrent If IsMissing(pvFindFirst) Then pvFindFirst = True If Not (Utils._CheckArgument(pvFindWhat, 1, Utils._AddNumeric(Array(vbString, vbDate))) _ And Utils._CheckArgument(pvMatch, 2, Utils._AddNumeric(), Array(acAnywhere, acEntire, acStart)) _ And Utils._CheckArgument(pvMatchCase, 3, vbBoolean) _ And Utils._CheckArgument(pvSearch, 4, Utils._AddNumeric(), Array(acDown, acSearchAll, acUp)) _ And Utils._CheckArgument(pvSearchAsFormatted, 5, vbBoolean, Array(False)) _ And Utils._CheckArgument(pvTargetedField, 6, Utils._AddNumeric(vbString)) _ And Utils._CheckArgument(pvFindFirst, 7, vbBoolean) _ ) Then Exit Function If VarType(pvTargetedField) <> vbString Then If Not Utils._CheckArgument(pvTargetedField, 6, Utils._AddNumeric(), Array(acAll, acCurrent)) Then Exit Function End If Dim ocTarget As Object, i As Integer, j As Integer, vNames() As Variant, iCount As Integer, vIndexes() As Variant Dim vColumn As Variant, vDataField As Variant, ofParentForm As Variant, oColumns As Object, vParentGrid As Object Dim bFound As Boolean, ocGridControl As Object, iFocus As Integer Dim oFindRecord As _FindParams With oFindRecord .FindRecord = 0 .FindWhat = pvFindWhat .Match = pvMatch .MatchCase = pvMatchCase .Search = pvSearch .SearchAsFormatted = pvSearchAsFormatted .FindFirst = pvFindFirst Select Case True Case VarType(pvTargetedField) = vbString Set ocTarget = getObject(pvTargetedField) If ocTarget.SubType = CTLGRIDCONTROL Then .OnlyCurrentField = acAll .GridControl = ocTarget._Shortcut .Target = .GridControl ofParentForm = getObject(_getUpperShortcut(ocTarget._Shortcut, ocTarget._Name)) If IsNull(ofParentForm.DatabaseForm) Then Goto Error_DatabaseForm Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns iCount = -1 For i = 0 To ocTarget.ControlModel.Count - 1 Set vColumn = ocTarget.ControlModel.getByIndex(i) Set vDataField = vColumn.BoundField If Not IsNull(vDataField) Then If _CheckColumnType(pvFindWhat, vDataField) Then iCount = iCount + 1 ReDim Preserve vNames(0 To iCount) vNames(iCount) = vColumn.Name ReDim Preserve vIndexes(0 To iCount) For j = 0 To oColumns.Count - 1 If vDataField.Name = oColumns.ElementNames(j) Then vIndexes(iCount) = j + 1 Exit For End If Next j End If End If Next i ElseIf ocTarget._Type = OBJCONTROL Then If IsNull(ocTarget.ControlModel.BoundField) Then Goto Error_Target .OnlyCurrentField = acCurrent vParentGrid = getObject(_getUpperShortcut(ocTarget._Shortcut, ocTarget._Name)) If vParentGrid.SubType <> CTLGRIDCONTROL Then Goto Error_Target .GridControl = vParentGrid._Shortcut ofParentForm = getObject(_getUpperShortcut(vParentGrid._Shortcut, vParentGrid._Name)) If ofParentForm._Type = OBJCONTROL Then Set ofParentForm = ofParentForm.Form If IsNull(ofParentForm.DatabaseForm) Then Goto Error_DatabaseForm .Target = ocTarget._Shortcut Set vDataField = ocTarget.ControlModel.BoundField If Not _CheckColumnType(pvFindWhat, vDataField) Then Goto Error_Target ReDim vNames(0), vIndexes(0) vNames(0) = ocTarget._Name Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns For j = 0 To oColumns.Count - 1 If vDataField.Name = oColumns.ElementNames(j) Then vIndexes(0) = j + 1 Exit For End If Next j End If Case Else iCount = Application.Forms()._Count If iCount = 0 Then Goto Error_ActiveForm bFound = False For i = 0 To iCount - 1 Set ofParentForm = Application.Forms(i) If ofParentForm.Component.CurrentController.Frame.IsActive() Then bFound = True Exit For End If Next i If Not bFound Then Goto Error_ActiveForm If IsNull(ofParentForm.DatabaseForm) Then Goto Error_DatabaseForm iCount = ofParentForm.Controls().Count bFound = False For i = 0 To iCount - 1 Set ocGridControl = ofParentForm.Controls(i) If ocGridControl.SubType = CTLGRIDCONTROL Then bFound = True Exit For End If Next i If Not bFound Then Goto Error_NoGrid .GridControl= ocGridControl._Shortcut iFocus = -1 iFocus = ocGridControl.ControlView.getCurrentColumnPosition() If pvTargetedField = acAll Or iFocus < 0 Or iFocus >= ocGridControl.ControlModel.Count Then .OnlyCurrentField = acAll Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns iCount = -1 For i = 0 To ocGridControl.ControlModel.Count - 1 Set vColumn = ocGridControl.ControlModel.getByIndex(i) Set vDataField = vColumn.BoundField If Not IsNull(vDataField) Then If _CheckColumnType(pvFindWhat, vDataField) Then iCount = iCount + 1 ReDim Preserve vNames(0 To iCount) vNames(iCount) = vColumn.Name ReDim Preserve vIndexes(0 To iCount) For j = 0 To oColumns.Count - 1 If vDataField.Name = oColumns.ElementNames(j) Then vIndexes(iCount) = j + 1 Exit For End If Next j End If End If Next i Else .OnlyCurrentField = acCurrent Set vColumn = ocGridControl.ControlModel.getByIndex(iFocus) Set ocTarget = ocGridControl.Controls(vColumn.Name) .Target = ocTarget._Shortcut Set vDataField = ocTarget.ControlModel.BoundField If IsNull(vDataField) Then Goto Error_Target If Not _CheckColumnType(pvFindWhat, vDataField) Then Goto Error_Target ReDim vNames(0), vIndexes(0) vNames(0) = ocTarget._Name Set oColumns = ofParentForm.DatabaseForm.createResultSet().Columns For j = 0 To oColumns.Count - 1 If vDataField.Name = oColumns.ElementNames(j) Then vIndexes(0) = j + 1 Exit For End If Next j End If
End Select .Form = ofParentForm._Shortcut .LastColumn = UBound(vNames) .ColumnNames = vNames .ResultSetIndex = vIndexes If pvFindFirst Then Select Case pvSearch Case acDown, acSearchAll ofParentForm.DatabaseForm.beforeFirst() .LastRow = 0 Case acUp ofParentForm.DatabaseForm.afterLast() .LastRow = ofParentForm.DatabaseForm.RowCount + 1 End Select Else Select Case True Case ofParentForm.DatabaseForm.isBeforeFirst And (pvSearch = acSearchAll Or pvSearch = acDown) .LastRow = 0 Case ofParentForm.DatabaseForm.isAfterLast And pvSearch = acUp ofParentForm.DatabaseForm.last() .LastRow = ofParentForm.DatabaseForm.RowCount + 1 Case Else .LastRow = ofParentForm.DatabaseForm.getRow() End Select End If
.FindRecord = 1 End With Set _A2B_.FindRecord = oFindRecord FindRecord = DoCmd.Findnext() Exit_Function: Utils._ResetCalledSub("FindRecord") Exit Function Error_Function: TraceError(TRACEABORT, Err, "FindRecord", Erl) GoTo Exit_Function Error_ActiveForm: TraceError(TRACEERRORS, ERRNOACTIVEFORM, Utils._CalledSub(), 0) Goto Exit_Function Error_DatabaseForm: TraceError(TRACEFATAL, ERRDATABASEFORM, Utils._CalledSub(), 0, 1, vParentForm._Name) Goto Exit_Function Error_Target: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(6, pvTargetedField)) Goto Exit_Function Error_NoGrid: TraceError(TRACEFATAL, ERRNOGRIDINFORM, Utils._CalledSub(), 0, 1, vParentForm._Name) Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
GetHiddenAttribute |
Basic |
|
38 |
Public Function GetHiddenAttribute(ByVal Optional pvObjectType As Variant _ , ByVal Optional pvObjectName As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "GetHiddenAttribute" Utils._SetCalledSub(cstThisSub) If IsMissing(pvObjectType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _ Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow, acDocument) _ ) Then Goto Exit_Function If IsMissing(pvObjectName) Then Select Case pvObjectType Case acForm, acQuery, acTable, acReport, acDocument : Call _TraceArguments() Case Else End Select pvObjectName = "" Else If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function End If Dim oWindow As Object Set oWindow = _SelectWindow(pvObjectType, pvObjectName) If IsNull(oWindow.Frame) Then Goto Error_NotFound GetHiddenAttribute = Not oWindow.Frame.ContainerWindow.isVisible()
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName)) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
GoToControl |
Basic |
|
38 |
Public Function GoToControl(Optional ByVal pvControlName As variant) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("GoToControl") If IsMissing(pvControlName) Then Call _TraceArguments() If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function GoToControl = False Dim oWindow As Object, ofForm As Object, ocControl As Object Dim i As Integer, iCount As Integer Set oWindow = _SelectWindow() If oWindow.WindowType = acForm Then Set ofForm = Application.Forms(oWindow._Name) iCount = ofForm.Controls().Count For i = 0 To iCount - 1 ocControl = ofForm.Controls(i) If UCase(ocControl._Name) = UCase(pvControlName) Then If Methods.hasProperty(ocControl, "Enabled") Then If ocControl.Enabled Then ocControl.setFocus() GoToControl = True Exit For End If End If End If Next i End If Exit_Function: Utils._ResetCalledSub("GoToControl") Exit Function Error_Function: TraceError(TRACEABORT, Err, "GoToControl", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
GoToRecord |
Basic |
|
126 |
Public Function GoToRecord(Optional ByVal pvObjectType As Variant _ , Optional ByVal pvObjectName As Variant _ , Optional ByVal pvRecord As Variant _ , Optional ByVal pvOffset As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function GoToRecord = False Const cstThisSub = "GoTorecord" Utils._SetCalledSub(cstThisSub) If IsMissing(pvObjectName) Then pvObjectName = "" If IsMissing(pvObjectType) Then pvObjectType = acActiveDataObject If IsMissing(pvRecord) Then pvRecord = acNext If IsMissing(pvOffset) Then pvOffset = 1 If Not (Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric() _ , Array(acActiveDataObject, acDataForm, acDataQuery, acDataTable)) _ And Utils._CheckArgument(pvObjectName, 2, vbString) _ And Utils._CheckArgument(pvRecord, 3, Utils._AddNumeric() _ , Array(acFirst, acGoTo, acLast, acNewRec, acNext, acPrevious)) _ And Utils._CheckArgument(pvOffset, 4, Utils._AddNumeric()) _ ) Then Goto Exit_Function If pvObjectType = acActiveDataObject And pvObjectName <> "" Then Goto Error_Target If pvOffset < 0 And pvRecord <> acGoTo Then Goto Error_Offset Dim ofForm As Object, oGeneric As Object, oResultSet As Object, oWindow As Object Dim i As Integer, iCount As Integer, bFound As Boolean, lOffset As Long Dim sObjectName, iLengthName As Integer Select Case pvObjectType Case acActiveDataObject Set oWindow = _SelectWindow() With oWindow Select Case .WindowType Case acForm Set oResultSet = _DatabaseForm(._Name, "") Case acQuery, acTable If IsNull(.Frame.Controller.FormOperations) Then Goto Error_NotApplicable Set oResultSet = .Frame.Controller.FormOperations.Cursor Case Else Goto Exit_Function End Select End With Case acDataForm sObjectName = UCase(pvObjectName) iLengthName = Len(sObjectName) Select Case True Case iLengthName > 6 And Left(sObjectName, 6) = "FORMS!" And Right(sObjectName, 5) = ".FORM" Set ofForm = getObject(pvObjectName) If ofForm._Type <> OBJSUBFORM Then Goto Error_Target Case iLengthName > 6 And Left(sObjectName, 6) = "FORMS!" Set oGeneric = getObject(pvObjectName) If oGeneric._Type = OBJFORM Or oGeneric._Type = OBJSUBFORM Then Set ofForm = oGeneric ElseIf oGeneric.SubType = CTLSUBFORM Then Set ofForm = oGeneric.Form Else Goto Error_Target End If Case sObjectName = "" Call _TraceArguments() Case Else Set ofForm = Application.Forms(pvObjectName) End Select Set oResultSet = ofForm.DatabaseForm Case acDataQuery Set oWindow = _SelectWindow(acQuery, pvObjectName) If IsNull(oWindow.Frame.Controller.FormOperations) Then Goto Error_NotApplicable Set oResultSet = oWindow.Frame.Controller.FormOperations.Cursor Case acDataTable Set oWindow = _SelectWindow(acTable, pvObjectName) If IsNull(oWindow.Frame.Controller.FormOperations) Then Goto Error_NotApplicable Set oResultSet = oWindow.Frame.Controller.FormOperations.Cursor Case Else End Select If oResultSet.IsNew Then oResultSet.insertRow() ElseIf oResultSet.IsModified Then oResultSet.updateRow() End If lOffset = pvOffset Select Case pvRecord Case acFirst : GoToRecord = oResultSet.first() Case acGoTo : GoToRecord = oResultSet.absolute(lOffset) Case acLast : GoToRecord = oResultSet.last() Case acNewRec oResultSet.last() oResultSet.moveToInsertRow() GoToRecord = True Case acNext If lOffset = 1 Then GoToRecord = oResultSet.next() Else GoToRecord = oResultSet.relative(lOffset) End If Case acPrevious If lOffset = 1 Then GoToRecord = oResultSet.previous() Else GoToRecord = oResultSet.relative(- lOffset) End If End Select Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_Target: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(2, pvObjectName)) Goto Exit_Function Error_Offset: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(4, pvOffset)) Goto Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
Maximize |
Basic |
|
16 |
Public Function Maximize() As Boolean Utils._SetCalledSub("Maximize")
Dim oWindow As Object Maximize = False Set oWindow = _SelectWindow() If Not IsNull(oWindow.Frame) Then If Utils._hasUNOProperty(oWindow.Frame.ContainerWindow, "IsMaximized") Then oWindow.Frame.ContainerWindow.IsMaximized = True Maximize = True End If
Utils._ResetCalledSub("Maximize") Exit Function End Function |
Access2BaseDev |
DoCmd |
mClose |
Basic |
|
82 |
Public Function mClose(Optional ByVal pvObjectType As Variant _ , Optional ByVal pvObjectName As Variant _ , Optional ByVal pvSave As Variant _ ) As Boolean If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "Close" Utils._SetCalledSub(cstThisSub) mClose = False If IsMissing(pvObjectType) Or IsMissing(pvObjectName) Then Call _TraceArguments() If IsMissing(pvSave) Then pvSave = acSavePrompt If Not (Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _ Array(acTable, acQuery, acForm, acReport)) _ And Utils._CheckArgument(pvObjectName, 2, vbString) _ And Utils._CheckArgument(pvSave, 3, Utils._AddNumeric(), Array(acSavePrompt)) _ ) Then Goto Exit_Function Dim sObjects() As String, sObjectName As String, oController As Object, oObject As Object Dim i As Integer, bFound As Boolean, lComponent As Long Dim oDatabase As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable Select Case pvObjectType Case acForm sObjects = oDatabase.Document.getFormDocuments.ElementNames() lComponent = com.sun.star.sdb.application.DatabaseObject.FORM Case acTable sObjects = oDatabase.Connection.getTables.ElementNames() lComponent = com.sun.star.sdb.application.DatabaseObject.TABLE Case acQuery sObjects = oDatabase.Connection.getQueries.ElementNames() lComponent = com.sun.star.sdb.application.DatabaseObject.QUERY Case acReport sObjects = oDatabase.Document.getReportDocuments.ElementNames() lComponent = com.sun.star.sdb.application.DatabaseObject.REPORT End Select bFound = False For i = 0 To UBound(sObjects) If UCase(pvObjectName) = UCase(sObjects(i)) Then sObjectName = sObjects(i) bFound = True Exit For End If Next i If Not bFound Then Goto Trace_NotFound Select Case pvObjectType Case acForm Set oController = oDatabase.Document.getFormDocuments.getByName(sObjectName) mClose = oController.close() Case acTable, acQuery Set oController = oDatabase.Document.CurrentController Set oObject = oController.loadComponent(lComponent, sObjectName, False) oObject.frame.close(False) mClose = True Case acReport Set oController = oDatabase.Document.getReportDocuments.getByName(sObjectName) mClose = oController.close() End Select
Exit_Function: Set oObject = Nothing Set oController = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, "Close", Erl) GoTo Exit_Function Trace_Error: TraceError(TRACEFATAL, ERRCLOSEOBJECT, Utils._CalledSub(), 0, , Array(_GetLabel(Array("Table", "Query", "Form", "Report")(pvObjectType)), pvObjectName)) Goto Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(Array("Table", "Query", "Form", "Report")(pvObjectType)), pvObjectName)) Goto Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
Minimize |
Basic |
|
16 |
Public Function Minimize() As Boolean Utils._SetCalledSub("Minimize")
Dim oWindow As Object Minimize = False Set oWindow = _SelectWindow() If Not IsNull(oWindow.Frame) Then If Utils._hasUNOProperty(oWindow.Frame.ContainerWindow, "IsMinimized") Then oWindow.Frame.ContainerWindow.IsMinimized = True Minimize = True End If
Utils._ResetCalledSub("Minimize") Exit Function End Function |
Access2BaseDev |
DoCmd |
MoveSize |
Basic |
|
62 |
Public Function MoveSize(ByVal Optional pvLeft As Variant _ , ByVal Optional pvTop As Variant _ , ByVal Optional pvWidth As Variant _ , ByVal Optional pvHeight As Variant _ ) As Variant If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("MoveSize") MoveSize = False If IsMissing(pvLeft) Then pvLeft = -1 If IsMissing(pvTop) Then pvTop = -1 If IsMissing(pvWidth) Then pvWidth = -1 If IsMissing(pvHeight) Then pvHeight = -1 If Not Utils._CheckArgument(pvLeft, 1, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvTop, 2, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvWidth, 3, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvHeight, 4, Utils._AddNumeric()) Then Goto Exit_Function Dim iArg As Integer, iWrong As Integer iArg = 0 If pvHeight < -1 Then iArg = 4 : iWrong = pvHeight ElseIf pvWidth < -1 Then iArg = 3 : iWrong = pvWidth ElseIf pvTop < -1 Then iArg = 2 : iWrong = pvTop ElseIf pvLeft < -1 Then iArg = 1 : iWrong = pvLeft End If If iArg > 0 Then TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(iArg, iWrong)) Goto Exit_Function End If
Dim iPosSize As Integer iPosSize = 0 If pvLeft >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X If pvTop >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y If pvWidth > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH If pvHeight > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT
Dim oWindow As Object Set oWindow = _SelectWindow() With oWindow If Not IsNull(.Frame) Then If Utils._hasUNOProperty(.Frame.ContainerWindow, "IsMaximized") Then .Frame.ContainerWindow.IsMaximized = False .Frame.ContainerWindow.IsMinimized = False End If .Frame.ContainerWindow.setPosSize(pvLeft, pvTop, pvWidth, pvHeight, iPosSize) MoveSize = True End If End With Exit_Function: Utils._ResetCalledSub("MoveSize") Exit Function Error_Function: TraceError(TRACEABORT, Err, "MoveSize", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
OpenForm |
Basic |
Quit (Procedure) |
117 |
Public Function OpenForm(Optional ByVal pvFormName As Variant _ , Optional ByVal pvView As Variant _ , Optional ByVal pvFilterName As Variant _ , Optional ByVal pvWhereCondition As Variant _ , Optional ByVal pvDataMode As Variant _ , Optional ByVal pvWindowMode As Variant _ , Optional ByVal pvOpenArgs As Variant _ ) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub("OpenForm") If IsMissing(pvFormName) Then Call _TraceArguments() If IsMissing(pvView) Then pvView = acNormal If IsMissing(pvFilterName) Then pvFilterName = "" If IsMissing(pvWhereCondition) Then pvWhereCondition = "" If IsMissing(pvDataMode) Then pvDataMode = acFormPropertySettings If IsMissing(pvWindowMode) Then pvWindowMode = acWindowNormal If IsMissing(pvOpenArgs) Then pvOpenArgs = "" Set OpenForm = Nothing If Not (Utils._CheckArgument(pvFormName, 1, vbString) _ And Utils._CheckArgument(pvView, 2, Utils._AddNumeric(), Array(acNormal, acPreview, acDesign)) _ And Utils._CheckArgument(pvFilterName, 3, vbString) _ And Utils._CheckArgument(pvWhereCondition, 4, vbString) _ And Utils._CheckArgument(pvDataMode, 5, Utils._AddNumeric(), Array(acFormAdd, acFormEdit, acFormPropertySettings, acFormReadOnly)) _ And Utils._CheckArgument(pvWindowMode, 6, Utils._AddNumeric(), Array(acDialog, acHidden, acIcon, acWindowNormal)) _ ) Then Goto Exit_Function Dim ofForm As Object, sWarning As String Dim oDatabase As Object, oOpenForm As Object, bOpenMode As Boolean, oController As Object
Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable Set ofForm = Application.AllForms(pvFormName) If ofForm.IsLoaded Then sWarning = _GetLabel("ERR" & ERRFORMYETOPEN) sWarning = Join(Split(sWarning, "%0"), ofForm._Name) TraceLog(TRACEANY, "OpenForm: " & sWarning) Set OpenForm = ofForm Goto Exit_Function End If Select Case pvView Case acNormal, acPreview: bOpenMode = False Case acDesign : bOpenMode = True End Select Set oController = oDatabase.Document.CurrentController Set oOpenForm = oController.loadComponent(com.sun.star.sdb.application.DatabaseObject.FORM, ofForm._Name, bOpenMode)
Dim sFilter As String, oForm As Object, oFormsCollection As Object If pvFilterName = "" And pvWhereCondition = "" Then sFilter = "" ElseIf pvFilterName = "" Or pvWhereCondition = "" Then sFilter = pvFilterName & pvWhereCondition Else sFilter = "(" & pvFilterName & ") And (" & pvWhereCondition & ")" End If If Not IsNull(oForm) Then If sFilter <> "" Then oForm.Filter = oDatabase._ReplaceSquareBrackets(sFilter) oForm.ApplyFilter = True oForm.reload() ElseIf oForm.Filter <> "" Then oForm.Filter = "" oForm.ApplyFilter = False oForm.reload() End If End If Set ofForm = Application.AllForms(pvFormName) With ofForm If Not IsNull(.DatabaseForm) Then Select Case pvDataMode Case acFormAdd .AllowAdditions = True .AllowDeletions = False .AllowEdits = False Case acFormEdit .AllowAdditions = True .AllowDeletions = True .AllowEdits = True Case acFormReadOnly .AllowAdditions = False .AllowDeletions = False .AllowEdits = False Case acFormPropertySettings End Select End If .Visible = ( pvWindowMode <> acHidden ) ._OpenArgs = pvOpenArgs .Component.CurrentController.ViewSettings.ShowOnlineLayout = True End With
Set OpenForm = ofForm
Exit_Function: Utils._ResetCalledSub("OpenForm") Set ofForm = Nothing Set oOpenForm = Nothing Exit Function Error_Function: TraceError(TRACEABORT, Err, "OpenForm", Erl) Set OpenForm = Nothing GoTo Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1) Goto Exit_Function Trace_Error: TraceError(TRACEFATAL, ERROPENFORM, Utils._CalledSub(), 0, , pvFormName) Set OpenForm = Nothing Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
OpenQuery |
Basic |
|
21 |
Public Function OpenQuery(Optional ByVal pvQueryName As Variant _ , Optional ByVal pvView As Variant _ , Optional ByVal pvDataMode As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub("OpenQuery") If IsMissing(pvQueryName) Then Call _TraceArguments() If IsMissing(pvView) Then pvView = acViewNormal If IsMissing(pvDataMode) Then pvDataMode = acEdit OpenQuery = DoCmd._OpenObject("Query", pvQueryName, pvView, pvDataMode)
Exit_Function: Utils._ResetCalledSub("OpenQuery") Exit Function Error_Function: TraceError(TRACEABORT, Err, "OpenQuery", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
OpenReport |
Basic |
|
21 |
Public Function OpenReport(Optional ByVal pvReportName As Variant _ , Optional ByVal pvView As Variant _ , Optional ByVal pvDataMode As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub("OpenReport") If IsMissing(pvReportName) Then Call _TraceArguments() If IsMissing(pvView) Then pvView = acViewNormal If IsMissing(pvDataMode) Then pvDataMode = acEdit OpenReport = DoCmd._OpenObject("Report", pvReportName, pvView, pvDataMode)
Exit_Function: Utils._ResetCalledSub("OpenReport") Exit Function Error_Function: TraceError(TRACEABORT, Err, "OpenReport", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
OpenSQL |
Basic |
|
31 |
Public Function OpenSQL(Optional ByVal pvSQL As Variant _ , Optional ByVal pvOption As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub("OpenSQL") OpenSQL = False If IsMissing(pvSQL) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function Const cstNull = -1 If IsMissing(pvOption) Then pvOption = cstNull Else If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function End If
OpenSQL = Application._CurrentDb.OpenSQL(pvSQL, pvOption)
Exit_Function: Utils._ResetCalledSub("OpenSQL") Exit Function Error_Function: TraceError(TRACEABORT, Err, "OpenSQL", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
OpenTable |
Basic |
|
21 |
Public Function OpenTable(Optional ByVal pvTableName As Variant _ , Optional ByVal pvView As Variant _ , Optional ByVal pvDataMode As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub("OpenTable") If IsMissing(pvTableName) Then Call _TraceArguments() If IsMissing(pvView) Then pvView = acViewNormal If IsMissing(pvDataMode) Then pvDataMode = acEdit OpenTable = DoCmd._OpenObject("Table", pvTableName, pvView, pvDataMode)
Exit_Function: Utils._ResetCalledSub("OpenTable") Exit Function Error_Function: TraceError(TRACEABORT, Err, "OpenTable", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
OutputTo |
Basic |
SendObject (Procedure) |
146 |
Public Function OutputTo(ByVal pvObjectType As Variant _ , ByVal Optional pvObjectName As Variant _ , ByVal Optional pvOutputFormat As Variant _ , ByVal Optional pvOutputFile As Variant _ , ByVal Optional pvAutoStart As Variant _ , ByVal Optional pvTemplateFile As Variant _ , ByVal Optional pvEncoding As Variant _ , ByVal Optional pvQuality As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "OutputTo" Utils._SetCalledSub(cstThisSub)
OutputTo = False If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery, acOutputForm)) Then Goto Exit_Function If IsMissing(pvObjectName) Then pvObjectName = "" If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function If IsMissing(pvOutputFormat) Then pvOutputFormat = "" If Not Utils._CheckArgument(pvOutputFormat, 3, vbString) Then Goto Exit_Function If pvOutputFormat <> "" Then If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _ UCase(acFormatPDF), UCase(acFormatODT), UCase(acFormatDOC), UCase(acFormatHTML) _ , UCase(acFormatODS), UCase(acFormatXLS), UCase(acFormatXLSX), UCase(acFormatTXT) _ , "PDF", "ODT", "DOC", "HTML", "ODS", "XLS", "XLSX", "TXT", "CSV", "" _ )) Then Goto Exit_Function End If If IsMissing(pvOutputFile) Then pvOutputFile = "" If Not Utils._CheckArgument(pvOutputFile, 4, vbString) Then Goto Exit_Function If IsMissing(pvAutoStart) Then pvAutoStart = False If Not Utils._CheckArgument(pvAutoStart, 5, vbBoolean) Then Goto Exit_Function If IsMissing(pvTemplateFile) Then pvTemplateFile = "" If Not Utils._CheckArgument(pvTemplateFile, 6, vbString) Then Goto Exit_Function If IsMissing(pvEncoding) Then pvEncoding = 0 If Not Utils._CheckArgument(pvEncoding, 7, _AddNumeric()) Then Goto Exit_Function If IsMissing(pvQuality) Then pvQuality = acExportQualityPrint If Not Utils._CheckArgument(pvQuality, 7, _AddNumeric(), Array(acExportQualityPrint, acExportQualityScreen)) Then Goto Exit_Function
If pvObjectType = acOutputTable Or pvObjectType = acOutputQuery Then OutputTo = Application._CurrentDb().OutputTo( _ pvObjectType _ , pvObjectName _ , pvOutputFormat _ , pvOutputFile _ , pvAutoStart _ , pvTemplateFile _ , pvEncoding _ , pvQuality _ ) GoTo Exit_Function End If Dim vWindow As Variant, sOutputFile As String, ofForm As Object, i As Integer, bFound As Boolean If pvObjectName = "" Then vWindow = _SelectWindow() If vWindow.WindowType <> acOutoutForm Then Goto Error_Action Set ofForm = Application.Forms(vWindow._Name) Else bFound = False For i = 0 To Application.Forms()._Count - 1 Set ofForm = Application.Forms(i) If UCase(ofForm._Name) = UCase(pvObjectName) Then bFound = True Exit For End If Next i If Not bFound Then Goto Error_NotFound End If Dim sOutputFormat As String, sFilter As String, oFilterData As Object, oExport As Object, sSuffix As String If pvOutputFormat = "" Then sOutputFormat = _PromptFormat(Array("PDF", "ODT", "DOC", "HTML")) If sOutputFormat = "" Then Goto Exit_Function Else sOutputFormat = UCase(pvOutputFormat) End If Select Case sOutputFormat Case UCase(acFormatPDF), "PDF" sFilter = acFormatPDF oFilterData = Array( _ _MakePropertyValue ("ExportFormFields", False), _ ) sSuffix = "pdf" Case UCase(acFormatDOC), "DOC" sFilter = acFormatDOC oFilterData = Array() sSuffix = "doc" Case UCase(acFormatODT), "ODT" sFilter = acFormatODT oFilterData = Array() sSuffix = "odt" Case UCase(acFormatHTML), "HTML" sFilter = acFormatHTML oFilterData = Array() sSuffix = "html" End Select oExport = Array( _ _MakePropertyValue("Overwrite", True), _ _MakePropertyValue("FilterName", sFilter), _ _MakePropertyValue("FilterData", oFilterData), _ ) If pvOutputFile = "" Then sOutputFile = _PromptFilePicker(sSuffix) If sOutputFile = "" Then Goto Exit_Function Else sOutputFile = pvOutputFile End If sOutputFile = ConvertToURL(sOutputFile)
On Local Error Goto Error_File ofForm.Component.storeToURL(sOutputFile, oExport) On Local Error Goto Error_Function If pvAutoStart Then Call _ShellExecute(sOutputFile)
OutputTo = True Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName)) Goto Exit_Function Error_Action: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_File: TraceError(TRACEFATAL, ERRFILENOTCREATED, Utils._CalledSub(), 0, , sOutputFile) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
Quit |
Basic |
|
51 |
Public Function Quit(Optional ByVal pvSave As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "Quit" Utils._SetCalledSub(cstThisSub) If IsMissing(pvSave) Then pvSave = acQuitSaveAll If Not Utils._CheckArgument(pvSave, 1, Utils._AddNumeric(), _ Array(acQuitPrompt, acQuitSaveAll, acQuitSaveNone) _ ) Then Goto Exit_Function Dim oDatabase As Object, oDoc As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable If Not IsNull(oDatabase) Then Set oDoc = oDatabase.Document Select Case pvSave Case acQuitPrompt If MsgBox(_GetLabel("QUIT"), vbYesNo + vbQuestion, _GetLabel("QUITSHORT")) = vbNo Then Exit Function Case acQuitSaveNone oDoc.setModified(False) Case Else End Select If HasUnoInterfaces(oDoc, "com.sun.star.util.XCloseable") Then If (oDoc.isModified) Then If (oDoc.hasLocation AND (Not oDoc.isReadOnly)) Then oDoc.store() End If End If oDoc.close(true) Else oDoc.dispose() End If End If Exit_Function: Utils._ResetCalledSub(cstThisSub) Set oDatabase = Nothing Set oDoc = Nothing Exit Function Error_Function: TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl) Set OpenForm = Nothing GoTo Exit_Function Error_NotApplicable: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
RunApp |
Basic |
|
20 |
Public Sub RunApp(Optional ByVal pvCommandLine As Variant)
If _ErrorHandler() Then On Local Error Goto Error_Sub
Utils._SetCalledSub("RunApp") If IsMissing(pvCommandLine) Then Call _TraceArguments() If Not Utils._CheckArgument(pvCommandLine, 1, vbString) Then Goto Exit_Sub
_ShellExecute(ConvertToURL(pvCommandLine))
Exit_Sub: Utils._ResetCalledSub("RunApp") Exit Sub Error_Sub: TraceError(TRACEABORT, Err, "RunApp", Erl) GoTo Exit_Sub End Sub |
Access2BaseDev |
DoCmd |
RunCommand |
Basic |
ShowAllrecords (Procedure) Execute (Procedure) _PropertySet (Procedure) |
218 |
Public Function RunCommand(Optional pvCommand As Variant, Optional pbReturnCommand As Boolean) As Variant
If _ErrorHandler() Then On Local Error Goto Exit_Function Const cstThisSub = "RunCommand" Utils._SetCalledSub(cstThisSub) Dim iVBACommand As Integer, sOOCommand As String, sDispatch As String If IsMissing(pvCommand) Then Call _TraceArguments() If Not ( Utils._CheckArgument(pvCommand, 1, Utils._AddNumeric(vbString)) ) Then Goto Exit_Function If IsMissing(pbReturnCommand) Then pbReturnCommand = False RunCommand = True Const cstUnoPrefix = ".uno:" If VarType(pvCommand) = vbString Then sOOCommand = pvCommand iVBACommand = -1 If _IsLeft(sOOCommand, cstUnoPrefix) Then Call _DispatchCommand(sOOCommand) Goto Exit_Function End If Else sOOCommand = "" iVBACommand = pvCommand End If Select Case True Case iVBACommand = acCmdAboutMicrosoftAccess Or UCase(sOOCommand) = "ABOUT" : sDispatch = "About" Case iVBACommand = acCmdAboutOpenOffice Or UCase(sOOCommand) = "ABOUT" : sDispatch = "About" Case iVBACommand = acCmdAboutLibreOffice Or UCase(sOOCommand) = "ABOUT" : sDispatch = "About" Case UCase(sOOCommand) = "ACTIVEHELP" : sDispatch = "ActiveHelp" Case UCase(sOOCommand) = "ADDDIRECT" : sDispatch = "AddDirect" Case UCase(sOOCommand) = "ADDFIELD" : sDispatch = "AddField" Case UCase(sOOCommand) = "AUTOCONTROLFOCUS" : sDispatch = "AutoControlFocus" Case UCase(sOOCommand) = "AUTOFILTER" : sDispatch = "AutoFilter" Case UCase(sOOCommand) = "AUTOPILOTADDRESSDATASOURCE" : sDispatch = "AutoPilotAddressDataSource" Case UCase(sOOCommand) = "BASICBREAK" : sDispatch = "BasicBreak" Case iVBACommand = acCmdVisualBasicEditor Or UCase(sOOCommand) = "BASICIDEAPPEAR" : sDispatch = "BasicIDEAppear" Case UCase(sOOCommand) = "BASICSTOP" : sDispatch = "BasicStop" Case iVBACommand = acCmdBringToFront Or UCase(sOOCommand) = "BRINGTOFRONT" : sDispatch = "BringToFront" Case UCase(sOOCommand) = "CHECKBOX" : sDispatch = "CheckBox" Case UCase(sOOCommand) = "CHOOSEMACRO" : sDispatch = "ChooseMacro" Case iVBACommand = acCmdClose Or UCase(sOOCommand) = "CLOSEDOC" : sDispatch = "CloseDoc" Case UCase(sOOCommand) = "CLOSEWIN" : sDispatch = "CloseWin" Case iVBACommand = acCmdToolbarsCustomize Or UCase(sOOCommand) = "CONFIGUREDIALOG" : sDispatch = "ConfigureDialog" Case UCase(sOOCommand) = "CONTROLPROPERTIES" : sDispatch = "ControlProperties" Case iVBACommand = acCmdChangeToCommandButton Or UCase(sOOCommand) = "CONVERTTOBUTTON" : sDispatch = "ConvertToButton" Case iVBACommand = acCmdChangeToCheckBox Or UCase(sOOCommand) = "CONVERTTOCHECKBOX" : sDispatch = "ConvertToCheckBox" Case iVBACommand = acCmdChangeToComboBox Or UCase(sOOCommand) = "CONVERTTOCOMBO" : sDispatch = "ConvertToCombo" Case UCase(sOOCommand) = "CONVERTTOCURRENCY" : sDispatch = "ConvertToCurrency" Case UCase(sOOCommand) = "CONVERTTODATE" : sDispatch = "ConvertToDate" Case iVBACommand = acCmdChangeToTextBox Or UCase(sOOCommand) = "CONVERTTOEDIT" : sDispatch = "ConvertToEdit" Case UCase(sOOCommand) = "CONVERTTOFILECONTROL" : sDispatch = "ConvertToFileControl" Case iVBACommand = acCmdChangeToLabel Or UCase(sOOCommand) = "CONVERTTOFIXED" : sDispatch = "ConvertToFixed" Case UCase(sOOCommand) = "CONVERTTOFORMATTED" : sDispatch = "ConvertToFormatted" Case UCase(sOOCommand) = "CONVERTTOGROUP" : sDispatch = "ConvertToGroup" Case UCase(sOOCommand) = "CONVERTTOIMAGEBTN" : sDispatch = "ConvertToImageBtn" Case iVBACommand = acCmdChangeToImage Or UCase(sOOCommand) = "CONVERTTOIMAGECONTROL" : sDispatch = "ConvertToImageControl" Case iVBACommand = acCmdChangeToListBox Or UCase(sOOCommand) = "CONVERTTOLIST" : sDispatch = "ConvertToList" Case UCase(sOOCommand) = "CONVERTTONAVIGATIONBAR" : sDispatch = "ConvertToNavigationBar" Case UCase(sOOCommand) = "CONVERTTONUMERIC" : sDispatch = "ConvertToNumeric" Case UCase(sOOCommand) = "CONVERTTOPATTERN" : sDispatch = "ConvertToPattern" Case iVBACommand = acCmdChangeToOptionButton Or UCase(sOOCommand) = "CONVERTTORADIO" : sDispatch = "ConvertToRadio" Case UCase(sOOCommand) = "CONVERTTOSCROLLBAR" : sDispatch = "ConvertToScrollBar" Case UCase(sOOCommand) = "CONVERTTOSPINBUTTON" : sDispatch = "ConvertToSpinButton" Case UCase(sOOCommand) = "CONVERTTOTIME" : sDispatch = "ConvertToTime" Case iVBACommand = acCmdCopy Or UCase(sOOCommand) = "COPY" : sDispatch = "Copy" Case UCase(sOOCommand) = "CURRENCYFIELD" : sDispatch = "CurrencyField" Case iVBACommand = acCmdCut Or UCase(sOOCommand) = "CUT" : sDispatch = "Cut" Case UCase(sOOCommand) = "DATEFIELD" : sDispatch = "DateField" Case iVBACommand = acCmdCreateRelationship Or UCase(sOOCommand) = "DBADDRELATION " : sDispatch = "DBAddRelation " Case UCase(sOOCommand) = "DBCONVERTTOVIEW " : sDispatch = "DBConvertToView " Case iVBACommand = acCmdDelete Or UCase(sOOCommand) = "DBDELETE " : sDispatch = "DBDelete " Case UCase(sOOCommand) = "DBDIRECTSQL " : sDispatch = "DBDirectSQL " Case UCase(sOOCommand) = "DBDSADVANCEDSETTINGS " : sDispatch = "DBDSAdvancedSettings " Case UCase(sOOCommand) = "DBDSCONNECTIONTYPE " : sDispatch = "DBDSConnectionType " Case iVBACommand = acCmdDatabaseProperties Or UCase(sOOCommand) = "DBDSPROPERTIES " : sDispatch = "DBDSProperties " Case UCase(sOOCommand) = "DBEDIT " : sDispatch = "DBEdit " Case iVBACommand = acCmdSQLView Or UCase(sOOCommand) = "DBEDITSQLVIEW " : sDispatch = "DBEditSqlView " Case iVBACommand = acCmdRemove Or UCase(sOOCommand) = "DBFORMDELETE " : sDispatch = "DBFormDelete " Case iVBACommand = acCmdDesignView Or UCase(sOOCommand) = "DBFORMEDIT " : sDispatch = "DBFormEdit " Case iVBACommand = acCmdFormView Or UCase(sOOCommand) = "DBFORMOPEN " : sDispatch = "DBFormOpen " Case UCase(sOOCommand) = "DBFORMRENAME " : sDispatch = "DBFormRename " Case iVBACommand = acCmdNewObjectForm Or UCase(sOOCommand) = "DBNEWFORM " : sDispatch = "DBNewForm " Case UCase(sOOCommand) = "DBNEWFORMAUTOPILOT " : sDispatch = "DBNewFormAutoPilot " Case UCase(sOOCommand) = "DBNEWQUERY " : sDispatch = "DBNewQuery " Case UCase(sOOCommand) = "DBNEWQUERYAUTOPILOT " : sDispatch = "DBNewQueryAutoPilot " Case UCase(sOOCommand) = "DBNEWQUERYSQL " : sDispatch = "DBNewQuerySql " Case UCase(sOOCommand) = "DBNEWREPORT " : sDispatch = "DBNewReport " Case UCase(sOOCommand) = "DBNEWREPORTAUTOPILOT " : sDispatch = "DBNewReportAutoPilot " Case iVBACommand = acCmdNewObjectTable Or UCase(sOOCommand) = "DBNEWTABLE " : sDispatch = "DBNewTable " Case UCase(sOOCommand) = "DBNEWTABLEAUTOPILOT " : sDispatch = "DBNewTableAutoPilot " Case iVBACommand = acCmdNewObjectView Or UCase(sOOCommand) = "DBNEWVIEW " : sDispatch = "DBNewView " Case UCase(sOOCommand) = "DBNEWVIEWSQL " : sDispatch = "DBNewViewSQL " Case iVBACommand = acCmdOpenDatabase Or UCase(sOOCommand) = "DBOPEN " : sDispatch = "DBOpen " Case iVBACommand = acCmdRemove Or UCase(sOOCommand) = "DBQUERYDELETE " : sDispatch = "DBQueryDelete " Case iVBACommand = acCmdDesignView Or UCase(sOOCommand) = "DBQUERYEDIT " : sDispatch = "DBQueryEdit " Case iVBACommand = acCmdNewObjectQuery Or UCase(sOOCommand) = "DBQUERYOPEN " : sDispatch = "DBQueryOpen " Case UCase(sOOCommand) = "DBQUERYRENAME " : sDispatch = "DBQueryRename " Case UCase(sOOCommand) = "DBREFRESHTABLES " : sDispatch = "DBRefreshTables " Case iVBACommand = acCmdShowAllRelationships Or UCase(sOOCommand) = "DBRELATIONDESIGN " : sDispatch = "DBRelationDesign " Case UCase(sOOCommand) = "DBRENAME " : sDispatch = "DBRename " Case iVBACommand = acCmdRemove Or UCase(sOOCommand) = "DBREPORTDELETE " : sDispatch = "DBReportDelete " Case iVBACommand = acCmdDesignView Or UCase(sOOCommand) = "DBREPORTEDIT " : sDispatch = "DBReportEdit " Case iVBACommand = acCmdNewObjectReport Or UCase(sOOCommand) = "DBREPORTOPEN " : sDispatch = "DBReportOpen " Case UCase(sOOCommand) = "DBREPORTRENAME " : sDispatch = "DBReportRename " Case iVBACommand = acCmdSelectAll Or UCase(sOOCommand) = "DBSELECTALL " : sDispatch = "DBSelectAll " Case UCase(sOOCommand) = "DBSHOWDOCINFOPREVIEW " : sDispatch = "DBShowDocInfoPreview " Case UCase(sOOCommand) = "DBSHOWDOCPREVIEW " : sDispatch = "DBShowDocPreview " Case iVBACommand = acCmdRemoveTable Or UCase(sOOCommand) = "DBTABLEDELETE " : sDispatch = "DBTableDelete " Case iVBACommand = acCmdDesignView Or UCase(sOOCommand) = "DBTABLEEDIT " : sDispatch = "DBTableEdit " Case UCase(sOOCommand) = "DBTABLEFILTER " : sDispatch = "DBTableFilter " Case iVBACommand = acCmdOpenTable Or UCase(sOOCommand) = "DBTABLEOPEN " : sDispatch = "DBTableOpen " Case iVBACommand = acCmdRename Or UCase(sOOCommand) = "DBTABLERENAME " : sDispatch = "DBTableRename " Case UCase(sOOCommand) = "DBUSERADMIN " : sDispatch = "DBUserAdmin " Case UCase(sOOCommand) = "DBVIEWFORMS " : sDispatch = "DBViewForms " Case UCase(sOOCommand) = "DBVIEWQUERIES " : sDispatch = "DBViewQueries " Case UCase(sOOCommand) = "DBVIEWREPORTS " : sDispatch = "DBViewReports " Case UCase(sOOCommand) = "DBVIEWTABLES " : sDispatch = "DBViewTables " Case iVBACommand = acCmdDelete Or UCase(sOOCommand) = "DELETE" : sDispatch = "Delete" Case iVBACommand = acCmdDeleteRecord Or UCase(sOOCommand) = "DELETERECORD" : sDispatch = "DeleteRecord" Case UCase(sOOCommand) = "DESIGNERDIALOG" : sDispatch = "DesignerDialog" Case UCase(sOOCommand) = "EDIT" : sDispatch = "Edit" Case UCase(sOOCommand) = "FIRSTRECORD" : sDispatch = "FirstRecord" Case UCase(sOOCommand) = "FONTDIALOG" : sDispatch = "FontDialog" Case UCase(sOOCommand) = "FONTHEIGHT" : sDispatch = "FontHeight" Case UCase(sOOCommand) = "FORMATTEDFIELD" : sDispatch = "FormattedField" Case UCase(sOOCommand) = "FORMFILTER" : sDispatch = "FormFilter" Case iVBACommand = acCmdApplyFilterSort Or UCase(sOOCommand) = "FORMFILTERED" : sDispatch = "FormFiltered" Case UCase(sOOCommand) = "FORMFILTEREXECUTE" : sDispatch = "FormFilterExecute" Case UCase(sOOCommand) = "FORMFILTEREXIT" : sDispatch = "FormFilterExit" Case UCase(sOOCommand) = "FORMFILTERNAVIGATOR" : sDispatch = "FormFilterNavigator" Case UCase(sOOCommand) = "FORMPROPERTIES" : sDispatch = "FormProperties" Case UCase(sOOCommand) = "FULLSCREEN" : sDispatch = "FullScreen" Case UCase(sOOCommand) = "GALLERY" : sDispatch = "Gallery" Case UCase(sOOCommand) = "GRID" : sDispatch = "Grid" Case iVBACommand = acCmdSnapToGrid Or UCase(sOOCommand) = "GRIDUSE" : sDispatch = "GridUse" Case iVBACommand = acCmdViewGrid Or UCase(sOOCommand) = "GRIDVISIBLE" : sDispatch = "GridVisible" Case UCase(sOOCommand) = "GROUPBOX" : sDispatch = "GroupBox" Case UCase(sOOCommand) = "HELPINDEX" : sDispatch = "HelpIndex" Case UCase(sOOCommand) = "HELPSUPPORT" : sDispatch = "HelpSupport" Case iVBACommand = acCmdInsertHyperlink Or UCase(sOOCommand) = "HYPERLINKDIALOG" : sDispatch = "HyperlinkDialog" Case UCase(sOOCommand) = "IMAGEBUTTON" : sDispatch = "Imagebutton" Case UCase(sOOCommand) = "IMAGECONTROL" : sDispatch = "ImageControl" Case UCase(sOOCommand) = "LABEL" : sDispatch = "Label" Case iVBACommand = acCmdMaximumRecords Or UCase(sOOCommand) = "LASTRECORD" : sDispatch = "LastRecord" Case UCase(sOOCommand) = "LISTBOX" : sDispatch = "ListBox" Case UCase(sOOCommand) = "MACRODIALOG" : sDispatch = "MacroDialog" Case UCase(sOOCommand) = "MACROORGANIZER" : sDispatch = "MacroOrganizer" Case UCase(sOOCommand) = "MORECONTROLS" : sDispatch = "MoreControls" Case UCase(sOOCommand) = "NAVIGATIONBAR" : sDispatch = "NavigationBar" Case iVBACommand = acCmdObjectBrowser Or UCase(sOOCommand) = "NAVIGATOR" : sDispatch = "Navigator" Case UCase(sOOCommand) = "NEWDOC" : sDispatch = "NewDoc" Case UCase(sOOCommand) = "NEWRECORD" : sDispatch = "NewRecord" Case UCase(sOOCommand) = "NEXTRECORD" : sDispatch = "NextRecord" Case UCase(sOOCommand) = "NUMERICFIELD" : sDispatch = "NumericField" Case UCase(sOOCommand) = "OPEN" : sDispatch = "Open" Case UCase(sOOCommand) = "OPTIONSTREEDIALOG" : sDispatch = "OptionsTreeDialog" Case UCase(sOOCommand) = "ORGANIZER" : sDispatch = "Organizer" Case UCase(sOOCommand) = "PARAGRAPHDIALOG" : sDispatch = "ParagraphDialog" Case iVBACommand = acCmdPaste Or UCase(sOOCommand) = "PASTE" : sDispatch = "Paste" Case iVBACommand = acCmdPasteSpecial Or UCase(sOOCommand) = "PASTESPECIAL " : sDispatch = "PasteSpecial " Case UCase(sOOCommand) = "PATTERNFIELD" : sDispatch = "PatternField" Case UCase(sOOCommand) = "PREVRECORD" : sDispatch = "PrevRecord" Case iVBACommand = acCmdPrint Or UCase(sOOCommand) = "PRINT" : sDispatch = "Print" Case UCase(sOOCommand) = "PRINTDEFAULT" : sDispatch = "PrintDefault" Case UCase(sOOCommand) = "PRINTERSETUP" : sDispatch = "PrinterSetup" Case iVBACommand = acCmdPrintPreview Or UCase(sOOCommand) = "PRINTPREVIEW" : sDispatch = "PrintPreview" Case UCase(sOOCommand) = "PUSHBUTTON" : sDispatch = "Pushbutton" Case UCase(sOOCommand) = "QUIT" : sDispatch = "Quit" Case UCase(sOOCommand) = "RADIOBUTTON" : sDispatch = "RadioButton" Case iVBACommand = acCmdSaveRecord Or UCase(sOOCommand) = "RECSAVE" : sDispatch = "RecSave" Case iVBACommand = acCmdFind Or UCase(sOOCommand) = "RECSEARCH" : sDispatch = "RecSearch" Case iVBACommand = acCmdUndo Or UCase(sOOCommand) = "RECUNDO" : sDispatch = "RecUndo" Case iVBACommand = acCmdRefresh Or UCase(sOOCommand) = "REFRESH" : sDispatch = "Refresh" Case UCase(sOOCommand) = "RELOAD" : sDispatch = "Reload" Case iVBACommand = acCmdRemoveFilterSort Or UCase(sOOCommand) = "REMOVEFILTERSORT" : sDispatch = "RemoveFilterSort" Case iVBACommand = acCmdRunMacro Or UCase(sOOCommand) = "RUNMACRO" : sDispatch = "RunMacro" Case iVBACommand = acCmdSave Or UCase(sOOCommand) = "SAVE" : sDispatch = "Save" Case UCase(sOOCommand) = "SAVEALL" : sDispatch = "SaveAll" Case iVBACommand = acCmdSaveAs Or UCase(sOOCommand) = "SAVEAS" : sDispatch = "SaveAs" Case UCase(sOOCommand) = "SAVEBASICAS" : sDispatch = "SaveBasicAs" Case UCase(sOOCommand) = "SCRIPTORGANIZER" : sDispatch = "ScriptOrganizer" Case UCase(sOOCommand) = "SCROLLBAR" : sDispatch = "ScrollBar" Case iVBACommand = acCmdFind Or UCase(sOOCommand) = "SEARCHDIALOG" : sDispatch = "SearchDialog" Case iVBACommand = acCmdSelectAll Or UCase(sOOCommand) = "SELECTALL" : sDispatch = "SelectAll" Case iVBACommand = acCmdSelectAllRecords Or UCase(sOOCommand) = "SELECTALL" : sDispatch = "SelectAll" Case iVBACommand = acCmdSendToBack Or UCase(sOOCommand) = "SENDTOBACK" : sDispatch = "SendToBack" Case UCase(sOOCommand) = "SHOWFMEXPLORER" : sDispatch = "ShowFmExplorer" Case UCase(sOOCommand) = "SIDEBAR" : sDispatch = "Sidebar" Case iVBACommand = acCmdSortDescending Or UCase(sOOCommand) = "SORTDOWN" : sDispatch = "SortDown" Case iVBACommand = acCmdSortAscending Or UCase(sOOCommand) = "SORTUP" : sDispatch = "Sortup" Case UCase(sOOCommand) = "SPINBUTTON" : sDispatch = "SpinButton" Case UCase(sOOCommand) = "STATUSBARVISIBLE" : sDispatch = "StatusBarVisible" Case UCase(sOOCommand) = "SWITCHCONTROLDESIGNMODE" : sDispatch = "SwitchControlDesignMode" Case iVBACommand = acCmdTabOrder Or UCase(sOOCommand) = "TABDIALOG" : sDispatch = "TabDialog" Case UCase(sOOCommand) = "USEWIZARDS" : sDispatch = "UseWizards" Case UCase(sOOCommand) = "VERSIONDIALOG" : sDispatch = "VersionDialog" Case UCase(sOOCommand) = "VIEWDATASOURCEBROWSER" : sDispatch = "ViewDataSourceBrowser" Case iVBACommand = acCmdDatasheetView Or UCase(sOOCommand) = "VIEWFORMASGRID" : sDispatch = "ViewFormAsGrid" Case iVBACommand = acCmdZoomSelection Or UCase(sOOCommand) = "ZOOM" : sDispatch = "Zoom" Case Else If iVBACommand >= 0 Then Goto Exit_Function sDispatch = pvCommand End Select If pbReturnCommand Then RunCommand = cstUnoPrefix & sDispatch Else Call _DispatchCommand(cstUnoPrefix & sDispatch)
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
RunSQL |
Basic |
CopyObject (Procedure) |
30 |
Public Function RunSQL(Optional ByVal pvSQL As Variant _ , Optional ByVal pvOption As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function
Utils._SetCalledSub("RunSQL") RunSQL = False If IsMissing(pvSQL) Then Call _TraceArguments() If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function Const cstNull = -1 If IsMissing(pvOption) Then pvOption = cstNull Else If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function End If
RunSQL = Application._CurrentDb.RunSQL(pvSQL, pvOption)
Exit_Function: Utils._ResetCalledSub("RunSQL") Exit Function Error_Function: TraceError(TRACEABORT, Err, "RunSQL", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
SelectObject |
Basic |
|
48 |
Public Function SelectObject( ByVal Optional pvObjectType As Variant _ , ByVal Optional pvObjectName As Variant _ , ByVal Optional pvInDatabaseWindow As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "SelectObject" Utils._SetCalledSub(cstThisSub) If IsMissing(pvObjectType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _ Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow, acDocument) _ ) Then Goto Exit_Function If IsMissing(pvObjectName) Then Select Case pvObjectType Case acForm, acQuery, acTable, acReport, acDocument : Call _TraceArguments() Case Else End Select pvObjectName = "" Else If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function End If If Not IsMissing(pvInDatabaseWindow) Then If Not Utils._CheckArgument(pvInDatabaseWindow, 3, vbBoolean, False) Then Goto Exit_Function End If Dim oWindow As Object Set oWindow = _SelectWindow(pvObjectType, pvObjectName) If IsNull(oWindow.Frame) Then Goto Error_NotFound With oWindow.Frame.ContainerWindow If .isVisible() = False Then .setVisible(True) .IsMinimized = False .setFocus() .setEnable(True) .toFront() End With
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName)) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
SendObject |
Basic |
|
101 |
Public Function SendObject(ByVal Optional pvObjectType As Variant _ , ByVal Optional pvObjectName As Variant _ , ByVal Optional pvOutputFormat As Variant _ , ByVal Optional pvTo As Variant _ , ByVal Optional pvCc As Variant _ , ByVal Optional pvBcc As Variant _ , ByVal Optional pvSubject As Variant _ , ByVal Optional pvMessageText As Variant _ , ByVal Optional pvEditMessage As Variant _ , ByVal Optional pvTemplateFile As Variant _ ) As Boolean If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("SendObject") SendObject = False If IsMissing(pvObjectType) Then pvObjectType = acSendNoObject If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acSendNoObject, acSendForm)) Then Goto Exit_Function If IsMissing(pvObjectName) Then pvObjectName = "" If Not Utils._CheckArgument(pvObjectName, 2,vbString) Then Goto Exit_Function If IsMissing(pvOutputFormat) Then pvOutputFormat = "" If Not Utils._CheckArgument(pvOutputFormat, 3, vbString) Then Goto Exit_Function If pvOutputFormat <> "" Then If Not Utils._CheckArgument(UCase(pvOutputFormat), 3, vbString, Array( _ UCase(acFormatPDF), UCase(acFormatODT), UCase(acFormatDOC), UCase(acFormatHTML) _ , "PDF", "ODT", "DOC", "HTML", "" _ )) Then Goto Exit_Function End If If IsMissing(pvTo) Then pvTo = "" If Not Utils._CheckArgument(pvTo, 4, vbString) Then Goto Exit_Function If IsMissing(pvCc) Then pvCc = "" If Not Utils._CheckArgument(pvCc, 5, vbString) Then Goto Exit_Function If IsMissing(pvBcc) Then pvBcc = "" If Not Utils._CheckArgument(pvBcc, 6, vbString) Then Goto Exit_Function If IsMissing(pvSubject) Then pvSubject = "" If Not Utils._CheckArgument(pvSubject, 7, vbString) Then Goto Exit_Function If IsMissing(pvMessageText) Then pvMessageText = "" If Not Utils._CheckArgument(pvMessageText, 8, vbString) Then Goto Exit_Function If IsMissing(pvEditMessage) Then pvEditMessage = True If Not Utils._CheckArgument(pvEditMessage, 9, vbBoolean) Then Goto Exit_Function If IsMissing(pvTemplateFile) Then pvTemplateFile = "" If Not Utils._CheckArgument(pvTemplateFile,10, vbString, "") Then Goto Exit_Function
Dim vTo() As Variant, vCc() As Variant, vBcc() As Variant, oWindow As Object Dim sDirectory As String, sOutputFile As String, sSuffix As String, sOutputFormat As String Const cstSemiColon = ";" If pvTo <> "" Then vTo() = Split(pvTo, cstSemiColon) Else vTo() = Array() If pvCc <> "" Then vCc() = Split(pvCc, cstSemiColon) Else vCc() = Array() If pvBcc <> "" Then vBcc() = Split(pvBcc, cstSemiColon) Else vBcc() = Array() Select Case True Case pvObjectType = acSendNoObject And pvObjectName = "" SendObject = _SendWithoutAttachment(vTo, vCc, vBcc, pvSubject, pvMessageText) Case Else If pvObjectType = acSendNoObject And pvObjectName <> "" Then If Not FileExists(pvObjectName) Then Goto Error_File sOutputFile = pvObjectName Else If pvObjectType <> acSendNoObject And pvObjectName = "" Then oWindow = _SelectWindow() If oWindow.WindowType <> acSendForm Then Goto Error_Action pvObjectType = acSendForm pvObjectName = oWindow._Name End If sDirectory = Utils._getTempDirectoryURL() If Right(sDirectory, 1) <> "/" Then sDirectory = sDirectory & "/" If pvOutputFormat = "" Then sOutputFormat = _PromptFormat(Array("PDF", "ODT", "DOC", "HTML")) If sOutputFormat = "" Then Goto Exit_Function Else sOutputFormat = UCase(pvOutputFormat) End If Select Case sOutputFormat Case UCase(acFormatPDF), "PDF" : sSuffix = "pdf" Case UCase(acFormatDOC), "DOC" : sSuffix = "doc" Case UCase(acFormatODT), "ODT" : sSuffix = "odt" Case UCase(acFormatHTML), "HTML" : sSuffix = "html" End Select sOutputFile = sDirectory & pvObjectName & "." & sSuffix If Not OutputTo(pvObjectType, pvObjectName, sOutputFormat, sOutputFile, False) Then Goto Exit_Function End If SendObject = _SendWithAttachment(vTo, vCc, vBcc, pvSubject, Array(sOutputFile), pvMessageText, pvEditMessage) End Select
Exit_Function: Utils._ResetCalledSub("SendObject") Exit Function Error_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName)) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "SendObject", Erl) GoTo Exit_Function Error_Action: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0) Goto Exit_Function Error_File: TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , pvObjectName) Goto Exit_Function End Function |
Access2BaseDev |
DoCmd |
SetHiddenAttribute |
Basic |
|
46 |
Public Function SetHiddenAttribute(ByVal Optional pvObjectType As Variant _ , ByVal Optional pvObjectName As Variant _ , ByVal Optional pvHidden As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function SetHiddenAttribute = False Const cstThisSub = "SetHiddenAttribute" Utils._SetCalledSub(cstThisSub) If IsMissing(pvObjectType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), _ Array(acDiagram, acForm, acQuery, acTable, acReport, acBasicIDE, acDatabaseWindow), acDocument _ ) Then Goto Exit_Function If IsMissing(pvObjectName) Then Select Case pvObjectType Case acForm, acQuery, acTable, acReport, acDocument : Call _TraceArguments() Case Else End Select pvObjectName = "" Else If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function End If If IsMissing(pvHidden) Then pvHidden = True Else If Not Utils._CheckArgument(pvHidden, 3, vbBoolean) Then Goto Exit_Function End If Dim oWindow As Object Set oWindow = _SelectWindow(pvObjectType, pvObjectName) If IsNull(oWindow.Frame) Then Goto Error_NotFound oWindow.Frame.ContainerWindow.setVisible(Not pvHidden) SetHiddenAttribute = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("OBJECT"), pvObjectName)) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
SetOrderBy |
Basic |
|
54 |
Public Function SetOrderBy( _ ByVal Optional pvOrder As Variant _ , ByVal Optional pvControlName As Variant _ ) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "SetOrderBy" Utils._SetCalledSub(cstThisSub) SetOrderBy = False If IsMissing(pvOrder) Then pvOrder = "" If Not Utils._CheckArgument(pvOrder, 1, vbString) Then Goto Exit_Function If IsMissing(pvControlName) Then pvControlName = "" If Not Utils._CheckArgument(pvControlName, 1, vbString) Then Goto Exit_Function
Dim sOrder As String, oWindow As Object, oDatabase As Object, oTarget As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
sOrder = oDatabase._ReplaceSquareBrackets(pvOrder)
Set oWindow = _SelectWindow() With oWindow Select Case .WindowType Case acForm Set oTarget = _DatabaseForm(._Name, pvControlName) Case acQuery, acTable If pvControlName <> "" Then Goto Exit_Function If IsNull(.Frame.Controller.FormOperations) Then Goto Error_NotApplicable Set oTarget = .Frame.Controller.FormOperations.Cursor Case Else Goto Exit_Function End Select End With
With oTarget .Order = sOrder .reload() End With SetOrderBy = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotApplicable: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
DoCmd |
ShowAllrecords |
Basic |
|
31 |
Public Function ShowAllrecords() As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "ShowAllRecords" Utils._SetCalledSub(cstThisSub) ShowAllRecords = False
Dim oWindow As Object, oDatabase As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
Set oWindow = _SelectWindow() Select Case oWindow.WindowType Case acForm, acQuery, acTable RunCommand(acCmdRemoveFilterSort) ShowAllrecords = True Case Else End Select
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_NotApplicable: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Event |
_Initialize |
Basic |
|
155 |
Public Sub _Initialize(poEvent As Object)
Dim oObject As Object, i As Integer Dim sShortcut As String, sAddShortcut As String, sArray() As String Dim sImplementation As String, oSelection As Object Dim iCurrentDoc As Integer, oDoc As Object Const cstDatabaseForm = "com.sun.star.comp.forms.ODatabaseForm"
If _ErrorHandler() Then On Local Error Goto Error_Function
Set oObject = poEvent.Source _EventSource = oObject sArray = Split(Utils._getUNOTypeName(poEvent), ".") _EventType = UCase(sArray(UBound(sArray))) If Utils._hasUNOProperty(poEvent, "EventName") Then _EventName = poEvent.EventName
Select Case _EventType Case "DOCUMENTEVENT" Select Case UCase(_EventName) Case UCase("OnSubComponentClosed"), UCase("OnSubComponentOpened") Set oSelection = poEvent.ViewController.getSelection()(0) _SubComponentName = oSelection.Name With com.sun.star.sdb.application.DatabaseObject Select Case oSelection.Type Case .TABLE : _SubComponentType = acTable Case .QUERY : _SubComponentType = acQuery Case .FORM : _SubComponentType = acForm Case .REPORT : _SubComponentType = acReport Case Else End Select End With Case Else End Select Case "EVENTOBJECT" Case "ACTIONEVENT" Case "FOCUSEVENT" _FocusChangeTemporary = poEvent.Temporary Case "ITEMEVENT" Case "INPUTEVENT", "KEYEVENT" _KeyCode = poEvent.KeyCode _KeyChar = poEvent.KeyChar _KeyFunction = poEvent.KeyFunc _KeyAlt = Utils._BitShift(poEvent.Modifiers, com.sun.star.awt.KeyModifier.MOD2) _KeyCtrl = Utils._BitShift(poEvent.Modifiers, com.sun.star.awt.KeyModifier.MOD1) _KeyShift = Utils._BitShift(poEvent.Modifiers, com.sun.star.awt.KeyModifier.SHIFT) Case "MOUSEEVENT" _ButtonLeft = Utils._BitShift(poEvent.Buttons, com.sun.star.awt.MouseButton.LEFT) _ButtonRight = Utils._BitShift(poEvent.Buttons, com.sun.star.awt.MouseButton.RIGHT) _ButtonMiddle = Utils._BitShift(poEvent.Buttons, com.sun.star.awt.MouseButton.MIDDLE) _XPos = poEvent.X _YPos = poEvent.Y _ClickCount = poEvent.ClickCount Case "ROWCHANGEEVENT" _RowChangeAction = poEvent.Action Case "TEXTEVENT" Case "ADJUSTMENTEVENT", "DOCKINGEVENT", "ENDDOCKINGEVENT", "ENDPOPUPMODEEVENT", "ENHANCEDMOUSEEVENT" _ , "MENUEVENT", "PAINTEVENT", "SPINEVENT", "VCLCONTAINEREVENT", "WINDOWEVENT" Goto Exit_Function Case Else Goto Exit_Function End Select
sShortcut = "" sImplementation = Utils._ImplementationName(oObject) Select Case True Case sImplementation = "stardiv.Toolkit.UnoDialogControl" _ContextShortcut = "Dialogs!" & _EventSource.Model.Name Goto Exit_Function Case Left(sImplementation, 16) = "stardiv.Toolkit." _ContextShortcut = "Dialogs!" & _EventSource.Context.Model.Name _ & "!" & _EventSource.Model.Name Goto Exit_Function Case Else End Select iCurrentDoc = _A2B_.CurrentDocIndex(, False) If iCurrentDoc < 0 Then Goto Exit_Function Set oDoc = _A2B_.CurrentDocument(iCurrentDoc)
If _EventType = "ROWCHANGEEVENT" And sImplementation <> "com.sun.star.comp.forms.ODatabaseForm" Then _Recommendation = "IGNORE"
Do While sImplementation <> "SwXTextDocument" sAddShortcut = "" Select Case sImplementation Case "com.sun.star.comp.forms.OFormsCollection" Case Else If Utils._hasUNOProperty(oObject, "Model") Then If oObject.Model.Name <> "MainForm" And oObject.Model.Name <> "Form" Then sAddShortcut = Utils._Surround(oObject.Model.Name) ElseIf Utils._hasUNOProperty(oObject, "Name") Then If oObject.Name <> "MainForm" And oObject.Name <> "Form" Then sAddShortcut = Utils._Surround(oObject.Name) End If If sAddShortcut <> "" Then If sImplementation = cstDatabaseForm And oDoc.DbConnect = DBCONNECTBASE Then sAddShortcut = sAddShortcut & ".Form" sShortcut = sAddShortcut & Iif(Len(sShortcut) > 0, "!" & sShortcut, "") End If End Select Select Case True Case Utils._hasUNOProperty(oObject, "Model") Set oObject = oObject.Model.Parent Case Utils._hasUNOProperty(oObject, "Parent") Set oObject = oObject.Parent Case Else Goto Exit_Function End Select sImplementation = Utils._ImplementationName(oObject) Loop If Utils._hasUNOProperty(oObject, "Args") Then For i = 0 To UBound(oObject.Args) If oObject.Args(i).Name = "DocumentTitle" Then sAddShortcut = Utils._Surround(oObject.Args(i).Value) Exit For End If Next i End If sShortcut = "Forms!" & sAddShortcut & "!" & sShortcut
sArray = Split(sShortcut, "!") If UBound(sArray) >= 2 Then If UCase(sArray(1)) & ".FORM" = UCase(sArray(2)) Then sArray(1) = "" sArray = Utils._TrimArray(sArray) End If If UBound(sArray) >= 1 Then If Len(sArray(1)) > 5 And Right(sArray(1), 5) = ".Form" Then sArray(1) = left(sArray(1), Len(sArray(1)) - 5) sShortcut = Join(sArray, "!") End If If Len(sShortcut) >= 2 Then If Right(sShortcut, 1) = "!" Then _ContextShortcut = Left(sShortcut, Len(sShortcut) - 1) Else _ContextShortcut = sShortcut End If End If
Exit_Function: Exit Sub Error_Function: TraceError(TRACEWARNING, Err, "Event.Initialize", Erl) GoTo Exit_Function End Sub |
Access2BaseDev |
Event |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
19 |
Private Function _PropertiesList() As Variant
Dim sSubComponentName As String, sSubComponentType As String sSubComponentName = Iif(_SubComponentType > -1, "SubComponentName", "") sSubComponentType = Iif(_SubComponentType > -1, "SubComponentType", "") Dim sXPos As String, sYPos As String sXPos = Iif(IsNull(_XPos), "", "XPos") sYPos = Iif(IsNull(_YPos), "", "YPos")
_PropertiesList = Utils._TrimArray(Array( _ "ButtonLeft", "ButtonRight", "ButtonMiddle", "ClickCount" _ , "ContextShortcut", "EventName", "EventType", "FocusChangeTemporary", _ , "KeyAlt", "KeyChar", "KeyCode", "KeyCtrl", "KeyFunction", "KeyShift" _ , "ObjectType", "Recommendation", "RowChangeAction", "Source" _ , sSubComponentName, sSubComponentType, sXPos, sYPos _ ))
End Function |
Access2BaseDev |
Event |
_PropertyGet |
Basic |
ButtonLeft (Procedure) ButtonMiddle (Procedure) ButtonRight (Procedure) ClickCount (Procedure) ContextShortcut (Procedure) EventName (Procedure) EventSource (Procedure) EventType (Procedure) FocusChangeTemporary (Procedure) KeyAlt (Procedure) KeyChar (Procedure) KeyCode (Procedure) KeyCtrl (Procedure) KeyFunction (Procedure) KeyShift (Procedure) ObjectType (Procedure) Properties (Procedure) Recommendation (Procedure) RowChangeAction (Procedure) Source (Procedure) SubComponentName (Procedure) SubComponentType (Procedure) XPos (Procedure) YPos (Procedure) getProperty (Procedure) |
79 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Event.get" & psProperty)
_PropertyGet = EMPTY Select Case UCase(psProperty) Case UCase("ButtonLeft") _PropertyGet = _ButtonLeft Case UCase("ButtonMiddle") _PropertyGet = _ButtonMiddle Case UCase("ButtonRight") _PropertyGet = _ButtonRight Case UCase("ClickCount") _PropertyGet = _ClickCount Case UCase("ContextShortcut") _PropertyGet = _ContextShortcut Case UCase("FocusChangeTemporary") _PropertyGet = _FocusChangeTemporary Case UCase("EventName") _PropertyGet = _EventName Case UCase("EventSource") _PropertyGet = _EventSource Case UCase("EventType") _PropertyGet = _EventType Case UCase("KeyAlt") _PropertyGet = _KeyAlt Case UCase("KeyChar") _PropertyGet = _KeyChar Case UCase("KeyCode") _PropertyGet = _KeyCode Case UCase("KeyCtrl") _PropertyGet = _KeyCtrl Case UCase("KeyFunction") _PropertyGet = _KeyFunction Case UCase("KeyShift") _PropertyGet = _KeyShift Case UCase("ObjectType") _PropertyGet = _Type Case UCase("Recommendation") _PropertyGet = _Recommendation Case UCase("RowChangeAction") _PropertyGet = _RowChangeAction Case UCase("Source") If _ContextShortcut = "" Then _PropertyGet = _EventSource Else _PropertyGet = getObject(_ContextShortcut) End If Case UCase("SubComponentName") _PropertyGet = _SubComponentName Case UCase("SubComponentType") _PropertyGet = _SubComponentType Case UCase("XPos") If IsNull(_XPos) Then Goto Trace_Error _PropertyGet = _XPos Case UCase("YPos") If IsNull(_YPos) Then Goto Trace_Error _PropertyGet = _YPos Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("Event.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, False, psProperty) _PropertyGet = EMPTY Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Event._PropertyGet", Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function |
Access2BaseDev |
Event |
ButtonLeft |
Basic |
|
6 |
Property Get ButtonLeft() As Variant ButtonLeft = _PropertyGet("ButtonLeft") End Property |
Access2BaseDev |
Event |
ButtonMiddle |
Basic |
|
4 |
Property Get ButtonMiddle() As Variant ButtonMiddle = _PropertyGet("ButtonMiddle") End Property |
Access2BaseDev |
Event |
ButtonRight |
Basic |
|
4 |
Property Get ButtonRight() As Variant ButtonRight = _PropertyGet("ButtonRight") End Property |
Access2BaseDev |
Event |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
27 |
Private Sub Class_Initialize() _Type = OBJEVENT _EventSource = Nothing _EventType = "" _EventName = "" _SubComponentName = "" _SubComponentType = -1 _ContextShortcut = "" _ButtonLeft = False _ButtonRight = False _ButtonMiddle = False _XPos = Null _YPos = Null _ClickCount = 0 _KeyCode = 0 _KeyChar = "" _KeyFunction = com.sun.star.awt.KeyFunction.DONTKNOW _KeyAlt = False _KeyCtrl = False _KeyShift = False _FocusChangeTemporary = False _RowChangeAction = 0 _Recommendation = "" End Sub |
Access2BaseDev |
Event |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
Event |
ClickCount |
Basic |
|
4 |
Property Get ClickCount() As Variant ClickCount = _PropertyGet("ClickCount") End Property |
Access2BaseDev |
Event |
ContextShortcut |
Basic |
|
4 |
Property Get ContextShortcut() As Variant ContextShortcut = _PropertyGet("ContextShortcut") End Property |
Access2BaseDev |
Event |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
Event |
EventName |
Basic |
|
4 |
Property Get EventName() As Variant EventName = _PropertyGet("EventName") End Property |
Access2BaseDev |
Event |
EventSource |
Basic |
|
4 |
Property Get EventSource() As Variant EventSource = _PropertyGet("EventSource") End Property |
Access2BaseDev |
Event |
EventType |
Basic |
|
4 |
Property Get EventType() As Variant EventType = _PropertyGet("EventType") End Property |
Access2BaseDev |
Event |
FocusChangeTemporary |
Basic |
|
4 |
Property Get FocusChangeTemporary() As Variant FocusChangeTemporary = _PropertyGet("FocusChangeTemporary") End Property |
Access2BaseDev |
Event |
getProperty |
Basic |
|
12 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("Form.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("Form.getProperty") End Function |
Access2BaseDev |
Event |
hasProperty |
Basic |
|
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
Event |
KeyAlt |
Basic |
|
4 |
Property Get KeyAlt() As Variant KeyAlt = _PropertyGet("KeyAlt") End Property |
Access2BaseDev |
Event |
KeyChar |
Basic |
|
4 |
Property Get KeyChar() As Variant KeyChar = _PropertyGet("KeyChar") End Property |
Access2BaseDev |
Event |
KeyCode |
Basic |
|
4 |
Property Get KeyCode() As Variant KeyCode = _PropertyGet("KeyCode") End Property |
Access2BaseDev |
Event |
KeyCtrl |
Basic |
|
4 |
Property Get KeyCtrl() As Variant KeyCtrl = _PropertyGet("KeyCtrl") End Property |
Access2BaseDev |
Event |
KeyFunction |
Basic |
|
4 |
Property Get KeyFunction() As Variant KeyFunction = _PropertyGet("KeyFunction") End Property |
Access2BaseDev |
Event |
KeyShift |
Basic |
|
4 |
Property Get KeyShift() As Variant KeyShift = _PropertyGet("KeyShift") End Property |
Access2BaseDev |
Event |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
Event |
Properties |
Basic |
|
20 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, "", vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, "", vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Exit Function End Function |
Access2BaseDev |
Event |
Recommendation |
Basic |
|
4 |
Property Get Recommendation() As Variant Recommendation = _PropertyGet("Recommendation") End Property |
Access2BaseDev |
Event |
RowChangeAction |
Basic |
|
4 |
Property Get RowChangeAction() As Variant RowChangeAction = _PropertyGet("RowChangeAction") End Property |
Access2BaseDev |
Event |
Source |
Basic |
|
6 |
Public Function Source() As Variant Source = _PropertyGet("Source") End Function |
Access2BaseDev |
Event |
SubComponentName |
Basic |
|
4 |
Property Get SubComponentName() As String SubComponentName = _PropertyGet("SubComponentName") End Property |
Access2BaseDev |
Event |
SubComponentType |
Basic |
|
4 |
Property Get SubComponentType() As Long SubComponentType = _PropertyGet("SubComponentType") End Property |
Access2BaseDev |
Event |
XPos |
Basic |
|
4 |
Property Get XPos() As Variant XPos = _PropertyGet("XPos") End Property |
Access2BaseDev |
Event |
YPos |
Basic |
|
4 |
Property Get YPos() As Variant YPos = _PropertyGet("YPos") End Property |
Access2BaseDev |
Field |
_PropertiesList |
Basic |
hasProperty (Procedure) Properties (Procedure) |
22 |
Private Function _PropertiesList() As Variant
Select Case _ParentType Case OBJTABLEDEF _PropertiesList =Array("DataType", "dbType", "DefaultValue" _ , "Description", "Name", "ObjectType", "Size", "SourceField", "SourceTable" _ , "TypeName" _ ) Case OBJQUERYDEF _PropertiesList = Array("DataType", "dbType", "DefaultValue" _ , "Description", "Name", "ObjectType", "Size", "SourceField", "SourceTable" _ , "TypeName" _ ) Case OBJRECORDSET _PropertiesList = Array("DataType", "DataUpdatable", "dbType", "DefaultValue" _ , "Description" , "FieldSize", "Name", "ObjectType" _ , "Size", "SourceTable", "TypeName", "Value" _ ) End Select
End Function |
Access2BaseDev |
Field |
_PropertyGet |
Basic |
DataType (Procedure) DataUpdatable (Procedure) DbType (Procedure) DefaultValue (Procedure) Description (Procedure) FieldSize (Procedure) Name (Procedure) ObjectType (Procedure) Size (Procedure) SourceField (Procedure) SourceTable (Procedure) TypeName (Procedure) Value (Procedure) getProperty (Procedure) Properties (Procedure) |
228 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = "Field.get" & psProperty Utils._SetCalledSub(cstThisSub)
If Not hasProperty(psProperty) Then Goto Trace_Error
Dim bCond1 As Boolean, bCond2 As Boolean, vValue As Variant, oValue As Object, sValue As String Dim oSize As Object, lSize As Long, bNullable As Boolean, bNull As Boolean Const cstMaxBinlength = 2 * 65535
_PropertyGet = EMPTY Select Case UCase(psProperty) Case UCase("DataType") _PropertyGet = Column.Type Case UCase("DbType") With com.sun.star.sdbc.DataType Select Case Column.Type Case .BIT : _PropertyGet = dbBoolean Case .TINYINT : _PropertyGet = dbInteger Case .SMALLINT : _PropertyGet = dbLong Case .INTEGER : _PropertyGet = dbLong Case .BIGINT : _PropertyGet = dbBigInt Case .FLOAT : _PropertyGet = dbFloat Case .REAL : _PropertyGet = dbSingle Case .DOUBLE : _PropertyGet = dbDouble Case .NUMERIC : _PropertyGet = dbNumeric Case .DECIMAL : _PropertyGet = dbDecimal Case .CHAR : _PropertyGet = dbChar Case .VARCHAR : _PropertyGet = dbText Case .LONGVARCHAR : _PropertyGet = dbMemo Case .CLOB : _PropertyGet = dbMemo Case .DATE : _PropertyGet = dbDate Case .TIME : _PropertyGet = dbTime Case .TIMESTAMP : _PropertyGet = dbTimeStamp Case .BINARY : _PropertyGet = dbBinary Case .VARBINARY : _PropertyGet = dbVarBinary Case .LONGVARBINARY : _PropertyGet = dbLongBinary Case .BLOB : _PropertyGet = dbLongBinary Case .BOOLEAN : _PropertyGet = dbBoolean Case Else : _PropertyGet = dbUndefined End Select End With Case UCase("DataUpdatable") If Utils._hasUNOProperty(Column, "IsWritable") Then _PropertyGet = Column.IsWritable ElseIf Utils._hasUNOProperty(Column, "IsReadOnly") Then _PropertyGet = Not Column.IsReadOnly ElseIf Utils._hasUNOProperty(Column, "IsDefinitelyWritable") Then _PropertyGet = Column.IsDefinitelyWritable Else _PropertyGet = False End If If Utils._hasUNOProperty(Column, "IsAutoIncrement") Then If Column.IsAutoIncrement Then _PropertyGet = False End If Case UCase("DefaultValue") If Not _DefaultValueSet Then If Utils._hasUNOProperty(Column, "DefaultValue") Then _DefaultValue = Column.DefaultValue ElseIf Utils._hasUNOProperty(Column, "ControlDefault") Then If IsEmpty(Column.ControlDefault) Then _DefaultValue = "" Else _DefaultValue = Column.ControlDefault Else _DefaultValue = "" End If _DefaultValueSet = True End If _PropertyGet = _DefaultValue Case UCase("Description") bCond1 = Utils._hasUNOProperty(Column, "Description") bCond2 = Utils._hasUNOProperty(Column, "HelpText") Select Case True Case ( bCond1 And bCond2 ) If IsEmpty(Column.HelpText) Then _PropertyGet = Column.Description Else _PropertyGet = Column.HelpText Case ( bCond1 And ( Not bCond2 ) ) _PropertyGet = Column.Description Case ( ( Not bCond1 ) And bCond2 ) _PropertyGet = Column.HelpText Case Else _PropertyGet = "" End Select Case UCase("FieldSize") With com.sun.star.sdbc.DataType Select Case Column.Type Case .VARCHAR, .LONGVARCHAR, .CLOB Set oSize = Column.getCharacterStream Case .LONGVARBINARY, .VARBINARY, .BINARY, .BLOB Set oSize = Column.getBinaryStream Case Else Set oSize = Nothing End Select End With If Not IsNull(oSize) Then bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE ) If bNullable Then If Column.wasNull() Then _PropertyGet = 0 Else _PropertyGet = CLng(oSize.getLength()) Else _PropertyGet = CLng(oSize.getLength()) End If oSize.closeInput() Else _PropertyGet = EMPTY End If Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("Size") With com.sun.star.sdbc.DataType Select Case Column.Type Case .LONGVARCHAR, .LONGVARBINARY, .VARBINARY, .BINARY, .BLOB, .CLOB _PropertyGet = 0 Case Else If Utils._hasUNOProperty(Column, "Precision") Then _PropertyGet = Column.Precision Else _PropertyGet = 0 End Select End With Case UCase("SourceField") Select Case _ParentType Case OBJTABLEDEF _PropertyGet = _Name Case OBJQUERYDEF If Utils._hasUNOProperty(Column, "RealName") Then _PropertyGet = Column.RealName Else _PropertyGet = _Name End Select Case UCase("SourceTable") Select Case _ParentType Case OBJTABLEDEF _PropertyGet = _ParentName Case OBJQUERYDEF, OBJRECORDSET _PropertyGet = Column.TableName End Select Case UCase("TypeName") _PropertyGet = Column.TypeName Case UCase("Value") bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE ) bNull = False With com.sun.star.sdbc.DataType Select Case Column.Type Case .BIT, .BOOLEAN : vValue = Column.getBoolean() Case .TINYINT : vValue = Column.getShort() Case .SMALLINT, .INTEGER: vValue = Column.getInt() Case .BIGINT : vValue = Column.getLong() Case .FLOAT : vValue = Column.getFloat() Case .REAL, .DOUBLE : vValue = Column.getDouble() Case .NUMERIC, .DECIMAL If Utils._hasUNOProperty(Column, "Scale") Then If Column.Scale > 0 Then vValue = Column.getDouble() Else On Local Error Resume Next sValue = Join(Split(Column.getString(), "."), Utils._DecimalPoint()) vValue = CLng(sValue) If Err <> 0 Then vValue = CDbl(sValue) Err.Clear On Local Error Goto Error_Function End If End If Else vValue = CDbl(Column.getString()) End If Case .CHAR : vValue = Column.getString() Case .VARCHAR : vValue = Column.getString() Case .LONGVARCHAR, .CLOB Set oValue = Column.getCharacterStream() If bNullable Then bNull = Column.wasNull() If Not bNull Then lSize = CLng(oValue.getLength()) oValue.closeInput() vValue = Column.getString() Else oValue.closeInput() End If Case .DATE : Set oValue = Column.getDate() If bNullable Then bNull = Column.wasNull() If Not bNull Then vValue = DateSerial(CInt(oValue.Year), CInt(oValue.Month), CInt(oValue.Day)) Case .TIME : Set oValue = Column.getTime() If bNullable Then bNull = Column.wasNull() If Not bNull Then vValue = TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds) Case .TIMESTAMP : Set oValue = Column.getTimeStamp() If bNullable Then bNull = Column.wasNull() If Not bNull Then vValue = DateSerial(CInt(oValue.Year), CInt(oValue.Month), CInt(oValue.Day)) _ + TimeSerial(oValue.Hours, oValue.Minutes, oValue.Seconds) Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB Set oValue = Column.getBinaryStream() If bNullable Then bNull = Column.wasNull() If Not bNull Then lSize = CLng(oValue.getLength()) If lSize > cstMaxBinlength Then Goto Trace_Length vValue = Array() oValue.readBytes(vValue, lSize) End If oValue.closeInput() Case Else vValue = Column.getString() If IsNumeric(vValue) Then vValue = Val(vValue) End Select If bNullable Then If Column.wasNull() Then vValue = Null End If End With _PropertyGet = vValue Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error: TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertyGet = EMPTY Goto Exit_Function Trace_Length: TraceError(TRACEFATAL, ERROVERFLOW, Utils._CalledSub(), 0, , Array(lSize, "GetChunk")) _PropertyGet = EMPTY Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function |
Access2BaseDev |
Field |
_PropertySet |
Basic |
DefaultValue (Procedure) Description (Procedure) Value (Procedure) AppendChunk (Procedure) setProperty (Procedure) |
162 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = "Field.set" & psProperty Utils._SetCalledSub(cstThisSub) _PropertySet = True Dim iArgNr As Integer, vTemp As Variant Dim oParent As Object
Select Case UCase(_A2B_.CalledSub) Case UCase("setProperty") : iArgNr = 3 Case UCase("Field.setProperty") : iArgNr = 2 Case UCase(cstThisSub) : iArgNr = 1 End Select If Not hasProperty(psProperty) Then Goto Trace_Error
Select Case UCase(psProperty) Case UCase("DefaultValue") If _ParentType <> OBJTABLEDEF Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Utils._hasUNOProperty(Column, "ControlDefault") Then Column.ControlDefault = pvValue _DefaultValue = pvValue _DefaultValueSet = True End If Case UCase("Description") If _ParentType <> OBJTABLEDEF Then Goto Trace_Error If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value Column.HelpText = pvValue Case UCase("Value") If _ParentType <> OBJRECORDSET Then Goto Trace_Error If Not Column.IsWritable Then Goto Trace_Error_Updatable If Column.IsReadOnly Then Goto Trace_Error_Updatable If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update With com.sun.star.sdbc.DataType If IsNull(pvValue) Then If Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then Column.updateNull() Else Goto Trace_Null Else Select Case Column.Type Case .BIT, .BOOLEAN If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value Column.updateBoolean(pvValue) Case .TINYINT If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < -128 Or pvValue > +127 Then Goto Trace_Error_Value Column.updateShort(CInt(pvValue)) Case .SMALLINT If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < -32768 Or pvValue > 32767 Then Goto trace_Error_Value Column.updateInt(CLng(pvValue)) Case .INTEGER If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < -2147483648 Or pvValue > 2147483647 Then Goto trace_Error_Value Column.updateInt(CLng(pvValue)) Case .BIGINT If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value Column.updateLong(pvValue) Case .FLOAT If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If Abs(pvValue) < 3.402823E38 And Abs(pvValue) > 1.401298E-45 Then Column.updateFloat(CSng(pvValue)) Else Goto trace_Error_Value Case .REAL, .DOUBLE If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value Column.updateDouble(CDbl(pvValue)) Case .NUMERIC, .DECIMAL If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If Utils._hasUNOProperty(Column, "Scale") Then If Column.Scale > 0 Then Column.updateDouble(CDbl(pvValue)) Else Column.updateString(CStr(pvValue)) End If Else Column.updateString(CStr(pvValue)) End If Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Len(pvValue) > _Precision Then Goto Trace_Error_Length Column.updateString(pvValue) Case .DATE If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value vTemp = New com.sun.star.util.Date With vTemp .Day = Day(pvValue) .Month = Month(pvValue) .Year = Year(pvValue) End With Column.updateDate(vTemp) Case .TIME If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value vTemp = New com.sun.star.util.Time With vTemp .Hours = Hour(pvValue) .Minutes = Minute(pvValue) .Seconds = Second(pvValue) End With Column.updateTime(vTemp) Case .TIMESTAMP If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value vTemp = New com.sun.star.util.DateTime With vTemp .Day = Day(pvValue) .Month = Month(pvValue) .Year = Year(pvValue) .Hours = Hour(pvValue) .Minutes = Minute(pvValue) .Seconds = Second(pvValue) End With Column.updateTimestamp(vTemp) Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB If Not IsArray(pvValue) Then Goto Trace_Error_Value If UBound(pvValue) < LBound(pvValue) Then Goto Trace_Error_Value If Not Utils._CheckArgument(pvValue(LBound(pvValue)), iArgNr, vbInteger, , False) Then Goto Trace_Error_Value Column.updateBytes(pvValue) Case Else Goto trace_Error End Select End If End With Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Trace_Null: TraceError(TRACEFATAL, ERRNOTNULLABLE, Utils._CalledSub(), 0, 1, _Name) _PropertySet = False Goto Exit_Function Trace_Error_Update: TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1) _PropertySet = False Goto Exit_Function Trace_Error_Updatable: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1) _PropertySet = False Goto Exit_Function Trace_Error_Length: TraceError(TRACEFATAL, ERROVERFLOW, Utils._CalledSub(), 0, , Array(lSize, "AppendChunk")) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
Field |
_ReadAll |
Basic |
ReadAllBytes (Procedure) ReadAllText (Procedure) |
76 |
Public Function _ReadAll(ByVal psFile As String, ByVal psMethod As String) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function _ReadAll = False
If _ParentType <> OBJRECORDSET Then Goto Trace_Error If Not Column.IsWritable Then Goto Trace_Error_Updatable If Column.IsReadOnly Then Goto Trace_Error_Updatable If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update
Dim sFile As String, oSimpleFileAccess As Object, sMethod As String, oStream As Object Dim lFileLength As Long, sBuffer As String, sMemo As String, iFile As Integer Const cstMaxLength = 64000 sFile = ConvertToURL(psFile)
oSimpleFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") If Not oSimpleFileAccess.exists(sFile) Then Goto Trace_File
With com.sun.star.sdbc.DataType Select Case Column.Type Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB If psMethod <> "ReadAllBytes" Then Goto Trace_Error Set oStream = oSimpleFileAccess.openFileRead(sFile) lFileLength = oStream.getLength() If lFileLength = 0 Then Goto Trace_File Column.updateBinaryStream(oStream, lFileLength) oStream.closeInput() Case .VARCHAR, .LONGVARCHAR, .CLOB If psMethod <> "ReadAllText" Then Goto Trace_Error sMemo = "" lFileLength = 0 iFile = FreeFile() Open sFile For Input Access Read Shared As iFile Do While Not Eof(iFile) Line Input #iFile, sBuffer lFileLength = lFileLength + Len(sBuffer) + 1 If lFileLength > cstMaxLength Then Exit Do sMemo = sMemo & sBuffer & vbNewLine Loop If lFileLength = 0 Or lFileLength > cstMaxLength Then Close #iFile Goto Trace_File End If sMemo = Left(sMemo, lFileLength - 1) Column.updateString(sMemo) Case Else Goto Trace_Error End Select End With
_ReadAll = True Exit_Function: Exit Function Trace_Error: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , psMethod) Goto Exit_Function Trace_File: TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , sFile) If Not IsNull(oStream) Then oStream.closeInput() Goto Exit_Function Trace_Error_Update: TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1) If Not IsNull(oStream) Then oStream.closeInput() Goto Exit_Function Trace_Error_Updatable: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1) If Not IsNull(oStream) Then oStream.closeInput() Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, _CalledSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Field |
_WriteAll |
Basic |
WriteAllBytes (Procedure) WriteAllText (Procedure) |
53 |
Public Function _WriteAll(ByVal psFile As String, ByVal psMethod As String) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function _WriteAll = False
Dim sFile As String, oSimpleFileAccess As Object, sMethod As String, oStream As Object sFile = ConvertToURL(psFile)
oSimpleFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") With com.sun.star.sdbc.DataType Select Case Column.Type Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB If psMethod <> "WriteAllBytes" Then Goto Trace_Error Set oStream = Column.getBinaryStream() Case .VARCHAR, .LONGVARCHAR, .CLOB If psMethod <> "WriteAllText" Then Goto Trace_Error Set oStream = Column.getCharacterStream() Case Else Goto Trace_Error End Select End With
If Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then If Column.wasNull() Then Goto Trace_Null End If If oStream.getLength() = 0 Then Goto Trace_Null On Local Error Goto Trace_File If oSimpleFileAccess.exists(sFile) Then oSimpleFileAccess.kill(sFile) oSimpleFileAccess.writeFile(sFile, oStream) On Local Error Goto Error_Function oStream.closeInput()
_WriteAll = True Exit_Function: Exit Function Trace_Error: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , psMethod) Goto Exit_Function Trace_File: TraceError(TRACEFATAL, ERRFILEACCESS, Utils._CalledSub(), 0, , sFile) If Not IsNull(oStream) Then oStream.closeInput() Goto Exit_Function Trace_Null: TraceError(TRACEFATAL, ERRFIELDNULL, _CalledSub, 0) If Not IsNull(oStream) Then oStream.closeInput() Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, _CalledSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Field |
AppendChunk |
Basic |
|
50 |
Public Function AppendChunk(ByRef Optional pvValue As Variant) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "Field.AppendChunk" Utils._SetCalledSub(cstThisSub) AppendChunk = False
If IsMissing(pvValue) Then Call _TraceArguments()
If _ParentType <> OBJRECORDSET Then Goto Trace_Error If Not Column.IsWritable Then Goto Trace_Error_Updatable If Column.IsReadOnly Then Goto Trace_Error_Updatable If _ParentDatabase.Recordsets(_ParentName)._EditMode = dbEditNone Then Goto Trace_Error_Update
Dim iChunkType As Integer
With com.sun.star.sdbc.DataType Select Case Column.Type Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB, .CHAR iChunkType = vbByte Case Else Goto Trace_Error End Select End With AppendChunk = _ParentRecordset._AppendChunk(_Name, pvValue, iChunkType)
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error_Update: TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1) _PropertySet = False Goto Exit_Function Trace_Error_Updatable: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1) _PropertySet = False Goto Exit_Function Trace_Error: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , cstThisSub) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
Field |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
12 |
Private Sub Class_Initialize() _Type = OBJFIELD _Name = "" _ParentName = "" _ParentType = "" _DefaultValue = "" _DefaultValueSet = False Set Column = Nothing End Sub |
Access2BaseDev |
Field |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
Field |
DataType |
Basic |
|
3 |
Property Get DataType() As Long DataType = _PropertyGet("DataType") End Property |
Access2BaseDev |
Field |
DataUpdatable |
Basic |
|
3 |
Property Get DataUpdatable() As Boolean DataUpdatable = _PropertyGet("DataUpdatable") End Property |
Access2BaseDev |
Field |
DbType |
Basic |
|
4 |
Property Get DbType() As Long DbType = _PropertyGet("DbType") End Property |
Access2BaseDev |
Field |
DefaultValue |
Basic |
|
7 |
Property Get DefaultValue() As Variant DefaultValue = _PropertyGet("DefaultValue") End Property
Property Let DefaultValue(ByVal pvDefaultValue As Variant) Call _PropertySet("DefaultValue", pvDefaultValue) End Property |
Access2BaseDev |
Field |
Description |
Basic |
|
7 |
Property Get Description() As Variant Description = _PropertyGet("Description") End Property
Property Let Description(ByVal pvDescription As Variant) Call _PropertySet("Description", pvDescription) End Property |
Access2BaseDev |
Field |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
Field |
FieldSize |
Basic |
|
4 |
Property Get FieldSize() As Long FieldSize = _PropertyGet("FieldSize") End Property |
Access2BaseDev |
Field |
GetChunk |
Basic |
|
64 |
Public Function GetChunk(ByVal Optional pvOffset As Variant, ByVal Optional pvBytes As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "Field.GetChunk" Utils._SetCalledSub(cstThisSub)
Dim oValue As Object, bNullable As Boolean, bNull As Boolean, vValue() As Variant Dim lLength As Long, lOffset As Long, lValue As Long
If IsMissing(pvOffset) Or IsMissing(pvBytes) Then Call _TraceArguments() If Not Utils._CheckArgument(pvOffset, 1, _AddNumeric()) Then Goto Exit_Function If pvOffset < 0 Then TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvOffset)) Goto Exit_Function End If If Not Utils._CheckArgument(pvBytes, 2, _AddNumeric()) Then Goto Exit_Function If pvBytes < 0 Then TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(2, pvBytes)) Goto Exit_Function End If
bNullable = ( Column.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE ) bNull = False GetChunk = Null vValue = Array() With com.sun.star.sdbc.DataType Select Case Column.Type Case .BINARY, .VARBINARY, .LONGVARBINARY Set oValue = Column.getBinaryStream() Case .BLOB Set oValue = Column.getBlob.getBinaryStream() Case Else Goto Trace_Error End Select If bNullable Then bNull = Column.wasNull() If Not bNull Then lOffset = CLng(pvOffset) If lOffset > 0 Then oValue.skipBytes(lOffset) lValue = oValue.readBytes(vValue, pvBytes) End If oValue.closeInput() End With GetChunk = vValue
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, , cstThisSub) Goto Exit_Function Trace_Argument: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(iArg, pvIndex)) Set vForms = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Field |
getProperty |
Basic |
|
11 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Const cstThisSub = "Field.getProperty" Utils._SetCalledSub(cstThisSub) If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Field |
hasProperty |
Basic |
_PropertyGet (Procedure) _PropertySet (Procedure) |
11 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
Const cstThisSub = "Field.hasProperty" Utils._SetCalledSub(cstThisSub) If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Field |
Name |
Basic |
|
4 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
Field |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
Field |
Properties |
Basic |
|
25 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String, sName As String Const cstThisSub = "Field.Properties" Utils._SetCalledSub(cstThisSub) vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) sName = _ParentType & "/" & _ParentName & "/" & _Name If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, sName, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, sName, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Set vProperty._ParentDatabase = _ParentDatabase Exit_Function: Set Properties = vProperty Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Field |
ReadAllBytes |
Basic |
|
13 |
Public Function ReadAllBytes(ByVal Optional pvFile As Variant) As Boolean
Const cstThisSub = "Field.ReadAllBytes" Utils._SetCalledSub(cstThisSub) If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function ReadAllBytes = _ReadAll(pvFile, "ReadAllBytes")
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Field |
ReadAllText |
Basic |
|
13 |
Public Function ReadAllText(ByVal Optional pvFile As Variant) As Boolean
Const cstThisSub = "Field.ReadAllText" Utils._SetCalledSub(cstThisSub) If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function ReadAllText = _ReadAll(pvFile, "ReadAllText")
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Field |
setProperty |
Basic |
|
8 |
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean Const cstThisSub = "Field.setProperty" Utils._SetCalledSub(cstThisSub) setProperty = _PropertySet(psProperty, pvValue) Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Field |
Size |
Basic |
|
4 |
Property Get Size() As Long Size = _PropertyGet("Size") End Property |
Access2BaseDev |
Field |
SourceField |
Basic |
|
4 |
Property Get SourceField() As String SourceField = _PropertyGet("SourceField") End Property |
Access2BaseDev |
Field |
SourceTable |
Basic |
|
4 |
Property Get SourceTable() As String SourceTable = _PropertyGet("SourceTable") End Property |
Access2BaseDev |
Field |
TypeName |
Basic |
|
4 |
Property Get TypeName() As String TypeName = _PropertyGet("TypeName") End Property |
Access2BaseDev |
Field |
Value |
Basic |
|
7 |
Property Get Value() As Variant Value = _PropertyGet("Value") End Property
Property Let Value(ByVal pvValue As Variant) Call _PropertySet("Value", pvValue) End Property |
Access2BaseDev |
Field |
WriteAllBytes |
Basic |
|
13 |
Public Function WriteAllBytes(ByVal Optional pvFile As Variant) As Boolean
Const cstThisSub = "Field.WriteAllBytes" Utils._SetCalledSub(cstThisSub) If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function WriteAllBytes = _WriteAll(pvFile, "WriteAllBytes")
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Field |
WriteAllText |
Basic |
|
13 |
Public Function WriteAllText(ByVal Optional pvFile As Variant) As Boolean
Const cstThisSub = "Field.WriteAllText" Utils._SetCalledSub(cstThisSub) If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function WriteAllText = _WriteAll(pvFile, "WriteAllText")
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Form |
_GetListener |
Basic |
_PropertySet (Procedure) |
26 |
Private Function _GetListener(ByVal psProperty As String) As String
Select Case UCase(psProperty) Case UCase("OnApproveCursorMove") _GetListener = "XRowSetApproveListener" Case UCase("OnApproveParameter") _GetListener = "XDatabaseParameterListener" Case UCase("OnApproveReset"), UCase("OnResetted") _GetListener = "XResetListener" Case UCase("OnApproveRowChange") _GetListener = "XRowSetApproveListener" Case UCase("OnApproveSubmit") _GetListener = "XSubmitListener" Case UCase("OnConfirmDelete") _GetListener = "XConfirmDeleteListener" Case UCase("OnCursorMoved"), UCase("OnRowChanged") _GetListener = "XRowSetListener" Case UCase("OnErrorOccurred") _GetListener = "XSQLErrorListener" Case UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnUnloaded"), UCase("OnUnloading") _GetListener = "XLoadListener" End Select End Function |
Access2BaseDev |
Form |
_Initialize |
Basic |
|
54 |
Public Sub _Initialize(psName As String)
Dim oDoc As Object, oDatabase As Object If _ErrorHandler() Then On Local Error Goto Trace_Error _Name = psName _Shortcut = "Forms!" & Utils._Surround(psName) If IsLoaded Then Set oDoc = _A2B_.CurrentDocument() Select Case oDoc.DbConnect Case DBCONNECTBASE If Not IsNull(Component.CurrentController) Then Set ContainerWindow = Component.CurrentController.Frame.ContainerWindow Set FormsCollection = Component.getDrawPage.Forms If FormsCollection.Count = 0 Then Set DatabaseForm = Nothing Else _MainForms = FormsCollection.ElementNames() Set DatabaseForm = FormsCollection.getByIndex(0) End If End If Case DBCONNECTFORM Set ContainerWindow = oDoc.Document.CurrentController.Frame.ContainerWindow Set oDatabase = Application._CurrentDb(_DocEntry, _DbEntry) With oDatabase Set DatabaseForm = .Form If IsNull(.Connection) Then Set .Connection = DatabaseForm.ActiveConnection If Not IsNull(.Connection) Then Set .MetaData = .Connection.MetaData oDatabase._ReadOnly = .Connection.isReadOnly() End If End If End With End Select If IsNull(DatabaseForm) Then _OrderBy = "" Else _OrderBy = DatabaseForm.Order Else Set Component = Nothing Set ContainerWindow = Nothing Set DatabaseForm = Nothing End If Exit_Sub: Exit Sub Trace_Error: TraceError(TRACEABORT, Err, "Form.Initialize", Erl) Goto Exit_Sub Trace_Internal_Error: TraceError(TRACEABORT, ERRFORMNOTIDENTIFIED, Utils._CalledSub(), 0, , _Name) Goto Exit_Sub End Sub |
Access2BaseDev |
Form |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
18 |
Private Function _PropertiesList() As Variant
If IsLoaded Then _PropertiesList = Array("AllowAdditions", "AllowDeletions", "AllowEdits", "Bookmark" _ , "Caption", "CurrentRecord", "Filter", "FilterOn", "Height", "IsLoaded" _ , "Name", "ObjectType", "OnApproveCursorMove", "OnApproveParameter" _ , "OnApproveReset", "OnApproveRowChange", "OnApproveSubmit", "OnConfirmDelete" _ , "OnCursorMoved", "OnErrorOccurred", "OnLoaded", "OnReloaded", "OnReloading" _ , "OnResetted", "OnRowChanged", "OnUnloaded", "OnUnloading", "OpenArgs" _ , "OrderBy", "OrderByOn", "RecordSource", "Visible", "Width" _ ) Else _PropertiesList = Array("IsLoaded", "Name" _ ) End If End Function |
Access2BaseDev |
Form |
_PropertyGet |
Basic |
AllowAdditions (Procedure) AllowDeletions (Procedure) AllowEdits (Procedure) Bookmark (Procedure) Caption (Procedure) CurrentRecord (Procedure) Filter (Procedure) FilterOn (Procedure) Height (Procedure) Name (Procedure) pName (Procedure) ObjectType (Procedure) OnApproveCursorMove (Procedure) OnApproveParameter (Procedure) OnApproveReset (Procedure) OnApproveRowChange (Procedure) OnApproveSubmit (Procedure) OnConfirmDelete (Procedure) OnCursorMoved (Procedure) OnErrorOccurred (Procedure) OnLoaded (Procedure) OnReloaded (Procedure) OnReloading (Procedure) OnResetted (Procedure) OnRowChanged (Procedure) OnUnloaded (Procedure) OnUnloading (Procedure) OpenArgs (Procedure) OrderBy (Procedure) OrderByOn (Procedure) Properties (Procedure) Recordset (Procedure) RecordSource (Procedure) Visible (Procedure) Width (Procedure) getProperty (Procedure) |
116 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Form.get" & psProperty) Dim oDatabase As Object, vBookmark As Variant Dim i As Integer, oObject As Object
_PropertyGet = EMPTY
Select Case UCase(psProperty) Case UCase("Name"), UCase("IsLoaded") Case Else : If Not IsLoaded Then Goto Trace_Error_Form End Select
Select Case UCase(psProperty) Case UCase("AllowAdditions") If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.AllowInserts Case UCase("AllowDeletions") If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.AllowDeletes Case UCase("AllowEdits") If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.AllowUpdates Case UCase("Bookmark") If IsNull(DatabaseForm) Then _PropertyGet = 0 Else On Local Error Resume Next If DatabaseForm.IsBookmarkable Then vBookmark = DatabaseForm.getBookmark() Else vBookmark = Nothing If _ErrorHandler() Then On Local Error Goto Error_Function Else On Local Error Goto 0 If IsNull(vBookmark) Then Goto Trace_Error _PropertyGet = vBookmark End If Case UCase("Caption") Set odatabase = Application._CurrentDb(_DocEntry, _DbEntry) Select Case oDatabase._DbConnect Case DBCONNECTFORM : _PropertyGet = oDatabase.Document.CurrentController.Frame.Title Case DBCONNECTBASE : _PropertyGet = Component.CurrentController.Frame.Title End Select Case UCase("CurrentRecord") If IsNull(DatabaseForm) Then _PropertyGet = 0 Else _PropertyGet = DatabaseForm.Row Case UCase("Filter") If IsNull(DatabaseForm) Then _PropertyGet = "" Else _PropertyGet = DatabaseForm.Filter Case UCase("FilterOn") If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = DatabaseForm.ApplyFilter Case UCase("Height") _PropertyGet = ContainerWindow.getPosSize().Height Case UCase("IsLoaded") _PropertyGet = IsLoaded Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _ , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _ , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _ , UCase("OnUnloaded"), UCase("OnUnloading") If IsNull(DatabaseForm) Then _PropertyGet = "" Else _PropertyGet = Utils._GetEventScriptCode(DatabaseForm, psProperty, _Name, True) Case UCase("OpenArgs") _PropertyGet = _OpenArgs Case UCase("OrderBy") _PropertyGet = _OrderBy Case UCase("OrderByOn") If IsNull(DatabaseForm) Then _PropertyGet = False Else _PropertyGet = ( DatabaseForm.Order <> "" ) Case UCase("Recordset") If IsNull(DatabaseForm) Then Goto Trace_Error If DatabaseForm.Command = "" Then Goto Trace_Error Set oObject = New Recordset With DatabaseForm oObject._CommandType = .CommandType oObject._Command = .Command oObject._ParentName = _Name oObject._ParentType = _Type Set oDatabase = Application._CurrentDb(_DocEntry, _DbEntry) Set oObject._ParentDatabase = oDatabase Set oObject._ParentDatabase.Connection = .ActiveConnection oObject._ForwardOnly = ( .ResultSetType = com.sun.star.sdbc.ResultSetType.FORWARD_ONLY ) oObject._PassThrough = ( .EscapeProcessing = False ) oObject._ReadOnly = ( .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY ) Call oObject._Initialize() End With With oDatabase .RecordsetMax = .RecordsetMax + 1 oObject._Name = Format(.RecordsetMax, "0000000") .RecordsetsColl.Add(oObject, UCase(oObject._Name)) End With If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst() Set _PropertyGet = oObject Case UCase("RecordSource") If IsNull(DatabaseForm) Then _PropertyGet = "" Else _PropertyGet = DatabaseForm.Command Case UCase("Visible") _PropertyGet = ContainerWindow.IsVisible() Case UCase("Width") _PropertyGet = ContainerWindow.getPosSize().Width Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("Form.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = EMPTY Goto Exit_Function Trace_Error_Form: TraceError(TRACEFATAL, ERRFORMNOTOPEN, Utils._CalledSub(), 0, 1, _Name) _PropertyGet = EMPTY Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Form._PropertyGet", Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function |
Access2BaseDev |
Form |
_PropertySet |
Basic |
AllowAdditions (Procedure) AllowDeletions (Procedure) AllowEdits (Procedure) Bookmark (Procedure) Caption (Procedure) CurrentRecord (Procedure) Filter (Procedure) FilterOn (Procedure) Height (Procedure) OnApproveCursorMove (Procedure) OnApproveParameter (Procedure) OnApproveReset (Procedure) OnApproveRowChange (Procedure) OnApproveSubmit (Procedure) OnConfirmDelete (Procedure) OnCursorMoved (Procedure) OnErrorOccurred (Procedure) OnLoaded (Procedure) OnReloaded (Procedure) OnReloading (Procedure) OnResetted (Procedure) OnRowChanged (Procedure) OnUnloaded (Procedure) OnUnloading (Procedure) OrderBy (Procedure) OrderByOn (Procedure) RecordSource (Procedure) Visible (Procedure) Width (Procedure) setProperty (Procedure) |
124 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
Utils._SetCalledSub("Form.set" & psProperty) If _ErrorHandler() Then On Local Error Goto Error_Function _PropertySet = True
Dim iArgNr As Integer, i As Integer Dim oDatabase As Object
If _Isleft(_A2B_.CalledSub, "Form.") Then iArgNr = 1 Else iArgNr = 2 If Not IsLoaded Then Goto Trace_Error_Form
Select Case UCase(psProperty) Case UCase("AllowAdditions") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error DatabaseForm.AllowInserts = pvValue DatabaseForm.reload() Case UCase("AllowDeletions") If Not Utils._CheckArgument(pvValue,iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error DatabaseForm.AllowDeletes = pvValue DatabaseForm.reload() Case UCase("AllowEdits") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error DatabaseForm.AllowUpdates = pvValue DatabaseForm.reload() Case UCase("Bookmark") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(vbObject), , False) Then Goto Trace_Error_Value If IsNull(pvValue) Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error DatabaseForm.MoveToBookmark(pvValue) Case UCase("Caption") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value Set oDatabase = Application._CurrentDb(_DocEntry, _DbEntry) Select Case oDatabase._DbConnect Case DBCONNECTFORM : oDatabase.Document.CurrentController.Frame.Title = pvValue Case DBCONNECTBASE : Component.CurrentController.Frame.Title = pvValue End Select Case UCase("CurrentRecord") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 1 Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error DatabaseForm.absolute(pvValue) Case UCase("Filter") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error DatabaseForm.Filter = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) Case UCase("FilterOn") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error DatabaseForm.ApplyFilter = pvValue DatabaseForm.reload() Case UCase("Height") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If Utils._hasUNOProperty(ContainerWindow, "IsMaximized") Then ContainerWindow.IsMaximized = False ContainerWindow.IsMinimized = False End If ContainerWindow.setPosSize(0, 0, 0, pvValue, com.sun.star.awt.PosSize.HEIGHT) Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _ , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _ , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _ , UCase("OnUnloaded"), UCase("OnUnloading") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error If Not Utils._RegisterEventScript(DatabaseForm _ , psProperty _ , _GetListener(psProperty) _ , pvValue, _Name, True _ ) Then GoTo Trace_Error Case UCase("OrderBy") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error _OrderBy = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) Case UCase("OrderByOn") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error If pvValue Then DatabaseForm.Order = _OrderBy Else DatabaseForm.Order = "" DatabaseForm.reload() Case UCase("RecordSource") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If IsNull(DatabaseForm) Then Goto Trace_Error DatabaseForm.Command = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) DatabaseForm.CommandType = com.sun.star.sdb.CommandType.COMMAND DatabaseForm.Filter = "" DatabaseForm.reload() Case UCase("Visible") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value ContainerWindow.setVisible(pvValue) Case UCase("Width") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric()) Then Goto Trace_Error_Value If Utils._hasUNOProperty(ContainerWindow, "IsMaximized") Then ContainerWindow.IsMaximized = False ContainerWindow.IsMinimized = False End If ContainerWindow.setPosSize(0, 0, pvValue, 0, com.sun.star.awt.PosSize.WIDTH) Case Else Goto Trace_Error End Select
Exit_Function: Utils._ResetCalledSub("Form.set" & psProperty) Exit Function Trace_Error_Form: TraceError(TRACEFATAL, ERRFORMNOTOPEN, Utils._CalledSub(), 0, 1, _Name) _PropertySet = False Goto Exit_Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Form._PropertySet", Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
Form |
AllowAdditions |
Basic |
|
9 |
Property Get AllowAdditions() As Variant AllowAdditions = _PropertyGet("AllowAdditions") End Property
Property Let AllowAdditions(ByVal pvValue As Variant) Call _PropertySet("AllowAdditions", pvValue) End Property |
Access2BaseDev |
Form |
AllowDeletions |
Basic |
|
7 |
Property Get AllowDeletions() As Variant AllowDeletions = _PropertyGet("AllowDeletions") End Property
Property Let AllowDeletions(ByVal pvValue As Variant) Call _PropertySet("AllowDeletions", pvValue) End Property |
Access2BaseDev |
Form |
AllowEdits |
Basic |
|
7 |
Property Get AllowEdits() As Variant AllowEdits = _PropertyGet("AllowEdits") End Property
Property Let AllowEdits(ByVal pvValue As Variant) Call _PropertySet("AllowEdits", pvValue) End Property |
Access2BaseDev |
Form |
Bookmark |
Basic |
|
7 |
Property Get Bookmark() As Variant Bookmark = _PropertyGet("Bookmark") End Property
Property Let Bookmark(ByVal pvValue As Variant) Call _PropertySet("Bookmark", pvValue) End Property |
Access2BaseDev |
Form |
Caption |
Basic |
|
7 |
Property Get Caption() As Variant Caption = _PropertyGet("Caption") End Property
Property Let Caption(ByVal pvValue As Variant) Call _PropertySet("Caption", pvValue) End Property |
Access2BaseDev |
Form |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
18 |
Private Sub Class_Initialize() _Type = OBJFORM _Shortcut = "" _Name = "" _DocEntry = -1 _DbEntry = -1 _MainForms = Array() _IsLoaded = False _OpenArgs = "" _OrderBy = "" Set Component = Nothing Set ContainerWindow = Nothing Set FormsCollection = Nothing Set DatabaseForm = Nothing End Sub |
Access2BaseDev |
Form |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
Form |
Controls |
Basic |
|
114 |
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Form.Controls")
Dim ocControl As Variant, iControlCount As Integer Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String Dim j As Integer, iCount As Integer, sName As String, iAddCount As Integer Dim oDatabaseForm As Object, iCtlCount As Integer
Set ocControl = Nothing If Not IsLoaded Then Goto Trace_Error_NotOpen iControlCount = 0 iCount = FormsCollection.Count For i = 0 To iCount - 1 If i = 0 Then Set oDatabaseForm = DatabaseForm Else Set oDatabaseForm = FormsCollection.getByIndex(i) If Not IsNull(oDatabaseForm) Then iControlCount = iControlCount + oDatabaseForm.getCount() Next i If IsMissing(pvIndex) Then Set oCounter = New Collect oCounter._CollType = COLLCONTROLS oCounter._ParentType = OBJFORM oCounter._ParentName = _Name oCounter._Count = iControlCount Set Controls = oCounter Goto Exit_Function End If If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function sName = "" Select Case VarType(pvIndex) Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index iAddCount = 0 For i = 0 To iCount - 1 If i = 0 Then Set oDatabaseForm = DatabaseForm Else Set oDatabaseForm = FormsCollection.getByIndex(i) If Not IsNull(oDatabaseForm) Then iCtlCount = oDatabaseForm.getCount() If pvIndex >= iAddCount And pvIndex <= iAddcount + iCtlCount - 1 Then sName = oDatabaseForm.ElementNames(pvIndex - iAddCount) Exit For End If iAddCount = iAddcount +iCtlCount End If Next i Case vbString sIndex = UCase(Utils._Trim(pvIndex)) bFound = False For i = 0 To iCount - 1 If i = 0 Then Set oDatabaseForm = DatabaseForm Else Set oDatabaseForm = FormsCollection.getByIndex(i) If Not IsNull(oDatabaseForm) Then sControls() = oDatabaseForm.getElementNames() For j = 0 To UBound(sControls) If UCase(sControls(j)) = sIndex Then sName = sControls(j) bFound = True Exit For End If Next j If bFound Then Exit For End If Next i If Not bFound Then Goto Trace_NotFound End Select
Set ocControl = New Control With ocControl ._ParentType = CTLPARENTISFORM ._Name = sName ._Shortcut = _Shortcut & "!" & Utils._Surround(sName) If IsNull(oDatabaseForm) Then ._MainForm = "" Else ._MainForm = oDatabaseForm.Name Set .ControlModel = oDatabaseForm.getByName(sName) ._ImplementationName = .ControlModel.getImplementationName() ._FormComponent = Component If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId If ._ClassId > 0 And ._ClassId <> acHiddenControl Then Set .ControlView = Component.CurrentController.getControl(.ControlModel) End If
._Initialize() ._DocEntry = _DocEntry ._DbEntry = _DbEntry End With Set Controls = ocControl Exit_Function: Utils._ResetCalledSub("Form.Controls") Exit Function Trace_Error_NotOpen: TraceError(TRACEFATAL, ERRFORMNOTOPEN, Utils._CalledSub(), 0, , _Name) Set Controls = Nothing Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set Controls = Nothing Goto Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, pvIndex)) Set Controls = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Form.Controls", Erl) Set Controls = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
Form |
CurrentDb |
Basic |
|
13 |
Public Function CurrentDb() As Object
Const cstThisSub = "Form.CurrentDb" Utils._SetCalledSub(cstThisSub)
Set CurrentDb = Application._CurrentDb(_DocEntry, _DbEntry)
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Form |
CurrentRecord |
Basic |
|
7 |
Property Get CurrentRecord() As Variant CurrentRecord = _PropertyGet("CurrentRecord") End Property
Property Let CurrentRecord(ByVal pvValue As Variant) Call _PropertySet("CurrentRecord", pvValue) End Property |
Access2BaseDev |
Form |
Dispose |
Basic |
mClose (Procedure) |
8 |
Public Sub Dispose() Dim ofForm As Object If Not IsLoaded(True) Then If Not IsNull(DatabaseForm) Then DatabaseForm.Dispose() End If Call Class_Terminate() End Sub |
Access2BaseDev |
Form |
Filter |
Basic |
|
7 |
Property Get Filter() As Variant Filter = _PropertyGet("Filter") End Property
Property Let Filter(ByVal pvValue As Variant) Call _PropertySet("Filter", pvValue) End Property |
Access2BaseDev |
Form |
FilterOn |
Basic |
|
7 |
Property Get FilterOn() As Variant FilterOn = _PropertyGet("FilterOn") End Property
Property Let FilterOn(ByVal pvValue As Variant) Call _PropertySet("FilterOn", pvValue) End Property |
Access2BaseDev |
Form |
getProperty |
Basic |
|
10 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("Form.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("Form.getProperty") End Function |
Access2BaseDev |
Form |
hasProperty |
Basic |
|
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
Form |
Height |
Basic |
|
7 |
Property Get Height() As Variant Height = _PropertyGet("Height") End Property
Property Let Height(ByVal pvValue As Variant) Call _PropertySet("Height", pvValue) End Property |
Access2BaseDev |
Form |
IsLoaded |
Basic |
Dispose (Procedure) Controls (Procedure) _Initialize (Procedure) _PropertiesList (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Controls (Procedure) _PropertiesList (Procedure) |
53 |
Function IsLoaded(ByVal Optional pbForce As Boolean) As Boolean
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Form.getIsLoaded") If IsMissing(pbForce) Then pbForce = False If ( Not pbForce ) And _IsLoaded Then IsLoaded = True Goto Exit_Function End If IsLoaded = False Dim oDoc As Object, oDatabase As Object, oEnum As Object, oDesk As Object, oComp As Object, bFound As Boolean Dim i As Integer Set oDoc = _A2B_.CurrentDocument() Select Case oDoc.DbConnect Case DBCONNECTBASE Set oDesk = CreateUnoService("com.sun.star.frame.Desktop") Set oEnum = oDesk.Components().createEnumeration bFound = False Do While oEnum.hasMoreElements And Not bFound oComp = oEnum.nextElement If HasUnoInterfaces(oComp, "com.sun.star.frame.XModule") Then If oComp.Identifier = "com.sun.star.sdb.FormDesign" Then For i = 0 To UBound(oComp.Args()) If oComp.Args(i).Name = "DocumentTitle" Then bFound = ( oComp.Args(i).Value = _Name ) If bFound Then _IsLoaded = True Set Component = oComp Exit For End If End If Next i End If End If Loop Case DBCONNECTFORM Set Component = oDoc.Document _IsLoaded = True End Select Set oComp = Nothing IsLoaded = _IsLoaded
Exit_Function: Utils._ResetCalledSub("Form.getIsLoaded") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Form.getIsLoaded", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Form |
mClose |
Basic |
|
25 |
Public Function mClose() As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Form.Close") mClose = False Dim oDatabase As Object, oController As Object Set oDatabase = Application._CurrentDb() If oDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
Set oController = oDatabase.Document.getFormDocuments.getByName(_Name) oController.close() Dispose() mClose = True
Exit_Function: Utils._ResetCalledSub("Form.Close") Exit Function Error_NotApplicable: TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Form.Close", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Form |
Move |
Basic |
|
63 |
Public Function Move( ByVal Optional pvLeft As Variant _ , ByVal Optional pvTop As Variant _ , ByVal Optional pvWidth As Variant _ , ByVal Optional pvHeight As Variant _ ) As Variant Utils._SetCalledSub("Form.Move") If IsMissing(pvLeft) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function Move = False Dim iArgNr As Integer Select Case UCase(_A2B_.CalledSub) Case UCase("Move") : iArgNr = 1 Case UCase("Form.Move") : iArgNr = 0 End Select If IsMissing(pvLeft) Then Call _TraceArguments() If IsMissing(pvTop) Then pvTop = -1 If IsMissing(pvWidth) Then pvWidth = -1 If IsMissing(pvHeight) Then pvHeight = -1 If Not Utils._CheckArgument(pvLeft, iArgNr + 1, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvTop, iArgNr + 2, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvWidth, iArgNr + 3, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvHeight, iArgNr + 4, Utils._AddNumeric()) Then Goto Exit_Function Dim iArg As Integer, iWrong As Integer iArg = 0 If pvHeight < -1 Then iArg = 4 : iWrong = pvHeight ElseIf pvWidth < -1 Then iArg = 3 : iWrong = pvWidth ElseIf pvTop < -1 Then iArg = 2 : iWrong = pvTop ElseIf pvLeft < -1 Then iArg = 1 : iWrong = pvLeft End If If iArg > 0 Then TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(iArgNr + iArg, iWrong)) Goto Exit_Function End If Dim iPosSize As Integer iPosSize = 0 If pvLeft >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X If pvTop >= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y If pvWidth > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH If pvHeight > 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT If iPosSize > 0 Then If Utils._hasUNOProperty(ContainerWindow, "IsMaximized") Then ContainerWindow.IsMaximized = False ContainerWindow.IsMinimized = False End If ContainerWindow.setPosSize(pvLeft, pvTop, pvWidth, pvHeight, iPosSize) End If Move = True Exit_Function: Utils._ResetCalledSub("Form.Move") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Form.Move", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Form |
Name |
Basic |
|
4 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
Form |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
Form |
OnApproveCursorMove |
Basic |
|
7 |
Property Get OnApproveCursorMove() As Variant OnApproveCursorMove = _PropertyGet("OnApproveCursorMove") End Property
Property Let OnApproveCursorMove(ByVal pvValue As Variant) Call _PropertySet("OnApproveCursorMove", pvValue) End Property |
Access2BaseDev |
Form |
OnApproveParameter |
Basic |
|
7 |
Property Get OnApproveParameter() As Variant OnApproveParameter = _PropertyGet("OnApproveParameter") End Property
Property Let OnApproveParameter(ByVal pvValue As Variant) Call _PropertySet("OnApproveParameter", pvValue) End Property |
Access2BaseDev |
Form |
OnApproveReset |
Basic |
|
7 |
Property Get OnApproveReset() As Variant OnApproveReset = _PropertyGet("OnApproveReset") End Property
Property Let OnApproveReset(ByVal pvValue As Variant) Call _PropertySet("OnApproveReset", pvValue) End Property |
Access2BaseDev |
Form |
OnApproveRowChange |
Basic |
|
7 |
Property Get OnApproveRowChange() As Variant OnApproveRowChange = _PropertyGet("OnApproveRowChange") End Property
Property Let OnApproveRowChange(ByVal pvValue As Variant) Call _PropertySet("OnApproveRowChange", pvValue) End Property |
Access2BaseDev |
Form |
OnApproveSubmit |
Basic |
|
7 |
Property Get OnApproveSubmit() As Variant OnApproveSubmit = _PropertyGet("OnApproveSubmit") End Property
Property Let OnApproveSubmit(ByVal pvValue As Variant) Call _PropertySet("OnApproveSubmit", pvValue) End Property |
Access2BaseDev |
Form |
OnConfirmDelete |
Basic |
|
7 |
Property Get OnConfirmDelete() As Variant OnConfirmDelete = _PropertyGet("OnConfirmDelete") End Property
Property Let OnConfirmDelete(ByVal pvValue As Variant) Call _PropertySet("OnConfirmDelete", pvValue) End Property |
Access2BaseDev |
Form |
OnCursorMoved |
Basic |
|
7 |
Property Get OnCursorMoved() As Variant OnCursorMoved = _PropertyGet("OnCursorMoved") End Property
Property Let OnCursorMoved(ByVal pvValue As Variant) Call _PropertySet("OnCursorMoved", pvValue) End Property |
Access2BaseDev |
Form |
OnErrorOccurred |
Basic |
|
7 |
Property Get OnErrorOccurred() As Variant OnErrorOccurred = _PropertyGet("OnErrorOccurred") End Property
Property Let OnErrorOccurred(ByVal pvValue As Variant) Call _PropertySet("OnErrorOccurred", pvValue) End Property |
Access2BaseDev |
Form |
OnLoaded |
Basic |
|
7 |
Property Get OnLoaded() As Variant OnLoaded = _PropertyGet("OnLoaded") End Property
Property Let OnLoaded(ByVal pvValue As Variant) Call _PropertySet("OnLoaded", pvValue) End Property |
Access2BaseDev |
Form |
OnReloaded |
Basic |
|
7 |
Property Get OnReloaded() As Variant OnReloaded = _PropertyGet("OnReloaded") End Property
Property Let OnReloaded(ByVal pvValue As Variant) Call _PropertySet("OnReloaded", pvValue) End Property |
Access2BaseDev |
Form |
OnReloading |
Basic |
|
7 |
Property Get OnReloading() As Variant OnReloading = _PropertyGet("OnReloading") End Property
Property Let OnReloading(ByVal pvValue As Variant) Call _PropertySet("OnReloading", pvValue) End Property |
Access2BaseDev |
Form |
OnResetted |
Basic |
|
7 |
Property Get OnResetted() As Variant OnResetted = _PropertyGet("OnResetted") End Property
Property Let OnResetted(ByVal pvValue As Variant) Call _PropertySet("OnResetted", pvValue) End Property |
Access2BaseDev |
Form |
OnRowChanged |
Basic |
|
7 |
Property Get OnRowChanged() As Variant OnRowChanged = _PropertyGet("OnRowChanged") End Property
Property Let OnRowChanged(ByVal pvValue As Variant) Call _PropertySet("OnRowChanged", pvValue) End Property |
Access2BaseDev |
Form |
OnUnloaded |
Basic |
|
7 |
Property Get OnUnloaded() As Variant OnUnloaded = _PropertyGet("OnUnloaded") End Property
Property Let OnUnloaded(ByVal pvValue As Variant) Call _PropertySet("OnUnloaded", pvValue) End Property |
Access2BaseDev |
Form |
OnUnloading |
Basic |
|
7 |
Property Get OnUnloading() As Variant OnUnloading = _PropertyGet("OnUnloading") End Property
Property Let OnUnloading(ByVal pvValue As Variant) Call _PropertySet("OnUnloading", pvValue) End Property |
Access2BaseDev |
Form |
OpenArgs |
Basic |
|
4 |
Property Get OpenArgs() As Variant OpenArgs = _PropertyGet("OpenArgs") End Property |
Access2BaseDev |
Form |
OptionGroup |
Basic |
_OptionGroup (Procedure) |
24 |
Public Function OptionGroup(ByVal Optional pvGroupName As Variant) As Variant
Const cstThisSub = "Form.OptionGroup" Dim ogGroup As Object Utils._SetCalledSub(cstThisSub) If IsMissing(pvGroupName) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function Set ogGroup = _OptionGroup(pvGroupName, CTLPARENTISFORM, Component, FormsCollection) If Not IsNull(ogGroup) Then ogGroup._DocEntry = _DocEntry ogGroup._DbEntry = _DbEntry End If Set OptionGroup = ogGroup Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, Form.OptionGroup, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Form |
OrderBy |
Basic |
|
7 |
Property Get OrderBy() As Variant OrderBy = _PropertyGet("OrderBy") End Property
Property Let OrderBy(ByVal pvValue As Variant) Call _PropertySet("OrderBy", pvValue) End Property |
Access2BaseDev |
Form |
OrderByOn |
Basic |
|
7 |
Property Get OrderByOn() As Variant OrderByOn = _PropertyGet("OrderByOn") End Property
Property Let OrderByOn(ByVal pvValue As Variant) Call _PropertySet("OrderByOn", pvValue) End Property |
Access2BaseDev |
Form |
pName |
Basic |
|
3 |
Public Function pName() As String pName = _PropertyGet("Name") End Function |
Access2BaseDev |
Form |
Properties |
Basic |
|
20 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Exit Function End Function |
Access2BaseDev |
Form |
Recordset |
Basic |
|
4 |
Property Get Recordset() As Object Recordset = _PropertyGet("Recordset") End Property |
Access2BaseDev |
Form |
RecordSource |
Basic |
|
7 |
Property Get RecordSource() As Variant RecordSource = _PropertyGet("RecordSource") End Property
Property Let RecordSource(ByVal pvValue As Variant) Call _PropertySet("RecordSource", pvValue) End Property |
Access2BaseDev |
Form |
Refresh |
Basic |
|
22 |
Public Function Refresh() As Boolean Utils._SetCalledSub("Form.Refresh") If _ErrorHandler() Then On Local Error Goto Error_Function Refresh = False
Dim oSet As Object Set oSet = DatabaseForm.createResultSet() If Not IsNull(oSet) Then oSet.refreshRow() Refresh = True End If
Exit_Function: Set oSet = Nothing Utils._ResetCalledSub("Form.Refresh") Exit Function Error_Function: TraceError(TRACEABORT, Err, "SubForm.Refresh", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Form |
Requery |
Basic |
|
17 |
Public Function Requery() As Boolean Utils._SetCalledSub("Form.Requery") If _ErrorHandler() Then On Local Error Goto Error_Function Requery = False
DatabaseForm.reload() Requery = True
Exit_Function: Utils._ResetCalledSub("Form.Requery") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Form.Requery", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Form |
setFocus |
Basic |
|
24 |
Public Function setFocus() As Boolean Const cstThisSub = "Form.setFocus" Utils._SetCalledSub(cstThisSub) If _ErrorHandler() Then On Local Error Goto Error_Function setFocus = False
With ContainerWindow If .isVisible() = False Then .setVisible(True) .IsMinimized = False .setFocus() .setEnable(True) .toFront() End With setFocus = True Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) Goto Exit_Function End Function |
Access2BaseDev |
Form |
setProperty |
Basic |
|
7 |
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean Utils._SetCalledSub("Form.setProperty") setProperty = _PropertySet(psProperty, pvValue) Utils._ResetCalledSub("Form.setProperty") End Function |
Access2BaseDev |
Form |
Visible |
Basic |
|
7 |
Property Get Visible() As Variant Visible = _PropertyGet("Visible") End Property
Property Let Visible(ByVal pvValue As Variant) Call _PropertySet("Visible", pvValue) End Property |
Access2BaseDev |
Form |
Width |
Basic |
|
7 |
Property Get Width() As Variant Width = _PropertyGet("Width") End Property
Property Let Width(ByVal pvValue As Variant) Call _PropertySet("Width", pvValue) End Property |
Access2BaseDev |
L10N |
_GetLabel |
Basic |
CommandBars (Procedure) TempVars (Procedure) TraceConsole (Procedure) TraceError (Procedure) _DumpToFile (Procedure) _ErrorMessage (Procedure) mClose (Procedure) CopyObject (Procedure) GetHiddenAttribute (Procedure) OpenForm (Procedure) OutputTo (Procedure) Quit (Procedure) SelectObject (Procedure) SendObject (Procedure) SetHiddenAttribute (Procedure) _OpenObject (Procedure) _PromptFormat (Procedure) _CalledSub (Procedure) _ResetCalledSub (Procedure) _SetCalledSub (Procedure) OpenRecordset (Procedure) OutputTo (Procedure) QueryDefs (Procedure) Recordsets (Procedure) TableDefs (Procedure) Delete (Procedure) _GetLabelArray (Procedure) Fields (Procedure) Fields (Procedure) |
486 |
Public Function _GetLabel(ByVal psShortlabel As String, Optional ByVal psLocale As String) As String
If IsMissing(psLocale) Then psLocale = UCase(Left(_A2B_.Locale, 2)) Else psLocale = UCase(psLocale) On Local Error Goto Error_Function If Not Utils._InList(psLocale, Array( _ "EN", "FR", "ES", "DE" _ )) Then psLocale = "DEFAULT" Dim sLocal As String sLocal = psShortLabel Select Case psLocale Case "EN", "DEFAULT" Select Case UCase(psShortlabel) Case "ERR" & ERRDBNOTCONNECTED : sLocal = "No active connection to a database found" Case "ERR" & ERRMISSINGARGUMENTS : sLocal = "Arguments are missing or are not initialized" Case "ERR" & ERRWRONGARGUMENT : sLocal = "Argument nr. %0 [Value = '%1'] is invalid" Case "ERR" & ERRMAINFORM : sLocal = "Document '%0' does not contain any form" Case "ERR" & ERRFORMNOTIDENTIFIED : sLocal = "Form '%0' not identified in database Forms set" Case "ERR" & ERRFORMNOTFOUND : sLocal = "Form '%0' not found" Case "ERR" & ERRFORMNOTOPEN : sLocal = "Form '%0' is currently not open" Case "ERR" & ERRDFUNCTION : sLocal = "DFunction execution failed, SQL=%0" Case "ERR" & ERROPENFORM : sLocal = "Form '%0' could not be opened" Case "ERR" & ERRPROPERTY : sLocal = "Property '%0' not applicable in this context" Case "ERR" & ERRPROPERTYVALUE : sLocal = "Value '%0' is invalid for property '%1'" Case "ERR" & ERRINDEXVALUE : sLocal = "Out of array range or incorrect array size for property '%0'" Case "ERR" & ERRCOLLECTION : sLocal = "Out of array range" Case "ERR" & ERRPROPERTYNOTARRAY : sLocal = "Argument nr.%0 should be an array" Case "ERR" & ERRCONTROLNOTFOUND : sLocal = "Control '%0' not found in parent (form, grid or dialog) '%1'" Case "ERR" & ERRNOACTIVEFORM : sLocal = "No active form or control found" Case "ERR" & ERRDATABASEFORM : sLocal = "Form '%0' has no underlying dataset" Case "ERR" & ERRFOCUSINGRID : sLocal = "Control '%0' not found in gridcontrol '%1'" Case "ERR" & ERRNOGRIDINFORM : sLocal = "No gridcontrol found in form '%0'" Case "ERR" & ERRFINDRECORD : sLocal = "FindNext() must be preceded by a successful FindRecord(...) call" Case "ERR" & ERRSQLSTATEMENT : sLocal = "SQL Error, SQL statement = '%0'" Case "ERR" & ERROBJECTNOTFOUND : sLocal = "%0 '%1' not found" Case "ERR" & ERROPENOBJECT : sLocal = "%0 '%1' could not be opened" Case "ERR" & ERRCLOSEOBJECT : sLocal = "%0 '%1' could not be closed" Case "ERR" & ERRACTION : sLocal = "Action not applicable in this context" Case "ERR" & ERRSENDMAIL : sLocal = "Mail service could not be activated" Case "ERR" & ERRFORMYETOPEN : sLocal = "Form %0 is already open" Case "ERR" & ERRMETHOD : sLocal = "Method '%0' not applicable in this context" Case "ERR" & ERRPROPERTYINIT : sLocal = "Property '%0' applicable but not initialized" Case "ERR" & ERRFILENOTCREATED : sLocal = "File '%0' could not be created" Case "ERR" & ERRDIALOGNOTFOUND : sLocal = "Dialog '%0' not found in the currently loaded libraries" Case "ERR" & ERRDIALOGUNDEFINED : sLocal = "Dialog unknown" Case "ERR" & ERRDIALOGSTARTED : sLocal = "Dialog already started" Case "ERR" & ERRDIALOGNOTSTARTED : sLocal = "Dialog '%0' not active" Case "ERR" & ERRRECORDSETNODATA : sLocal = "Recordset delivered no data. Action on current record rejected" Case "ERR" & ERRRECORDSETCLOSED : sLocal = "Recordset has been closed. Recordset action rejected" Case "ERR" & ERRRECORDSETRANGE : sLocal = "Current record out of range" Case "ERR" & ERRRECORDSETFORWARD : sLocal = "Action rejected in a forward-only or not bookmarkable recordset" Case "ERR" & ERRFIELDNULL : sLocal = "Field is null or empty. Action rejected" Case "ERR" & ERRFILEACCESS : sLocal = "File access error on file '%0'" Case "ERR" & ERROVERFLOW : sLocal = "Field length (%0) exceeds maximum length. Use the '%1' method instead" Case "ERR" & ERRNOTACTIONQUERY : sLocal = "Query '%0' is not an action query" Case "ERR" & ERRNOTUPDATABLE : sLocal = "Database, recordset or field is read only" Case "ERR" & ERRUPDATESEQUENCE : sLocal = "Recordset update sequence error" Case "ERR" & ERRNOTNULLABLE : sLocal = "Field '%0' must not contain a NULL value" Case "ERR" & ERRROWDELETED : sLocal = "Current row has been deleted by another process or user" Case "ERR" & ERRRECORDSETCLONE : sLocal = "Cloning a cloned Recordset is forbidden" Case "ERR" & ERRQUERYDEFDELETED : sLocal = "Pre-existing query '%0' has been deleted" Case "ERR" & ERRTABLEDEFDELETED : sLocal = "Pre-existing table '%0' has been deleted" Case "ERR" & ERRTABLECREATION : sLocal = "Table '%0' could not be created" Case "ERR" & ERRFIELDCREATION : sLocal = "Field '%0' could not be created" Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "Subform '%0' not found in parent form '%1'" Case "ERR" & ERRWINDOW : sLocal = "Current window is not a document" Case "ERR" & ERRCOMPATIBILITY : sLocal = "Field '%0' could not be converted due to incompatibility of field types between the respective database systems" Case "ERR" & ERRPRECISION : sLocal = "Field '%0' could not be loaded in record #%1 due to capacity shortage" Case "ERR" & ERRMODULENOTFOUND : sLocal = "Module '%0' not found in the currently loaded libraries" Case "ERR" & ERRPROCEDURENOTFOUND : sLocal = "Procedure '%0' not found in module '%1'" Case "OBJECT" : sLocal = "Object" Case "TABLE" : sLocal = "Table" Case "QUERY" : slocal = "Query" Case "FORM" : sLocal = "Form" Case "REPORT" : sLocal = "Report" Case "RECORDSET" : sLocal = "Recordset" Case "FIELD" : sLocal = "Field" Case "TEMPVAR" : sLocal = "Temporary variable" Case "COMMANDBAR" : sLocal = "Command bar" Case "COMMANDBARCONTROL" : sLocal = "Command bar control" Case "ERR#" : sLocal = "Error #" Case "ERROCCUR" : sLocal = "occurred" Case "ERRLINE" : sLocal = "at line" Case "ERRIN" : sLocal = "in" Case "CALLTO" : sLocal = "a call to function" Case "SAVECONSOLE" : sLocal = "Save console" Case "SAVECONSOLEENTRIES" : sLocal = "The console entries have been saved successfully." Case "QUITSHORT" : sLocal = "Quit" Case "QUIT" : sLocal = "Do you really want to quit the application ? Changed data will be saved." Case "ENTERING" : sLocal = "Entering" Case "EXITING" : sLocal = "Exiting" Case "DLGTRACE_HELP" : sLocal = "Manage the console buffer and its entries" Case "DLGTRACE_TITLE" : sLocal = "Console" Case "DLGTRACE_LBLENTRIES_HELP" : sLocal = "Clear the list and resize the circular buffer" Case "DLGTRACE_LBLENTRIES_LABEL" : sLocal = "Set max number of entries" Case "DLGTRACE_TXTTRACELOG_HELP" : sLocal = "Text can be selected, copied, ..." Case "DLGTRACE_TXTTRACELOG_TEXT" : sLocal = "--- Log file is empty ---" Case "DLGTRACE_CMDCANCEL_HELP" : sLocal = "Cancel and close the dialog" Case "DLGTRACE_CMDCANCEL_LABEL" : sLocal = "Cancel" Case "DLGTRACE_LBLCLEAR_HELP" : sLocal = "Clear the list" Case "DLGTRACE_LBLCLEAR_LABEL" : sLocal = "Clear the list" Case "DLGTRACE_LBLMINLEVEL_HELP" : sLocal = "Register only logging requests above given level" Case "DLGTRACE_LBLMINLEVEL_LABEL" : sLocal = "Set minimal trace level" Case "DLGTRACE_CMDOK_HELP" : sLocal = "Validate" Case "DLGTRACE_CMDOK_LABEL" : sLocal = "OK" Case "DLGTRACE_CMDDUMP_HELP" : sLocal = "Choose a file and dump the actual list content in it" Case "DLGTRACE_CMDDUMP_LABEL" : sLocal = "Dump to file" Case "DLGTRACE_LBLNBENTRIES_HELP" : sLocal = "Actual size of list" Case "DLGTRACE_LBLNBENTRIES_LABEL" : sLocal = "Actual number of entries:" Case "DLGFORMAT_HELP" : sLocal = "Export the form" Case "DLGFORMAT_TITLE" : sLocal = "OutputTo" Case "DLGFORMAT_LBLFORMAT_HELP" : sLocal = "Format in which the form should be exported" Case "DLGFORMAT_LBLFORMAT_LABEL" : sLocal = "Select the output format" Case "DLGFORMAT_CMDOK_HELP" : sLocal = "Validate your choice" Case "DLGFORMAT_CMDOK_LABEL" : sLocal = "OK" Case "DLGFORMAT_CMDCANCEL_HELP" : sLocal = "Cancel and close the dialog" Case "DLGFORMAT_CMDCANCEL_LABEL" : sLocal = "Cancel" Case Else : sLocal = "" End Select Case "FR" Select Case UCase(psShortlabel) Case "ERR" & ERRDBNOTCONNECTED : sLocal = "Pas de connexion active trouvée à une banque de données" Case "ERR" & ERRMISSINGARGUMENTS : sLocal = "Des arguments sont manquants ou non initialisés" Case "ERR" & ERRWRONGARGUMENT : sLocal = "L'argument n° %0 [Valeur = '%1'] n'est pas valable" Case "ERR" & ERRMAINFORM : sLocal = "Le document '%0' ne contient aucun formulaire" Case "ERR" & ERRFORMNOTIDENTIFIED : sLocal = "Le formulaire '%0' n'a pas pu être identifié parmi l'ensemble des formulaires de la Database" Case "ERR" & ERRFORMNOTFOUND : sLocal = "Formulaire '%0' non trouvé" Case "ERR" & ERRFORMNOTOPEN : sLocal = "Le formulaire '%0' n'est actuellement pas ouvert" Case "ERR" & ERRDFUNCTION : sLocal = "L'exécution de la ""fonction database"" a échoué, SQL=%0" Case "ERR" & ERROPENFORM : sLocal = "Le formulaire '%0' n'a pas pu être ouvert" Case "ERR" & ERRPROPERTY : sLocal = "La propriété '%0' n'est pas applicable dans ce contexte" Case "ERR" & ERRPROPERTYVALUE : sLocal = "La valeur '%0' est invalide pour la propriété '%1'" Case "ERR" & ERRINDEXVALUE : sLocal = "Indice invalide ou dimension erronée du tableau pour la propriété '%0'" Case "ERR" & ERRCOLLECTION : sLocal = "Indice de tableau invalide" Case "ERR" & ERRPROPERTYNOTARRAY : sLocal = "L'argument n°%0 doit être un tableau" Case "ERR" & ERRCONTROLNOTFOUND : sLocal = "Contrôle '%0' non trouvé dans le parent (formulaire, contrôle de table ou dialogue) '%1'" Case "ERR" & ERRNOACTIVEFORM : sLocal = "Pas de formulaire ou de contrôle actif" Case "ERR" & ERRDATABASEFORM : sLocal = "Le formulaire '%0' n'a pas de données sous-jacentes" Case "ERR" & ERRFOCUSINGRID : sLocal = "Contrôle '%0' non trouvé dans le contrôle de table '%1'" Case "ERR" & ERRNOGRIDINFORM : sLocal = "Aucun contrôle de table trouvé dans le formulaire '%0'" Case "ERR" & ERRFINDRECORD : sLocal = "FindNext() doit être précédé par un appel réussi à FindRecord(...)" Case "ERR" & ERRSQLSTATEMENT : sLocal = "Erreur SQL, instruction SQL = '%0'" Case "ERR" & ERROBJECTNOTFOUND : sLocal = "%0 '%1' non trouvé(e)" Case "ERR" & ERROPENOBJECT : sLocal = "%0 '%1': ouverture en échec" Case "ERR" & ERRCLOSEOBJECT : sLocal = "%0 '%1': fermeture en échec" Case "ERR" & ERRACTION : sLocal = "Action non applicable dans ce contexte" Case "ERR" & ERRSENDMAIL : sLocal = "Le service de messagerie n'a pas pu être activé" Case "ERR" & ERRFORMYETOPEN : sLocal = "Le formulaire %0 est déjà ouvert" Case "ERR" & ERRMETHOD : sLocal = "La méthode '%0' n'est pas applicable dans ce contexte" Case "ERR" & ERRPROPERTYINIT : sLocal = "Propriété '%0' applicable mais non initialisée" Case "ERR" & ERRFILENOTCREATED : sLocal = "Erreur de création du fichier '%0'" Case "ERR" & ERRDIALOGNOTFOUND : sLocal = "Dialogue '%0' introuvable dans les librairies chargées actuellement" Case "ERR" & ERRDIALOGUNDEFINED : sLocal = "Boîte de dialogue inconnue" Case "ERR" & ERRDIALOGSTARTED : sLocal = "Dialogue déjà initialisé précédemment" Case "ERR" & ERRDIALOGNOTSTARTED : sLocal = "Dialogue '%0' non initialisé" Case "ERR" & ERRRECORDSETNODATA : sLocal = "Recordset n'a pas fourni de données. Toute action sur les enregistrements est rejetée" Case "ERR" & ERRRECORDSETCLOSED : sLocal = "Recordset a été clôturé. Action sur l'enregistrement courant est rejetée" Case "ERR" & ERRRECORDSETRANGE : sLocal = "L'enregistrement courant est hors cadre" Case "ERR" & ERRRECORDSETFORWARD : sLocal = "Action rejetée car recordset lisible seulement vers l'avant ou n'acceptant pas de signets" Case "ERR" & ERRFIELDNULL : sLocal = "Champ nul ou vide. Action rejetée" Case "ERR" & ERRFILEACCESS : sLocal = "Erreur d'accès au fichier '%0'" Case "ERR" & ERROVERFLOW : sLocal = "La longueur du champ (%0) dépasse la taille maximale autorisée. Utiliser de préférence la méthode '%1'" Case "ERR" & ERRNOTACTIONQUERY : sLocal = "La requête '%0' n'est pas une requête d'action" Case "ERR" & ERRNOTUPDATABLE : sLocal = "La banque de données, le recordset ou le champ sont en lecture seulement" Case "ERR" & ERRUPDATESEQUENCE : sLocal = "Erreur de séquence lors de la mise à jour d'un Recordset" Case "ERR" & ERRNOTNULLABLE : sLocal = "Le champ '%0' ne peut pas recevoir une valeur NULLe" Case "ERR" & ERRROWDELETED : sLocal = "L'enregistrement courant a été effacé par un autre processus ou un autre utilisateur" Case "ERR" & ERRRECORDSETCLONE : sLocal = "Le clonage d'un Recordset cloné est interdit" Case "ERR" & ERRQUERYDEFDELETED : sLocal = "La requête existante '%0' a été supprimée" Case "ERR" & ERRTABLEDEFDELETED : sLocal = "La table existante '%0' a été supprimée" Case "ERR" & ERRTABLECREATION : sLocal = "La table '%0' n'a pas pu être créée" Case "ERR" & ERRFIELDCREATION : sLocal = "Le champ '%0' n'a pas pu être créé" Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "Sous-formulaire '%0' non trouvé dans le formulaire parent '%1'" Case "ERR" & ERRWINDOW : sLocal = "La fenêtre courante n'est pas un document" Case "ERR" & ERRCOMPATIBILITY : sLocal = "Le champ '%0' n'a pas pu être converti à cause d'une incompatibilité entre les types de champs supportés par les systèmes de bases de données respectifs" Case "ERR" & ERRPRECISION : sLocal = "Le champ '%0' n'a pas pu être chargé dans l'enregistrement #%1 par manque de capacité" Case "ERR" & ERRMODULENOTFOUND : sLocal = "Le module '%0' est introuvable dans les librairies chargées actuellement" Case "ERR" & ERRPROCEDURENOTFOUND : sLocal = "La procédure '%0' est introuvable dans le module '%1'" Case "OBJECT" : sLocal = "Objet" Case "TABLE" : sLocal = "Table" Case "QUERY" : slocal = "Requête" Case "FORM" : sLocal = "Formulaire" Case "REPORT" : sLocal = "Rapport" Case "RECORDSET" : sLocal = "Recordset" Case "FIELD" : sLocal = "Champ" Case "TEMPVAR" : sLocal = "Variable temporaire" Case "COMMANDBAR" : sLocal = "Barre de commande" Case "COMMANDBARCONTROL" : sLocal = "Elément de barre de commande" Case "ERR#" : sLocal = "L'erreur #" Case "ERROCCUR" : sLocal = "s'est produite" Case "ERRLINE" : sLocal = "à la ligne" Case "ERRIN" : sLocal = "dans" Case "CALLTO" : sLocal = "un appel à la fonction" Case "SAVECONSOLE" : sLocal = "Sauver console" Case "SAVECONSOLEENTRIES" : sLocal = "Les entrées de la console ont été sauvées avec succès." Case "QUITSHORT" : sLocal = "Quitter" Case "QUIT" : sLocal = "Voulez-vous réellement quitter l'application ? Les données modifiées seront sauvées." Case "ENTERING" : sLocal = "Entrée dans" Case "EXITING" : sLocal = "Sortie de" Case "DLGTRACE_HELP" : sLocal = "Gestion du tampon de la console et toutes ses entrées" Case "DLGTRACE_TITLE" : sLocal = "Console" Case "DLGTRACE_LBLENTRIES_HELP" : sLocal = "Effacer la liste et redimensionner le tampon circulaire" Case "DLGTRACE_LBLENTRIES_LABEL" : sLocal = "Définir le nombre maximum d'entrées" Case "DLGTRACE_TXTTRACELOG_HELP" : sLocal = "Le texte peut être sélectionné, copié, ..." Case "DLGTRACE_TXTTRACELOG_TEXT" : sLocal = "--- Le fichier journal est vide ---" Case "DLGTRACE_CMDCANCEL_HELP" : sLocal = "Annuler et fermer la boîte de dialogue" Case "DLGTRACE_CMDCANCEL_LABEL" : sLocal = "Annuler" Case "DLGTRACE_LBLCLEAR_HELP" : sLocal = "Effacer la liste" Case "DLGTRACE_LBLCLEAR_LABEL" : sLocal = "Effacer la liste" Case "DLGTRACE_LBLMINLEVEL_HELP" : sLocal = "N'enregistrer que les demandes de journalisation à partir du niveau indiqué" Case "DLGTRACE_LBLMINLEVEL_LABEL" : sLocal = "Définir le niveau minimal d'enregistrement" Case "DLGTRACE_CMDOK_HELP" : sLocal = "Valider" Case "DLGTRACE_CMDOK_LABEL" : sLocal = "OK" Case "DLGTRACE_CMDDUMP_HELP" : sLocal = "Sélectionner un fichier et y vider le contenu actuel des traces enregistrées" Case "DLGTRACE_CMDDUMP_LABEL" : sLocal = "Vider dans fichier" Case "DLGTRACE_LBLNBENTRIES_HELP" : sLocal = "Taille actuelle de la liste" Case "DLGTRACE_LBLNBENTRIES_LABEL" : sLocal = "Nombre actuel d'entrées:" Case "DLGFORMAT_HELP" : sLocal = "Exporter le formulaire" Case "DLGFORMAT_TITLE" : sLocal = "OutputTo" Case "DLGFORMAT_LBLFORMAT_HELP" : sLocal = "Format dans lequel le formulaire sera exporté" Case "DLGFORMAT_LBLFORMAT_LABEL" : sLocal = "Selectionner le format de sortie" Case "DLGFORMAT_CMDOK_HELP" : sLocal = "Valider votre choix" Case "DLGFORMAT_CMDOK_LABEL" : sLocal = "OK" Case "DLGFORMAT_CMDCANCEL_HELP" : sLocal = "Annuler et fermer la boîte de dialogue" Case "DLGFORMAT_CMDCANCEL_LABEL" : sLocal = "Annuler" Case Else : sLocal = _Getlabel(psShortLabel, "DEFAULT") End Select Case "ES" Select Case UCase(psShortlabel) Case "ERR" & ERRDBNOTCONNECTED : sLocal = "No se ha encontrado una conexión activa a una base de datos" Case "ERR" & ERRMISSINGARGUMENTS : sLocal = "Faltan argumentos o no están inicializados" Case "ERR" & ERRWRONGARGUMENT : sLocal = "El argumento nr. %0 [Value = '%1'] no es válido" Case "ERR" & ERRMAINFORM : sLocal = "El documento '%0' no contiene ningún formulario" Case "ERR" & ERRFORMNOTIDENTIFIED : sLocal = "No se ha identificado el formulario '%0' en el conjunto de formularios de la base de datos" Case "ERR" & ERRFORMNOTFOUND : sLocal = "No se ha encontrado el formulario '%0'" Case "ERR" & ERRFORMNOTOPEN : sLocal = "El formulario '%0' no está abierto" Case "ERR" & ERRDFUNCTION : sLocal = "La ejecución de DFunction falló, SQL=%0" Case "ERR" & ERROPENFORM : sLocal = "El formulario '%0' no se puede abrir" Case "ERR" & ERRPROPERTY : sLocal = "La propiedad '%0' no es aplicable en este contexto" Case "ERR" & ERRPROPERTYVALUE : sLocal = "El valor '%0' es inválido para la propiedad '%1'" Case "ERR" & ERRINDEXVALUE : sLocal = "Fuera del rango de la matriz o tamaño incorrecto de la matriz para la propiedad '%0'" Case "ERR" & ERRCOLLECTION : sLocal = "Fuera del rango de la matriz" Case "ERR" & ERRPROPERTYNOTARRAY : sLocal = "El argumento nr.%0 debería ser una matriz" Case "ERR" & ERRCONTROLNOTFOUND : sLocal = "El control '%0' not found in parent (formulario, control de tabla or diálogo) '%1'" Case "ERR" & ERRNOACTIVEFORM : sLocal = "No se ha encontrado un formulario o control activo" Case "ERR" & ERRDATABASEFORM : sLocal = "El formulario '%0' no tiene datos subyacentes" Case "ERR" & ERRFOCUSINGRID : sLocal = "No se ha encontrado el control '%0' en el control de tabla '%1'" Case "ERR" & ERRNOGRIDINFORM : sLocal = "No se ha encontrado un control de tabla en el formulario '%0'" Case "ERR" & ERRFINDRECORD : sLocal = "FindNext() tiene que ser precedido por una llamada exitosa de FindRecord(...)" Case "ERR" & ERRSQLSTATEMENT : sLocal = "Error SQL, instrución SQL = '%0'" Case "ERR" & ERROBJECTNOTFOUND : sLocal = "%0 '%1' no encontrado" Case "ERR" & ERROPENOBJECT : sLocal = "%0 '%1' no se puede abrir" Case "ERR" & ERRCLOSEOBJECT : sLocal = "%0 '%1' no se puede abrir" Case "ERR" & ERRACTION : sLocal = "Acción no aplicable en este contexto" Case "ERR" & ERRSENDMAIL : sLocal = "No se puede activar el servicio de correo" Case "ERR" & ERRFORMYETOPEN : sLocal = "El formulario %0 ya está abierto" Case "ERR" & ERRMETHOD : sLocal = "El método '%0' no es aplicable en este contexto" Case "ERR" & ERRPROPERTYINIT : sLocal = "Propiedad '%0' aplicable pero no inicializada" Case "ERR" & ERRFILENOTCREATED : sLocal = "No se ha podido crear el archivo '%0'" Case "ERR" & ERRDIALOGNOTFOUND : sLocal = "No se ha encontrado el diálogo '%0' en las bibliotecas cargadas actualmente" Case "ERR" & ERRDIALOGUNDEFINED : sLocal = "Diálogo desconocido" Case "ERR" & ERRDIALOGSTARTED : sLocal = "El diálogo ya está iniciado" Case "ERR" & ERRDIALOGNOTSTARTED : sLocal = "El diálogo '%0' no está activo" Case "ERR" & ERRRECORDSETNODATA : sLocal = "El Recordset no suministra datos. La acción en el registro actual rechazada" Case "ERR" & ERRRECORDSETCLOSED : sLocal = "El recorset se ha cerrado. Acción con el Recordset rechazada" Case "ERR" & ERRRECORDSETRANGE : sLocal = "Registro actual fuera de rango" Case "ERR" & ERRRECORDSETFORWARD : sLocal = "Acción rechazada en un recorset legible sólo hacia adelante o que no admita marcadores" Case "ERR" & ERRFIELDNULL : sLocal = "El campo es nulo o vacío. Acción rechazada" Case "ERR" & ERRFILEACCESS : sLocal = "Error durante el acceso al archivo '%0'" Case "ERR" & ERROVERFLOW : sLocal = "La longitud del campo (%0) excede la longitud máxima. Reemplazar por el método '%1'" Case "ERR" & ERRNOTACTIONQUERY : sLocal = "La consulta '%0' no es una consulta de acción" Case "ERR" & ERRNOTUPDATABLE : sLocal = "La base de datos, el Recordset o el Campo es de sólo lectura" Case "ERR" & ERRUPDATESEQUENCE : sLocal = "Error durante la secuencia de actualización del Recordset" Case "ERR" & ERRNOTNULLABLE : sLocal = "El campo '%0' no puede contener un valor NULL" Case "ERR" & ERRROWDELETED : sLocal = "La fila actual ha sido borrada por otro proceso o usuario" Case "ERR" & ERRRECORDSETCLONE : sLocal = "No se puede clonar un Recordset clonado" Case "ERR" & ERRQUERYDEFDELETED : sLocal = "Se ha borrado la consulta pre-existente '%0'" Case "ERR" & ERRTABLEDEFDELETED : sLocal = "Se ha borrado la tabla pre-existente '%0'" Case "ERR" & ERRTABLECREATION : sLocal = "No se ha podido crear la Tabla '%0'" Case "ERR" & ERRFIELDCREATION : sLocal = "No se ha podido crear el campo '%0'" Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "No se ha encontrado el Subformulario '%0' en el subformulario padre '%1'" Case "ERR" & ERRWINDOW : sLocal = "La ventana actual no es un documento" Case "ERR" & ERRCOMPATIBILITY : sLocal = "El campo '%0' no se ha convertido debido a una incompatibilidad de los tipos de campo soportados entre las dos bases de datos" Case "ERR" & ERRPRECISION : sLocal = "El campo '%0' no se ha cargado en el registro #%1 por falta de capacidad" Case "ERR" & ERRMODULENOTFOUND : sLocal = "Module '%0' not found in the currently loaded libraries" Case "ERR" & ERRPROCEDURENOTFOUND : sLocal = "Procedure '%0' not found in module '%1'" Case "OBJECT" : sLocal = "Objeto" Case "TABLE" : sLocal = "Tabla" Case "QUERY" : slocal = "Consulta" Case "FORM" : sLocal = "Formulario" Case "REPORT" : sLocal = "Informe" Case "RECORDSET" : sLocal = "Recordset" Case "FIELD" : sLocal = "Campo" Case "TEMPVAR" : sLocal = "Variable temporal" Case "COMMANDBAR" : sLocal = "Barra de comandos" Case "COMMANDBARCONTROL" : sLocal = "Control de barra de comandos" Case "ERR#" : sLocal = "Error #" Case "ERROCCUR" : sLocal = "ocurrido" Case "ERRLINE" : sLocal = "en línea" Case "ERRIN" : sLocal = "en" Case "CALLTO" : sLocal = "una llamada a la función" Case "SAVECONSOLE" : sLocal = "Guardar consola" Case "SAVECONSOLEENTRIES" : sLocal = "Las entradas de la consola han sido guardadas correctamente." Case "QUITSHORT" : sLocal = "Cerrar" Case "QUIT" : sLocal = "Quieres realmente cerrar la aplicación? los datos cambiados se guardarán." Case "ENTERING" : sLocal = "Entrando" Case "EXITING" : sLocal = "Saliendo" Case "DLGTRACE_HELP" : sLocal = "Gestión del buffer de la consola y sus entradas" Case "DLGTRACE_TITLE" : sLocal = "Consola" Case "DLGTRACE_LBLENTRIES_HELP" : sLocal = "Limpiar la lista y redimensionar el buffer circular" Case "DLGTRACE_LBLENTRIES_LABEL" : sLocal = "Definir el número máximo de entradas" Case "DLGTRACE_TXTTRACELOG_HELP" : sLocal = "El texto puede ser seleccionado, copiado, ..." Case "DLGTRACE_TXTTRACELOG_TEXT" : sLocal = "--- El archivo Histórico está vacío ---" Case "DLGTRACE_CMDCANCEL_HELP" : sLocal = "Cancelar y cerrar el diálogo" Case "DLGTRACE_CMDCANCEL_LABEL" : sLocal = "Cancelar" Case "DLGTRACE_LBLCLEAR_HELP" : sLocal = "Limpiar la lista" Case "DLGTRACE_LBLCLEAR_LABEL" : sLocal = "Limpiar la lista" Case "DLGTRACE_LBLMINLEVEL_HELP" : sLocal = "No registrar más que las peticiones de registro a partir de un nivel indicado" Case "DLGTRACE_LBLMINLEVEL_LABEL" : sLocal = "Definir el nivel mínimo de registro" Case "DLGTRACE_CMDOK_HELP" : sLocal = "Validar" Case "DLGTRACE_CMDOK_LABEL" : sLocal = "Aceptar" Case "DLGTRACE_CMDDUMP_HELP" : sLocal = "Elegir un archivo y guardar en él el contenido de la lista actual" Case "DLGTRACE_CMDDUMP_LABEL" : sLocal = "Guardar en a archivo" Case "DLGTRACE_LBLNBENTRIES_HELP" : sLocal = "Tamaño actual de la lista" Case "DLGTRACE_LBLNBENTRIES_LABEL" : sLocal = "Numero actual de entradas:" Case "DLGFORMAT_HELP" : sLocal = "Exportar el formulario" Case "DLGFORMAT_TITLE" : sLocal = "Exportar como" Case "DLGFORMAT_LBLFORMAT_HELP" : sLocal = "Formato en el que será ser exportado el formulario" Case "DLGFORMAT_LBLFORMAT_LABEL" : sLocal = "Seleccionar el formato de salida" Case "DLGFORMAT_CMDOK_HELP" : sLocal = "Validar su elección" Case "DLGFORMAT_CMDOK_LABEL" : sLocal = "Aceptar" Case "DLGFORMAT_CMDCANCEL_HELP" : sLocal = "Cancelar y cerrar el diálogo" Case "DLGFORMAT_CMDCANCEL_LABEL" : sLocal = "Cancelar" Case Else : sLocal = _Getlabel(psShortLabel, "DEFAULT") End Select Case "DE" Select Case UCase(psShortlabel) Case "ERR" & ERRDBNOTCONNECTED : sLocal = "Keine aktive Verbindung zu einer Datenbank gefunden" Case "ERR" & ERRMISSINGARGUMENTS : sLocal = "Argumente fehlen oder sind nicht initialisiert" Case "ERR" & ERRWRONGARGUMENT : sLocal = "Argument Nr. %0 [Wert = '%1'] ist ungültig" Case "ERR" & ERRMAINFORM : sLocal = "Dokument '%0' enthält kein Formular" Case "ERR" & ERRFORMNOTIDENTIFIED : sLocal = "Formular '%0' nicht bei den Datenbank-Formularen erkannt" Case "ERR" & ERRFORMNOTFOUND : sLocal = "Formular '%0' nicht gefunden" Case "ERR" & ERRFORMNOTOPEN : sLocal = "Formular '%0' ist zur Zeit nicht offen" Case "ERR" & ERRDFUNCTION : sLocal = "DFunction Ausführung misslungen, SQL=%0" Case "ERR" & ERROPENFORM : sLocal = "Formular '%0' konnte nicht geöffnet werden" Case "ERR" & ERRPROPERTY : sLocal = "Eigenschaft '%0' in diesem Kontext nicht anwendbar" Case "ERR" & ERRPROPERTYVALUE : sLocal = "Wert '%0' ist ungültig für die Eigenschaft '%1'" Case "ERR" & ERRINDEXVALUE : sLocal = "Außerhalb des Array-Bereichs oder falsche Array-Größe für Eigenschaft '%0'" Case "ERR" & ERRCOLLECTION : sLocal = "Außerhalb des Array-Bereichs" Case "ERR" & ERRPROPERTYNOTARRAY : sLocal = "Argument Nr.%0 sollte ein Array sein" Case "ERR" & ERRCONTROLNOTFOUND : sLocal = "Steuerelement '%0' nicht gefunden in parent (Formular, Tabelle oder Dialog) '%1'" Case "ERR" & ERRNOACTIVEFORM : sLocal = "Kein aktives Formular oder Steuerelement gefunden" Case "ERR" & ERRDATABASEFORM : sLocal = "Formular '%0' basiert nicht auf einem Datensatz" Case "ERR" & ERRFOCUSINGRID : sLocal = "Steuerelement '%0' im Tabellen-Steuerelement '%1' nicht gefunden" Case "ERR" & ERRNOGRIDINFORM : sLocal = "Kein Tabellen-Steuerelement im Formular '%0' gefunden" Case "ERR" & ERRFINDRECORD : sLocal = "Bei FindNext() muss ein erfolgreicher FindRecord(...)-Aufruf vorhergehen" Case "ERR" & ERRSQLSTATEMENT : sLocal = "SQL Error, SQL statement = '%0'" Case "ERR" & ERROBJECTNOTFOUND : sLocal = "%0 '%1' nicht gefunden" Case "ERR" & ERROPENOBJECT : sLocal = "%0 '%1' konnte nicht geöffnet werden" Case "ERR" & ERRCLOSEOBJECT : sLocal = "%0 '%1' konnte nicht geschlossen werden" Case "ERR" & ERRACTION : sLocal = "Aktion in diesem Kontext nicht anwendbar" Case "ERR" & ERRSENDMAIL : sLocal = "Email-Dienst konnte nicht aktiviert werden" Case "ERR" & ERRFORMYETOPEN : sLocal = "Formular %0 ist schon offen" Case "ERR" & ERRMETHOD : sLocal = "Methode '%0' in diesem Kontext nicht anwendbar" Case "ERR" & ERRPROPERTYINIT : sLocal = "Eigenschaft '%0' anwendbar aber nicht initialisiert" Case "ERR" & ERRFILENOTCREATED : sLocal = "Datei '%0' konnte nicht erzeugt werden" Case "ERR" & ERRDIALOGNOTFOUND : sLocal = "Dialog '%0' nicht in den aktuell geladenen Bibliotheken gefunden" Case "ERR" & ERRDIALOGUNDEFINED : sLocal = "Dialog unbekannt" Case "ERR" & ERRDIALOGSTARTED : sLocal = "Dialog schon gestartet" Case "ERR" & ERRDIALOGNOTSTARTED : sLocal = "Dialog '%0' nicht aktiv" Case "ERR" & ERRRECORDSETNODATA : sLocal = "Datensatz ergab keine Daten. Aktion auf aktuellem Datensatz verweigert" Case "ERR" & ERRRECORDSETCLOSED : sLocal = "Datensatz wurde geschlossen. Datensatz-Aktion verweigert" Case "ERR" & ERRRECORDSETRANGE : sLocal = "Aktueller Datensatz außerhalb des Bereichs" Case "ERR" & ERRRECORDSETFORWARD : sLocal = "Aktion verweigert auf einem nur vorwärts lesbaren oder keine Textmarken unterstützenden Datensatz" Case "ERR" & ERRFIELDNULL : sLocal = "Feld ist null oder leer. Aktion verweigert" Case "ERR" & ERRFILEACCESS : sLocal = "Dateizugriffs-Fehler bei Datei '%0'" Case "ERR" & ERROVERFLOW : sLocal = "Feldlänge (%0) überschreitet die maximale Länge. Verwende stattdessen die Methode '%1'" Case "ERR" & ERRNOTACTIONQUERY : sLocal = "Abfrage '%0' ist keine Aktionsabfrage" Case "ERR" & ERRNOTUPDATABLE : sLocal = "Datenbank, Datensatz oder Feld kann nur gelesen werden" Case "ERR" & ERRUPDATESEQUENCE : sLocal = "Datensatz-Update Folgefehler" Case "ERR" & ERRNOTNULLABLE : sLocal = "Feld '%0' darf keinen NULL-Wert haben" Case "ERR" & ERRROWDELETED : sLocal = "Aktuelle Zeile wurde durch einen anderen Prozess oder Benutzer gelösch" Case "ERR" & ERRRECORDSETCLONE : sLocal = "Ein geklonter Datensatz kann nicht geklont werden" Case "ERR" & ERRQUERYDEFDELETED : sLocal = "Bereits vorhandene Abfrage '%0' wurde gelöscht" Case "ERR" & ERRTABLEDEFDELETED : sLocal = "Bereits vorhandene Tabelle '%0' wurde gelöscht" Case "ERR" & ERRTABLECREATION : sLocal = "Tabelle '%0' konnte nicht erzeugt werden" Case "ERR" & ERRFIELDCREATION : sLocal = "Feld '%0' konnte nicht erzeugt werden" Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "Unterformular '%0' nicht im Eltern-Formular '%1 gefunden" Case "ERR" & ERRWINDOW : sLocal = "Aktuelles Fenster ist kein Dokument" Case "ERR" & ERRCOMPATIBILITY : sLocal = "Feld '%0' konnte wegen inkompatibler Feldtypen der Datenbanksysteme nicht konvertiert werden" Case "ERR" & ERRPRECISION : sLocal = "Feld '%0' konnte wegen fehlender Speicherkapazität nicht in den Datensatz #%1 geladen werden" Case "ERR" & ERRMODULENOTFOUND : sLocal = "Modul '%0' nicht gefunden in den aktuell geladen Bibliotheken" Case "ERR" & ERRPROCEDURENOTFOUND : sLocal = "Prozedur '%0' im Modul '%1' nicht gefunden" Case "OBJECT" : sLocal = "Objekt" Case "TABLE" : sLocal = "Tabelle" Case "QUERY" : slocal = "Abfrage" Case "FORM" : sLocal = "Formular" Case "REPORT" : sLocal = "Report" Case "RECORDSET" : sLocal = "Datensatz" Case "FIELD" : sLocal = "Feld" Case "TEMPVAR" : sLocal = "Temporäre Variable" Case "COMMANDBAR" : sLocal = "Befehlsleiste" Case "COMMANDBARCONTROL" : sLocal = "Befehlsleisten-Steuerelement" Case "ERR#" : sLocal = "Error #" Case "ERROCCUR" : sLocal = "aufgetreten" Case "ERRLINE" : sLocal = "in Zeile" Case "ERRIN" : sLocal = "in" Case "CALLTO" : sLocal = "ein Funktionsaufruf" Case "SAVECONSOLE" : sLocal = "Konsoleneingaben sichern" Case "SAVECONSOLEENTRIES" : sLocal = "Die Konsoleneingaben wurden erfolgreich gesichert." Case "QUITSHORT" : sLocal = "Beenden" Case "QUIT" : sLocal = "Wollen Sie wirklich die Anwendung beenden? Geänderte Daten werden gesichert." Case "ENTERING" : sLocal = "Beginne mit" Case "EXITING" : sLocal = "Verlasse" Case "DLGTRACE_HELP" : sLocal = "Verwalte den Konsolenpuffer und seine Eingaben" Case "DLGTRACE_TITLE" : sLocal = "Konsole" Case "DLGTRACE_LBLENTRIES_HELP" : sLocal = "Leere die Liste und ändere die Größe des Umlaufpuffers" Case "DLGTRACE_LBLENTRIES_LABEL" : sLocal = "Setze maximale Anzahl von Eingaben" Case "DLGTRACE_TXTTRACELOG_HELP" : sLocal = "Text kann ausgewählt, kopiert, ... werden" Case "DLGTRACE_TXTTRACELOG_TEXT" : sLocal = "--- Log Datei ist leer ---" Case "DLGTRACE_CMDCANCEL_HELP" : sLocal = "Abbrechen und den Dialog schließen" Case "DLGTRACE_CMDCANCEL_LABEL" : sLocal = "Abbrechen" Case "DLGTRACE_LBLCLEAR_HELP" : sLocal = "Leere die Liste" Case "DLGTRACE_LBLCLEAR_LABEL" : sLocal = "Leere die Liste" Case "DLGTRACE_LBLMINLEVEL_HELP" : sLocal = "Registriere nur Logging-Anfragen oberhalb des gegebenen Levels" Case "DLGTRACE_LBLMINLEVEL_LABEL" : sLocal = "Setze minimalen Fehlerbehandlungs-Level" Case "DLGTRACE_CMDOK_HELP" : sLocal = "Übernehmen" Case "DLGTRACE_CMDOK_LABEL" : sLocal = "OK" Case "DLGTRACE_CMDDUMP_HELP" : sLocal = "Wähle eine Datei und speichere darin den aktuellen Listeninhalt" Case "DLGTRACE_CMDDUMP_LABEL" : sLocal = "Ausgabe in Datei" Case "DLGTRACE_LBLNBENTRIES_HELP" : sLocal = "Aktuelle Länge der Liste" Case "DLGTRACE_LBLNBENTRIES_LABEL" : sLocal = "Aktuelle Anzahl von Einträgen:" Case "DLGFORMAT_HELP" : sLocal = "Exportiere das Formular" Case "DLGFORMAT_TITLE" : sLocal = "Export" Case "DLGFORMAT_LBLFORMAT_HELP" : sLocal = "Format, in dem das Formular exportiert werden soll" Case "DLGFORMAT_LBLFORMAT_LABEL" : sLocal = "Wähle das Ausgabe-Format" Case "DLGFORMAT_CMDOK_HELP" : sLocal = "Auswahl übernehmen" Case "DLGFORMAT_CMDOK_LABEL" : sLocal = "OK" Case "DLGFORMAT_CMDCANCEL_HELP" : sLocal = "Abbrechen und den Dialog schließen" Case "DLGFORMAT_CMDCANCEL_LABEL" : sLocal = "Abbrechen" Case Else : sLocal = _Getlabel(psShortLabel, "DEFAULT") End Select Case Else sLocal = _Getlabel(psShortLabel, "DEFAULT") End Select Exit_Function: _Getlabel = sLocal Exit Function Error_Function: sLocal = psShortLabel GoTo Exit_Function End Function |
Access2BaseDev |
L10N |
_GetLabelArray |
Basic |
|
27 |
Public Function _GetLabelArray(ByVal pvShortlabel As Variant, Optional ByVal psLocale As String) As Variant
If IsMissing(psLocale) Then psLocale = UCase(Left(_GetLocale(), 2)) Else psLocale = UCase(psLocale) On Local Error Goto Error_Function
Dim vLocal() As Variant, i As integer vLocal = Array()
If Not IsArray(pvShortLabel) Then vLocal = _GetLabel(pvShortLabel, psLocale) Goto Exit_Function End If ReDim vLocal(LBound(pvShortLabel) To UBound(pvShortlabel)) For i = LBound(pvShortLabel) To UBound(pvShortlabel) vLocal(i) = _GetLabel(pvShortLabel(i), psLocale) Next i Exit_Function: _GetlabelArray = vLocal() Exit Function Error_Function: vLocal = Array() GoTo Exit_Function End Function |
Access2BaseDev |
L10N |
_GetLocale |
Basic |
_GetLabelArray (Procedure) Class_Initialize (Procedure) |
9 |
Public Function _GetLocale() as String
Dim oLocale as Object oLocale = _GetRegistryKeyContent("org.openoffice.Setup/L10N") _GetLocale = oLocale.getByName("ooLocale") End Function |
Access2BaseDev |
Methods |
_OptionGroup |
Basic |
OptionGroup (Procedure) OptionGroup (Procedure) |
100 |
Public Function _OptionGroup(ByVal pvGroupName As Variant _ , ByVal psParentType As String _ , poComponent As Object _ , poParent As Object _ ) As Variant
If IsMissing(pvGroupName) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function Set _OptionGroup = Nothing If Not Utils._CheckArgument(pvGroupName, 1, vbString) Then Goto Exit_Function
Dim ogGroup As Variant, i As Integer, j As Integer, bFound As Boolean Dim vOptionButtons() As Variant, sGroupName As String Dim lXY() As Long, iIndex() As Integer Dim oView As Object, oDatabaseForm As Object, vControls As Variant
Const cstPixels = 10 bFound = False Select Case psParentType Case CTLPARENTISFORM For i = 0 To poParent.Count - 1 Set oDatabaseForm = poParent.getByIndex(i) If Not IsNull(oDatabaseForm) Then For j = 0 To oDatabaseForm.GroupCount - 1 oDatabaseForm.getGroup(j, vOptionButtons, sGroupName) If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then bFound = True Exit For End If Next j If bFound Then Exit For End If If bFound Then Exit For Next i Case CTLPARENTISSUBFORM Set oDatabaseForm = poParent For j = 0 To oDatabaseForm.GroupCount - 1 oDatabaseForm.getGroup(j, vOptionButtons, sGroupName) If UCase(sGroupName) = UCase(Utils._Trim(pvGroupName)) Then bFound = True Exit For End If Next j End Select
If bFound Then
ogGroup = New Optiongroup ogGroup._Name = sGroupName ogGroup._ButtonsGroup = vOptionButtons ogGroup._Count = UBound(vOptionButtons) + 1 ogGroup._ParentType = psParentType ogGroup._MainForm = oDatabaseForm.Name Set ogGroup._ParentComponent = poComponent
ReDim lXY(1, ogGroup._Count - 1) ReDim iIndex(ogGroup._Count - 1) For i = 0 To ogGroup._Count - 1 Set oView = poComponent.CurrentController.getControl(ogGroup._ButtonsGroup(i)) lXY(0, i) = oView.PosSize.X lXY(1, i) = oView.PosSize.Y Next i For i = 0 To ogGroup._Count - 1 If i = 0 Then iIndex(0) = 0 Else iIndex(i) = i For j = i - 1 To 0 Step -1 If lXY(1, i) - lXY(1, j) < - cstPixels Or ( Abs(lXY(1, i) - lXY(1, j)) <= cstPixels And lXY(0, i) - lXY(0, j) < - cstPixels ) Then iIndex(i) = iIndex(j) iIndex(j) = iIndex(j) + 1 End If Next j End If Next i ogGroup._ButtonsIndex = iIndex()
Set _OptionGroup = ogGroup
Else
Set _OptionGroup = Nothing TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvGroupName))
End If Exit_Function: Exit Function Error_Function: TraceError(TRACEABORT, Err,"_OptionGroup", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Methods |
AddItem |
Basic |
Add (Procedure) Remove (Procedure) |
21 |
Public Function AddItem(Optional pvBox As Variant, ByVal Optional pvItem As Variant, ByVal Optional pvIndex) As Boolean
Utils._SetCalledSub("AddItem") If _ErrorHandler() Then On Local Error Goto Error_Function If IsMissing(pvBox) Or IsMissing(pvItem) Then Call _TraceArguments() If IsMissing(pvIndex) Then pvIndex = -1 If Not Utils._CheckArgument(pvBox, 1, Array(CTLLISTBOX, CTLCOMBOBOX)) Then Goto Exit_Function
AddItem = pvBox.AddItem(pvItem, pvIndex)
Exit_Function: Utils._ResetCalledSub("AddItem") Exit Function Error_Function: TraceError(TRACEABORT, Err, "AddItem", Erl) AddItem = False GoTo Exit_Function End Function |
Access2BaseDev |
Methods |
hasProperty |
Basic |
GoToControl (Procedure) |
21 |
Public Function hasProperty(Optional pvObject As Variant, ByVal Optional pvProperty As Variant) As Boolean
Dim vPropertiesList As Variant
Utils._SetCalledSub("hasProperty") If IsMissing(pvObject) Or IsMissing(pvProperty) Then Call _TraceArguments() hasProperty = False If Not Utils._CheckArgument(pvObject, 1, Array(OBJCOLLECTION, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJEVENT _ , OBJPROPERTY, OBJDATABASE, OBJQUERYDEF, OBJTABLEDEF, OBJRECORDSET _ )) Then Goto Exit_Function If Not Utils._CheckArgument(pvProperty, 2, vbString) Then Goto Exit_Function hasProperty = pvObject.hasProperty(pvProperty)
Exit_Function: Utils._ResetCalledSub("hasProperty") Exit Function End Function |
Access2BaseDev |
Methods |
Move |
Basic |
|
27 |
Public Function Move(Optional pvObject As Object _ , ByVal Optional pvLeft As Variant _ , ByVal Optional pvTop As Variant _ , ByVal Optional pvWidth As Variant _ , ByVal Optional pvHeight As Variant _ ) As Variant Utils._SetCalledSub("Move") If IsMissing(pvObject) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function Move = False If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function If IsMissing(pvLeft) Then Call _TraceArguments() If IsMissing(pvTop) Then pvTop = -1 If IsMissing(pvWidth) Then pvWidth = -1 If IsMissing(pvHeight) Then pvHeight = -1
Move = pvObject.Move(pvLeft, pvTop, pvWidth, pvHeight) Exit_Function: Utils._ResetCalledSub("Move") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Move", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Methods |
OpenHelpFile |
Basic |
|
9 |
Public Function OpenHelpFile() Const cstHelpFile = "http://www.access2base.com/access2base.html"
On Local Error Resume Next Call _ShellExecute(cstHelpFile) End Function |
Access2BaseDev |
Methods |
Properties |
Basic |
|
24 |
Public Function Properties(Optional pvObject As Variant, ByVal Optional pvIndex As Variant) As Variant
Dim vProperties As Variant, oCounter As Variant, opProperty As Variant Dim vPropertiesList() As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments() Utils._SetCalledSub("Properties") Set vProperties = Nothing If Not Utils._CheckArgument(pvObject, 1, Array(OBJCOLLECTION, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP, OBJEVENT _ , OBJPROPERTY, OBJDATABASE, OBJQUERYDEF, OBJTABLEDEF, OBJRECORDSET _ )) Then Goto Exit_Function
If IsMissing(pvIndex) Then vProperties = pvObject.Properties Else vProperties = pvObject.Properties(pvIndex) Exit_Function: Set Properties = vProperties Utils._ResetCalledSub("Properties") Exit Function End Function |
Access2BaseDev |
Methods |
Refresh |
Basic |
|
18 |
Public Function Refresh(Optional pvObject As Variant) As Boolean Utils._SetCalledSub("Refresh") If IsMissing(pvObject) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function Refresh = False If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function
Refresh = pvObject.Refresh()
Exit_Function: Utils._ResetCalledSub("Refresh") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Refresh", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Methods |
RemoveItem |
Basic |
|
21 |
Public Function RemoveItem(Optional pvBox As Variant,ByVal Optional pvIndex) As Boolean
Utils._SetCalledSub("RemoveItem") If _ErrorHandler() Then On Local Error Goto Error_Function If IsMissing(pvBox) Or IsMissing(pvIndex) Then Call _TraceArguments() If Not Utils._CheckArgument(pvBox, 1, Array(CTLLISTBOX, CTLCOMBOBOX)) Then Goto Exit_Function RemoveItem = pvBox.RemoveItem(pvIndex)
Exit_Function: Utils._ResetCalledSub("RemoveItem") Exit Function Error_Function: TraceError(TRACEABORT, Err, "RemoveItem", Erl) RemoveItem = False GoTo Exit_Function End Function |
Access2BaseDev |
Methods |
Requery |
Basic |
|
17 |
Public Function Requery(Optional pvObject As Variant) As Boolean Utils._SetCalledSub("Requery") If IsMissing(pvObject) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJCONTROL, OBJSUBFORM)) Then Goto Exit_Function Requery = pvObject.Requery()
Exit_Function: Utils._ResetCalledSub("Requery") Exit Function Error_Function: TraceError(TRACEABORT, Err, "Requery", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Methods |
SetFocus |
Basic |
|
20 |
Public Function SetFocus(Optional pvObject As Variant) As Boolean Utils._SetCalledSub("setFocus") If IsMissing(pvObject) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function If Not Utils._CheckArgument(pvObject, 1, Array(OBJFORM, OBJCONTROL)) Then Goto Exit_Function
SetFocus = pvObject.setFocus() Exit_Function: Utils._ResetCalledSub("SetFocus") Exit Function Error_Function: TraceError(TRACEABORT, Err, "SetFocus", Erl) Goto Exit_Function Error_Grid: TraceError(TRACEFATAL, ERRFOCUSINGRID, Utils._CalledSub(), 0, 1, Array(pvObject._Name, ocGrid._Name)) Goto Exit_Function End Function |
Access2BaseDev |
Module |
_BeginStatement |
Basic |
|
21 |
Private Function _BeginStatement(ByVal plStart As Long) As Long
Dim sProc As String, iProc As Integer, iType As Integer Dim lPosition As Long, lPrevious As Long, sFind As String
sProc = ProcOfLine(_LineOfPosition(plStart), iType) iProc = _FindProcIndex(sProc, iType) If iProc < 0 Then lPosition = 1 Else lPosition = _ProcDecPositions(iProc)
sFind = "Any" Do While lPosition < plStart And sFind <> "" lPrevious = lPosition sFind = _FindPattern("%^\w", lPosition) If sFind = "" Then Exit Do Loop
_BeginStatement = lPrevious
End Function |
Access2BaseDev |
Module |
_EndStatement |
Basic |
|
11 |
Private Function _EndStatement(ByVal plStart As Long) As Long
Dim sMatch As String, lPosition As Long lPosition = plStart sMatch = _FindPattern("%$", lPosition) _EndStatement = lPosition
End Function |
Access2BaseDev |
Module |
_FindPattern |
Basic |
_BeginStatement (Procedure) _EndStatement (Procedure) _ParseProcs (Procedure) _PropertyGet (Procedure) |
93 |
Private Function _FindPattern(ByVal psPattern As Variant, Optional ByRef plStart As Long) As String
Const cstComment = "('|\bREM\b)[^\n]*$" Const cstString = """[^""\n]*""" Const cstBeginStatement = "(^|:|\bthen\b|\belse\b|\n)[ \t]*" Const cstEndStatement = "[ \t]*($|:|\bthen\b|\belse\b|\n)" Const cstContinuation = "[ \t]_\n" Const cstWordBreak = "\b[ \t]+(_\n[ \t]*)?\b" Const cstAlt = "|"
Dim sRegex As String, lStart As Long, bContinue As Boolean, sMatch As String Dim bEndStatement As Boolean, bQuote As Boolean
If psPattern = "%$" Then sRegex = cstEndStatement Else sRegex = psPattern If Left(psPattern, 2) = "%^" Then sRegex = cstBeginStatement & Right(sRegex, Len(sregex) - 2) sregex = Replace(sregex, "%B", cstWordBreak) End If If Len(psPattern) > 2 And Left(psPattern, 1) = """" And Right(psPattern, 1) = """" Then bQuote = True sRegex = sRegex & cstAlt & cstComment & cstAlt & cstContinuation Else bQuote = False sRegex = sRegex & cstAlt & cstComment & cstAlt & cstString & cstAlt & cstContinuation End If
If IsMissing(plStart) Then plStart = 1 lStart = plStart
bContinue = True Do While bContinue bEndStatement = False sMatch = Utils._RegexSearch(_Script, sRegex, lStart) Select Case True Case sMatch = "" bContinue = False Case Left(sMatch, 1) = "'" bEndStatement = True Case Left(sMatch, 1) = """" If bQuote Then plStart = lStart bContinue = False End If Case Left(smatch, 1) = ":" Or Left(sMatch, 1) = vbLf If psPattern = "%$" Then bEndStatement = True Else bContinue = False plStart = lStart + 1 sMatch = Right(sMatch, Len(sMatch) - 1) End If Case UCase(Left(sMatch, 4)) = "REM " Or UCase(Left(sMatch, 4)) = "REM" & vbTab Or UCase(Left(sMatch, 4)) = "REM" & vbNewLine bEndStatement = True Case UCase(Left(sMatch, 4)) = "THEN" Or UCase(Left(sMatch, 4)) = "ELSE" If psPattern = "%$" Then bEndStatement = True Else bContinue = False plStart = lStart + 4 sMatch = Right(sMatch, Len(sMatch) - 4) End If Case sMatch = " _" & vbLf Case Else plStart = lStart bContinue = False End Select If bEndStatement And psPattern = "%$" Then bContinue = False plStart = lStart - 1 sMatch = "" End If lStart = lStart + Len(sMatch) Loop _FindPattern = sMatch
End Function |
Access2BaseDev |
Module |
_FindProcIndex |
Basic |
ProcBodyLine (Procedure) ProcCountLines (Procedure) _BeginStatement (Procedure) |
21 |
Private Function _FindProcIndex(ByVal psProc As String, ByVal piType As Integer) As Integer
Dim i As Integer, iIndex As Integer
If Not _ProcsParsed Then _ParseProcs
iIndex = -1 For i = 0 To UBound(_ProcNames) If UCase(psProc) = UCase(_ProcNames(i)) And piType = _ProcTypes(i) Then iIndex = i Exit For End If Next i If iIndex < 0 Then TraceError(TRACEFATAL, ERRPROCEDURENOTFOUND, Utils._CalledSub(), 0, , Array(psProc, _Name))
Exit_Function: _FindProcIndex = iIndex Exit Function End Function |
Access2BaseDev |
Module |
_Initialize |
Basic |
|
8 |
Public Sub _Initialize()
_Script = Replace(_Script, vbCr, "") _Lines = Split(_Script, vbLf) _CountOfLines = UBound(_Lines) + 1
End Sub |
Access2BaseDev |
Module |
_LineOfPosition |
Basic |
ProcBodyLine (Procedure) ProcCountLines (Procedure) ProcOfLine (Procedure) Find (Procedure) _BeginStatement (Procedure) |
27 |
Private Function _LineOfPosition(ByVal plPosition) As Long
Dim lLine As Long, lLength As Long If plPosition <= Len(_Script) / 2 Then lLength = 0 For lLine = 0 To UBound(_Lines) lLength = lLength + Len(_Lines(lLine)) + 1 If lLength >= plPosition Then _LineOfPosition = lLine + 1 Exit Function End If Next lLine Else If Right(_Script, 1) = vbLf Then lLength = Len(_Script) + 1 Else lLength = Len(_Script) For lLine = UBound(_Lines) To 0 Step -1 lLength = lLength - Len(_Lines(lLine)) - 1 If lLength <= plPosition Then _LineOfPosition = lLine + 1 Exit Function End If Next lLine End If
End Function |
Access2BaseDev |
Module |
_ParseProcs |
Basic |
ProcOfLine (Procedure) _FindProcIndex (Procedure) _PropertyGet (Procedure) |
54 |
Private Sub _ParseProcs()
Dim lPosition As Long, iProc As Integer, sDecProc As String, sEndProc As String, sNameProc As String, sType As String Const cstDeclaration = "%^(private%B|public%B)?\b(property%Bget|property%Blet|property%Bset|function|sub)\b" Const cstEnd = "%^end%B(property|function|sub)\b" Const cstName = "\w*" If _ProcsParsed Then Exit Sub _ProcNames = Array() _ProcDecPositions = Array() _ProcEndPositions = Array() _ProcTypes = Array() lPosition = 1 iProc = -1 sDecProc = "???" Do While sDecProc <> "" sDecProc = _FindPattern(cstDeclaration, lPosition) If sDecProc <> "" Then iProc = iProc + 1 ReDim Preserve _ProcNames(0 To iProc) ReDim Preserve _ProcDecPositions(0 To iProc) ReDim Preserve _ProcEndPositions(0 To iProc) ReDim Preserve _ProcTypes(0 To iProc) _ProcDecPositions(iProc) = lPosition lPosition = lPosition + Len(sDecProc) Select Case True Case InStr(UCase(sDecProc), "FUNCTION") > 0 : _ProcTypes(iProc) = vbext_pk_Proc Case InStr(UCase(sDecProc), "SUB") > 0 : _ProcTypes(iProc) = vbext_pk_Proc Case InStr(UCase(sDecProc), "GET") > 0 : _ProcTypes(iProc) = vbext_pk_Get Case InStr(UCase(sDecProc), "LET") > 0 : _ProcTypes(iProc) = vbext_pk_Let Case InStr(UCase(sDecProc), "SET") > 0 : _ProcTypes(iProc) = vbext_pk_Set End Select sNameProc = _FindPattern(cstName, lPosition) If sNameProc = "" Then Exit Do _ProcNames(iProc) = sNameProc lPosition = lPosition + Len(sNameProc) sEndProc = _FindPattern(cstEnd, lPosition) If sEndProc = "" Then Exit Do _ProcEndPositions(iProc) = lPosition lPosition = lPosition + Len(sEndProc) End If Loop _ProcsParsed = True End Sub |
Access2BaseDev |
Module |
_PositionOfLine |
Basic |
Find (Procedure) |
22 |
Private Function _PositionOfLine(ByVal plLine) As Long
Dim lLine As Long, lPosition As Long If plLine <= (UBound(_Lines) + 1) / 2 Then lPosition = 0 For lLine = 0 To plLine - 1 lPosition = lPosition + 1 If lLine < plLine - 1 Then lPosition = lPosition + Len(_Lines(lLine)) Next lLine Else lPosition = Len(_Script) + 2 For lLine = UBound(_Lines) To plLine - 1 Step -1 lPosition = lPosition - Len(_Lines(lLine)) - 1 Next lLine End If
_PositionOfLine = lPosition
End Function |
Access2BaseDev |
Module |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
6 |
Private Function _PropertiesList() As Variant
_PropertiesList = Array("CountOfDeclarationLines", "CountOfLines", "Name", "ObjectType", "Type")
End Function |
Access2BaseDev |
Module |
_PropertyGet |
Basic |
CountOfDeclarationLines (Procedure) CountOfLines (Procedure) Name (Procedure) ObjectType (Procedure) Properties (Procedure) pType (Procedure) getProperty (Procedure) |
48 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
Dim cstThisSub As String Const cstDot = "."
Dim sText As String
If _ErrorHandler() Then On Local Error Goto Error_Function cstThisSub = "Module.get" & psProperty Utils._SetCalledSub(cstThisSub) _PropertyGet = Null Select Case UCase(psProperty) Case UCase("CountOfDeclarationLines") If Not _ProcsParsed Then _ParseProcs() If UBound(_ProcNames) >= 0 Then _PropertyGet = ProcStartLine(_ProcNames(0), _ProcTypes(0)) - 1 Else _PropertyGet = _CountOfLines End If Case UCase("CountOfLines") _PropertyGet = _CountOfLines Case UCase("Name") _PropertyGet = _Storage & cstDot & _LibraryName & cstDot & _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("Type") sText = _FindPattern("%^option%Bclassmodule\b|\bfunction\b|\bsub\b|\bproperty\b") If UCase(Left(sText, 6)) = "OPTION" Then _PropertyGet = acClassModule Else _PropertyGet = acStandardModule Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Module._PropertyGet", Erl) _PropertyGet = Null GoTo Exit_Function End Function |
Access2BaseDev |
Module |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
17 |
Private Sub Class_Initialize() _Type = OBJMODULE _Name = "" Set _Library = Nothing _LibraryName = "" _Storage = "" _Script = "" _Lines = Array() _CountOfLines = 0 _ProcsParsed = False _ProcNames = Array() _ProcDecPositions = Array() _ProcEndPositions = Array() End Sub |
Access2BaseDev |
Module |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
Module |
CountOfDeclarationLines |
Basic |
|
4 |
Property Get CountOfDeclarationLines() As Long CountOfDeclarationLines = _PropertyGet("CountOfDeclarationLines") End Property |
Access2BaseDev |
Module |
CountOfLines |
Basic |
|
4 |
Property Get CountOfLines() As Long CountOfLines = _PropertyGet("CountOfLines") End Property |
Access2BaseDev |
Module |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
Module |
Find |
Basic |
|
106 |
Public Function Find(Optional ByVal pvTarget As Variant _ , Optional ByRef pvStartLine As Variant _ , Optional ByRef pvStartColumn As Variant _ , Optional ByRef pvEndLine As Variant _ , Optional ByRef pvEndColumn As Variant _ , Optional ByVal pvWholeWord As Boolean _ , Optional ByVal pvMatchCase As Boolean _ , Optional ByVal pvPatternSearch As Boolean _ ) As Boolean
Const cstThisSub = "Module.Find" Utils._SetCalledSub(cstThisSub) If _ErrorHandler() Then On Local Error Goto Error_Function
Dim bFound As Boolean, lPosition As Long, lStartLine As Long, lStartColumn As Long, lStartPosition As Long Dim lEndLine As Long, lEndColumn As Long, lEndPosition As Long Dim sMatch As String, vOptions As Variant, sPattern As String Dim i As Integer, sSpecChar As String
Const cstSpecialCharacters = "\[^$.|?*+()"
bFound = False
If IsMissing(pvTarget) Or IsMissing(pvStartLine) Or IsMissing(pvStartColumn) Or IsMissing(pvEndLine) Or IsMissing(pvEndColumn) Then Call _TraceArguments() If Not Utils._CheckArgument(pvTarget, 1, vbString) Then GoTo Exit_Function If Len(pvTarget) = 0 Then GoTo Exit_Function If Not IsEmpty(pvStartLine) Then If Not Utils._CheckArgument(pvStartLine, 2, _AddNumeric()) Then GoTo Exit_Function End If If Not IsEmpty(pvStartColumn) Then If Not Utils._CheckArgument(pvStartColumn, 3, _AddNumeric()) Then GoTo Exit_Function End If If Not IsEmpty(pvEndLine) Then If Not Utils._CheckArgument(pvEndLine, 4, _AddNumeric()) Then GoTo Exit_Function End If If Not IsEmpty(pvEndColumn) Then If Not Utils._CheckArgument(pvEndColumn, 5, _AddNumeric()) Then GoTo Exit_Function End If If IsMissing(pvWholeWord) Then pvWholeWord = False If Not Utils._CheckArgument(pvWholeWord, 6, vbBoolean) Then GoTo Exit_Function If IsMissing(pvMatchCase) Then pvMatchCase = False If Not Utils._CheckArgument(pvMatchCase, 7, vbBoolean) Then GoTo Exit_Function If IsMissing(pvPatternSearch) Then pvPatternSearch = False If Not Utils._CheckArgument(pvPatternSearch, 8, vbBoolean) Then GoTo Exit_Function
If IsEmpty(pvStartLine) Then lStartLine = 1 Else lStartLine = pvStartLine If lStartLine <= 0 Or lStartLine > UBound(_Lines) + 1 Then GoTo Exit_Function If IsEmpty(pvStartColumn) Then lStartColumn = 1 Else lStartColumn = pvStartColumn If lStartColumn <= 0 Then GoTo Exit_Function If lStartColumn > 1 And lStartColumn > Len(_Lines(lStartLine + 1)) Then GoTo Exit_Function lStartPosition = _PositionOfLine(lStartline) + lStartColumn - 1 If IsEmpty(pvEndLine) Then lEndLine = UBound(_Lines) + 1 Else lEndLine = pvEndLine If lEndLine < lStartLine Or lEndLine > UBound(_Lines) + 1 Then GoTo Exit_Function If IsEmpty(pvEndColumn) Then lEndColumn = Len(_Lines(lEndLine - 1)) Else lEndColumn = pvEndColumn If lEndColumn < 0 Then GoTo Exit_Function If lEndColumn = 0 Then lEndColumn = 1 If lEndColumn > Len(_Lines(lEndLine - 1)) + 1 Then GoTo Exit_Function lEndPosition = _PositionOfLine(lEndline) + lEndColumn - 1
If pvMatchCase Then Set vOptions = _A2B_.SearchOptions vOptions.transliterateFlags = 0 End If
sPattern = pvTarget For i = 1 To Len(cstSpecialCharacters) sSpecChar = Mid(cstSpecialCharacters, i, 1) sPattern = Replace(sPattern, sSpecChar, "\" & sSpecChar) Next i If pvPatternSearch Then sPattern = Replace(Replace(sPattern, "\*", ".*"), "\?", ".") If pvWholeWord Then sPattern = "\b" & sPattern & "\b"
lPosition = lStartPosition sMatch = Utils._RegexSearch(_Script, sPattern, lPosition) If pvMatchCase Then vOptions.transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE
If sMatch <> "" And lPosition >= lStartPosition And lPosition <= lEndPosition Then pvStartLine = _LineOfPosition(lPosition) pvStartColumn = lPosition - _PositionOfLine(pvStartLine) + 1 pvEndLine = _LineOfPosition(lPosition + Len(sMatch) - 1) If pvEndLine > pvStartLine Then pvEndColumn = lPosition + Len(sMatch) - 1 - _PositionOfLine(pvEndLine) Else pvEndColumn = pvStartColumn + Len(sMatch) - 1 End If bFound = True End If
Exit_Function: Find = bFound Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, "Module.Find", Erl) bFound = False GoTo Exit_Function End Function |
Access2BaseDev |
Module |
getProperty |
Basic |
|
12 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Const cstThisSub = "Module.Properties"
Utils._SetCalledSub(cstThisSub) If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Module |
hasProperty |
Basic |
|
12 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
Const cstThisSub = "Module.hasProperty"
Utils._SetCalledSub(cstThisSub) If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Module |
Lines |
Basic |
|
26 |
Public Function Lines(Optional ByVal pvLine As Variant, Optional ByVal pvNumLines As Variant) As String
Const cstThisSub = "Module.Lines" Utils._SetCalledSub(cstThisSub)
Dim sLines As String, lLine As Long sLines = ""
If IsMissing(pvLine) Or IsMissing(pvNumLines) Then Call _TraceArguments() If Not Utils._CheckArgument(pvLine, 1, _AddNumeric()) Then GoTo Exit_Function If Not Utils._CheckArgument(pvNumLines, 1, _AddNumeric()) Then GoTo Exit_Function lLine = pvLine Do While lLine < _CountOfLines And lLine < pvLine + pvNumLines sLines = sLines & _Lines(lLine - 1) & vbLf lLine = lLine + 1 Loop If Len(sLines) > 0 Then sLines = Left(sLines, Len(sLines) - 1)
Exit_Function: Lines = sLines Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Module |
Name |
Basic |
|
4 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
Module |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
Module |
ProcBodyLine |
Basic |
ProcStartLine (Procedure) |
20 |
Public Function ProcBodyLine(Optional ByVal pvProc As Variant, Optional ByVal pvProcType As Variant) As Long
Const cstThisSub = "Module.ProcBodyLine" Utils._SetCalledSub(cstThisSub)
Dim iIndex As Integer
If IsMissing(pvProc) Or IsMissing(pvProcType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvProc, 1, vbString) Then GoTo Exit_Function If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function
iIndex = _FindProcIndex(pvProc, pvProcType) If iIndex >= 0 Then ProcBodyLine = _LineOfPosition(_ProcDecPositions(iIndex)) Else ProcBodyLine = iIndex
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Module |
ProcCountLines |
Basic |
|
22 |
Public Function ProcCountLines(Optional ByVal pvProc As Variant, Optional ByVal pvProcType As Variant) As Long
Const cstThisSub = "Module.ProcCountLines" Utils._SetCalledSub(cstThisSub)
Dim iIndex As Integer, lStart As Long, lEnd As Long
If IsMissing(pvProc) Or IsMissing(pvProcType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvProc, 1, vbString) Then GoTo Exit_Function If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function
iIndex = _FindProcIndex(pvProc, pvProcType) lStart = ProcStartLine(pvProc, pvProcType) lEnd = _LineOfPosition(_ProcEndPositions(iIndex)) ProcCountLines = lEnd - lStart + 1 Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Module |
ProcOfLine |
Basic |
_BeginStatement (Procedure) |
35 |
Public Function ProcOfLine(Optional ByVal pvLine As Variant, Optional ByRef pvProcType As Variant) As String
Const cstThisSub = "Module.ProcOfLine" Utils._SetCalledSub(cstThisSub)
Dim sProcedure As String, iProc As Integer, lLineDec As Long, lLineEnd As Long
If IsMissing(pvLine) Or IsMissing(pvProcType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvLine, 1, _AddNumeric()) Then GoTo Exit_Function If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function
If Not _ProcsParsed Then _ParseProcs()
sProcedure = "" For iProc = 0 To UBound(_ProcNames) lLineEnd = _LineOfPosition(_ProcEndPositions(iProc)) If pvLine <= lLineEnd Then lLineDec = _LineOfPosition(_ProcDecPositions(iProc)) If pvLine < lLineDec Then sProcedure = "" Else sProcedure = _ProcNames(iProc) pvProcType = _ProcTypes(iProc) End If Exit For End If Next iProc
Exit_Function: ProcOfLine = sProcedure Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Module |
ProcStartLine |
Basic |
ProcCountLines (Procedure) _PropertyGet (Procedure) |
32 |
Public Function ProcStartLine(Optional ByVal pvProc As Variant, Optional ByVal pvProcType As Variant) As Long
Const cstThisSub = "Module.ProcStartLine" Utils._SetCalledSub(cstThisSub)
Dim lLine As Long, lIndex As Long, sLine As String
If IsMissing(pvProc) Or IsMissing(pvProcType) Then Call _TraceArguments() If Not Utils._CheckArgument(pvProc, 1, vbString) Then GoTo Exit_Function If Not Utils._CheckArgument(pvProcType, 2, _AddNumeric()) Then GoTo Exit_Function
lLine = ProcBodyLine(pvProc, pvProcType) lIndex = lLine - 1 Do While lIndex > 0 sLine = _Trim(_Lines(lIndex - 1)) If UCase(Left(sLine, 4)) = "REM " Or Left(sLine, 1) = "'" Then lLine = lIndex Else Exit Do End If lIndex = lIndex - 1 Loop
ProcStartLine = lLine
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Module |
Properties |
Basic |
|
25 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Const cstThisSub = "Module.Properties" Utils._SetCalledSub(cstThisSub)
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Module |
pType |
Basic |
|
4 |
Property Get pType() As String pType = _PropertyGet("Type") End Property |
Access2BaseDev |
OptionGroup |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
9 |
Private Function _PropertiesList() As Variant
_PropertiesList = Array("Count", "Name", "ObjectType", "Value") End Function |
Access2BaseDev |
OptionGroup |
_PropertyGet |
Basic |
Count (Procedure) Name (Procedure) pName (Procedure) ObjectType (Procedure) Properties (Procedure) Value (Procedure) getProperty (Procedure) |
47 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("OptionGroup.get" & psProperty) Dim oDatabase As Object, vBookmark As Variant Dim iValue As Integer, i As Integer _PropertyGet = EMPTY Select Case UCase(psProperty) Case UCase("Count") _PropertyGet = _Count Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("Value") iValue = -1 For i = 0 To _Count - 1 If _ButtonsGroup(i).State = 1 Then iValue = _ButtonsIndex(i) Exit For End If Next i _PropertyGet = iValue Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("OptionGroup.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = EMPTY Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = EMPTY Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "OptionGroup._PropertyGet", Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function |
Access2BaseDev |
OptionGroup |
_PropertySet |
Basic |
Value (Procedure) setProperty (Procedure) |
46 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
Utils._SetCalledSub("OptionGroup.set" & psProperty) If _ErrorHandler() Then On Local Error Goto Error_Function _PropertySet = True
Dim i As Integer, iRadioIndex As Integer, oModel As Object, iArgNr As Integer
If _IsLeft(_A2B_.CalledSub, "OptionGroup.") Then iArgNr = 1 Else iArgNr = 2 Select Case UCase(psProperty) Case UCase("Value") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 0 Or pvValue > _Count - 1 Then Goto Trace_Error_Value For i = 0 To _Count - 1 _ButtonsGroup(i).State = 0 If _ButtonsIndex(i) = pvValue Then iRadioIndex = i Next i _ButtonsGroup(iRadioIndex).State = 1 Set oModel = _ButtonsGroup(iRadioIndex) If Utils._hasUNOProperty(oModel, "DataField") Then If Not IsNull(oModel.Datafield) And Not IsEmpty(oModel.Datafield) Then If oModel.Datafield <> "" And Utils._hasUNOMethod(oModel, "commit") Then oModel.commit() End If End If Case Else Goto Trace_Error End Select
Exit_Function: Utils._ResetCalledSub("OptionGroup.set" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "OptionGroup._PropertySet", Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
OptionGroup |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
14 |
Private Sub Class_Initialize() _Type = OBJOPTIONGROUP _Name = "" _ParentType = "" _ParentComponent = Nothing _DocEntry = -1 _DbEntry = -1 _ButtonsGroup = Array() _ButtonsIndex = Array() _Count = 0 End Sub |
Access2BaseDev |
OptionGroup |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
OptionGroup |
Controls |
Basic |
|
68 |
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("OptionGroup.Controls")
Dim ocControl As Variant, iArgNr As Integer, i As Integer
Set ocControl = Nothing If IsMissing(pvIndex) Then Set oCounter = New Collect oCounter._SubType = OBJCONTROL oCounter._ParentType = OBJOPTIONGROUP oCounter._ParentName = _Name oCounter._Count = _Count Set Controls = oCounter Goto Exit_Function End If If _IsLeft(_A2B_.CalledSub, "OptionGroup.") Then iArgNr = 1 Else iArgNr = 2 If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function If pvIndex < 0 Or pvIndex > _Count - 1 Then Goto Trace_Error_Index Set ocControl = New Control ocControl._ParentType = CTLPARENTISGROUP ocControl._Shortcut = "" For i = 0 To _Count - 1 If _ButtonsIndex(i) = pvIndex Then Set ocControl.ControlModel = _ButtonsGroup(i) Select Case _ParentType Case CTLPARENTISDIALOG : ocControl._Name = _ButtonsGroup(i).Name Case Else : ocControl._Name = _Name End Select ocControl._ImplementationName = ocControl.ControlModel.getImplementationName() Exit For End If Next i ocControl._FormComponent = _ParentComponent ocControl._ClassId = acRadioButton Select Case _ParentType Case CTLPARENTISDIALOG : Set ocControl.ControlView = _ParentComponent.getControl(ocControl._Name) Case Else : Set ocControl.ControlView = _ParentComponent.CurrentController.getControl(ocControl.ControlModel) End Select
ocControl._Initialize() ocControl._DocEntry = _DocEntry ocControl._DbEntry = _DbEntry Set Controls = ocControl Exit_Function: Utils._ResetCalledSub("OptionGroup.Controls") Exit Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set Controls = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "OptionGroup.Controls", Erl) Set Controls = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
OptionGroup |
Count |
Basic |
|
6 |
Property Get Count() As Variant Count = _PropertyGet("Count") End Property |
Access2BaseDev |
OptionGroup |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
OptionGroup |
getProperty |
Basic |
|
10 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("OptionGroup.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("OptionGroup.getProperty") End Function |
Access2BaseDev |
OptionGroup |
hasProperty |
Basic |
|
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
OptionGroup |
Name |
Basic |
|
4 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
OptionGroup |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
OptionGroup |
pName |
Basic |
|
3 |
Public Function pName() As String pName = _PropertyGet("Name") End Function |
Access2BaseDev |
OptionGroup |
Properties |
Basic |
|
20 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Exit Function End Function |
Access2BaseDev |
OptionGroup |
setProperty |
Basic |
|
7 |
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean Utils._SetCalledSub("OptionGroup.setProperty") setProperty = _PropertySet(psProperty, pvValue) Utils._ResetCalledSub("OptionGroup.setProperty") End Function |
Access2BaseDev |
OptionGroup |
Value |
Basic |
|
7 |
Property Get Value() As Variant Value = _PropertyGet("Value") End Property
Property Let Value(ByVal pvValue As Variant) Call _PropertySet("Value", pvValue) End Property |
Access2BaseDev |
PropertiesGet |
_getProperty |
Basic |
getAbsolutePosition (Procedure) getAllowAdditions (Procedure) getAllowDeletions (Procedure) getAllowEdits (Procedure) getBackColor (Procedure) getBeginGroup (Procedure) getBOF (Procedure) getBookmark (Procedure) getBookmarkable (Procedure) getBorderColor (Procedure) getBorderStyle (Procedure) getBuiltIn (Procedure) getButtonLeft (Procedure) getButtonMiddle (Procedure) getButtonRight (Procedure) getCancel (Procedure) getCaption (Procedure) getClickCount (Procedure) getContextShortcut (Procedure) getControlSource (Procedure) getControlTipText (Procedure) getControlType (Procedure) getCount (Procedure) getCurrentRecord (Procedure) getDataType (Procedure) getDbType (Procedure) getDefault (Procedure) getDefaultValue (Procedure) getDescription (Procedure) getEditMode (Procedure) getEnabled (Procedure) getEOF (Procedure) getEventName (Procedure) getEventType (Procedure) getFieldSize (Procedure) getFilter (Procedure) getFilterOn (Procedure) getFocusChangeTemporary (Procedure) getFontBold (Procedure) getFontItalic (Procedure) getFontName (Procedure) getFontSize (Procedure) getFontUnderline (Procedure) getFontWeight (Procedure) getForm (Procedure) getFormat (Procedure) getHeight (Procedure) getForeColor (Procedure) getIsLoaded (Procedure) getItemData (Procedure) getKeyAlt (Procedure) getKeyChar (Procedure) getKeyCode (Procedure) getKeyCtrl (Procedure) getKeyFunction (Procedure) getKeyShift (Procedure) getLinkChildFields (Procedure) getLinkMasterFields (Procedure) getListCount (Procedure) getListIndex (Procedure) getLocked (Procedure) getMultiSelect (Procedure) getName (Procedure) getObjectType (Procedure) getOpenArgs (Procedure) getOptionValue (Procedure) getOrderBy (Procedure) getOrderByOn (Procedure) getPage (Procedure) getParent (Procedure) getProperty (Procedure) getRecommendation (Procedure) getRecordCount (Procedure) getRecordset (Procedure) getRecordSource (Procedure) getRequired (Procedure) getRowChangeAction (Procedure) getRowSource (Procedure) getRowSourceType (Procedure) getSelected (Procedure) getSize (Procedure) getSource (Procedure) getSourceField (Procedure) getSourceTable (Procedure) getSpecialEffect (Procedure) getSubType (Procedure) getSubComponentName (Procedure) getSubComponentType (Procedure) getTabIndex (Procedure) getTabStop (Procedure) getTag (Procedure) getText (Procedure) getTextAlign (Procedure) getTooltipText (Procedure) getTripleState (Procedure) getTypeName (Procedure) getVisible (Procedure) getWidth (Procedure) getXPos (Procedure) getYPos (Procedure) |
350 |
Public Function _getProperty(pvItem As Variant, ByVal psProperty As String, ByVal Optional pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("get" & psProperty) _getProperty = Nothing If Not Utils._CheckArgument(pvItem, 1, vbObject) Then Goto Exit_Function If Not PropertiesGet._hasProperty(pvItem._Type, pvItem._PropertiesList(), psProperty) Then Goto Trace_Error If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 3, Utils._AddNumeric()) Then Goto Exit_Function End If 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 |
Access2BaseDev |
PropertiesGet |
_hasProperty |
Basic |
hasProperty (Procedure) _setProperty (Procedure) hasProperty (Procedure) _getProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) hasProperty (Procedure) |
19 |
Public Function _hasProperty(ByVal psObject As String, ByVal pvPropertiesList() As Variant, ByVal pvProperty As Variant) As Boolean
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 |
Access2BaseDev |
PropertiesGet |
_ParentObject |
Basic |
Parent (Procedure) _PropertyGet (Procedure) |
22 |
Public Function _ParentObject(psShortcut As String) As Object
Dim sParent As String, vParent() As Variant, iBound As Integer vParent = Split(psShortcut, "!") iBound = UBound(vParent) - 1 ReDim Preserve vParent(0 To iBound) sParent = Join(vParent, "!") 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 |
Access2BaseDev |
PropertiesGet |
_Properties |
Basic |
Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) |
46 |
Public Function _Properties(ByVal psObject As String _ , ByVal psObjectName As String _ , ByVal pvPropertiesList() As Variant _ , ByVal Optional pvIndex As Variant _ ) As Variant
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 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 |
Access2BaseDev |
PropertiesGet |
_PropertiesList |
Basic |
|
21 |
Public Function _PropertiesList(pvObject As Variant) As Variant
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 |
Access2BaseDev |
PropertiesGet |
getAbsolutePosition |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getAllowAdditions |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getAllowDeletions |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getAllowEdits |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getBackColor |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getBeginGroup |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getBOF |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getBookmark |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getBookmarkable |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getBorderColor |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getBorderStyle |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getBuiltIn |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getButtonLeft |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getButtonMiddle |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getButtonRight |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getCancel |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getCaption |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getClickCount |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getContextShortcut |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getControlSource |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getControlTipText |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getControlType |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getCount |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getCurrentRecord |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getDataType |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getDbType |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getDefault |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getDefaultValue |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getDescription |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getEditMode |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getEnabled |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getEOF |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getEventName |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getEventType |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getFieldSize |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getFilter |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getFilterOn |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getFocusChangeTemporary |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getFontBold |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getFontItalic |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getFontName |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getFontSize |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getFontUnderline |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getFontWeight |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getForeColor |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getForm |
Basic |
|
5 |
Public Function getForm(Optional pvObject As Variant) As Variant If IsMissing(pvObject) Or IsEmpty(pvObject) Then Call _TraceArguments("getForm") getForm = PropertiesGet._getProperty(pvObject, "Form") End Function |
Access2BaseDev |
PropertiesGet |
getFormat |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getHeight |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getIsLoaded |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getItemData |
Basic |
|
9 |
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 |
Access2BaseDev |
PropertiesGet |
getKeyAlt |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getKeyChar |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getKeyCode |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getKeyCtrl |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getKeyFunction |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getKeyShift |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getLinkChildFields |
Basic |
|
9 |
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 |
Access2BaseDev |
PropertiesGet |
getLinkMasterFields |
Basic |
|
9 |
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 |
Access2BaseDev |
PropertiesGet |
getListCount |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getListIndex |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getLocked |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getMultiSelect |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getName |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getObject |
Basic |
FindNext (Procedure) FindRecord (Procedure) GoToRecord (Procedure) setValue (Procedure) Item (Procedure) getValue (Procedure) _ParentObject (Procedure) _PropertyGet (Procedure) setFocus (Procedure) |
79 |
Public Function getObject(Optional pvShortcut As Variant) As Variant
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) 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) 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)) End Select Case OBJFORM, OBJSUBFORM, OBJCONTROL, OBJDIALOG vCurrentObject = vCurrentObject.Controls(sComponents(iCurrentIndex)) End Select If sCurrentProperty <> "" Then vCurrentObject = vCurrentObject.getProperty(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 |
Access2BaseDev |
PropertiesGet |
getObjectType |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getOpenArgs |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getOptionGroup |
Basic |
|
20 |
Public Function getOptionGroup(Optional pvObject As Variant, pvName As variant) As Variant
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 |
Access2BaseDev |
PropertiesGet |
getOptionValue |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getOrderBy |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getOrderByOn |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getPage |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getParent |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getProperty |
Basic |
|
9 |
Public Function getProperty(Optional pvItem As Variant, Optional ByVal pvProperty As Variant, ByVal Optional pvIndex As Variant) As Variant 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 |
Access2BaseDev |
PropertiesGet |
getRecommendation |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getRecordCount |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getRecordset |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getRecordSource |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getRequired |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getRowChangeAction |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getRowSource |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getRowSourceType |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getSelected |
Basic |
|
9 |
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 |
Access2BaseDev |
PropertiesGet |
getSize |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getSource |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getSourceField |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getSourceTable |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getSpecialEffect |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getSubComponentName |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getSubComponentType |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getSubType |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getTabIndex |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getTabStop |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getTag |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getText |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getTextAlign |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getTooltipText |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getTripleState |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getTypeName |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getValue |
Basic |
Item (Procedure) _ParentObject (Procedure) |
17 |
Public Function getValue(Optional pvObject As Variant) As Variant 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" getValue = vItem.getProperty(sproperty) Utils._ResetCalledSub("getValue") Else Set vItem = pvObject getValue = vItem.getProperty("Value") End If End Function |
Access2BaseDev |
PropertiesGet |
getVisible |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getWidth |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getXPos |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesGet |
getYPos |
Basic |
|
5 |
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 |
Access2BaseDev |
PropertiesSet |
_CheckProperty |
Basic |
|
18 |
Private Function _CheckProperty(pvObject As Object, ByVal psProperty As String) As Boolean
Dim i As Integer, oPropertyValues As Variant, oProperty As Variant oPropertyValues = pvObject.PropertyValues For i = LBound(oPropertyValues) To UBound(oPropertyValues) oProperty = oPropertyValues(i) If UCase(oProperty.Name) = UCase(psProperty) Then _CheckProperty = True Exit Function End If Next i _CheckProperty = False Exit Function
End Function |
Access2BaseDev |
PropertiesSet |
_setProperty |
Basic |
setAbsolutePosition (Procedure) setAllowAdditions (Procedure) setAllowDeletions (Procedure) setAllowEdits (Procedure) setBackColor (Procedure) setBookmark (Procedure) setBorderColor (Procedure) setBorderStyle (Procedure) setCancel (Procedure) setCaption (Procedure) setControlTipText (Procedure) setCurrentRecord (Procedure) setDefault (Procedure) setDefaultValue (Procedure) setDescription (Procedure) setEnabled (Procedure) setFilter (Procedure) setFilterOn (Procedure) setFontBold (Procedure) setFontItalic (Procedure) setFontName (Procedure) setFontSize (Procedure) setFontUnderline (Procedure) setFontWeight (Procedure) setForeColor (Procedure) setHeight (Procedure) setListIndex (Procedure) setLocked (Procedure) setMultiSelect (Procedure) setOnAction (Procedure) setOptionValue (Procedure) setOrderBy (Procedure) setOrderByOn (Procedure) setPage (Procedure) setProperty (Procedure) setRecordSource (Procedure) setRequired (Procedure) setRowSource (Procedure) setRowSourceType (Procedure) setSelected (Procedure) setSelLength (Procedure) setSelStart (Procedure) setSelText (Procedure) setSpecialEffect (Procedure) setTabIndex (Procedure) setTabStop (Procedure) setTag (Procedure) setTextAlign (Procedure) setTooltipText (Procedure) setTripleState (Procedure) setVisible (Procedure) setWidth (Procedure) |
208 |
Private Function _setProperty(pvItem As Variant, ByVal psProperty As String, ByVal pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean Utils._SetCalledSub("set" & psProperty) If _ErrorHandler() Then On Local Error Goto Error_Function
If Not Utils._CheckArgument(pvItem, 1, vbObject) Then Goto Exit_Function If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 4, Utils._AddNumeric()) Then Goto Exit_Function End If Dim iArgNr As Integer, lFormat As Long Dim i As Integer, iCount As Integer, iSelectedItems() As Integer, bListboxBound As Boolean Dim odbDatabase As Object, vNames As Variant, bFound As Boolean, sName As String, oModel As Object Dim ocButton As Variant, iRadioIndex As Integer _setProperty = True If _A2B_.CalledSub = "setProperty" Then iArgNr = 3 Else iArgNr = 2 If Not PropertiesGet._hasProperty(pvItem._Type, pvItem._PropertiesList(), psProperty) Then Goto Trace_Error_Control Select Case UCase(psProperty) Case UCase("AbsolutePosition") If Not Utils._CheckArgument(pvItem, 1, OBJRECORDSET) Then Goto Exit_Function pvItem.AbsolutePosition = pvValue Case UCase("AllowAdditions") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function pvItem.AllowAdditions = pvValue Case UCase("AllowDeletions") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function pvItem.AllowDeletions = pvValue Case UCase("AllowEdits") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function pvItem.AllowEdits = pvValue Case UCase("BackColor") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.BackColor = pvValue Case UCase("Bookmark") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJRECORDSET)) Then Goto Exit_Function pvItem.Bookmark = pvValue Case UCase("BorderColor") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.BorderColor = pvValue Case UCase("BorderStyle") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.BorderColor = pvValue Case UCase("Cancel") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.Cancel = pvValue Case UCase("Caption") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function pvItem.Caption = pvValue Case UCase("ControlTipText") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.ControlTipText = pvValue Case UCase("CurrentRecord") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function pvItem.CurrentRecord = pvValue Case UCase("Default") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.Default = pvValue Case UCase("DefaultValue") If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJFIELD)) Then Goto Exit_Function pvItem.DefaultValue = pvValue Case UCase("Description") If Not Utils._CheckArgument(pvItem, 1, OBJFIELD) Then Goto Exit_Function pvItem.DefaultValue = pvValue Case UCase("Enabled") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.Enabled = pvValue Case UCase("Filter") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM, OBJRECORDSET)) Then Goto Exit_Function pvItem.Filter = pvValue Case UCase("FilterOn") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function pvItem.FilterOn = pvValue Case UCase("FontBold") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.FontBold = pvValue Case UCase("FontItalic") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.FontItalic = pvValue Case UCase("FontName") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.FontName = pvValue Case UCase("FontSize") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.FontSize = pvValue Case UCase("FontUnderline") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.FontUnderline = pvValue Case UCase("FontWeight") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.FontWeight = pvValue Case UCase("ForeColor") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.ForeColor = pvValue Case UCase("Height") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function pvItem.Height = pvValue Case UCase("ListIndex") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.ListIndex = pvValue Case UCase("Locked") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.Locked = pvValue Case UCase("MultiSelect") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.MultiSelect = pvValue Case UCase("OnAction") If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function pvItem.OnAction = pvValue Case UCase("OptionValue") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.OptionValue = pvValue Case UCase("OrderBy") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function pvItem.OrderBy = pvValue Case UCase("OrderByOn") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function pvItem.OrderByOn = pvValue Case UCase("Page") If Not Utils._CheckArgument(pvItem, 1, Array(OBJDIALOG, OBJCONTROL)) Then Goto Exit_Function pvItem.Page = pvValue Case UCase("RecordSource") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJSUBFORM)) Then Goto Exit_Function pvItem.RecordSource = pvValue Case UCase("Required") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.Required = pvValue Case UCase("RowSource") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.RowSource = pvValue Case UCase("RowSourceType") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.RowSourceType = pvValue Case UCase("Selected") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function If IsMissing(pvIndex) Then pvItem.Selected = pvValue Else pvItem.SelectedI(pvValue, pvIndex) Case UCase("SelLength") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.SelLength = pvValue Case UCase("SelStart") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.SelStart = pvValue Case UCase("SelText") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.SelText = pvValue Case UCase("SpecialEffect") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.SpecialEffect = pvValue Case UCase("TabIndex") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.TabIndex = pvValue Case UCase("TabStop") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.TabStop = pvValue Case UCase("Tag") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.Tag = pvValue Case UCase("TextAlign") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.TextAlign = pvValue Case UCase("TooltipText") If Not Utils._CheckArgument(pvItem, 1, OBJCOMMANDBARCONTROL) Then Goto Exit_Function pvItem.TooltipText = pvValue Case UCase("TripleState") If Not Utils._CheckArgument(pvItem, 1, OBJCONTROL) Then Goto Exit_Function pvItem.TripleState = pvValue Case UCase("Value") If Not Utils._CheckArgument(pvItem, 1, Array(OBJCONTROL, OBJOPTIONGROUP, OBJFIELD, OBJTEMPVAR)) Then Goto Exit_Function pvItem.Value = pvValue Case UCase("Visible") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG, OBJCONTROL, OBJCOMMANDBAR, OBJCOMMANDBARCONTROL)) Then Goto Exit_Function pvItem.Visible = pvValue Case UCase("Width") If Not Utils._CheckArgument(pvItem, 1, Array(OBJFORM, OBJDIALOG)) Then Goto Exit_Function pvItem.Width = pvValue Case Else Goto Trace_Error_Control End Select
Exit_Function: Utils._ResetCalledSub("set" & psProperty) Exit Function Trace_Error_Form: TraceError(TRACEFATAL, ERRFORMNOTFOUND, Utils._CalledSub(), 0, 1, pvItem._Name) _setProperty = False Goto Exit_Function Trace_Error_Control: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _setProperty = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _setProperty = False Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty) _setProperty = Nothing Goto Exit_Function Trace_Error_Array: TraceError(TRACEFATAL, ERRPROPERTYNOTARRAY, Utils._CalledSub(), 0, 1, iArgNr) _setProperty = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "_setProperty", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
PropertiesSet |
setAbsolutePosition |
Basic |
|
6 |
Public Function setAbsolutePosition(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setAbsolutePosition") setAbsolutePosition = PropertiesSet._setProperty(pvObject, "AbsolutePosition", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setAllowAdditions |
Basic |
|
6 |
Public Function setAllowAdditions(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setAllowAdditions") setAllowAdditions = PropertiesSet._setProperty(pvObject, "AllowAdditions", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setAllowDeletions |
Basic |
|
6 |
Public Function setAllowDeletions(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setAllowDeletions") setAllowDeletions = PropertiesSet._setProperty(pvObject, "AllowDeletions", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setAllowEdits |
Basic |
|
6 |
Public Function setAllowEdits(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setAllowEdits") setAllowEdits = PropertiesSet._setProperty(pvObject, "AllowEdits", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setBackColor |
Basic |
|
5 |
Public Function setBackColor(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setBackColor") setBackColor = PropertiesSet._setProperty(pvObject, "BackColor", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setBookmark |
Basic |
|
5 |
Public Function setBookmark(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setBookmark") setBookmark = PropertiesSet._setProperty(pvObject, "Bookmark", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setBorderColor |
Basic |
|
5 |
Public Function setBorderColor (Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setBorderColor") setBorderColor = PropertiesSet._setProperty(pvObject, "BorderColor", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setBorderStyle |
Basic |
|
5 |
Public Function setBorderStyle(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setBorderStyle") setBorderStyle = PropertiesSet._setProperty(pvObject, "BorderStyle", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setCancel |
Basic |
|
5 |
Public Function setCancel(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setCancel") setCancel = PropertiesSet._setProperty(pvObject, "Cancel", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setCaption |
Basic |
|
5 |
Public Function setCaption(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setCaption") setCaption = PropertiesSet._setProperty(pvObject, "Caption", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setControlTipText |
Basic |
|
5 |
Public Function setControlTipText(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setControlTipText") setControlTipText = PropertiesSet._setProperty(pvObject, "ControlTipText", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setCurrentRecord |
Basic |
|
5 |
Public Function setCurrentRecord(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setCurrentRecord") setCurrentRecord = PropertiesSet._setProperty(pvObject, "CurrentRecord", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setDefault |
Basic |
|
5 |
Public Function setDefault(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setDefault") setDefault = PropertiesSet._setProperty(pvObject, "Default", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setDefaultValue |
Basic |
|
5 |
Public Function setDefaultValue(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setDefaultValue") setDefaultValue = PropertiesSet._setProperty(pvObject, "DefaultValue", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setDescription |
Basic |
|
5 |
Public Function setDescription(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setDescription") setDescription = PropertiesSet._setProperty(pvObject, "Description", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setEnabled |
Basic |
|
5 |
Public Function setEnabled(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setEnabled") setEnabled = PropertiesSet._setProperty(pvObject, "Enabled", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setFilter |
Basic |
|
5 |
Public Function setFilter(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFilter") setFilter = PropertiesSet._setProperty(pvObject, "Filter", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setFilterOn |
Basic |
|
6 |
Public Function setFilterOn(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFilterOn") setFilterOn = PropertiesSet._setProperty(pvObject, "FilterOn", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setFontBold |
Basic |
|
5 |
Public Function setFontBold(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontBold") setFontBold = PropertiesSet._setProperty(pvObject, "FontBold", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setFontItalic |
Basic |
|
5 |
Public Function setFontItalic(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontItalic") setFontItalic = PropertiesSet._setProperty(pvObject, "FontItalic", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setFontName |
Basic |
|
5 |
Public Function setFontName(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontName") setFontName = PropertiesSet._setProperty(pvObject, "FontName", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setFontSize |
Basic |
|
5 |
Public Function setFontSize(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontSize") setFontSize = PropertiesSet._setProperty(pvObject, "FontSize", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setFontUnderline |
Basic |
|
5 |
Public Function setFontUnderline(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontUnderline") setFontUnderline = PropertiesSet._setProperty(pvObject, "FontUnderline", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setFontWeight |
Basic |
|
5 |
Public Function setFontWeight(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setFontWeight") setFontWeight = PropertiesSet._setProperty(pvObject, "FontWeight", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setForeColor |
Basic |
|
5 |
Public Function setForeColor(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setForeColor") setForeColor = PropertiesSet._setProperty(pvObject, "ForeColor", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setHeight |
Basic |
|
6 |
Public Function setHeight(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setHeight") setHeight = PropertiesSet._setProperty(pvObject, "Height", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setListIndex |
Basic |
|
5 |
Public Function setListIndex(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setListIndex") setListIndex = PropertiesSet._setProperty(pvObject, "ListIndex", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setLocked |
Basic |
|
5 |
Public Function setLocked(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setLocked") setLocked = PropertiesSet._setProperty(pvObject, "Locked", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setMultiSelect |
Basic |
|
5 |
Public Function setMultiSelect(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setMultiSelect") setMultiSelect = PropertiesSet._setProperty(pvObject, "MultiSelect", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setOnAction |
Basic |
|
5 |
Public Function setOnAction(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setOnAction") setOnAction = PropertiesSet._setProperty(pvObject, "OnAction", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setOptionValue |
Basic |
|
5 |
Public Function setOptionValue(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setOptionValue") setOptionValue = PropertiesSet._setProperty(pvObject, "OptionValue", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setOrderBy |
Basic |
|
5 |
Public Function setOrderBy(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setOrderBy") setOrderBy = PropertiesSet._setProperty(pvObject, "OrderBy", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setOrderByOn |
Basic |
|
6 |
Public Function setOrderByOn(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setOrderByOn") setOrderByOn = PropertiesSet._setProperty(pvObject, "OrderByOn", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setPage |
Basic |
|
5 |
Public Function setPage(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setPage") setPage = PropertiesSet._setProperty(pvObject, "Page", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setProperty |
Basic |
|
12 |
Public Function setProperty(Optional pvItem As Variant, ByVal Optional psProperty As String, ByVal Optional pvValue As Variant, ByVal Optional pvIndex As Variant) As Variant Utils._SetCalledSub("setProperty") If IsMissing(pvItem) Or IsMissing(psProperty) Or IsMissing(pvValue) Or IsEmpty(pvItem) Then Call _TraceArguments() If IsMissing(pvIndex) Then setProperty = PropertiesSet._setProperty(pvItem, psProperty, pvValue) Else setProperty = PropertiesSet._setProperty(pvItem, psProperty, pvValue, pvIndex) End If Utils._ResetCalledSub("setProperty") End Function |
Access2BaseDev |
PropertiesSet |
setRecordSource |
Basic |
|
6 |
Public Function setRecordSource(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setRecordSource") setRecordSource = PropertiesSet._setProperty(pvObject, "RecordSource", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setRequired |
Basic |
|
5 |
Public Function setRequired(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setRequired") setRequired = PropertiesSet._setProperty(pvObject, "Required", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setRowSource |
Basic |
|
5 |
Public Function setRowSource(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setRowSource") setRowSource = PropertiesSet._setProperty(pvObject, "RowSource", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setRowSourceType |
Basic |
|
5 |
Public Function setRowSourceType(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setRowSourceType") setRowSourceType = PropertiesSet._setProperty(pvObject, "RowSourceType", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setSelected |
Basic |
|
10 |
Public Function setSelected(Optional pvObject As Variant, ByVal Optional pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Then Call _TraceArguments("setSelected") If IsEmpty(pvObject) Then Call _TraceArguments("setSelected") If IsMissing(pvIndex) Then setSelected = PropertiesSet._setProperty(pvObject, "Selected", pvValue) Else setSelected = PropertiesSet._setProperty(pvObject, "Selected", pvValue, pvIndex) End If End Function |
Access2BaseDev |
PropertiesSet |
setSelLength |
Basic |
|
5 |
Public Function setSelLength(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setSelLength") setSelLength = PropertiesSet._setProperty(pvObject, "SelLength", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setSelStart |
Basic |
|
5 |
Public Function setSelStart(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setSelStart") setSelStart = PropertiesSet._setProperty(pvObject, "SelStart", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setSelText |
Basic |
|
5 |
Public Function setSelText(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setSelText") setSelText = PropertiesSet._setProperty(pvObject, "SelText", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setSpecialEffect |
Basic |
|
5 |
Public Function setSpecialEffect(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setSpecialEffect") setSpecialEffect = PropertiesSet._setProperty(pvObject, "SpecialEffect", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setTabIndex |
Basic |
|
5 |
Public Function setTabIndex(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTabIndex") setTabIndex = PropertiesSet._setProperty(pvObject, "TabIndex", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setTabStop |
Basic |
|
5 |
Public Function setTabStop(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTabStop") setTabStop = PropertiesSet._setProperty(pvObject, "TabStop", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setTag |
Basic |
|
5 |
Public Function setTag(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTag") setTag = PropertiesSet._setProperty(pvObject, "Tag", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setTextAlign |
Basic |
|
5 |
Public Function setTextAlign(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTextAlign") setTextAlign = PropertiesSet._setProperty(pvObject, "TextAlign", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setTooltipText |
Basic |
|
5 |
Public Function setTooltipText(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTooltipText") setTooltipText = PropertiesSet._setProperty(pvObject, "TooltipText", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setTripleState |
Basic |
|
5 |
Public Function setTripleState(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setTripleState") setTripleState = PropertiesSet._setProperty(pvObject, "TripleState", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setValue |
Basic |
|
17 |
Public Function setValue(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean Dim vItem As Variant, sProperty As String If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setValue") If VarType(pvObject) = vbString Then Utils._SetCalledSub("setValue") Set vItem = getObject(pvObject) sProperty = Utils._FinalProperty(pvObject) If sProperty = "" Then sProperty = "Value" setValue = vItem.setProperty(sProperty, pvValue) Utils._ResetCalledSub("setValue") Else Set vItem = pvObject setValue = vItem.setProperty("Value", pvValue) End If End Function |
Access2BaseDev |
PropertiesSet |
setVisible |
Basic |
|
6 |
Public Function setVisible(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setVisible") setVisible = PropertiesSet._setProperty(pvObject, "Visible", pvValue) End Function |
Access2BaseDev |
PropertiesSet |
setWidth |
Basic |
|
6 |
Public Function setWidth(Optional pvObject As Variant, ByVal Optional pvValue As Variant) As Boolean If IsMissing(pvObject) Or IsMissing(pvValue) Or IsEmpty(pvObject) Then Call _TraceArguments("setWidth") setWidth = PropertiesSet._setProperty(pvObject, "Width", pvValue) End Function |
Access2BaseDev |
Property |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
6 |
Private Function _PropertiesList() As Variant _PropertiesList = Array("Name", "ObjectType", "Value") End Function |
Access2BaseDev |
Property |
_PropertyGet |
Basic |
Name (Procedure) pName (Procedure) ObjectType (Procedure) Properties (Procedure) Value (Procedure) getProperty (Procedure) |
31 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("Property.get" & psProperty) _PropertyGet = Nothing Select Case UCase(psProperty) Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("Value") _PropertyGet = _Value Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("Property.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "Property._PropertyGet", Erl) _PropertyGet = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
Property |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
8 |
Private Sub Class_Initialize() _Type = OBJPROPERTY _Name = "" _Value = Null End Sub |
Access2BaseDev |
Property |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
Property |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
Property |
getProperty |
Basic |
|
9 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("Property.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("Property.getProperty") End Function |
Access2BaseDev |
Property |
hasProperty |
Basic |
|
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
Property |
Name |
Basic |
|
3 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
Property |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
Property |
pName |
Basic |
|
3 |
Public Function pName() As String pName = _PropertyGet("Name") End Function |
Access2BaseDev |
Property |
Properties |
Basic |
|
20 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Exit Function End Function |
Access2BaseDev |
Property |
Value |
Basic |
|
4 |
Property Get Value() As Variant Value = _PropertyGet("Value") End Property |
Access2BaseDev |
Recordset |
_AppendChunk |
Basic |
|
48 |
Public Function _AppendChunk(ByVal psFieldName As String, ByRef pvChunk As Variant, piChunkType) As Boolean
If _ErrorHandler() Then On Local Error GoTo Error_Function Dim oFileAccess As Object Dim i As Integer, oChunk As Object, iChunk As Integer
_AppendChunk = False If IsNull(pvChunk) Then GoTo Exit_Function If IsArray(pvChunk) Then If UBound(pvChunk) < LBound(pvChunk) Then GoTo Exit_Function End If
iChunk = -1 For i = 0 To UBound(_ManageChunks) Set oChunk = _ManageChunks(i) If oChunk.FieldName = psFieldName Then iChunk = i Exit For End If Next i If iChunk = -1 Then _AppendChunkInit(psFieldName) iChunk = UBound(_ManageChunks) End If
Set oChunk = _ManageChunks(iChunk) With oChunk If Not .ChunksRequested Then .ChunksRequested = True .ChunkType = piChunkType .FileName = Utils._GetRandomFileName(_Name) Set oFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") .FileHandler = oFileAccess.openFileWrite(.FileName) End If .FileHandler.writeBytes(pvChunk) End With _AppendChunk = True
Exit_Function: Exit Function Error_Function: TraceError(TRACEABORT, Err, "Recordset._AppendChunk", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Recordset |
_AppendChunkClose |
Basic |
CancelUpdate (Procedure) Update (Procedure) |
44 |
Public Function _AppendChunkClose(ByVal pbCancel As Boolean) As Boolean
If _ErrorHandler() Then On Local Error GoTo Error_Function Dim oFileAccess As Object, oStream As Object, lFileLength As Long, oField As Object Dim i As Integer, oChunk As Object
_AppendChunkClose = False For i = 0 To UBound(_ManageChunks) Set oChunk = _ManageChunks(i) With oChunk If Not .ChunksRequested Then GoTo Exit_Function If IsNull(.FileHandler) Then GoTo Exit_Function .Filehandler.closeOutput Set oFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess") If Not pbCancel Then Set oStream = oFileAccess.openFileRead(.FileName) lFileLength = oStream.getLength() If lFileLength > 0 Then Set oField = RowSet.getColumns.getByName(.FieldName) Select Case .ChunkType Case vbByte oField.updateBinaryStream(oStream, lFileLength) End Select End If oStream.closeInput() End If If oFileAccess.exists(.FileName) Then oFileAccess.kill(.FileName) End With Next i Set _ManageChunks = Array() _AppendChunkClose = True
Exit_Function: Exit Function Error_Function: TraceError(TRACEABORT, Err, "Recordset._AppendChunkClose", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Recordset |
_AppendChunkInit |
Basic |
_AppendChunk (Procedure) |
16 |
Public Function _AppendChunkInit(psFieldName As String) As Boolean
Dim iSize As Integer iSize = UBound(_ManageChunks) + 1 ReDim Preserve _ManageChunks(0 To iSize) Set _ManageChunks(iSize) = New ChunkDescriptor With _ManageChunks(iSize) .ChunksRequested = False .FieldName = psFieldName .FileName = "" Set .FileHandler = Nothing End With
End Function |
Access2BaseDev |
Recordset |
_Initialize |
Basic |
|
56 |
Public Sub _Initialize(ByVal Optional pvFilter As Variant, Optional poRowSet As Object)
If _Command = "" Then Exit Sub If _ErrorHandler() Then On Local Error Goto Error_Sub If IsMissing(pvFilter) Then pvFilter = "" If Not IsMissing(poRowSet) Then Set RowSet = poRowSet.createResultSet() _IsClone = True RowSet.last() Else Set RowSet = CreateUnoService("com.sun.star.sdb.RowSet") _IsClone = False With RowSet If IsNull(.ActiveConnection) Then Set .ActiveConnection = _ParentDatabase.Connection .CommandType = _CommandType .Command = _Command If _ForwardOnly Then .ResultSetType = com.sun.star.sdbc.ResultSetType.FORWARD_ONLY _ Else .ResultSetType = com.sun.star.sdbc.ResultSetType.SCROLL_SENSITIVE If _PassThrough Then .EscapeProcessing = False _ Else .EscapeProcessing = True If _ReadOnly Then .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY .TransactionIsolation = com.sun.star.sdbc.TransactionIsolation.READ_UNCOMMITTED Else .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.UPDATABLE .TransactionIsolation = com.sun.star.sdbc.TransactionIsolation.READ_COMMITTED End If End With
If Not IsMissing(pvFilter) Then If pvFilter <> "" Then RowSet.Filter = pvFilter RowSet.ApplyFilter = True End If End If On Local Error Goto SQL_Error RowSet.execute() On Local Error Goto Error_Sub End If _DataSet = True _BOF = ( RowSet.IsRowCountFinal And RowSet.RowCount = 0 ) _EOF = _BOF
Exit_Sub: Exit Sub SQL_Error: TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , _Command) Goto Exit_Sub Error_Sub: TraceError(TRACEABORT, Err, "Recordset._Initialize", Erl) GoTo Exit_Sub End Sub |
Access2BaseDev |
Recordset |
_Move |
Basic |
GetRows (Procedure) Move (Procedure) MoveFirst (Procedure) MoveLast (Procedure) MoveNext (Procedure) MovePrevious (Procedure) _PropertySet (Procedure) |
107 |
Public Function _Move(pvTarget As Variant, ByVal Optional pvBookmark As Variant, ByVal Optional pbAbsolute As Boolean) As Boolean
Dim cstThisSub As String cstThisSub = "Recordset.Move" & Iif(VarType(pvTarget) = vbString, pvTarget, "") Utils._SetCalledSub(cstThisSub) If _ErrorHandler() Then On Local Error Goto Error_Function
If IsNull(RowSet) Then Goto Trace_Closed If Not _DataSet Then Goto Trace_NoData If _BOF And _EOF Then Goto Trace_NoData _Move = False CancelUpdate() Dim l As Long, lRow As Long With RowSet Select Case VarType(pvTarget) Case vbString Select Case UCase(pvTarget) Case "FIRST" If _ForwardOnly Then If Not ( .isBeforeFirst() Or .isFirst() ) Then Goto Trace_Forward Else .next() End If Else .first() End If Case "LAST" If _ForwardOnly Then If .isAfterLast() Then Goto Trace_Forward Do While Not ( .isRowCountFinal And .Row = .RowCount ) .next() Loop Else .last() End If Case "NEXT" If _EOF Then Goto Trace_OutOfRange .next() Case "PREVIOUS" If _ForwardOnly Then Goto Trace_Forward If _BOF Then Goto Trace_OutOfRange .previous() End Select Case Else If IsMissing(pbAbsolute) Then pbAbsolute = False If _ForwardOnly And pvTarget < 0 then Goto Trace_Forward If IsMissing(pvBookmark) Then If pvTarget = 0 Then Goto Exit_Function If _ForwardOnly Then If pbAbsolute Then lRow = .getRow() Else lRow = 0 For l = 1 To pvTarget - lRow If .isAfterLast() Then Exit For .next() Next l Else If pbAbsolute Then .absolute(pvTarget) Else .relative(pvTarget) End If Else If _ForwardOnly Then Goto Trace_Forward If pvTarget = 0 Then .moveToBookmark(pvBookmark) Else .moveRelativeToBookmark(pvBookmark, pvTarget) End If End If End Select
_BOF = .isBeforeFirst() _EOF = .isAfterlast() If _BOF Or _EOF Then _Move = False Else If .rowDeleted() Then Goto Error_RowDeleted If .rowUpdated() Then .refreshRow() _Move = True End If End With
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Exit_Close: mClose() Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Close Trace_Forward: TraceError(TRACEFATAL, ERRRECORDSETFORWARD, Utils._CalledSub(), 0) Goto Exit_Close Trace_NoData: TraceError(TRACEFATAL, ERRRECORDSETNODATA, Utils._CalledSub(), 0) Goto Exit_Close Trace_OutOfRange: TraceError(TRACEFATAL, ERRRECORDSETRANGE, Utils._CalledSub(), 0) Goto Exit_Close Error_RowDeleted: TraceError(TRACEFATAL, ERRROWDELETED, Utils._CalledSub(), 0) Goto Exit_Function Trace_Closed: TraceError(TRACEFATAL, ERRRECORDSETCLOSED, Utils._CalledSub(), 0) Goto Exit_Close End Function |
Access2BaseDev |
Recordset |
_PropertiesList |
Basic |
hasProperty (Procedure) Properties (Procedure) |
8 |
Private Function _PropertiesList() As Variant
_PropertiesList = Array("AbsolutePosition", "BOF", "Bookmarkable", "Bookmark", "EditMode" _ , "EOF", "Filter", "LastModified", "Name", "ObjectType" , "RecordCount" _ )
End Function |
Access2BaseDev |
Recordset |
_PropertyGet |
Basic |
AbsolutePosition (Procedure) BOF (Procedure) Bookmark (Procedure) Bookmarkable (Procedure) EOF (Procedure) EditMode (Procedure) Filter (Procedure) LastModified (Procedure) Name (Procedure) ObjectType (Procedure) RecordCount (Procedure) getProperty (Procedure) Properties (Procedure) |
89 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = "Recordset.get" Utils._SetCalledSub(cstThisSub & psProperty)
_PropertyGet = EMPTY Select Case UCase(psProperty) Case UCase("AbsolutePosition") If IsNull(RowSet) Then Goto Trace_Closed With RowSet Select Case True Case _BOF And _EOF : _PropertyGet = -1 Case .isBeforeFirst() Or .isAfterLast() : _PropertyGet = -1 Case Else : _PropertyGet = .getRow() End Select End With Case UCase("BOF") If IsNull(RowSet) Then Goto Trace_Closed Select Case True Case _BOF And _EOF : _PropertyGet = True Case RowSet.isBeforeFirst() : _PropertyGet = True Case Else : _PropertyGet = False End Select Case UCase("Bookmarkable") If IsNull(RowSet) Then Goto Trace_Closed If _ForwardOnly Then _PropertyGet = False Else _PropertyGet = RowSet.IsBookmarkable Case UCase("Bookmark") If IsNull(RowSet) Then Goto Trace_Closed If RowSet.IsBookmarkable And Not _ForwardOnly Then If _BOF Or _EOF Then _PropertyGet = Null Else _PropertyGet = RowSet.getBookmark() Else _PropertyGet = Null If _ForwardOnly Then Goto Trace_Forward End If Case UCase("EditMode") If IsNull(RowSet) Then Goto Trace_Closed _PropertyGet = _EditMode Case UCase("EOF") If IsNull(RowSet) Then Goto Trace_Closed Select Case True Case _BOF And _EOF : _PropertyGet = True Case RowSet.isAfterLast() : _PropertyGet = True Case Else : _PropertyGet = False End Select Case UCase("Filter") If IsNull(RowSet) Then Goto Trace_Closed _PropertyGet = RowSet.Filter Case UCase("LastModified") If IsNull(RowSet) Then Goto Trace_Closed If RowSet.IsBookmarkable And Not _ForwardOnly Then _PropertyGet = _BookmarkLastModified Else _PropertyGet = Null If _ForwardOnly Then Goto Trace_Forward End If Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("RecordCount") If IsNull(RowSet) Then Goto Trace_Closed _PropertyGet = RowSet.RowCount Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub(cstThisSub & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty) _PropertyGet = EMPTY Goto Exit_Function Trace_Forward: TraceError(TRACEFATAL, ERRRECORDSETFORWARD, Utils._CalledSub(), 0) Goto Exit_Function Trace_Closed: TraceError(TRACEFATAL, ERRRECORDSETCLOSED, Utils._CalledSub(), 0) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub & "._PropertyGet", Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function |
Access2BaseDev |
Recordset |
_PropertySet |
Basic |
AbsolutePosition (Procedure) Bookmark (Procedure) Filter (Procedure) setProperty (Procedure) |
49 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
Dim cstThisSub As String cstThisSub = "Recordset.set" Utils._SetCalledSub(cstThisSub & psProperty) If _ErrorHandler() Then On Local Error Goto Error_Function _PropertySet = True
Dim iArgNr As Integer Dim oObject As Object
If _IsLeft(_A2B_.CalledSub, "Recordset.") Then iArgNr = 1 Else iArgNr = 2 Select Case UCase(psProperty) Case UCase("AbsolutePosition") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value If pvValue < 1 Then Goto Trace_Error_Value _Move(pvValue, , True) Case UCase("Bookmark") If IsNull(RowSet) Then Goto Trace_Closed _Move(0, pvValue) Case UCase("Filter") If IsNull(RowSet) Then Goto Trace_Closed If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value _Filter = _ParentDatabase._ReplaceSquareBrackets(pvValue) Case Else Goto Trace_Error End Select
Exit_Function: Utils._ResetCalledSub(cstThisSub & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Trace_Closed: TraceError(TRACEFATAL, ERRRECORDSETCLOSED, Utils._CalledSub(), 0) Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
Recordset |
AbsolutePosition |
Basic |
|
7 |
Property Get AbsolutePosition() As Variant AbsolutePosition = _PropertyGet("AbsolutePosition") End Property
Property Let AbsolutePosition(ByVal pvValue As Variant) Call _PropertySet("AbsolutePosition", pvValue) End Property |
Access2BaseDev |
Recordset |
AddNew |
Basic |
|
134 |
Public Function AddNew() As Boolean
Const cstThisSub = "Recordset.AddNew" Dim i As Integer, iFieldsCount As Integer, oField As Object Dim sDefault As String, oColumn As Object Dim iValue As Integer, lValue As Long, sgValue As Single, dbValue As Double, dValue As Date Dim vTemp As Variant If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub(cstThisSub) AddNew = False With RowSet If _ForwardOnly Or _ReadOnly Then Goto Error_NoUpdate If Not .CanUpdateInsertedRows Then Goto Error_NoUpdate If Not .IsBookmarkable Then Goto Error_NoUpdate If _EditMode <> dbEditNone Then CancelUpdate() If _BOF And _EOF Then _BookmarkBeforeNew = "_BOF_" ElseIf .isBeforeFirst() Then _BookmarkBeforeNew = "_BOF_" ElseIf .isAfterLast() Then _BookmarkBeforeNew = "_EOF_" Else _BookmarkBeforeNew = .getBookmark() End If
.moveToInsertRow() iFieldsCount = Fields().Count On Local Error Resume Next For i = 0 To iFieldsCount - 1 Set oField = Fields(i) Set oColumn = oField.Column sDefault = oField.DefaultValue If sDefault = "" Then If oColumn.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then oColumn.updateNull() Else With com.sun.star.sdbc.DataType Select Case oColumn.Type Case .BIT, .BOOLEAN If sDefault = "1" Then oColumn.updateBoolean(True) Else oColumn.updateBoolean(False) Case .TINYINT iValue = CInt(sDefault) If iValue >= -128 And iValue <= +127 Then oColumn.updateShort(iValue) Case .SMALLINT lValue = CLng(sDefault) If lValue >= -32768 And lValue <= 32767 Then oColumn.updateInt(lValue) Case .INTEGER lValue = CLng(sDefault) If lValue >= -2147483648 And lValue <= 2147483647 Then oColumn.updateInt(lValue) Case .BIGINT lValue = CLng(sDefault) Column.updateLong(lValue) Case .FLOAT sgValue = CSng(sDefault) If Abs(sgValue) < 3.402823E38 And Abs(sgValue) > 1.401298E-45 Then oColumn.updateFloat(sgValue) Case .REAL, .DOUBLE dbValue = CDbl(sDefault) oColumn.updateDouble(dbValue) Case .NUMERIC, .DECIMAL dbValue = CDbl(sDefault) If Utils._hasUNOProperty(Column, "Scale") Then If Column.Scale > 0 Then oColumn.updateDouble(dbValue) Else oColumn.updateString(sDefault) End If Else oColumn.updateString(sDefault) End If Case .CHAR, .VARCHAR, .LONGVARCHAR oColumn.updateString(sDefault) Case .DATE dValue = DateValue(sDefault) vTemp = New com.sun.star.util.Date With vTemp .Day = Day(dValue) .Month = Month(dValue) .Year = Year(dValue) End With oColumn.updateDate(vTemp) Case .TIME dValue = TimeValue(sDefault) vTemp = New com.sun.star.util.Time With vTemp .Hours = Hour(dValue) .Minutes = Minute(dValue) .Seconds = Second(dValue) End With oColumn.updateTime(vTemp) Case .TIMESTAMP dValue = DateValue(sDefault) vTemp = New com.sun.star.util.DateTime With vTemp .Day = Day(dValue) .Month = Month(dValue) .Year = Year(dValue) .Hours = Hour(dValue) .Minutes = Minute(dValue) .Seconds = Second(dValue) End With oColumn.updateTimestamp(vTemp) Case Else End Select End With End If Next i End With If _ErrorHandler() Then On Local Error Goto Error_Function Else On Local Error Goto 0
_EditMode = dbEditAdd AddNew = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_NoUpdate: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
Recordset |
BOF |
Basic |
|
4 |
Property Get BOF() As Boolean BOF = _PropertyGet("BOF") End Property |
Access2BaseDev |
Recordset |
Bookmark |
Basic |
|
7 |
Property Get Bookmark() As Variant Bookmark = _PropertyGet("Bookmark") End Property
Property Let Bookmark(ByVal pvValue As Variant) Call _PropertySet("Bookmark", pvValue) End Property |
Access2BaseDev |
Recordset |
Bookmarkable |
Basic |
|
4 |
Property Get Bookmarkable() As Boolean Bookmarkable = _PropertyGet("Bookmarkable") End Property |
Access2BaseDev |
Recordset |
CancelUpdate |
Basic |
AddNew (Procedure) Delete (Procedure) Edit (Procedure) GetRows (Procedure) _Move (Procedure) |
40 |
Public Function CancelUpdate() As Boolean
Const cstThisSub = "Recordset.CancelUpdate"
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub(cstThisSub) CancelUpdate = False With RowSet Select Case _EditMode Case dbEditNone Case dbEditAdd _AppendChunkClose(True) If Not IsNull(_BookmarkBeforeNew) Then Select Case _BookmarkBeforeNew Case "_BOF_" : .beforeFirst() Case "_EOF_" : .afterLast() Case Else : .moveToBookmark(_BookmarkBeforeNew) End Select End If Case dbEditInProgress .cancelRowUpdates() _AppendChunkClose(True) End Select End With _EditMode = dbEditNone _BookmarkBeforeNew = Null _BookmarkLastModified = Null CancelUpdate = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Recordset |
Class_Initialize |
Basic |
|
27 |
Private Sub Class_Initialize() _Type = OBJRECORDSET _Name = "" Set _This = Nothing _Fields = Array() _ParentName = "" Set _ParentDatabase = Nothing _ParentType = "" _ForwardOnly = False _PassThrough = False _ReadOnly = False _CommandType = 0 _Command = "" _DataSet = False _BOF = True _EOF = True _Filter = "" _EditMode = dbEditNone _BookmarkBeforeNew = Null _BookmarkLastModified = Null _IsClone = False Set _ManageChunks = Array() Set RowSet = Nothing End Sub |
Access2BaseDev |
Recordset |
Class_Terminate |
Basic |
|
5 |
Private Sub Class_Terminate() On Local Error Resume Next mClose() End Sub |
Access2BaseDev |
Recordset |
Clone |
Basic |
|
29 |
Public Function Clone() As Object
Const cstThisSub = "Recordset.Clone"
Const cstNull = -1 Dim iType As Integer, iOptions As Integer, iLockEdit As Integer If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub(cstThisSub) Set Clone = Nothing If _IsClone Then Goto Error_Clone If _ForwardOnly Then iType = dbOpenForwardOnly Else iType = cstNull If _PassThrough Then iOptions = dbSQLPassThrough Else iOptions = cstNull iLockEdit = dbReadOnly Set Clone = OpenRecordset(iType, iOptions, iLockEdit, True) Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_Clone: TraceError(TRACEFATAL, ERRRECORDSETCLONE, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
Recordset |
Delete |
Basic |
|
37 |
Public Function Delete() As Boolean
Const cstThisSub = "Recordset.Delete"
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub(cstThisSub) Delete = False If _ForwardOnly Or _ReadOnly Then Goto Error_NoUpdate If _EditMode <> dbEditNone Then CancelUpdate() Goto Error_Sequence End If If RowSet.rowDeleted() Then Goto Error_RowDeleted
RowSet.deleteRow() Delete = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_NoUpdate: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0) Goto Exit_Function Error_RowDeleted: TraceError(TRACEFATAL, ERRROWDELETED, Utils._CalledSub(), 0) Goto Exit_Function Error_Sequence: TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1) Goto Exit_Function End Function |
Access2BaseDev |
Recordset |
Edit |
Basic |
|
31 |
Public Function Edit() As Boolean
Const cstThisSub = "Recordset.Edit"
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub(cstThisSub) Edit = False If _ForwardOnly Or _ReadOnly Then Goto Error_NoUpdate If _EditMode <> dbEditNone Then CancelUpdate() If RowSet.rowDeleted() Then Goto Error_RowDeleted
_EditMode = dbEditInProgress Edit = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_NoUpdate: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0) Goto Exit_Function Error_RowDeleted: TraceError(TRACEFATAL, ERRROWDELETED, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
Recordset |
EditMode |
Basic |
|
4 |
Property Get EditMode() As Integer EditMode = _PropertyGet("EditMode") End Property |
Access2BaseDev |
Recordset |
EOF |
Basic |
|
4 |
Property Get EOF() As Boolean EOF = _PropertyGet("EOF") End Property |
Access2BaseDev |
Recordset |
Fields |
Basic |
AddNew (Procedure) |
85 |
Public Function Fields(ByVal Optional pvIndex As variant) As Object
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "Recordset.Fields" Utils._SetCalledSub(cstThisSub)
Set Fields = Nothing If Not IsMissing(pvIndex) Then If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function End If Dim sObjects() As String, sObjectName As String, oObject As Object Dim i As Integer, oFields As Object, iIndex As Integer
If IsMissing(pvIndex) Then Set oObject = New Collect oObject._CollType = COLLFIELDS oObject._ParentType = OBJRECORDSET oObject._ParentName = _Name Set oObject._ParentDatabase = _ParentDatabase oObject._Count = RowSet.getColumns().Count Goto Exit_Function End If
Set oFields = RowSet.getColumns() sObjects = oFields.ElementNames()
If VarType(pvIndex) = vbString Then iIndex = -1 For i = 0 To UBound(sObjects) If UCase(pvIndex) = UCase(sObjects(i)) Then sObjectName = sObjects(i) iIndex = i Exit For End If Next i If iIndex < 0 Then Goto Trace_NotFound Else If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError sObjectName = sObjects(pvIndex) iIndex = pvIndex End If
If UBound(_Fields) < 0 Then ReDim _Fields(0 To UBound(sObjects)) For i = 0 To UBound(sObjects) Set _Fields(i) = Nothing Next i End If If Not IsNull(_Fields(iIndex)) Then Set oObject = _Fields(iIndex) Else Set oObject = New Field oObject._Name = sObjectName Set oObject.Column = oFields.getByName(sObjectName) If Utils._hasUNOProperty(oObject.Column, "Precision") Then oObject._Precision = oObject.Column.Precision oObject._ParentName = _Name oObject._ParentType = _Type Set oObject._ParentDatabase = _ParentDatabase Set oObject._ParentRecordset = _This Set _Fields(iIndex) = oObject End If
Exit_Function: Set Fields = oObject Set oObject = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("FIELD"), pvIndex)) Goto Exit_Function Trace_IndexError: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
Recordset |
Filter |
Basic |
|
7 |
Property Get Filter() As Variant Filter = _PropertyGet("Filter") End Property
Property Let Filter(ByVal pvValue As Variant) Call _PropertySet("Filter", pvValue) End Property |
Access2BaseDev |
Recordset |
getProperty |
Basic |
|
11 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Const cstThisSub = "Recordset.getProperty" Utils._SetCalledSub(cstThisSub) If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Recordset |
GetRows |
Basic |
|
54 |
Public Function GetRows(ByVal Optional pvNumRows As variant, ByVal Optional pbStrDate As Boolean) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Const cstThisSub = "Recordset.GetRows" Utils._SetCalledSub(cstThisSub) If IsMissing(pbStrDate) Then pbStrDate = False
Dim vMatrix() As Variant, lSize As Long, iNumFields As Integer, i As Integer vMatrix() = Array() If IsMissing(pvNumRows) Then Call _TraceArguments() If Not Utils._CheckArgument(pvNumRows, 1, Utils._AddNumeric()) Then Goto Exit_Function If pvNumRows < 1 Then Goto Trace_Error If IsNull(RowSet) Then Goto Trace_Closed If Not _DataSet Then Goto Exit_Function
If _EditMode <> dbEditNone Then CancelUpdate() If _EOF Then Goto Exit_Function
lSize = -1 iNumFields = RowSet.getColumns().Count - 1 If iNumFields < 0 Then Goto Exit_Function
ReDim vMatrix(0 To iNumFields, 0 To pvNumRows - 1) Do While Not _EOF And lSize < pvNumRows - 1 lSize = lSize + 1 For i = 0 To iNumFields vMatrix(i, lSize) = _getResultSetColumnValue(RowSet, i + 1) If pbStrDate And IsDate(vMatrix(i, lSize)) Then vMatrix(i, lSize) = _CStr(vMatrix(i, lSize)) Next i _Move("NEXT") Loop If lSize < pvNumRows - 1 Then ReDim Preserve vMatrix(0 To iNumFields, 0 To lSize) End If
Exit_Function: GetRows() = vMatrix() Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Trace_Error: TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvNumRows)) Set Controls = Nothing Goto Exit_Function Trace_Closed: TraceError(TRACEFATAL, ERRRECORDSETCLOSED, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
Recordset |
hasProperty |
Basic |
|
11 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
Const cstThisSub = "Recordset.hasProperty" Utils._SetCalledSub(cstThisSub) If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Recordset |
LastModified |
Basic |
|
5 |
Property Get LastModified() As Variant LastModified = _PropertyGet("LastModified") End Property |
Access2BaseDev |
Recordset |
mClose |
Basic |
Class_Terminate (Procedure) _Move (Procedure) |
45 |
Public Function mClose(ByVal Optional pbRemove As Boolean) As Variant
Const cstThisSub = "Recordset.Close" Dim i As Integer
If _ErrorHandler() Then On Local Error Goto Exit_Function Utils._SetCalledSub(cstThisSub) If Not IsNull(RowSet) Then RowSet.close() RowSet.dispose() End If _ForwardOnly = False _PassThrough = False _ReadOnly = False _CommandType = 0 _Command = "" _ParentName = "" _ParentType = "" _DataSet = False _BOF = True _EOF = True _Filter = "" _EditMode = dbEditNone _BookmarkBeforeNew = Null _BookmarkLastModified = Null _IsClone = False For i = 0 To UBound(_Fields) If Not IsNull(_Fields(i)) Then _Fields(i).Dispose() Set _Fields(i) = Nothing End If Next i _Fields = Array() Set RowSet = Nothing If IsMissing(pbRemove) Then pbRemove = True If pbRemove Then _ParentDatabase.RecordsetsColl.Remove(_Name) Set _ParentDatabase = Nothing
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Recordset |
Move |
Basic |
|
12 |
Public Function Move(ByVal Optional pvRelative As Variant, ByVal Optional pvBookmark As variant) As Boolean
If IsMissing(pvRelative) Then Call _TraceArguments() If Not Utils._CheckArgument(pvRelative, 1, Utils._AddNumeric()) Then Goto Exit_Function If IsMissing(pvBookmark) Then Move = _Move(pvRelative) Else Move = _Move(pvRelative, pvBookmark)
Exit_Function: Exit Function End Function |
Access2BaseDev |
Recordset |
MoveFirst |
Basic |
|
4 |
Public Function MoveFirst() As Boolean MoveFirst = _Move("First") End Function |
Access2BaseDev |
Recordset |
MoveLast |
Basic |
|
4 |
Public Function MoveLast() As Boolean MoveLast = _Move("Last") End Function |
Access2BaseDev |
Recordset |
MoveNext |
Basic |
|
4 |
Public Function MoveNext() As Boolean MoveNext = _Move("Next") End Function |
Access2BaseDev |
Recordset |
MovePrevious |
Basic |
|
4 |
Public Function MovePrevious() As Boolean MovePrevious = _Move("Previous") End Function |
Access2BaseDev |
Recordset |
Name |
Basic |
|
4 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
Recordset |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
Recordset |
OpenRecordset |
Basic |
Clone (Procedure) |
67 |
Public Function OpenRecordset(ByVal Optional pvType As Variant _ , ByVal Optional pvOptions As Variant _ , ByVal Optional pvLockEdit As Variant _ , ByVal Optional pbClone As Boolean) As Object
If _ErrorHandler() Then On Local Error Goto Error_Function Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) & ".OpenRecordset" Utils._SetCalledSub(cstThisSub) Set OpenRecordset = Nothing Const cstNull = -1
Dim oObject As Object Set oObject = Nothing If IsMissing(pvType) Then pvType = cstNull Else If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric(), Array(cstNull, dbOpenForwardOnly)) Then Goto Exit_Function End If If IsMissing(pvOptions) Then pvOptions = cstNull Else If Not Utils._CheckArgument(pvOptions, 2, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function End If If IsMissing(pvLockEdit) Then pvLockEdit = cstNull Else If Not Utils._CheckArgument(pvLockEdit, 3, Utils._AddNumeric(), Array(cstNull, dbReadOnly)) Then Goto Exit_Function End If If IsMissing(pbClone) Then pbClone = False Set oObject = New Recordset With oObject ._CommandType = _CommandType ._Command = _Command ._ParentName = _Name ._ParentType = _Type Set ._ParentDatabase = _ParentDatabase Set ._This = oObject ._ForwardOnly = ( pvType = dbOpenForwardOnly ) ._PassThrough = ( pvOptions = dbSQLPassThrough ) ._ReadOnly = ( (pvLockEdit = dbReadOnly) Or _ReadOnly ) Select Case True Case pbClone : Call ._Initialize(, RowSet) Case _Filter <> "" : Call ._Initialize(_Filter) Case Else : Call ._Initialize() End Select End With With _ParentDatabase .RecordsetMax = .RecordsetMax + 1 oObject._Name = Format(.RecordsetMax, "0000000") .RecordsetsColl.Add(oObject, UCase(oObject._Name)) End With If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst() Exit_Function: Set OpenRecordset = oObject Set oObject = Nothing Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Recordset |
Properties |
Basic |
|
24 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Const cstThisSub = "Recordset.Properties" Utils._SetCalledSub(cstThisSub) Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Set vProperty._ParentDatabase = _ParentDatabase Exit_Function: Set Properties = vProperty Utils._ResetCalledSub(cstThisSub) Exit Function End Function |
Access2BaseDev |
Recordset |
RecordCount |
Basic |
|
4 |
Property Get RecordCount() As Long RecordCount = _PropertyGet("RecordCount") End Property |
Access2BaseDev |
Recordset |
setProperty |
Basic |
|
8 |
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean Const cstThisSub = "Recordset.setProperty" Utils._SetCalledSub(cstThisSub) setProperty = _PropertySet(psProperty, pvValue) Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
Recordset |
Update |
Basic |
|
55 |
Public Function Update() As Boolean
Const cstThisSub = "Recordset.Update"
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub(cstThisSub) Update = False If _ForwardOnly Or _ReadOnly Then Goto Error_NoUpdate With RowSet If .rowDeleted() Then Goto Error_RowDeleted Select Case _EditMode Case dbEditNone Goto Trace_Error_Update Case dbEditAdd _AppendChunkClose(False) If .IsNew And .IsModified Then .insertRow() _BookmarkLastModified = .getBookmark() If Not IsNull(_BookmarkBeforeNew) Then Select Case _BookmarkBeforeNew Case "_BOF_" : .beforeFirst() Case "_EOF_" : .afterLast() Case Else : .moveToBookmark(_BookmarkBeforeNew) End Select End If Case dbEditInProgress _AppendChunkClose(False) If .IsModified Then .updateRow() _BookmarkLastModified = .getBookmark() End If End Select End With _EditMode = dbEditNone Update = True
Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function Error_NoUpdate: TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0) Goto Exit_Function Trace_Error_Update: TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1) Goto Exit_Function Error_RowDeleted: TraceError(TRACEFATAL, ERRROWDELETED, Utils._CalledSub(), 0) Goto Exit_Function End Function |
Access2BaseDev |
Root_ |
_CurrentDb |
Basic |
|
24 |
Public Function _CurrentDb(ByVal Optional piDocEntry As Integer, ByVal Optional piDbEntry As Integer) As Variant
Dim odbDatabase As Variant If IsMissing(piDocEntry) Then Set odbDatabase = CurrentDb() Else If Not IsArray(CurrentDoc) Then Goto Trace_Error If piDocEntry < 0 Or piDbEntry < 0 Then Goto Trace_Error If piDocEntry > UBound(CurrentDoc) Then Goto Trace_Error If piDbEntry > UBound(CurrentDoc(piDocEntry).DbContainers) Then Goto Trace_Error Set odbDatabase = CurrentDoc(piDocEntry).DbContainers(piDbEntry).Database End If If IsNull(odbDatabase) Then GoTo Trace_Error
Exit_Function: Set _CurrentDb = odbDatabase Exit Function Trace_Error: TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1) Goto Exit_Function End Function |
Access2BaseDev |
Root_ |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
33 |
Private Sub Class_Initialize() Dim vCurrentDoc() As Variant VersionNumber = Access2Base_Version ErrorHandler = True MinimalTraceLevel = 0 TraceLogs() = Array() TraceLogCount = 0 TraceLogLast = 0 TraceLogMaxEntries = 0 CalledSub = "" DebugPrintShort = True Locale = L10N._GetLocale() ExcludeA2B = True Set Introspection = CreateUnoService("com.sun.star.beans.Introspection") Set TextSearch = CreateUnoService("com.sun.star.util.TextSearch") SearchOptions = New com.sun.star.util.SearchOptions With SearchOptions .algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP .searchFlag = 0 .transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE End With Set FindRecord = Nothing Set StatusBar = Nothing Set Dialogs = New Collection Set TempVars = New Collection vCurrentDoc() = Array() ReDim vCurrentDoc(0 To 0) Set vCurrentDoc(0) = Nothing Set CurrentDoc() = vCurrentDoc() End Sub |
Access2BaseDev |
Root_ |
Class_Terminate |
Basic |
Dispose (Procedure) |
4 |
Private Sub Class_Terminate() Call Class_Initialize() End Sub |
Access2BaseDev |
Root_ |
CloseConnection |
Basic |
|
41 |
Public Sub CloseConnection()
Dim i As Integer, iCurrentDoc As Integer Dim vDbContainer As Variant, vDbContainers() As Variant, vDocContainer As Variant
If ErrorHandler Then On Local Error Goto Error_Sub
If Not IsArray(CurrentDoc) Then Goto Exit_Sub If UBound(CurrentDoc) < 0 Then Goto Exit_Sub iCurrentDoc = CurrentDocIndex( , False) If iCurrentDoc < 0 Then GoTo Exit_Sub vDocContainer = CurrentDocument(iCurrentDoc) With vDocContainer If Not .Active Then GoTo Exit_Sub For i = 0 To UBound(.DbContainers) If Not IsNull(.DbContainers(i).Database) Then .DbContainers(i).Database.Dispose() Set .DbContainers(i).Database = Nothing End If TraceLog(TRACEANY, UCase(CalledSub) & " " & .URL & Iif(i = 0, "", " Form=" & .DbContainers(i).FormName), False) Set .DbContainers(i) = Nothing Next i .DbContainers = Array() .URL = "" .DbConnect = 0 .Active = False Set .Document = Nothing End With CurrentDoc(iCurrentDoc) = vDocContainer Exit_Sub: Exit Sub Error_Sub: TraceError(TRACEABORT, Err, CalledSub, Erl, False) GoTo Exit_Sub End Sub |
Access2BaseDev |
Root_ |
CurrentDb |
Basic |
_CurrentDb (Procedure) |
18 |
Public Function CurrentDb() As Object
Dim iCurrentDoc As Integer
Set CurrentDb = Nothing
If Not IsArray(CurrentDoc) Then Goto Exit_Function If UBound(CurrentDoc) < 0 Then Goto Exit_Function iCurrentDoc = CurrentDocIndex(, False) If iCurrentDoc >= 0 Then If UBound(CurrentDoc(iCurrentDoc).DbContainers) >= 0 Then Set CurrentDb = CurrentDoc(iCurrentDoc).DbContainers(0).Database End If
Exit_Function: Exit Function End Function |
Access2BaseDev |
Root_ |
CurrentDocIndex |
Basic |
CloseConnection (Procedure) CurrentDb (Procedure) CurrentDocument (Procedure) |
45 |
Public Function CurrentDocIndex(Optional pvURL As Variant, Optional pbAbort As Variant) As Integer
Dim i As Integer, bFound As Boolean, sURL As String Const cstBase = "com.sun.star.comp.dba.ODatabaseDocument"
bFound = False CurrentDocIndex = -1
If Not IsArray(CurrentDoc) Then Goto Trace_Error If UBound(CurrentDoc) < 0 Then Goto Trace_Error For i = 1 To UBound(CurrentDoc) If IsMissing(pvURL) Then If Utils._hasUNOProperty(ThisComponent, "URL") Then sURL = ThisComponent.URL Else Exit For End If Else sURL = pvURL End If If CurrentDoc(i).Active And CurrentDoc(i).URL = sURL Then CurrentDocIndex = i bFound = True Exit For End If Next i
If Not bFound Then If IsNull(CurrentDoc(0)) Then GoTo Trace_Error With CurrentDoc(0) If Not .Active Then GoTo Trace_Error If IsNull(.Document) Then GoTo Trace_Error End With CurrentDocIndex = 0 End If
Exit_Function: Exit Function Trace_Error: If IsMissing(pbAbort) Then pbAbort = True If pbAbort Then TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1) Else CurrentDocIndex = -1 Goto Exit_Function End Function |
Access2BaseDev |
Root_ |
CurrentDocument |
Basic |
CloseConnection (Procedure) |
9 |
Public Function CurrentDocument(ByVal Optional piDocIndex As Integer) As Variant
Dim iDocIndex As Integer If IsMissing(piDocIndex) Then iDocIndex = CurrentDocIndex(, False) Else iDocIndex = piDocIndex If iDocIndex >= 0 And iDocIndex <= UBound(CurrentDoc) Then Set CurrentDocument = CurrentDoc(iDocIndex) Else Set CurrentDocument = Nothing
End Function |
Access2BaseDev |
Root_ |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
Root_ |
Dump |
Basic |
|
24 |
Public Sub Dump() Dim i As Integer, j As Integer, vCurrentDoc As Variant On Local Error Resume Next
DebugPrint "Version", VersionNumber DebugPrint "TraceLevel", MinimalTraceLevel DebugPrint "TraceCount", TraceLogCount DebugPrint "CalledSub", CalledSub If IsArray(CurrentDoc) Then For i = 0 To UBound(CurrentDoc) vCurrentDoc = CurrentDoc(i) If Not IsNull(vCurrentDoc) Then DebugPrint i, "URL", vCurrentDoc.URL For j = 0 To UBound(vCurrentDoc.DbContainers) DebugPrint i, j, "Form", vCurrentDoc.DbContainers(j).FormName DebugPrint i, j, "Database", vCurrentDoc.DbContainers(j).Database.Title Next j End If Next i End If
End Sub |
Access2BaseDev |
Root_ |
hasItem |
Basic |
|
23 |
Public Function hasItem(psCollType As String, ByVal psName As String) As Boolean
Dim oItem As Object On Local Error Goto Error_Function hasItem = True Select Case psCollType Case COLLALLDIALOGS Set oItem = Dialogs.Item(UCase(psName)) Case COLLTEMPVARS Set oItem = TempVars.Item(UCase(psName)) Case Else hasItem = False End Select
Exit_Function: Exit Function Error_Function: hasItem = False GoTo Exit_Function End Function |
Access2BaseDev |
SubForm |
_GetListener |
Basic |
_PropertySet (Procedure) |
25 |
Private Function _GetListener(ByVal psProperty As String) As String
Select Case UCase(psProperty) Case UCase("OnApproveCursorMove") _GetListener = "XRowSetApproveListener" Case UCase("OnApproveParameter") _GetListener = "XDatabaseParameterListener" Case UCase("OnApproveReset"), UCase("OnResetted") _GetListener = "XResetListener" Case UCase("OnApproveRowChange") _GetListener = "XRowSetApproveListener" Case UCase("OnApproveSubmit") _GetListener = "XSubmitListener" Case UCase("OnConfirmDelete") _GetListener = "XConfirmDeleteListener" Case UCase("OnCursorMoved"), UCase("OnRowChanged") _GetListener = "XRowSetListener" Case UCase("OnErrorOccurred") _GetListener = "XSQLErrorListener" Case UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnUnloaded"), UCase("OnUnloading") _GetListener = "XLoadListener" End Select End Function |
Access2BaseDev |
SubForm |
_PropertiesList |
Basic |
Properties (Procedure) hasProperty (Procedure) |
13 |
Private Function _PropertiesList() As Variant
_PropertiesList = Array("AllowAdditions", "AllowDeletions", "AllowEdits", "CurrentRecord" _ , "Filter", "FilterOn", "LinkChildFields", "LinkMasterFields", "Name" _ , "ObjectType", "OnApproveCursorMove", "OnApproveParameter" _ , "OnApproveReset", "OnApproveRowChange", "OnApproveSubmit", "OnConfirmDelete" _ , "OnCursorMoved", "OnErrorOccurred", "OnLoaded", "OnReloaded", "OnReloading" _ , "OnResetted", "OnRowChanged", "OnUnloaded", "OnUnloading", "OrderBy" _ , "OrderByOn", "Parent", "RecordSource" _ ) End Function |
Access2BaseDev |
SubForm |
_PropertyGet |
Basic |
AllowAdditions (Procedure) AllowDeletions (Procedure) AllowEdits (Procedure) CurrentRecord (Procedure) Filter (Procedure) FilterOn (Procedure) LinkChildFields (Procedure) LinkMasterFields (Procedure) Name (Procedure) pName (Procedure) ObjectType (Procedure) OnApproveCursorMove (Procedure) OnApproveParameter (Procedure) OnApproveReset (Procedure) OnApproveRowChange (Procedure) OnApproveSubmit (Procedure) OnConfirmDelete (Procedure) OnCursorMoved (Procedure) OnErrorOccurred (Procedure) OnLoaded (Procedure) OnReloaded (Procedure) OnReloading (Procedure) OnResetted (Procedure) OnRowChanged (Procedure) OnUnloaded (Procedure) OnUnloading (Procedure) OrderBy (Procedure) OrderByOn (Procedure) Properties (Procedure) Recordset (Procedure) RecordSource (Procedure) getProperty (Procedure) |
110 |
Private Function _PropertyGet(ByVal psProperty As String, ByVal Optional pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("SubForm.get" & psProperty) Dim iArgNr As Integer If Not IsMissing(pvIndex) Then Select Case UCase(_A2B_.CalledSub) Case UCase("getProperty") : iArgNr = 3 Case UCase("SubForm.getProperty") : iArgNr = 2 Case UCase("SubForm.get" & psProperty) : iArgNr = 1 End Select If Not Utils._CheckArgument(pvIndex, iArgNr, Utils._AddNumeric()) Then Goto Exit_Function End If Dim oDatabase As Object, vBookmark As Variant, oObject As Object _PropertyGet = EMPTY
Select Case UCase(psProperty) Case UCase("AllowAdditions") _PropertyGet = DatabaseForm.AllowInserts Case UCase("AllowDeletions") _PropertyGet = DatabaseForm.AllowDeletes Case UCase("AllowEdits") _PropertyGet = DatabaseForm.AllowUpdates Case UCase("CurrentRecord") _PropertyGet = DatabaseForm.Row Case UCase("Filter") _PropertyGet = DatabaseForm.Filter Case UCase("FilterOn") _PropertyGet = DatabaseForm.ApplyFilter Case UCase("LinkChildFields") If Utils._hasUNOProperty(DatabaseForm, "DetailFields") Then If IsMissing(pvIndex) Then _PropertyGet = DatabaseForm.DetailFields Else If pvIndex < 0 Or pvIndex > UBound(DatabaseForm.DetailFields) Then Goto trace_Error_Index _PropertyGet = DatabaseForm.DetailFields(pvIndex) End If End If Case UCase("LinkMasterFields") If Utils._hasUNOProperty(DatabaseForm, "MasterFields") Then If IsMissing(pvIndex) Then _PropertyGet = DatabaseForm.MasterFields Else If pvIndex < 0 Or pvIndex > UBound(DatabaseForm.MasterFields) Then Goto trace_Error_Index _PropertyGet = DatabaseForm.MasterFields(pvIndex) End If End If Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _ , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _ , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _ , UCase("OnUnloaded"), UCase("OnUnloading") _PropertyGet = Utils._GetEventScriptCode(DatabaseForm, psProperty, _Name) Case UCase("OrderBy") _PropertyGet = _OrderBy Case UCase("OrderByOn") If DatabaseForm.Order = "" Then _PropertyGet = False Else _PropertyGet = True Case UCase("Parent") _PropertyGet = Parent Case UCase("Recordset") If DatabaseForm.Command = "" Then Goto Trace_Error Set oObject = New Recordset With DatabaseForm oObject._CommandType = .CommandType oObject._Command = .Command oObject._ParentName = _Name oObject._ParentType = _Type Set oDatabase = Application._CurrentDb(_DocEntry, _DbEntry) Set oObject._ParentDatabase = oDatabase Set oObject._ParentDatabase.Connection = .ActiveConnection oObject._ForwardOnly = ( .ResultSetType = com.sun.star.sdbc.ResultSetType.FORWARD_ONLY ) oObject._PassThrough = ( .EscapeProcessing = False ) oObject._ReadOnly = ( .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY ) Call oObject._Initialize() End With With oDatabase .RecordsetMax = .RecordsetMax + 1 oObject._Name = Format(.RecordsetMax, "0000000") .RecordsetsColl.Add(oObject, UCase(oObject._Name)) End With Set _PropertyGet = oObject Case UCase("RecordSource") _PropertyGet = DatabaseForm.Command Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("SubForm.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = EMPTY Goto Exit_Function Trace_Error_Index: TraceError(TRACEFATAL, ERRINDEXVALUE, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = EMPTY Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "SubForm._PropertyGet", Erl) _PropertyGet = EMPTY GoTo Exit_Function End Function |
Access2BaseDev |
SubForm |
_PropertySet |
Basic |
AllowAdditions (Procedure) AllowDeletions (Procedure) AllowEdits (Procedure) CurrentRecord (Procedure) Filter (Procedure) FilterOn (Procedure) OnApproveCursorMove (Procedure) OnApproveParameter (Procedure) OnApproveReset (Procedure) OnApproveRowChange (Procedure) OnApproveSubmit (Procedure) OnConfirmDelete (Procedure) OnCursorMoved (Procedure) OnErrorOccurred (Procedure) OnLoaded (Procedure) OnReloaded (Procedure) OnReloading (Procedure) OnResetted (Procedure) OnRowChanged (Procedure) OnUnloaded (Procedure) OnUnloading (Procedure) OrderBy (Procedure) OrderByOn (Procedure) RecordSource (Procedure) setProperty (Procedure) |
77 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
Utils._SetCalledSub("SubForm.set" & psProperty) If _ErrorHandler() Then On Local Error Goto Error_Function _PropertySet = True
Dim iArgNr As Integer
If _IsLeft(_A2B_.CalledSub, "SubForm.") Then iArgNr = 1 Else iArgNr = 2 Select Case UCase(psProperty) Case UCase("AllowAdditions") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value DatabaseForm.AllowInserts = pvValue DatabaseForm.reload() Case UCase("AllowDeletions") If Not Utils._CheckArgument(pvValue,iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value DatabaseForm.AllowDeletes = pvValue DatabaseForm.reload() Case UCase("AllowEdits") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value DatabaseForm.AllowUpdates = pvValue DatabaseForm.reload() Case UCase("CurrentRecord") If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value DatabaseForm.absolute(pvValue) Case UCase("Filter") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value DatabaseForm.Filter = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) Case UCase("FilterOn") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value DatabaseForm.ApplyFilter = pvValue DatabaseForm.reload() Case UCase("OnApproveCursorMove"), UCase("OnApproveParameter"), UCase("OnApproveReset"), UCase("OnApproveRowChange") _ , UCase("OnApproveSubmit"), UCase("OnConfirmDelete"), UCase("OnCursorMoved"), UCase("OnErrorOccurred") _ , UCase("OnLoaded"), UCase("OnReloaded"), UCase("OnReloading"), UCase("OnResetted"), UCase("OnRowChanged") _ , UCase("OnUnloaded"), UCase("OnUnloading") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value If Not Utils._RegisterEventScript(DatabaseForm _ , psProperty _ , _GetListener(psProperty) _ , pvValue, _Name _ ) Then GoTo Trace_Error Case UCase("OrderBy") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value _OrderBy = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) Case UCase("OrderByOn") If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value If pvValue Then DatabaseForm.Order = _OrderBy Else DatabaseForm.Order = "" DatabaseForm.reload() Case UCase("RecordSource") If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value DatabaseForm.Command = Application._CurrentDb(_DocEntry, _DbEntry)._ReplaceSquareBrackets(pvValue) DatabaseForm.CommandType = com.sun.star.sdb.CommandType.COMMAND DatabaseForm.Filter = "" DatabaseForm.reload() Case Else Goto Trace_Error End Select
Exit_Function: Utils._ResetCalledSub("SubForm.set" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "SubForm._PropertySet", Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
SubForm |
AllowAdditions |
Basic |
|
9 |
Property Get AllowAdditions() As Variant AllowAdditions = _PropertyGet("AllowAdditions") End Property
Property Let AllowAdditions(ByVal pvValue As Variant) Call _PropertySet("AllowAdditions", pvValue) End Property |
Access2BaseDev |
SubForm |
AllowDeletions |
Basic |
|
7 |
Property Get AllowDeletions() As Variant AllowDeletions = _PropertyGet("AllowDeletions") End Property
Property Let AllowDeletions(ByVal pvValue As Variant) Call _PropertySet("AllowDeletions", pvValue) End Property |
Access2BaseDev |
SubForm |
AllowEdits |
Basic |
|
7 |
Property Get AllowEdits() As Variant AllowEdits = _PropertyGet("AllowEdits") End Property
Property Let AllowEdits(ByVal pvValue As Variant) Call _PropertySet("AllowEdits", pvValue) End Property |
Access2BaseDev |
SubForm |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
14 |
Private Sub Class_Initialize() _Type = OBJSUBFORM _Shortcut = "" _Name = "" _MainForm = "" _DocEntry = -1 _DbEntry = -1 _OrderBy = "" Set ParentComponent = Nothing Set DatabaseForm = Nothing End Sub |
Access2BaseDev |
SubForm |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
SubForm |
Controls |
Basic |
|
83 |
Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("SubForm.Controls")
Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String Dim j As Integer
Set ocControl = Nothing iControlCount = DatabaseForm.getCount() If IsMissing(pvIndex) Then Set oCounter = New Collect oCounter._CollType = COLLCONTROLS oCounter._ParentType = OBJSUBFORM oCounter._ParentName = _Shortcut oCounter._Count = iControlCount Set Controls = oCounter Goto Exit_Function End If If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function Set ocControl = New Control ocControl._ParentType = CTLPARENTISSUBFORM sParentShortcut = _Shortcut sControls() = DatabaseForm.getElementNames() Select Case VarType(pvIndex) Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal If pvIndex < 0 Or pvIndex > iControlCount - 1 Then Goto Trace_Error_Index ocControl._Name = sControls(pvIndex) Case vbString bFound = False sIndex = UCase(Utils._Trim(pvIndex)) For i = 0 To iControlCount - 1 If UCase(sControls(i)) = sIndex Then bFound = True Exit For End If Next i If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound End Select
With ocControl ._Shortcut = sParentShortcut & "!" & Utils._Surround(._Name) Set .ControlModel = DatabaseForm.getByName(._Name) ._ImplementationName = .ControlModel.getImplementationName() ._FormComponent = ParentComponent If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId If ._ClassId > 0 And ._ClassId <> acHiddenControl Then Set .ControlView = ParentComponent.CurrentController.getControl(.ControlModel) End If
._Initialize() ._DocEntry = _DocEntry ._DbEntry = _DbEntry End With Set Controls = ocControl Exit_Function: Utils._ResetCalledSub("SubForm.Controls") Exit Function Trace_Error_Index: TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1) Set Controls = Nothing Goto Exit_Function Trace_NotFound: TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, _Name)) Set Controls = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "SubForm.Controls", Erl) Set Controls = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
SubForm |
CurrentRecord |
Basic |
|
7 |
Property Get CurrentRecord() As Variant CurrentRecord = _PropertyGet("CurrentRecord") End Property
Property Let CurrentRecord(ByVal pvValue As Variant) Call _PropertySet("CurrentRecord", pvValue) End Property |
Access2BaseDev |
SubForm |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
SubForm |
Filter |
Basic |
|
7 |
Property Get Filter() As Variant Filter = _PropertyGet("Filter") End Property
Property Let Filter(ByVal pvValue As Variant) Call _PropertySet("Filter", pvValue) End Property |
Access2BaseDev |
SubForm |
FilterOn |
Basic |
|
7 |
Property Get FilterOn() As Variant FilterOn = _PropertyGet("FilterOn") End Property
Property Let FilterOn(ByVal pvValue As Variant) Call _PropertySet("FilterOn", pvValue) End Property |
Access2BaseDev |
SubForm |
getProperty |
Basic |
|
10 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("SubForm.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("SubForm.getProperty") End Function |
Access2BaseDev |
SubForm |
hasProperty |
Basic |
|
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
SubForm |
LinkChildFields |
Basic |
|
4 |
Property Get LinkChildFields(ByVal Optional pvIndex As Variant) As Variant If IsMissing(pvIndex) Then LinkChildFields = _PropertyGet("LinkChildFields") Else LinkChildFields = _PropertyGet("LinkChildFields", pvIndex) End Property |
Access2BaseDev |
SubForm |
LinkMasterFields |
Basic |
|
4 |
Property Get LinkMasterFields(ByVal Optional pvIndex As Variant) As Variant If IsMissing(pvIndex) Then LinkMasterFields = _PropertyGet("LinkMasterFields") Else LinkMasterFields = _PropertyGet("LinkMasterFields", pvIndex) End Property |
Access2BaseDev |
SubForm |
Name |
Basic |
|
4 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
SubForm |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
SubForm |
OnApproveCursorMove |
Basic |
|
7 |
Property Get OnApproveCursorMove() As Variant OnApproveCursorMove = _PropertyGet("OnApproveCursorMove") End Property
Property Let OnApproveCursorMove(ByVal pvValue As Variant) Call _PropertySet("OnApproveCursorMove", pvValue) End Property |
Access2BaseDev |
SubForm |
OnApproveParameter |
Basic |
|
7 |
Property Get OnApproveParameter() As Variant OnApproveParameter = _PropertyGet("OnApproveParameter") End Property
Property Let OnApproveParameter(ByVal pvValue As Variant) Call _PropertySet("OnApproveParameter", pvValue) End Property |
Access2BaseDev |
SubForm |
OnApproveReset |
Basic |
|
7 |
Property Get OnApproveReset() As Variant OnApproveReset = _PropertyGet("OnApproveReset") End Property
Property Let OnApproveReset(ByVal pvValue As Variant) Call _PropertySet("OnApproveReset", pvValue) End Property |
Access2BaseDev |
SubForm |
OnApproveRowChange |
Basic |
|
7 |
Property Get OnApproveRowChange() As Variant OnApproveRowChange = _PropertyGet("OnApproveRowChange") End Property
Property Let OnApproveRowChange(ByVal pvValue As Variant) Call _PropertySet("OnApproveRowChange", pvValue) End Property |
Access2BaseDev |
SubForm |
OnApproveSubmit |
Basic |
|
7 |
Property Get OnApproveSubmit() As Variant OnApproveSubmit = _PropertyGet("OnApproveSubmit") End Property
Property Let OnApproveSubmit(ByVal pvValue As Variant) Call _PropertySet("OnApproveSubmit", pvValue) End Property |
Access2BaseDev |
SubForm |
OnConfirmDelete |
Basic |
|
7 |
Property Get OnConfirmDelete() As Variant OnConfirmDelete = _PropertyGet("OnConfirmDelete") End Property
Property Let OnConfirmDelete(ByVal pvValue As Variant) Call _PropertySet("OnConfirmDelete", pvValue) End Property |
Access2BaseDev |
SubForm |
OnCursorMoved |
Basic |
|
7 |
Property Get OnCursorMoved() As Variant OnCursorMoved = _PropertyGet("OnCursorMoved") End Property
Property Let OnCursorMoved(ByVal pvValue As Variant) Call _PropertySet("OnCursorMoved", pvValue) End Property |
Access2BaseDev |
SubForm |
OnErrorOccurred |
Basic |
|
7 |
Property Get OnErrorOccurred() As Variant OnErrorOccurred = _PropertyGet("OnErrorOccurred") End Property
Property Let OnErrorOccurred(ByVal pvValue As Variant) Call _PropertySet("OnErrorOccurred", pvValue) End Property |
Access2BaseDev |
SubForm |
OnLoaded |
Basic |
|
7 |
Property Get OnLoaded() As Variant OnLoaded = _PropertyGet("OnLoaded") End Property
Property Let OnLoaded(ByVal pvValue As Variant) Call _PropertySet("OnLoaded", pvValue) End Property |
Access2BaseDev |
SubForm |
OnReloaded |
Basic |
|
7 |
Property Get OnReloaded() As Variant OnReloaded = _PropertyGet("OnReloaded") End Property
Property Let OnReloaded(ByVal pvValue As Variant) Call _PropertySet("OnReloaded", pvValue) End Property |
Access2BaseDev |
SubForm |
OnReloading |
Basic |
|
7 |
Property Get OnReloading() As Variant OnReloading = _PropertyGet("OnReloading") End Property
Property Let OnReloading(ByVal pvValue As Variant) Call _PropertySet("OnReloading", pvValue) End Property |
Access2BaseDev |
SubForm |
OnResetted |
Basic |
|
7 |
Property Get OnResetted() As Variant OnResetted = _PropertyGet("OnResetted") End Property
Property Let OnResetted(ByVal pvValue As Variant) Call _PropertySet("OnResetted", pvValue) End Property |
Access2BaseDev |
SubForm |
OnRowChanged |
Basic |
|
7 |
Property Get OnRowChanged() As Variant OnRowChanged = _PropertyGet("OnRowChanged") End Property
Property Let OnRowChanged(ByVal pvValue As Variant) Call _PropertySet("OnRowChanged", pvValue) End Property |
Access2BaseDev |
SubForm |
OnUnloaded |
Basic |
|
7 |
Property Get OnUnloaded() As Variant OnUnloaded = _PropertyGet("OnUnloaded") End Property
Property Let OnUnloaded(ByVal pvValue As Variant) Call _PropertySet("OnUnloaded", pvValue) End Property |
Access2BaseDev |
SubForm |
OnUnloading |
Basic |
|
7 |
Property Get OnUnloading() As Variant OnUnloading = _PropertyGet("OnUnloading") End Property
Property Let OnUnloading(ByVal pvValue As Variant) Call _PropertySet("OnUnloading", pvValue) End Property |
Access2BaseDev |
SubForm |
OptionGroup |
Basic |
|
24 |
Public Function OptionGroup(ByVal Optional pvGroupName As Variant) As Variant
Const cstThisSub = "SubForm.OptionGroup" Dim ogGroup As Object Utils._SetCalledSub(cstThisSub) If IsMissing(pvGroupName) Then Call _TraceArguments() If _ErrorHandler() Then On Local Error Goto Error_Function Set ogGroup = _OptionGroup(pvGroupName, CTLPARENTISSUBFORM, ParentComponent, DatabaseForm) If Not IsNull(ogGroup) Then ogGroup._DocEntry = _DocEntry ogGroup._DbEntry = _DbEntry End If Set OptionGroup = ogGroup Exit_Function: Utils._ResetCalledSub(cstThisSub) Exit Function Error_Function: TraceError(TRACEABORT, Err, cstThisSub, Erl) GoTo Exit_Function End Function |
Access2BaseDev |
SubForm |
OrderBy |
Basic |
|
7 |
Property Get OrderBy() As Variant OrderBy = _PropertyGet("OrderBy") End Property
Property Let OrderBy(ByVal pvValue As Variant) Call _PropertySet("OrderBy", pvValue) End Property |
Access2BaseDev |
SubForm |
OrderByOn |
Basic |
|
7 |
Property Get OrderByOn() As Variant OrderByOn = _PropertyGet("OrderByOn") End Property
Property Let OrderByOn(ByVal pvValue As Variant) Call _PropertySet("OrderByOn", pvValue) End Property |
Access2BaseDev |
SubForm |
Parent |
Basic |
_PropertyGet (Procedure) |
16 |
Public Function Parent() As Object
Utils._SetCalledSub("SubForm.getParent") On Error Goto Error_Function
Set Parent = PropertiesGet._ParentObject(_Shortcut) Exit_Function: Utils._ResetCalledSub("SubForm.getParent") Exit Function Error_Function: TraceError(TRACEABORT, Err, "SubForm.getParent", Erl) Set Parent = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
SubForm |
pName |
Basic |
|
3 |
Public Function pName() As String pName = _PropertyGet("Name") End Function |
Access2BaseDev |
SubForm |
Properties |
Basic |
|
20 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Shortcut, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Shortcut, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Exit Function End Function |
Access2BaseDev |
SubForm |
Recordset |
Basic |
|
4 |
Property Get Recordset() As Object Recordset = _PropertyGet("Recordset") End Property |
Access2BaseDev |
SubForm |
RecordSource |
Basic |
|
7 |
Property Get RecordSource() As Variant RecordSource = _PropertyGet("RecordSource") End Property
Property Let RecordSource(ByVal pvValue As Variant) Call _PropertySet("RecordSource", pvValue) End Property |
Access2BaseDev |
SubForm |
Refresh |
Basic |
|
22 |
Public Function Refresh() As Boolean Utils._SetCalledSub("SubForm.Refresh") If _ErrorHandler() Then On Local Error Goto Error_Function Refresh = False
Dim oSet As Object Set oSet = DatabaseForm.createResultSet() If Not IsNull(oSet) Then oSet.refreshRow() Refresh = True End If
Exit_Function: Set oSet = Nothing Utils._ResetCalledSub("SubForm.Refresh") Exit Function Error_Function: TraceError(TRACEABORT, Err, "SubForm.Refresh", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
SubForm |
Requery |
Basic |
|
17 |
Public Function Requery() As Boolean Utils._SetCalledSub("SubForm.Requery") If _ErrorHandler() Then On Local Error Goto Error_Function Requery = False
DatabaseForm.reload() Requery = True
Exit_Function: Utils._ResetCalledSub("SubForm.Requery") Exit Function Error_Function: TraceError(TRACEABORT, Err, "SubForm.Requery", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
SubForm |
setProperty |
Basic |
|
7 |
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean Utils._SetCalledSub("SubForm.setProperty") setProperty = _PropertySet(psProperty, pvValue) Utils._ResetCalledSub("SubForm.setProperty") End Function |
Access2BaseDev |
TempVar |
_PropertiesList |
Basic |
hasProperty (Procedure) Properties (Procedure) |
6 |
Private Function _PropertiesList() As Variant _PropertiesList = Array("Name", "ObjectType", "Value") End Function |
Access2BaseDev |
TempVar |
_PropertyGet |
Basic |
Name (Procedure) ObjectType (Procedure) Value (Procedure) getProperty (Procedure) Properties (Procedure) |
31 |
Private Function _PropertyGet(ByVal psProperty As String) As Variant
If _ErrorHandler() Then On Local Error Goto Error_Function Utils._SetCalledSub("TempVar.get" & psProperty) _PropertyGet = Nothing Select Case UCase(psProperty) Case UCase("Name") _PropertyGet = _Name Case UCase("ObjectType") _PropertyGet = _Type Case UCase("Value") _PropertyGet = _Value Case Else Goto Trace_Error End Select Exit_Function: Utils._ResetCalledSub("TempVar.get" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertyGet = Nothing Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "TempVar._PropertyGet", Erl) _PropertyGet = Nothing GoTo Exit_Function End Function |
Access2BaseDev |
TempVar |
_PropertySet |
Basic |
Value (Procedure) setProperty (Procedure) |
35 |
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
Utils._SetCalledSub("TempVar.set" & psProperty) If _ErrorHandler() Then On Local Error Goto Error_Function _PropertySet = True
Dim iArgNr As Integer
If _IsLeft(_A2B_.CalledSub, "TempVar.") Then iArgNr = 1 Else iArgNr = 2 Select Case UCase(psProperty) Case UCase("Value") _Value = pvValue _A2B_.TempVars.Item(UCase(_Name)).Value = pvValue Case Else Goto Trace_Error End Select
Exit_Function: Utils._ResetCalledSub("TempVar.set" & psProperty) Exit Function Trace_Error: TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty) _PropertySet = False Goto Exit_Function Trace_Error_Value: TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty)) _PropertySet = False Goto Exit_Function Error_Function: TraceError(TRACEABORT, Err, "TempVar._PropertySet", Erl) _PropertySet = False GoTo Exit_Function End Function |
Access2BaseDev |
TempVar |
Class_Initialize |
Basic |
Class_Terminate (Procedure) |
8 |
Private Sub Class_Initialize() _Type = OBJTEMPVAR _Name = "" _Value = Null End Sub |
Access2BaseDev |
TempVar |
Class_Terminate |
Basic |
Dispose (Procedure) |
5 |
Private Sub Class_Terminate() On Local Error Resume Next Call Class_Initialize() End Sub |
Access2BaseDev |
TempVar |
Dispose |
Basic |
|
4 |
Public Sub Dispose() Call Class_Terminate() End Sub |
Access2BaseDev |
TempVar |
getProperty |
Basic |
|
9 |
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
Utils._SetCalledSub("Property.getProperty") If IsMissing(pvProperty) Then Call _TraceArguments() getProperty = _PropertyGet(pvProperty) Utils._ResetCalledSub("Property.getProperty") End Function |
Access2BaseDev |
TempVar |
hasProperty |
Basic |
|
8 |
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty) Exit Function End Function |
Access2BaseDev |
TempVar |
Name |
Basic |
|
3 |
Property Get Name() As String Name = _PropertyGet("Name") End Property |
Access2BaseDev |
TempVar |
ObjectType |
Basic |
|
4 |
Property Get ObjectType() As String ObjectType = _PropertyGet("ObjectType") End Property |
Access2BaseDev |
TempVar |
Properties |
Basic |
|
20 |
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String vPropertiesList = _PropertiesList() sObject = Utils._PCase(_Type) If IsMissing(pvIndex) Then vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList) Else vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex) vProperty._Value = _PropertyGet(vPropertiesList(pvIndex)) End If Exit_Function: Set Properties = vProperty Exit Function End Function |
Access2BaseDev |
TempVar |
setProperty |
Basic |
|
9 |
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean Dim cstThisSub As String cstThisSub = Utils._PCase(_Type) & ".getProperty" Utils._SetCalledSub(cstThisSub) setProperty = _PropertySet(psProperty, pvValue) Utils._ResetCalledSub(cstThisSub) End Function |
Access2BaseDev |
TempVar |
Value |
Basic |
|
7 |
Property Get Value() As Variant Value = _PropertyGet("Value") End Property
Property Let Value(ByVal pvValue As Variant) Call _PropertySet("Value", pvValue) End Property |
Access2BaseDev |
Test |
Main |
Basic |
|
7 |
Sub Main Dim a, b() _ErrorHandler(False) exit sub End Sub |
Access2BaseDev |
Trace |
_DumpToFile |
Basic |
|
32 |
Private Sub _DumpToFile(oEvent As Object)
If _ErrorHandler() Then On Local Error GoTo Error_Sub
Dim sPath as String, iFileNumber As Integer, i As Integer
sPath = _PromptFilePicker("txt") If sPath <> "" Then If UBound(_A2B_.TraceLogs) >= 0 Then iFileNumber = FreeFile() Open sPath For Append Access Write Lock Read As iFileNumber If _A2B_.TraceLogCount > 0 Then If _A2B_.TraceLogCount < _A2B_.TraceLogMaxEntries Then i = -1 Else i = _A2B_.TraceLogLast Do If i < _A2B_.TraceLogMaxEntries - 1 Then i = i + 1 Else i = 0 Print #iFileNumber _A2B_.TraceLogs(i) Loop While i <> _A2B_.TraceLogLast End If Close iFileNumber MsgBox _GetLabel("SAVECONSOLEENTRIES"), vbOK + vbInformation, _GetLabel("SAVECONSOLE") End If End If Exit_Sub: Exit Sub Error_Sub: TraceError("ERROR", Err, "DumpToFile", Erl) GoTo Exit_Sub End Sub |
Access2BaseDev |
Trace |
_ErrorHandler |
Basic |
AllDialogs (Procedure) AllForms (Procedure) AllModules (Procedure) CommandBars (Procedure) Controls (Procedure) Events (Procedure) Forms (Procedure) HtmlEncode (Procedure) OpenConnection (Procedure) OpenDatabase (Procedure) SysCmd (Procedure) TempVars (Procedure) AddItem (Procedure) Move (Procedure) Refresh (Procedure) RemoveItem (Procedure) Requery (Procedure) SetFocus (Procedure) _OptionGroup (Procedure) Main (Procedure) TraceConsole (Procedure) TraceLevel (Procedure) TraceLog (Procedure) _DumpToFile (Procedure) _PromptFilePicker (Procedure) ApplyFilter (Procedure) mClose (Procedure) CopyObject (Procedure) FindNext (Procedure) FindRecord (Procedure) GetHiddenAttribute (Procedure) GoToControl (Procedure) GoToRecord (Procedure) MoveSize (Procedure) OpenForm (Procedure) OpenQuery (Procedure) OpenReport (Procedure) OpenSQL (Procedure) OpenTable (Procedure) OutputTo (Procedure) Quit (Procedure) RunApp (Procedure) RunCommand (Procedure) RunSQL (Procedure) SelectObject (Procedure) SendObject (Procedure) SetHiddenAttribute (Procedure) SetOrderBy (Procedure) ShowAllrecords (Procedure) _OpenObject (Procedure) _SelectWindow (Procedure) _SendWithAttachment (Procedure) _SendWithoutAttachment (Procedure) _getTempDirectoryURL (Procedure) _IsPseudo (Procedure) mClose (Procedure) CreateQueryDef (Procedure) CreateTableDef (Procedure) OpenRecordset (Procedure) OpenSQL (Procedure) OutputTo (Procedure) QueryDefs (Procedure) Recordsets (Procedure) RunSQL (Procedure) TableDefs (Procedure) _DFunction (Procedure) _hasRecordset (Procedure) _OutputToCalc (Procedure) _PropertyGet (Procedure) _setProperty (Procedure) Add (Procedure) Delete (Procedure) Remove (Procedure) RemoveAll (Procedure) _PropertyGet (Procedure) getObject (Procedure) getOptionGroup (Procedure) _getProperty (Procedure) IsLoaded (Procedure) OptionGroup (Procedure) mClose (Procedure) Controls (Procedure) Move (Procedure) Refresh (Procedure) Requery (Procedure) setFocus (Procedure) _Initialize (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) OptionGroup (Procedure) Controls (Procedure) Refresh (Procedure) Requery (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Controls (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _Initialize (Procedure) _PropertyGet (Procedure) _PropertyGet (Procedure) AddItem (Procedure) Controls (Procedure) RemoveItem (Procedure) Requery (Procedure) setFocus (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) OptionGroup (Procedure) Controls (Procedure) EndExecute (Procedure) Start (Procedure) Terminate (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) AppendChunk (Procedure) GetChunk (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _ReadAll (Procedure) _WriteAll (Procedure) CreateField (Procedure) Fields (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) AddNew (Procedure) CancelUpdate (Procedure) Clone (Procedure) mClose (Procedure) Delete (Procedure) Edit (Procedure) Fields (Procedure) GetRows (Procedure) OpenRecordset (Procedure) Update (Procedure) _AppendChunk (Procedure) _AppendChunkClose (Procedure) _Initialize (Procedure) _Move (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) CommandBarControls (Procedure) Controls (Procedure) Reset (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Execute (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Find (Procedure) _PropertyGet (Procedure) |
9 |
Public Function _ErrorHandler(Optional ByVal pbCheck As Boolean) As Boolean If IsEmpty(_A2B_) Then Call Application._RootInit() If Not IsMissing(pbCheck) Then _A2B_.ErrorHandler = pbCheck _ErrorHandler = _A2B_.ErrorHandler Exit Function End Function |
Access2BaseDev |
Trace |
_ErrorMessage |
Basic |
TraceError (Procedure) |
29 |
Private Function _ErrorMessage(ByVal piErrorNumber As Integer, Optional ByVal pvArgs As Variant) As String
Dim sErrorMessage As String, i As Integer, sErrLabel _ErrorMessage = "" If piErrorNumber > ERRINIT Then sErrLabel = "ERR" & piErrorNumber sErrorMessage = _Getlabel(sErrLabel) If Not IsMissing(pvArgs) Then If Not IsArray(pvArgs) Then sErrorMessage = Join(Split(sErrorMessage, "%0"), Utils._CStr(pvArgs, False)) Else For i = LBound(pvArgs) To UBound(pvArgs) sErrorMessage = Join(Split(sErrorMessage, "%" & i), Utils._CStr(pvArgs(i), False)) Next i End If End If Else sErrorMessage = Error(piErrorNumber) If Len(sErrorMessage) > 1 And Right(sErrorMessage, 1) = "." Then sErrorMessage = Left(sErrorMessage, Len(sErrorMessage)-1) End If
_ErrorMessage = sErrorMessage Exit Function End Function |
Access2BaseDev |
Trace |
_PromptFilePicker |
Basic |
_DumpToFile (Procedure) OutputTo (Procedure) OutputTo (Procedure) |
36 |
Public Function _PromptFilePicker(ByVal psSuffix As String) As String
If _ErrorHandler() Then On Local Error GoTo Error_Function
Dim oFileDialog as Object, oUcb as object, oPath As Object Dim iAccept as Integer, sInitPath as String
Set oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") oFileDialog.Initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION)) Set oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
oFileDialog.appendFilter("*." & psSuffix, "*." & psSuffix) oFileDialog.appendFilter("*.*", "*.*") oFileDialog.setCurrentFilter("*." & psSuffix) Set oPath = createUnoService("com.sun.star.util.PathSettings") sInitPath = oPath.Work If oUcb.Exists(sInitPath) Then oFileDialog.SetDisplayDirectory(sInitPath)
iAccept = oFileDialog.Execute() _PromptFilePicker = "" If iAccept = 1 Then _PromptFilePicker = oFileDialog.Files(0) End If Exit_Function: If Not IsEmpty(oFileDialog) And Not IsNull(oFileDialog) Then oFileDialog.Dispose() Exit Function Error_Function: TraceError("ERROR", Err, "PromptFilePicker", Erl) GoTo Exit_Function End Function |
Access2BaseDev |
Trace |
_TraceArguments |
Basic |
Controls (Procedure) DAvg (Procedure) DCount (Procedure) DLookup (Procedure) DMax (Procedure) DMin (Procedure) DStDev (Procedure) DStDevP (Procedure) DSum (Procedure) DVar (Procedure) DVarP (Procedure) OpenConnection (Procedure) OpenDatabase (Procedure) SysCmd (Procedure) AddItem (Procedure) hasProperty (Procedure) Move (Procedure) Properties (Procedure) Refresh (Procedure) RemoveItem (Procedure) Requery (Procedure) SetFocus (Procedure) _OptionGroup (Procedure) ApplyFilter (Procedure) mClose (Procedure) CopyObject (Procedure) FindRecord (Procedure) GetHiddenAttribute (Procedure) GoToControl (Procedure) GoToRecord (Procedure) OpenForm (Procedure) OpenQuery (Procedure) OpenReport (Procedure) OpenSQL (Procedure) OpenTable (Procedure) RunApp (Procedure) RunCommand (Procedure) RunSQL (Procedure) SelectObject (Procedure) SetHiddenAttribute (Procedure) CreateQueryDef (Procedure) CreateTableDef (Procedure) DAvg (Procedure) DCount (Procedure) DLookup (Procedure) DMax (Procedure) DMin (Procedure) DStDev (Procedure) DStDevP (Procedure) DSum (Procedure) DVar (Procedure) DVarP (Procedure) getProperty (Procedure) OpenRecordset (Procedure) OpenSQL (Procedure) OutputTo (Procedure) RunSQL (Procedure) setAbsolutePosition (Procedure) setAllowAdditions (Procedure) setAllowDeletions (Procedure) setAllowEdits (Procedure) setBackColor (Procedure) setBookmark (Procedure) setBorderColor (Procedure) setBorderStyle (Procedure) setCancel (Procedure) setCaption (Procedure) setControlTipText (Procedure) setCurrentRecord (Procedure) setDefault (Procedure) setDefaultValue (Procedure) setDescription (Procedure) setEnabled (Procedure) setFilter (Procedure) setFilterOn (Procedure) setFontBold (Procedure) setFontItalic (Procedure) setFontName (Procedure) setFontSize (Procedure) setFontUnderline (Procedure) setFontWeight (Procedure) setForeColor (Procedure) setHeight (Procedure) setListIndex (Procedure) setLocked (Procedure) setMultiSelect (Procedure) setOnAction (Procedure) setOptionValue (Procedure) setOrderBy (Procedure) setOrderByOn (Procedure) setPage (Procedure) setProperty (Procedure) setRecordSource (Procedure) setRequired (Procedure) setRowSource (Procedure) setRowSourceType (Procedure) setSelected (Procedure) setSelLength (Procedure) setSelStart (Procedure) setSelText (Procedure) setSpecialEffect (Procedure) setTabIndex (Procedure) setTabStop (Procedure) setTag (Procedure) setTextAlign (Procedure) setTooltipText (Procedure) setTripleState (Procedure) setValue (Procedure) setVisible (Procedure) setWidth (Procedure) Add (Procedure) Delete (Procedure) getProperty (Procedure) Remove (Procedure) getAbsolutePosition (Procedure) getAllowAdditions (Procedure) getAllowDeletions (Procedure) getAllowEdits (Procedure) getBackColor (Procedure) getBeginGroup (Procedure) getBOF (Procedure) getBookmark (Procedure) getBookmarkable (Procedure) getBorderColor (Procedure) getBorderStyle (Procedure) getBuiltIn (Procedure) getButtonLeft (Procedure) getButtonMiddle (Procedure) getButtonRight (Procedure) getCancel (Procedure) getCaption (Procedure) getClickCount (Procedure) getContextShortcut (Procedure) getControlSource (Procedure) getControlTipText (Procedure) getControlType (Procedure) getCount (Procedure) getCurrentRecord (Procedure) getDataType (Procedure) getDbType (Procedure) getDefault (Procedure) getDefaultValue (Procedure) getDescription (Procedure) getEditMode (Procedure) getEnabled (Procedure) getEOF (Procedure) getEventName (Procedure) getEventType (Procedure) getFieldSize (Procedure) getFilter (Procedure) getFilterOn (Procedure) getFocusChangeTemporary (Procedure) getFontBold (Procedure) getFontItalic (Procedure) getFontName (Procedure) getFontSize (Procedure) getFontUnderline (Procedure) getFontWeight (Procedure) getForm (Procedure) getFormat (Procedure) getHeight (Procedure) getForeColor (Procedure) getIsLoaded (Procedure) getItemData (Procedure) getKeyAlt (Procedure) getKeyChar (Procedure) getKeyCode (Procedure) getKeyCtrl (Procedure) getKeyFunction (Procedure) getKeyShift (Procedure) getLinkChildFields (Procedure) getLinkMasterFields (Procedure) getListCount (Procedure) getListIndex (Procedure) getLocked (Procedure) getMultiSelect (Procedure) getName (Procedure) getObject (Procedure) getObjectType (Procedure) getOpenArgs (Procedure) getOptionGroup (Procedure) getOptionValue (Procedure) getOrderBy (Procedure) getOrderByOn (Procedure) getPage (Procedure) getParent (Procedure) getProperty (Procedure) getRecommendation (Procedure) getRecordCount (Procedure) getRecordset (Procedure) getRecordSource (Procedure) getRequired (Procedure) getRowChangeAction (Procedure) getRowSource (Procedure) getRowSourceType (Procedure) getSelected (Procedure) getSize (Procedure) getSource (Procedure) getSourceField (Procedure) getSourceTable (Procedure) getSpecialEffect (Procedure) getSubType (Procedure) getSubComponentName (Procedure) getSubComponentType (Procedure) getTabIndex (Procedure) getTabStop (Procedure) getTag (Procedure) getText (Procedure) getTextAlign (Procedure) getTooltipText (Procedure) getTripleState (Procedure) getTypeName (Procedure) getValue (Procedure) getVisible (Procedure) getWidth (Procedure) getXPos (Procedure) getYPos (Procedure) _hasProperty (Procedure) OptionGroup (Procedure) getProperty (Procedure) Move (Procedure) OptionGroup (Procedure) getProperty (Procedure) getProperty (Procedure) getProperty (Procedure) getProperty (Procedure) AddItem (Procedure) getProperty (Procedure) RemoveItem (Procedure) OptionGroup (Procedure) getProperty (Procedure) Move (Procedure) AppendChunk (Procedure) GetChunk (Procedure) getProperty (Procedure) CreateField (Procedure) getProperty (Procedure) getProperty (Procedure) GetRows (Procedure) Move (Procedure) getProperty (Procedure) getProperty (Procedure) getProperty (Procedure) Lines (Procedure) ProcBodyLine (Procedure) ProcCountLines (Procedure) ProcOfLine (Procedure) ProcStartLine (Procedure) Find (Procedure) getProperty (Procedure) |
10 |
Public Sub _TraceArguments(Optional psCall As String)
If Not IsMissing(psCall) Then Utils._SetCalledSub(psCall) TraceError(TRACEFATAL, ERRMISSINGARGUMENTS, Utils._CalledSub(), 0) Exit Sub End Sub |
Access2BaseDev |
Trace |
_TraceLevel |
Basic |
TraceConsole (Procedure) TraceLevel (Procedure) TraceLog (Procedure) |
21 |
Private Function _TraceLevel(ByVal pvTraceLevel As Variant) As Variant
Dim vTraces As Variant, i As Integer vTraces = Array(TRACEDEBUG, TRACEINFO, TRACEWARNING, TRACEERRORS, TRACEFATAL, TRACEABORT, TRACEANY) Select Case VarType(pvTraceLevel) Case vbString _TraceLevel = 4 For i = 0 To UBound(vTraces) If UCase(pvTraceLevel) = UCase(vTraces(i)) Then _TraceLevel = i + 1 Exit For End If Next i Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal If pvTraceLevel < 1 Or pvTraceLevel > UBound(vTraces) + 1 Then _TraceLevel = TRACEERRORS Else _TraceLevel = vTraces(pvTraceLevel - 1) End Select End Function |
Access2BaseDev |
Trace |
TraceConsole |
Basic |
|
111 |
Public Sub TraceConsole() If _ErrorHandler() Then On Local Error Goto Error_Sub
Dim sLineBreak As String, oTraceDialog As Object sLineBreak = vbNewLine
Set oTraceDialog = CreateUnoDialog(Utils._GetDialogLib().dlgTrace) oTraceDialog.Title = _GetLabel("DLGTRACE_TITLE") Dim oEntries As Object, oTraceLog As Object, oClear As Object, oMinLevel As Object, oNbEntries As Object, oDump As Object Dim oControl As Object Dim i As Integer, sText As String, iOKCancel As Integer Set oNbEntries = oTraceDialog.Model.getByName("numNbEntries") oNbEntries.Value = _A2B_.TraceLogCount oNbEntries.HelpText = _GetLabel("DLGTRACE_LBLNBENTRIES_HELP")
Set oControl = oTraceDialog.Model.getByName("lblNbEntries") oControl.Label = _GetLabel("DLGTRACE_LBLNBENTRIES_LABEL") oControl.HelpText = _GetLabel("DLGTRACE_LBLNBENTRIES_HELP")
Set oEntries = oTraceDialog.Model.getByName("numEntries") If _A2B_.TraceLogMaxEntries = 0 Then _A2B_.TraceLogMaxEntries = cstLogMaxEntries oEntries.Value = _A2B_.TraceLogMaxEntries oEntries.HelpText = _GetLabel("DLGTRACE_LBLENTRIES_HELP")
Set oControl = oTraceDialog.Model.getByName("lblEntries") oControl.Label = _GetLabel("DLGTRACE_LBLENTRIES_LABEL") oControl.HelpText = _GetLabel("DLGTRACE_LBLENTRIES_HELP")
Set oDump = oTraceDialog.Model.getByName("cmdDump") oDump.Enabled = 0 oDump.Label = _GetLabel("DLGTRACE_CMDDUMP_LABEL") oDump.HelpText = _GetLabel("DLGTRACE_CMDDUMP_HELP") Set oTraceLog = oTraceDialog.Model.getByName("txtTraceLog") oTraceLog.HelpText = _GetLabel("DLGTRACE_TXTTRACELOG_HELP") If UBound(_A2B_.TraceLogs) >= 0 Then oTraceLog.HardLineBreaks = True sText = "" If _A2B_.TraceLogCount > 0 Then If _A2B_.TraceLogCount < _A2B_.TraceLogMaxEntries Then i = -1 Else i = _A2B_.TraceLogLast Do If i < _A2B_.TraceLogMaxEntries - 1 Then i = i + 1 Else i = 0 If Len(_A2B_.TraceLogs(i)) > 11 Then sText = sText & Right(_A2B_.TraceLogs(i), Len(_A2B_.TraceLogs(i)) - 11) & sLineBreak End If Loop While i <> _A2B_.TraceLogLast oDump.Enabled = 1 End If If Len(sText) > 0 Then sText = Left(sText, Len(sText) - Len(sLineBreak)) oTraceLog.Text = sText Else oTraceLog.Text = _GetLabel("DLGTRACE_TXTTRACELOG_TEXT") End If Set oClear = oTraceDialog.Model.getByName("chkClear") oClear.State = 0 oClear.HelpText = _GetLabel("DLGTRACE_LBLCLEAR_HELP") Set oControl = oTraceDialog.Model.getByName("lblClear") oControl.Label = _GetLabel("DLGTRACE_LBLCLEAR_LABEL") oControl.HelpText = _GetLabel("DLGTRACE_LBLCLEAR_HELP")
Set oMinLevel = oTraceDialog.Model.getByName("cboMinLevel") If _A2B_.MinimalTraceLevel = 0 Then _A2B_.MinimalTraceLevel = _TraceLevel(TRACEERRORS) oMinLevel.Text = _TraceLevel(_A2B_.MinimalTraceLevel) oMinLevel.HelpText = _GetLabel("DLGTRACE_LBLMINLEVEL_HELP") Set oControl = oTraceDialog.Model.getByName("lblMinLevel") oControl.Label = _GetLabel("DLGTRACE_LBLMINLEVEL_LABEL") oControl.HelpText = _GetLabel("DLGTRACE_LBLMINLEVEL_HELP")
Set oControl = oTraceDialog.Model.getByName("cmdOK") oControl.Label = _GetLabel("DLGTRACE_CMDOK_LABEL") oControl.HelpText = _GetLabel("DLGTRACE_CMDOK_HELP")
Set oControl = oTraceDialog.Model.getByName("cmdCancel") oControl.Label = _GetLabel("DLGTRACE_CMDCANCEL_LABEL") oControl.HelpText = _GetLabel("DLGTRACE_CMDCANCEL_HELP")
iOKCancel = oTraceDialog.Execute()
Select Case iOKCancel Case 1 If oClear.State = 1 Then _A2B_.TraceLogs() = Array() _A2B_.TraceLogCount = 0 End If If oMinLevel.Text <> "" Then _A2B_.MinimalTraceLevel = _TraceLevel(oMinLevel.Text) If oEntries.Value <> 0 And oEntries.Value <> _A2B_.TraceLogMaxEntries Then _A2B_.TraceLogs() = Array() _A2B_.TraceLogMaxEntries = oEntries.Value End If Case 0 Case Else End Select Exit_Sub: If Not IsNull(oTraceDialog) Then oTraceDialog.Dispose() Exit Sub Error_Sub: With _A2B_ .TraceLogs() = Array() .TraceLogCount = 0 .TraceLogLast = 0 End With GoTo Exit_Sub End Sub |
Access2BaseDev |
Trace |
TraceError |
Basic |
AllDialogs (Procedure) AllForms (Procedure) AllModules (Procedure) CommandBars (Procedure) Controls (Procedure) Events (Procedure) Forms (Procedure) HtmlEncode (Procedure) OpenConnection (Procedure) OpenDatabase (Procedure) SysCmd (Procedure) TempVars (Procedure) _CurrentDb (Procedure) AddItem (Procedure) Move (Procedure) Refresh (Procedure) RemoveItem (Procedure) Requery (Procedure) SetFocus (Procedure) _OptionGroup (Procedure) _DumpToFile (Procedure) _PromptFilePicker (Procedure) _TraceArguments (Procedure) ApplyFilter (Procedure) mClose (Procedure) CopyObject (Procedure) FindNext (Procedure) FindRecord (Procedure) GetHiddenAttribute (Procedure) GoToControl (Procedure) GoToRecord (Procedure) MoveSize (Procedure) OpenForm (Procedure) OpenQuery (Procedure) OpenReport (Procedure) OpenSQL (Procedure) OpenTable (Procedure) OutputTo (Procedure) Quit (Procedure) RunApp (Procedure) RunCommand (Procedure) RunSQL (Procedure) SelectObject (Procedure) SendObject (Procedure) SetHiddenAttribute (Procedure) SetOrderBy (Procedure) ShowAllrecords (Procedure) _ConvertDataDescriptor (Procedure) _DatabaseForm (Procedure) _OpenObject (Procedure) _SelectWindow (Procedure) _SendWithAttachment (Procedure) _SendWithoutAttachment (Procedure) _CheckArgument (Procedure) _getTempDirectoryURL (Procedure) mClose (Procedure) CreateQueryDef (Procedure) CreateTableDef (Procedure) OpenRecordset (Procedure) OpenSQL (Procedure) OutputTo (Procedure) QueryDefs (Procedure) Recordsets (Procedure) RunSQL (Procedure) TableDefs (Procedure) _DFunction (Procedure) _OutputDataToHTML (Procedure) _OutputToCalc (Procedure) _PropertyGet (Procedure) _setProperty (Procedure) Item (Procedure) Add (Procedure) Delete (Procedure) Remove (Procedure) RemoveAll (Procedure) _PropertyGet (Procedure) getObject (Procedure) getOptionGroup (Procedure) _getProperty (Procedure) _Properties (Procedure) IsLoaded (Procedure) OptionGroup (Procedure) mClose (Procedure) Controls (Procedure) Move (Procedure) Refresh (Procedure) Requery (Procedure) setFocus (Procedure) _Initialize (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) OptionGroup (Procedure) Parent (Procedure) Controls (Procedure) Refresh (Procedure) Requery (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Controls (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _Initialize (Procedure) _PropertyGet (Procedure) _PropertyGet (Procedure) AddItem (Procedure) Controls (Procedure) RemoveItem (Procedure) Requery (Procedure) setFocus (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) OptionGroup (Procedure) Controls (Procedure) EndExecute (Procedure) Execute (Procedure) Move (Procedure) Start (Procedure) Terminate (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) AppendChunk (Procedure) GetChunk (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _ReadAll (Procedure) _WriteAll (Procedure) CreateField (Procedure) Execute (Procedure) Fields (Procedure) OpenRecordset (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) AddNew (Procedure) CancelUpdate (Procedure) Clone (Procedure) Delete (Procedure) Edit (Procedure) Fields (Procedure) GetRows (Procedure) OpenRecordset (Procedure) Update (Procedure) _AppendChunk (Procedure) _AppendChunkClose (Procedure) _Initialize (Procedure) _Move (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) CloseConnection (Procedure) CurrentDocIndex (Procedure) _CurrentDb (Procedure) CommandBarControls (Procedure) Controls (Procedure) Reset (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Execute (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Find (Procedure) _FindProcIndex (Procedure) _PropertyGet (Procedure) |
33 |
Public Sub TraceError(ByVal psErrorLevel As String _ , ByVal piErrorCode As Integer _ , ByVal psErrorProc As String _ , ByVal piErrorLine As Integer _ , ByVal Optional pvMsgBox As Variant _ , ByVal Optional pvArgs As Variant _ )
On Local Error Resume Next If IsEmpty(_A2B_) Then Call Application._RootInit() Dim sErrorText As String, sErrorDesc As String, oDb As Object sErrorDesc = _ErrorMessage(piErrorCode, pvArgs) sErrorText = _GetLabel("ERR#") & CStr(piErrorCode) _ & " (" & sErrorDesc & ") " & _GetLabel("ERROCCUR") _ & Iif(piErrorLine > 0, " " & _GetLabel("ERRLINE") & " " & CStr(piErrorLine), "") _ & Iif(psErrorProc <> "", " " & _GetLabel("ERRIN") & " " & psErrorProc, Iif(_A2B_.CalledSub = "", "", " " & _Getlabel("ERRIN") & " " & _A2B_.CalledSub)) If IsMissing(pvMsgBox) Then pvMsgBox = ( psErrorLevel = TRACEERRORS Or psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT ) TraceLog(psErrorLevel, sErrorText, pvMsgBox) If psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT Then _A2B_.CalledSub = "" If psErrorLevel = TRACEFATAL Then Set oDb = Application.CurrentDb() If Not IsNull(oDb) Then oDb.CloseAllrecordsets() End If Stop End If
End Sub |
Access2BaseDev |
Trace |
TraceLevel |
Basic |
|
25 |
Public Sub TraceLevel(ByVal Optional psTraceLevel As String)
If _ErrorHandler() Then On Local Error Goto Error_Sub Select Case True Case IsMissing(psTraceLevel) : psTraceLevel = "ERROR" Case psTraceLevel = "" : psTraceLevel = "ERROR" Case Utils._InList(UCase(psTraceLevel), Array( _ TRACEDEBUG, TRACEINFO, TRACEWARNING, TRACEERRORS, TRACEFATAL, TRACEABORT _ )) Case Else : Goto Exit_Sub End Select _A2B_.MinimalTraceLevel = _TraceLevel(psTraceLevel) Exit_Sub: Exit Sub Error_Sub: With _A2B_ .TraceLogs() = Array() .TraceLogCount = 0 .TraceLogLast = 0 End With GoTo Exit_Sub End Sub |
Access2BaseDev |
Trace |
TraceLog |
Basic |
OpenConnection (Procedure) OpenDatabase (Procedure) TraceError (Procedure) OpenForm (Procedure) _ResetCalledSub (Procedure) _SetCalledSub (Procedure) DebugPrint (Procedure) CloseConnection (Procedure) |
53 |
Public Sub TraceLog(Byval psTraceLevel As String _ , ByVal psText As String _ , ByVal Optional pbMsgBox As Boolean _ )
If _ErrorHandler() Then On Local Error Goto Error_Sub Dim vTraceLogs() As String, sTraceLevel As String
With _A2B_ If .MinimalTraceLevel = 0 Then .MinimalTraceLevel = _TraceLevel(TRACEERRORS) If _TraceLevel(psTraceLevel) < .MinimalTraceLevel Then Exit Sub
If UBound(.TraceLogs) = -1 Then If .TraceLogMaxEntries = 0 Then .TraceLogMaxEntries = cstLogMaxEntries Redim vTraceLogs(0 To .TraceLogMaxEntries - 1) .TraceLogs = vTraceLogs .TraceLogCount = 0 .TraceLogLast = -1 If .MinimalTraceLevel = 0 Then .MinimalTraceLevel = _TraceLevel(TRACEERRORS) End If .TraceLogLast = .TraceLogLast + 1 If .TraceLogLast > UBound(.TraceLogs) Then .TraceLogLast = LBound(.TraceLogs) If Len(psTraceLevel) > 7 Then sTraceLevel = Left(psTraceLevel, 7) Else sTraceLevel = psTraceLevel & Spc(8 - Len(psTraceLevel)) .TraceLogs(.TraceLogLast) = Format(Now(), "YYYY-MM-DD hh:mm:ss") & " " & sTraceLevel & psText If .TraceLogCount <= UBound(.TraceLogs) Then .TraceLogCount = .TraceLogCount + 1 End With If IsMissing(pbMsgBox) Then pbMsgBox = True Dim iMsgBox As Integer If pbMsgBox Then Select Case psTraceLevel Case TRACEINFO: iMsgBox = vbInformation Case TRACEERRORS, TRACEWARNING: iMsgBox = vbExclamation Case TRACEFATAL, TRACEABORT: iMsgBox = vbCritical Case Else: iMsgBox = vbInformation End Select MsgBox psText, vbOKOnly + iMsgBox, psTraceLevel End If
Exit_Sub: Exit Sub Error_Sub: With _A2B_ .TraceLogs() = Array() .TraceLogCount = 0 .TraceLogLast = 0 End With GoTo Exit_Sub End Sub |
Access2BaseDev |
UtilProperty |
_CheckPropertyValue |
Basic |
_MakePropertyValue (Procedure) _SetPropertyValue (Procedure) |
14 |
Public Function _CheckPropertyValue(ByRef pvValue As Variant) As Variant
If VarType(pvValue) = vbDate Then _CheckPropertyValue = Utils._CStr(pvValue, False) ElseIf IsArray(pvValue) Then If UBound(pvValue, 1) < LBound(pvValue, 1) Then _CheckPropertyValue = cstEMPTYARRAY Else _CheckPropertyValue = pvValue Else _CheckPropertyValue = pvValue End If
End Function |
Access2BaseDev |
UtilProperty |
_DeleteIndexedProperty |
Basic |
_DeleteProperty (Procedure) |
26 |
Public Sub _DeleteIndexedProperty(ByRef pvPropertyValuesArray As Variant, ByVal piPropIndex As Integer)
Dim iNumProperties As Integer, i As Integer iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
If piPropIndex < 0 Then ElseIf iNumProperties = 1 Then pvPropertyValuesArray = Array() Else If piPropIndex < iNumProperties - 1 Then For i = piPropIndex To iNumProperties - 2 pvPropertyValuesArray(i) = pvPropertyValuesArray(i + 1) Next i EndIf Redim Preserve pvPropertyValuesArray(iNumProperties - 2) EndIf
End Sub |
Access2BaseDev |
UtilProperty |
_DeleteProperty |
Basic |
|
9 |
Public Sub _DeleteProperty(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String)
Dim iPropIndex As Integer iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName) If iPropIndex >= 0 Then _DeleteIndexedProperty(pvPropertyValuesArray, iPropIndex)
End Sub |
Access2BaseDev |
UtilProperty |
_FindProperty |
Basic |
|
13 |
Public Function _FindProperty(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String) As com.sun.star.beans.PropertyValue
Dim iPropIndex As Integer, vProp As Variant iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName) If iPropIndex >= 0 Then vProp = pvPropertyValuesArray(iPropIndex) _FindProperty() = vProp EndIf
End Function |
Access2BaseDev |
UtilProperty |
_FindPropertyIndex |
Basic |
_FindProperty (Procedure) _GetPropertyValue (Procedure) _SetPropertyValue (Procedure) _DeleteProperty (Procedure) |
17 |
Public Function _FindPropertyIndex(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String ) As Integer
Dim iNumProperties As Integer, i As Integer, vProp As Variant iNumProperties = _NumPropertyValues(pvPropertyValuesArray) For i = 0 To iNumProperties - 1 vProp = pvPropertyValuesArray(i) If UCase(vProp.Name) = UCase(psPropName) Then _FindPropertyIndex() = i Exit Function EndIf Next i _FindPropertyIndex() = -1
End Function |
Access2BaseDev |
UtilProperty |
_GetPropertyValue |
Basic |
CommandBars (Procedure) CommandBarControls (Procedure) Execute (Procedure) _PropertyGet (Procedure) |
34 |
Public Function _GetPropertyValue(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String, Optional pvDefaultValue) As Variant
Dim iPropIndex As Integer, vProp As Variant, vValue As Variant, vMatrix As Variant, i As Integer, j As Integer iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName) If iPropIndex >= 0 Then vProp = pvPropertyValuesArray(iPropIndex) vValue = vProp.Value If VarType(vValue) = vbString Then If vValue = cstEMPTYARRAY Then _GetPropertyValue() = Array() Else _GetPropertyValue() = vValue ElseIf IsArray(vValue) Then If IsArray(vValue(0)) Then vMatrix = Array() ReDim vMatrix(0 To UBound(vValue), 0 To UBound(vValue(0))) For i = 0 To UBound(vValue) For j = 0 To UBound(vValue(0)) vMatrix(i, j) = vValue(i)(j) Next j Next i _GetPropertyValue() = vMatrix Else _GetPropertyValue() = vValue End If Else _GetPropertyValue() = vValue End If Else If IsMissing(pvDefaultValue) Then pvDefaultValue = Null _GetPropertyValue() = pvDefaultValue EndIf
End Function |
Access2BaseDev |
UtilProperty |
_MakePropertyValue |
Basic |
OutputTo (Procedure) _OutputToCalc (Procedure) _SetPropertyValue (Procedure) |
11 |
Public Function _MakePropertyValue(ByVal Optional psName As String, Optional pvValue As Variant) As com.sun.star.beans.PropertyValue
Dim oPropertyValue As New com.sun.star.beans.PropertyValue
If Not IsMissing(psName) Then oPropertyValue.Name = psName If Not IsMissing(pvValue) Then oPropertyValue.Value = _CheckPropertyValue(pvValue) _MakePropertyValue() = oPropertyValue End Function |
Access2BaseDev |
UtilProperty |
_NumPropertyValues |
Basic |
_FindPropertyIndex (Procedure) _SetPropertyValue (Procedure) _DeleteIndexedProperty (Procedure) _PropValuesToStr (Procedure) |
12 |
Public Function _NumPropertyValues(ByRef pvPropertyValuesArray As Variant) As Integer
Dim iNumProperties As Integer If Not IsArray(pvPropertyValuesArray) Then iNumProperties = 0 Else iNumProperties = UBound(pvPropertyValuesArray) + 1 _NumPropertyValues() = iNumProperties
End Function |
Access2BaseDev |
UtilProperty |
_PropValuesToStr |
Basic |
|
47 |
Public Function _PropValuesToStr(ByRef pvPropertyValuesArray As Variant) As String
Dim iNumProperties As Integer, sResult As String, i As Integer, j As Integer, vProp As Variant Dim sName As String, vValue As Variant, iType As Integer Dim cstLF As String
cstLF = vbLf() iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
sResult = cstHEADER & cstLF For i = 0 To iNumProperties - 1 vProp = pvPropertyValuesArray(i) sName = vProp.Name vValue = vProp.Value iType = VarType(vValue) Select Case iType Case < vbArray sResult = sResult & sName & " = " & Utils._CStr(vValue, False) & cstLF Case Else If uBound(vValue, 1) < 0 Then sResult = sResult & sName & " = (0)" & cstLF ElseIf VarType(vValue(0)) >= vbArray Then sResult = sResult & sName & " = (" & UBound(vValue) + 1 & "," & UBound(vValue(0)) + 1 & ")" & cstLF For j = 0 To UBound(vValue) sResult = sResult & Utils._CStr(vValue(j), False) & cstLF Next j Else sResult = sResult & sName & " = (" & UBound(vValue, 1) + 1 & ")" & cstLF sResult = sResult & Utils._CStr(vValue, False) & cstLF End If End Select Next i
_PropValuesToStr() = Left(sResult, Len(sResult) - 1) End Function |
Access2BaseDev |
UtilProperty |
_SetPropertyValue |
Basic |
_StrToPropValues (Procedure) _PropertySet (Procedure) |
26 |
Public Sub _SetPropertyValue(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String, ByVal pvValue As Variant)
Dim iPropIndex As Integer, vProp As Variant, iNumProperties As Integer
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName) If iPropIndex >= 0 Then vProp = pvPropertyValuesArray(iPropIndex) vProp.Value = _CheckPropertyValue(pvValue) pvPropertyValuesArray(iPropIndex) = vProp Else iNumProperties = _NumPropertyValues(pvPropertyValuesArray) If iNumProperties = 0 Then pvPropertyValuesArray = Array(_MakePropertyValue(psPropName, pvValue)) Else Redim Preserve pvPropertyValuesArray(iNumProperties) pvPropertyValuesArray(iNumProperties) = _MakePropertyValue(psPropName, pvValue) EndIf EndIf
End Sub |
Access2BaseDev |
UtilProperty |
_StrToPropValues |
Basic |
|
74 |
Public Function _StrToPropValues(psString) As Variant
Dim vString() As Variant, i As Integer,iArray As Integer, iRows As Integer, iCols As Integer Dim lPosition As Long, sName As String, vValue As Variant, vResult As Variant, sDim As String Dim lSearch As Long Dim cstLF As String Const cstEqualArray = " = (", cstEqual = " = "
cstLF = Chr(10) _StrToPropValues = Array() vResult = Array() If psString = "" Then Exit Function vString = Split(psString, cstLF) If UBound(vString) <= 0 Then Exit Function If vString(0) <> cstHEADER Then Exit Function iArray = -1 For i = 1 To UBound(vString) If vString(i) <> "" Then If iArray < 0 Then lPosition = 1 sName = Utils._RegexSearch(vString(i), "^\b\w+\b", lPosition) If sName = "" Then Exit Function If InStr(vString(i), cstEqualArray) = lPosition + Len(sName) Then lSearch = lPosition + Len(sName) + Len(cstEqualArray) - 1 sDim = Utils._RegexSearch(vString(i), "\([0-9]+\)", lSearch) If sDim = "(0)" Then iRows = -1 vValue = Array() _SetPropertyValue(vResult, sName, vValue) ElseIf sDim <> "" Then iCols = CInt(Mid(sDim, 2, Len(sDim) - 2)) iRows = 0 ReDim vValue(0 To iCols - 1) iArray = 0 Else lSearch = lPosition + Len(sName) + Len(cstEqualArray) - 1 sDim = Utils._RegexSearch(vString(i), "\([0-9]+,", lSearch) iRows = CInt(Mid(sDim, 2, Len(sDim) - 2)) sDim = Utils._RegexSearch(vString(i), ",[0-9]+\)", lSearch) iCols = CInt(Mid(sDim, 2, Len(sDim) - 2)) ReDim vValue(0 To iRows - 1) iArray = 0 End If ElseIf InStr(vString(i), cstEqual) = lPosition + Len(sName) Then vValue = Utils._CVar(Mid(vString(i), Len(sName) + Len(cstEqual) + 1)) _SetPropertyValue(vResult, sName, vValue) Else Exit Function End If Else If iRows = 0 Then vValue = Utils._CVar(vString(i), True) iArray = -1 _SetPropertyValue(vResult, sName, vValue) Else vValue(iArray) = Utils._CVar(vString(i), True) If iArray < iRows - 1 Then iArray = iArray + 1 Else iArray = -1 _SetPropertyValue(vResult, sName, vValue) End If End If End If End If Next i _StrToPropValues = vResult
End Function |
Access2BaseDev |
Utils |
_AddArray |
Basic |
_OutputDataToHTML (Procedure) |
10 |
Public Function _AddArray(ByVal pvArray As Variant, pvItem As Variant) As Variant
Dim vArray() As Variant If IsArray(pvArray) Then vArray = pvArray Else vArray = Array() ReDim Preserve vArray(LBound(vArray) To UBound(vArray) + 1) vArray(UBound(vArray)) = pvItem _AddArray() = vArray()
End Function |
Access2BaseDev |
Utils |
_AddNumeric |
Basic |
AllDialogs (Procedure) AllForms (Procedure) AllModules (Procedure) CommandBars (Procedure) Controls (Procedure) Forms (Procedure) HtmlEncode (Procedure) SysCmd (Procedure) TempVars (Procedure) mClose (Procedure) CopyObject (Procedure) FindRecord (Procedure) GetHiddenAttribute (Procedure) GoToRecord (Procedure) MoveSize (Procedure) OpenForm (Procedure) OpenSQL (Procedure) OutputTo (Procedure) Quit (Procedure) RunCommand (Procedure) RunSQL (Procedure) SelectObject (Procedure) SendObject (Procedure) SetHiddenAttribute (Procedure) _CheckColumnType (Procedure) _OpenObject (Procedure) CreateQueryDef (Procedure) OpenRecordset (Procedure) OpenSQL (Procedure) OutputTo (Procedure) QueryDefs (Procedure) Recordsets (Procedure) RunSQL (Procedure) TableDefs (Procedure) _setProperty (Procedure) Item (Procedure) _getProperty (Procedure) _Properties (Procedure) Controls (Procedure) Move (Procedure) _PropertySet (Procedure) DebugPrint (Procedure) Controls (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Controls (Procedure) _PropertySet (Procedure) AddItem (Procedure) Controls (Procedure) RemoveItem (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Controls (Procedure) EndExecute (Procedure) Move (Procedure) _PropertySet (Procedure) GetChunk (Procedure) _PropertySet (Procedure) CreateField (Procedure) Execute (Procedure) Fields (Procedure) OpenRecordset (Procedure) Fields (Procedure) GetRows (Procedure) Move (Procedure) OpenRecordset (Procedure) _PropertySet (Procedure) CommandBarControls (Procedure) _PropertySet (Procedure) Lines (Procedure) ProcBodyLine (Procedure) ProcCountLines (Procedure) ProcOfLine (Procedure) ProcStartLine (Procedure) Find (Procedure) |
25 |
Public Function _AddNumeric(ByVal Optional pvTypes As Variant) As Variant
Dim i As Integer, vNewList() As Variant, vNumeric() As Variant, iSize As Integer If IsMissing(pvTypes) Then vNewList = Array() ElseIf IsArray(pvTypes) Then vNewList = pvTypes Else vNewList = Array(pvTypes) End If vNumeric = Array(vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal, vbBoolean) iSize = UBound(vNewlist) ReDim Preserve vNewList(iSize + UBound(vNumeric) + 1) For i = 0 To UBound(vNumeric) vNewList(iSize + i + 1) = vNumeric(i) Next i _AddNumeric = vNewList
End Function |
Access2BaseDev |
Utils |
_BitShift |
Basic |
_Initialize (Procedure) |
28 |
Public Function _BitShift(piValue As Integer, piConstant As Integer) As Boolean
_BitShift = False If piValue = 0 Then Exit Function Select Case piConstant Case 1 Select Case piValue Case 1, 3, 5, 7, 9, 11, 13, 15: _BitShift = True Case Else End Select Case 2 Select Case piValue Case 2, 3, 6, 7, 10, 11, 14, 15: _BitShift = True Case Else End Select Case 4 Select Case piValue Case 4, 5, 6, 7, 12, 13, 14, 15: _BitShift = True Case Else End Select Case 8 Select Case piValue Case 8, 9, 10, 11, 12, 13, 14, 15: _BitShift = True Case Else End Select End Select
End Function |
Access2BaseDev |
Utils |
_CalledSub |
Basic |
AllDialogs (Procedure) AllForms (Procedure) AllModules (Procedure) CommandBars (Procedure) Events (Procedure) Forms (Procedure) OpenConnection (Procedure) OpenDatabase (Procedure) SysCmd (Procedure) TempVars (Procedure) _CurrentDb (Procedure) SetFocus (Procedure) _OptionGroup (Procedure) _TraceArguments (Procedure) ApplyFilter (Procedure) mClose (Procedure) CopyObject (Procedure) FindNext (Procedure) FindRecord (Procedure) GetHiddenAttribute (Procedure) GoToRecord (Procedure) MoveSize (Procedure) OpenForm (Procedure) OutputTo (Procedure) Quit (Procedure) RunCommand (Procedure) SelectObject (Procedure) SendObject (Procedure) SetHiddenAttribute (Procedure) SetOrderBy (Procedure) ShowAllrecords (Procedure) _ConvertDataDescriptor (Procedure) _DatabaseForm (Procedure) _OpenObject (Procedure) _SendWithAttachment (Procedure) _CheckArgument (Procedure) mClose (Procedure) CreateQueryDef (Procedure) CreateTableDef (Procedure) OpenRecordset (Procedure) OpenSQL (Procedure) OutputTo (Procedure) QueryDefs (Procedure) Recordsets (Procedure) RunSQL (Procedure) TableDefs (Procedure) _PropertyGet (Procedure) _setProperty (Procedure) Item (Procedure) Add (Procedure) Delete (Procedure) Remove (Procedure) RemoveAll (Procedure) _PropertyGet (Procedure) getObject (Procedure) _getProperty (Procedure) _Properties (Procedure) mClose (Procedure) Controls (Procedure) Move (Procedure) _Initialize (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Controls (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Controls (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _PropertyGet (Procedure) _PropertyGet (Procedure) AddItem (Procedure) Controls (Procedure) RemoveItem (Procedure) Requery (Procedure) setFocus (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) OptionGroup (Procedure) Controls (Procedure) EndExecute (Procedure) Execute (Procedure) Move (Procedure) Start (Procedure) Terminate (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) AppendChunk (Procedure) GetChunk (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _ReadAll (Procedure) _WriteAll (Procedure) CreateField (Procedure) Execute (Procedure) Fields (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) AddNew (Procedure) Clone (Procedure) Delete (Procedure) Edit (Procedure) Fields (Procedure) GetRows (Procedure) OpenRecordset (Procedure) Update (Procedure) _Initialize (Procedure) _Move (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) CurrentDocIndex (Procedure) _CurrentDb (Procedure) CommandBarControls (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _FindProcIndex (Procedure) _PropertyGet (Procedure) |
4 |
Public Function _CalledSub() As String _CalledSub = Iif(_A2B_.CalledSub = "", "", _GetLabel("CALLTO") & " '" & _A2B_.CalledSub & "'") End Function |
Access2BaseDev |
Utils |
_CheckArgument |
Basic |
AllDialogs (Procedure) AllForms (Procedure) AllModules (Procedure) CommandBars (Procedure) Controls (Procedure) Events (Procedure) Forms (Procedure) HtmlEncode (Procedure) OpenConnection (Procedure) OpenDatabase (Procedure) SysCmd (Procedure) TempVars (Procedure) AddItem (Procedure) hasProperty (Procedure) Move (Procedure) Properties (Procedure) Refresh (Procedure) RemoveItem (Procedure) Requery (Procedure) SetFocus (Procedure) _OptionGroup (Procedure) ApplyFilter (Procedure) mClose (Procedure) CopyObject (Procedure) FindRecord (Procedure) GetHiddenAttribute (Procedure) GoToControl (Procedure) GoToRecord (Procedure) MoveSize (Procedure) OpenForm (Procedure) OpenSQL (Procedure) OutputTo (Procedure) Quit (Procedure) RunApp (Procedure) RunCommand (Procedure) RunSQL (Procedure) SelectObject (Procedure) SendObject (Procedure) SetHiddenAttribute (Procedure) SetOrderBy (Procedure) _OpenObject (Procedure) CreateQueryDef (Procedure) CreateTableDef (Procedure) OpenRecordset (Procedure) OpenSQL (Procedure) OutputTo (Procedure) QueryDefs (Procedure) Recordsets (Procedure) RunSQL (Procedure) TableDefs (Procedure) _setProperty (Procedure) Item (Procedure) Add (Procedure) Delete (Procedure) Remove (Procedure) getObject (Procedure) getOptionGroup (Procedure) _getProperty (Procedure) _hasProperty (Procedure) _Properties (Procedure) Controls (Procedure) Move (Procedure) _PropertySet (Procedure) DebugPrint (Procedure) Controls (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Controls (Procedure) _PropertySet (Procedure) AddItem (Procedure) Controls (Procedure) RemoveItem (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) OptionGroup (Procedure) Controls (Procedure) EndExecute (Procedure) Move (Procedure) _PropertySet (Procedure) GetChunk (Procedure) ReadAllBytes (Procedure) ReadAllText (Procedure) WriteAllBytes (Procedure) WriteAllText (Procedure) _PropertySet (Procedure) CreateField (Procedure) Execute (Procedure) Fields (Procedure) OpenRecordset (Procedure) _PropertySet (Procedure) Fields (Procedure) GetRows (Procedure) Move (Procedure) OpenRecordset (Procedure) _PropertySet (Procedure) CommandBarControls (Procedure) _PropertySet (Procedure) _PropertySet (Procedure) Lines (Procedure) ProcBodyLine (Procedure) ProcCountLines (Procedure) ProcOfLine (Procedure) ProcStartLine (Procedure) Find (Procedure) |
36 |
Public Function _CheckArgument(pvItem As Variant _ , ByVal piArgNr As Integer _ , Byval pvType As Variant _ , ByVal Optional pvValid As Variant _ , ByVal Optional pvError As Boolean _ ) As Variant
_CheckArgument = False Dim iVarType As Integer If IsArray(pvType) Then iVarType = VarType(pvType(LBound(pvType))) Else iVarType = VarType(pvType) If iVarType = vbString Then _CheckArgument = Utils._IsPseudo(pvItem, pvType) Else If IsMissing(pvValid) Then _CheckArgument = Utils._IsScalar(pvItem, pvType) Else _CheckArgument = Utils._IsScalar(pvItem, pvType, pvValid) End If If VarType(pvItem) = vbCurrency Or VarType(pvItem) = vbDecimal Or VarType(pvItem) = vbBigint Then pvItem = CDbl(pvItem)
Exit_Function: If Not _CheckArgument Then If IsMissing(pvError) Then pvError = True If pvError Then TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(piArgNr, pvItem)) End If End If Exit Function End Function |
Access2BaseDev |
Utils |
_CStr |
Basic |
Events (Procedure) _ErrorMessage (Procedure) _OutputDataToHTML (Procedure) DebugPrint (Procedure) EndExecute (Procedure) GetRows (Procedure) _CheckPropertyValue (Procedure) _PropValuesToStr (Procedure) |
80 |
Public Function _CStr(ByVal pvArg As Variant, ByVal Optional pbShort As Boolean) As String
Dim sArg As String, sObject As String, oArg As Object, sLength As String, i As Long, iMax As Long Const cstLength = 50 Const cstByteLength = 25
If IsMissing(pbShort) Then pbShort = True If IsArray(pvArg) Then sArg = "" If VarType(pvArg) = vbByte Or VarType(pvArg) = vbArray + vbByte Then If pbShort And UBound(pvArg) > cstByteLength Then iMax = cstByteLength Else iMax = UBound(pvArg) For i = 0 To iMax sArg = sArg & Right("00" & Hex(pvArg(i)), 2) Next i Else If pbShort Then sArg = "[ARRAY]" Else For i = LBound(pvArg) To UBound(pvArg) sArg = sArg & Utils._CStr(pvArg(i), pbShort) & ";" Next i If Len(sArg) > 1 Then sArg = Left(sArg, Len(sArg) - 1) End If End If Else Select Case VarType(pvArg) Case vbEmpty : sArg = "[EMPTY]" Case vbNull : sArg = "[NULL]" Case vbObject If IsNull(pvArg) Then sArg = "[NULL]" Else sObject = Utils._ImplementationName(pvArg) If Utils._IsPseudo(pvArg, Array(OBJDATABASE, OBJCOLLECTION, OBJPROPERTY, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP _ , OBJEVENT, OBJFIELD, OBJTABLEDEF, OBJQUERYDEF, OBJRECORDSET, OBJTEMPVAR, OBJCOMMANDBAR, OBJCOMMANDBARCONTROL _ , OBJDIALOG _ )) Then Set oArg = pvArg sArg = "[" & oArg._Type & "] " & oArg._Name ElseIf sObject <> "" Then sArg = "[" & sObject & "]" Else sArg = "[OBJECT]" End If End If Case vbVariant : sArg = "[VARIANT]" Case vbString sArg = Replace( _ Replace( _ Replace( _ Replace( _ Replace(pvArg, "\", "\\") _ , Chr(13), "") _ , Chr(10), "\n") _ , Chr(9), "\t") _ , ";", "\;") Case vbBoolean : sArg = Iif(pvArg, "[TRUE]", "[FALSE]") Case vbByte : sArg = Right("00" & Hex(pvArg), 2) Case vbSingle, vbDouble, vbCurrency sArg = Format(pvArg) If InStr(UCase(sArg), "E") = 0 Then sArg = Format(pvArg, "##0.0##") sArg = Replace(sArg, ",", ".") Case vbBigint : sArg = CStr(CLng(pvArg)) Case vbDate : sArg = Year(pvArg) & "-" & Right("0" & Month(pvArg), 2) & "-" & Right("0" & Day(pvArg), 2) _ & " " & Right("0" & Hour(pvArg), 2) & ":" & Right("0" & Minute(pvArg), 2) Case Else : sArg = CStr(pvArg) End Select End If If pbShort And Len(sArg) > cstLength Then sLength = "(" & Len(sArg) & ")" sArg = Left(sArg, cstLength - 5 - Len(slength)) & " ... " & sLength End If _CStr = sArg End Function |
Access2BaseDev |
Utils |
_CVar |
Basic |
_StrToPropValues (Procedure) |
57 |
Public Function _CVar(ByRef psArg As String, ByVal Optional pbStrDate As Boolean) As Variant
Dim cstEscape1 As String, cstEscape2 As String cstEscape1 = Chr(14) cstEscape2 = Chr(27) _CVar = "" If Len(psArg) = 0 Then Exit Function
Dim sArg As String, vArgs() As Variant, vVars() As Variant, i As Integer If IsMissing(pbStrDate) Then pbStrDate = False sArg = Replace( _ Replace( _ Replace( _ Replace(psArg, "\\", cstEscape1) _ , "\;", cstEscape2) _ , "\n", Chr(10)) _ , "\t", Chr(9))
vArgs = Split(sArg, ";") If UBound(vArgs) > LBound(vArgs) Then vVars = Array() Redim vVars(LBound(vArgs) To UBound(vArgs)) For i = LBound(vVars) To UBound(vVars) vVars(i) = _CVar(vArgs(i), pbStrDate) Next i _CVar = vVars Exit Function End If
Select Case True Case sArg = "[EMPTY]" : _CVar = EMPTY Case sArg = "[NULL]" Or sArg = "[VARIANT]" : _CVar = Null Case sArg = "[OBJECT]" : _CVar = Nothing Case sArg = "[TRUE]" : _CVar = True Case sArg = "[FALSE]" : _CVar = False Case IsDate(sArg) If pbStrDate Then _CVar = sArg Else _CVar = CDate(sArg) Case IsNumeric(sArg) If InStr(sArg, ".") > 0 Then _CVar = Val(sArg) Else _CVar = CLng(Val(sArg)) End If Case _RegexSearch(sArg, "^[-+]?[0-9]*\.?[0-9]+(e[-+]?[0-9]+)?$") <> "" _CVar = Val(sArg) Case Else : _CVar = Replace(Replace(sArg, cstEscape1, "\"), cstEscape2, ";") End Select
End Function |
Access2BaseDev |
Utils |
_DecimalPoint |
Basic |
_FilterOptionsDefault (Procedure) _PropertyGet (Procedure) |
5 |
Public Function _DecimalPoint() As String _DecimalPoint = Mid(Format(0, "0.0"), 2, 1) End Function |
Access2BaseDev |
Utils |
_ExtensionLocation |
Basic |
|
10 |
Private Function _ExtensionLocation() As String
Dim oPip As Object, sLocation As String Set oPip = GetDefaultContext.getByName("/singletons/com.sun.star.deployment.PackageInformationProvider") _ExtensionLocation = oPip.getPackageLocation("Access2Base") End Function |
Access2BaseDev |
Utils |
_FinalProperty |
Basic |
setValue (Procedure) getValue (Procedure) |
21 |
Public Function _FinalProperty(psShortcut As String) As String
Const cstEXCLAMATION = "!" Const cstDOT = "."
Dim iCurrentIndex As Integer, vCurrentObject As Variant, sCurrentProperty As String Dim sComponents() As String, sSubComponents() As String _FinalProperty = "" sComponents = Split(Trim(psShortcut), cstEXCLAMATION) If UBound(sComponents) = 0 Then Exit Function sSubComponents = Split(sComponents(UBound(sComponents)), cstDOT) Select Case UBound(sSubComponents) Case 1 _FinalProperty = sSubComponents(1) Case Else Exit Function End Select End Function |
Access2BaseDev |
Utils |
_GetDialogLib |
Basic |
TraceConsole (Procedure) _PromptFormat (Procedure) |
18 |
Private Function _GetDialogLib() As Object
Dim oDialogLib As Object Set oDialogLib = DialogLibraries If oDialogLib.hasByName("Access2BaseDev") Then If Not oDialogLib.IsLibraryLoaded("Access2BaseDev") Then oDialogLib.loadLibrary("Access2BaseDev") Set _GetDialogLib = DialogLibraries.Access2BaseDev ElseIf oDialogLib.hasByName("Access2Base") Then If Not oDialogLib.IsLibraryLoaded("Access2Base") Then oDialogLib.loadLibrary("Access2Base") Set _GetDialogLib = DialogLibraries.Access2Base Else Set _GetDialogLib = Nothing EndIf
End Function |
Access2BaseDev |
Utils |
_GetEventName |
Basic |
_GetEventScriptCode (Procedure) _RegisterDialogEventScript (Procedure) _RegisterEventScript (Procedure) _PropertyGet (Procedure) _PropertyGet (Procedure) |
8 |
Public Function _GetEventName(ByVal psProperty As String) As String
_GetEventName = Replace(LCase(Mid(psProperty, 3, 1)) & Right(psProperty, Len(psProperty) - 3), "errorOccurred", "errorOccured") End Function |
Access2BaseDev |
Utils |
_GetEventScriptCode |
Basic |
_PropertyGet (Procedure) _PropertyGet (Procedure) _PropertyGet (Procedure) |
38 |
Public Function _GetEventScriptCode(poObject As Object _ , ByVal psEvent As String _ , ByVal psName As String _ , Optional ByVal pbExtendName As Boolean _ ) As String
Dim i As Integer, vEvents As Variant, sEvent As String, oParent As Object, iIndex As Integer, sName As String
_GetEventScriptCode = "" If Not Utils._hasUNOMethod(poObject, "getParent") Then Exit Function
If IsMissing(pbExtendName) Then pbExtendName = False Set oParent = poObject.getParent() iIndex = -1 For i = 0 To oParent.getCount() - 1 sName = oParent.getByIndex(i).Name If (sName = psName) Or (pbExtendName And (sName = "MainForm" Or sName = "Form")) Then iIndex = i Exit For End If Next i If iIndex < 0 Then Exit Function vEvents = oParent.getScriptEvents(iIndex) sEvent = Utils._GetEventName(psEvent) For i = 0 To UBound(vEvents) If vEvents(i).EventMethod = sEvent Then _GetEventScriptCode = vEvents(i).ScriptCode Exit For End If Next i
End Function |
Access2BaseDev |
Utils |
_GetProductName |
Basic |
OpenConnection (Procedure) OpenDatabase (Procedure) Version (Procedure) _SendWithAttachment (Procedure) |
18 |
Public Function _GetProductName(ByVal Optional psFlag As String) as String
Dim oProdNameAccess as Object Dim sVersion as String Dim sProdName as String If IsMissing(psFlag) Then psFlag = "ALL" oProdNameAccess = _GetRegistryKeyContent("org.openoffice.Setup/Product") sProdName = oProdNameAccess.getByName("ooName") sVersion = oProdNameAccess.getByName("ooSetupVersionAboutBox") Select Case psFlag Case "ALL" : _GetProductName = sProdName & " " & sVersion Case "PRODUCT" : _GetProductName = sProdName Case "VERSION" : _GetProductName = sVersion End Select End Function |
Access2BaseDev |
Utils |
_GetRandomFileName |
Basic |
CopyObject (Procedure) _AppendChunk (Procedure) |
9 |
Public Function _GetRandomFileName(ByVal psName As String) As String
Dim sRandom As String sRandom = Right("000000" & Int(999999 * Rnd), 6) _GetRandomFileName = Utils._getTempDirectoryURL() & "/" & "A2B_TEMP_" & psName & "_" & sRandom
End Function |
Access2BaseDev |
Utils |
_GetRegistryKeyContent |
Basic |
_GetProductName (Procedure) _GetLocale (Procedure) |
17 |
Public Function _GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean) As Variant
Dim oConfigProvider as Object Dim aNodePath(0) as new com.sun.star.beans.PropertyValue oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider") aNodePath(0).Name = "nodepath" aNodePath(0).Value = sKeyName If IsMissing(bForUpdate) Then bForUpdate = False If bForUpdate Then _GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", aNodePath()) Else _GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath()) End If End Function |
Access2BaseDev |
Utils |
_GetResultSetColumnValue |
Basic |
CopyObject (Procedure) FindNext (Procedure) _DFunction (Procedure) GetRows (Procedure) |
88 |
Private Function _GetResultSetColumnValue(poResultSet As Object _ , ByVal piColIndex As Integer _ , Optional ByVal pbReturnBinary As Boolean _ ) As Variant Dim vValue As Variant, iType As Integer, vDateTime As Variant, oValue As Object Dim bNullable As Boolean, lSize As Long Const cstMaxTextLength = 65535 Const cstMaxBinlength = 2 * 65535
On Local Error Goto 0 vValue = Null If IsMissing(pbReturnBinary) Then pbReturnBinary = False With com.sun.star.sdbc.DataType iType = poResultSet.MetaData.getColumnType(piColIndex) bNullable = ( poResultSet.MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE ) Select Case iType Case .ARRAY : vValue = poResultSet.getArray(piColIndex) Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB Set oValue = poResultSet.getBinaryStream(piColIndex) If bNullable Then If Not poResultSet.wasNull() Then If Not _hasUNOMethod(oValue, "getLength") Then lSize = cstMaxBinLength Else lSize = CLng(oValue.getLength()) End If If lSize <= cstMaxBinLength And pbReturnBinary Then vValue = Array() oValue.readBytes(vValue, lSize) Else vValue = lSize End If End If End If oValue.closeInput() Case .BIT, .BOOLEAN : vValue = poResultSet.getBoolean(piColIndex) Case .DATE : vDateTime = poResultSet.getDate(piColIndex) If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) Case .DISTINCT, .OBJECT, .OTHER, .STRUCT vValue = Null Case .DOUBLE, .REAL : vValue = poResultSet.getDouble(piColIndex) Case .FLOAT : vValue = poResultSet.getFloat(piColIndex) Case .INTEGER, .SMALLINT : vValue = poResultSet.getInt(piColIndex) Case .BIGINT : vValue = poResultSet.getLong(piColIndex) Case .DECIMAL, .NUMERIC : vValue = poResultSet.getDouble(piColIndex) Case .SQLNULL : vValue = poResultSet.getNull(piColIndex) Case .OBJECT, .OTHER, .STRUCT : vValue = Null Case .REF : vValue = poResultSet.getRef(piColIndex) Case .TINYINT : vValue = poResultSet.getShort(piColIndex) Case .CHAR, .VARCHAR : vValue = poResultSet.getString(piColIndex) Case .LONGVARCHAR, .CLOB Set oValue = poResultSet.getCharacterStream(piColIndex) If bNullable Then If Not poResultSet.wasNull() Then If Not _hasUNOMethod(oValue, "getLength") Then lSize = cstMaxTextLength Else lSize = CLng(oValue.getLength()) End If oValue.closeInput() vValue = poResultSet.getString(piColIndex) End If Else oValue.closeInput() End If Case .TIME : vDateTime = poResultSet.getTime(piColIndex) If Not poResultSet.wasNull() Then vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds) Case .TIMESTAMP : vDateTime = poResultSet.getTimeStamp(piColIndex) If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _ + TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds) Case Else vValue = poResultSet.getString(piColIndex) If IsNumeric(vValue) Then vValue = Val(vValue) End Select If bNullable Then If poResultSet.wasNull() Then vValue = Null End If End With _GetResultSetColumnValue = vValue End Function |
Access2BaseDev |
Utils |
_getTempDirectoryURL |
Basic |
SendObject (Procedure) _GetRandomFileName (Procedure) |
20 |
Public Function _getTempDirectoryURL() As String Dim sDirectory As String, oSettings As Object, oPathSettings As Object
If _ErrorHandler() Then On Local Error Goto Error_Function _getTempDirectoryURL = "" oPathSettings = createUnoService( "com.sun.star.util.PathSettings" ) sDirectory = oPathSettings.GetPropertyValue( "Temp" ) _getTempDirectoryURL = sDirectory
Exit_Function: Exit Function Error_Function: TraceError("ERROR", Err, "_getTempDirectoryURL", Erl) _getTempDirectoryURL = "" Goto Exit_Function End Function |
Access2BaseDev |
Utils |
_getUNOTypeName |
Basic |
_ImplementationName (Procedure) _Initialize (Procedure) |
16 |
Public Function _getUNOTypeName(pvObject As Variant) As String
Dim oService As Object, vClass as Variant _getUNOTypeName = "" On Local Error Resume Next oService = CreateUnoService("com.sun.star.reflection.CoreReflection") vClass = oService.getType(pvObject) If vClass.TypeClass = com.sun.star.uno.TypeClass.STRUCT Then _getUNOTypeName = vClass.Name End If oService.Dispose()
End Function |
Access2BaseDev |
Utils |
_hasUNOMethod |
Basic |
_NewBar (Procedure) _GetEventScriptCode (Procedure) _GetResultSetColumnValue (Procedure) _RegisterDialogEventScript (Procedure) _RegisterEventScript (Procedure) _PropertySet (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) |
13 |
Public Function _hasUNOMethod(pvObject As Variant, psMethod As String) As Boolean
Dim vInspect as Variant _hasUNOMethod = False If IsNull(pvObject) Then Exit Function On Local Error Resume Next vInspect = _A2B_.Introspection.Inspect(pvObject) _hasUNOMethod = vInspect.hasMethod(psMethod, com.sun.star.beans.MethodConcept.ALL)
End Function |
Access2BaseDev |
Utils |
_hasUNOProperty |
Basic |
Events (Procedure) OpenConnection (Procedure) Maximize (Procedure) Minimize (Procedure) MoveSize (Procedure) _SelectWindow (Procedure) Controls (Procedure) Move (Procedure) _PropertySet (Procedure) Controls (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _Initialize (Procedure) Controls (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) CreateField (Procedure) AddNew (Procedure) Fields (Procedure) CurrentDocIndex (Procedure) |
13 |
Public Function _hasUNOProperty(pvObject As Variant, psProperty As String) As Boolean
Dim vInspect as Variant _hasUNOProperty = False If IsNull(pvObject) Then Exit Function On Local Error Resume Next vInspect = _A2B_.Introspection.Inspect(pvObject) _hasUNOProperty = vInspect.hasProperty(psProperty, com.sun.star.beans.PropertyConcept.ALL)
End Function |
Access2BaseDev |
Utils |
_ImplementationName |
Basic |
_CStr (Procedure) _Initialize (Procedure) _Initialize (Procedure) |
12 |
Public Function _ImplementationName(pvObject As Variant) As String
Dim sObjectType As String On Local Error Resume Next sObjectType = pvObject.getImplementationName() If sObjectType = "" Then sObjectType = _getUNOTypeName(pvObject) _ImplementationName = sObjectType End Function |
Access2BaseDev |
Utils |
_InList |
Basic |
AllForms (Procedure) TraceLevel (Procedure) _CheckColumnType (Procedure) _IsPseudo (Procedure) _IsScalar (Procedure) Delete (Procedure) getObject (Procedure) _hasProperty (Procedure) _GetLabel (Procedure) Requery (Procedure) _ListboxBound (Procedure) |
61 |
Public Function _InList(ByVal pvItem As Variant, pvList As Variant, ByVal Optional pvReturnValue As Variant, Optional ByVal pbBinarySearch As Boolean) As Variant
Dim i As Integer, bFound As Boolean, iListVarType As Integer, iItemVarType As Integer Dim iTop As Integer, iBottom As Integer, iFound As Integer iItemVarType = VarType(pvItem) If IsMissing(pvReturnValue) Then pvReturnValue = False If iItemVarType = vbNull Or IsNull(pvList) Then _InList = False ElseIf Not IsArray(pvList) Then If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList) ) Else bFound = ( pvItem = pvList ) If Not pvReturnValue Then _InList = bFound Else If bFound Then _InList = pvList Else _InList = False End If ElseIf UBound(pvList) < LBound(pvList) Then _InList = False Else bFound = False _InList = False iListVarType = VarType(pvList(LBound(pvList))) If iListVarType = iItemVarType _ Or ( (iListVarType = vbInteger Or iListVarType = vbLong Or iListVarType = vbSingle Or iListVarType = vbDouble _ Or iListVarType = vbCurrency Or iListVarType = vbBigint Or iListVarType = vbDecimal) _ And (iItemVarType = vbInteger Or iItemVarType = vbLong Or iItemVarType = vbSingle Or iItemVarType = vbDouble _ Or iItemVarType = vbCurrency Or iItemVarType = vbBigint Or iItemVarType = vbDecimal) _ ) Then If IsMissing(pbBinarySearch) Then pbBinarySearch = False If Not pbBinarySearch Then For i = LBound(pvList) To UBound(pvList) If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList(i)) ) Else bFound = ( pvItem = pvList(i) ) If bFound Then iFound = i Exit For End If Next i Else iTop = UBound(pvList) iBottom = lBound(pvList) Do iFound = (iTop + iBottom) / 2 If ( iItemVarType = vbString And UCase(pvItem) > UCase(pvList(iFound)) ) Or ( iItemVarType <> vbString And pvItem > pvList(iFound) ) Then iBottom = iFound + 1 Else iTop = iFound - 1 End If If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList(iFound)) ) Else bFound = ( pvItem = pvList(iFound) ) Loop Until ( bFound ) Or ( iBottom > iTop ) End If If bFound Then If Not pvReturnValue Then _InList = True Else _InList = pvList(iFound) End If End If End If Exit Function End Function |
Access2BaseDev |
Utils |
_InspectPropertyType |
Basic |
_PropertySet (Procedure) |
16 |
Public Function _InspectPropertyType(poObject As Object, psProperty As String) As String
Dim oInspect1 As Object, oInspect2 As Object, oInspect3 As Object _InspectPropertyType = "" Set oInspect1 = CreateUnoService("com.sun.star.script.Invocation") Set oInspect2 = oInspect1.createInstanceWithArguments(Array(poObject)).IntroSpection If Not IsNull(oInspect2) Then Set oInspect3 = oInspect2.getProperty(psProperty, com.sun.star.beans.PropertyConcept.ALL) If Not IsNull(oInspect3) Then _InspectPropertyType = oInspect3.Type.Name End If Set oInspect1 = Nothing : Set oInspect2 = Nothing : Set oInspect3 = Nothing
End Function |
Access2BaseDev |
Utils |
_IsBinaryType |
Basic |
CopyObject (Procedure) _OutputDataToHTML (Procedure) |
13 |
Public Function _IsBinaryType(ByVal lType As Long) As Boolean
With com.sun.star.sdbc.DataType Select Case lType Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB _IsBinaryType = True Case Else _IsBinaryType = False End Select End With
End Function |
Access2BaseDev |
Utils |
_IsLeft |
Basic |
CommandBars (Procedure) RunCommand (Procedure) _PropertySet (Procedure) _PropertySet (Procedure) Controls (Procedure) _PropertySet (Procedure) _PropertySet (Procedure) _PropertySet (Procedure) _PropertySet (Procedure) Execute (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) |
12 |
Public Function _IsLeft(psString As String, psLeft As String) As Boolean
Dim iLength As Integer iLength = Len(psLeft) _IsLeft = False If Len(psString) >= iLength Then If Left(psString, iLength) = psLeft Then _IsLeft = True End If
End Function |
Access2BaseDev |
Utils |
_IsPseudo |
Basic |
_CheckArgument (Procedure) _CStr (Procedure) |
103 |
Public Function _IsPseudo(pvObject As Variant, ByVal pvType As Variant) As Boolean
Dim bIsPseudo As Boolean, bPseudoExists As Boolean, vObject As Variant
If _ErrorHandler() Then On Local Error Goto Exit_False _IsPseudo = False bIsPseudo = False vObject = pvObject Select Case True Case IsEmpty(vObject) Case IsNull(vObject) Case VarType(vObject) <> vbObject Case Else With vObject Select Case True Case IsEmpty(._Type) Case IsNull(._Type) Case ._Type = "" Case Else bIsPseudo = _InList(._Type, pvType) If Not bIsPseudo Then If ._Type = OBJCONTROL Then bIsPseudo = _InList(._SubType, pvType) End If End Select End With End Select If Not bIsPseudo Then Goto Exit_Function Dim oDoc As Object, oForms As Variant bPseudoExists = False With vObject Select Case ._Type Case OBJFORM If ._Name <> "" Then Set oDoc = _A2B_.CurrentDocument() If oDoc.DbConnect = DBCONNECTFORM Then bPseudoExists = True Else Set oForms = oDoc.Document.getFormDocuments() bPseudoExists = ( oForms.HasByName(._Name) ) End If End If Case OBJDATABASE If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = Not IsNull(.Connection) Case OBJDIALOG If ._Name <> "" Then bPseudoExists = ( _A2B_.hasItem(COLLALLDIALOGS, ._Name) ) End If Case OBJCOLLECTION bPseudoExists = True Case OBJCONTROL If Not IsNull(.ControlModel) And ._Name <> "" Then Set oForms = .ControlModel.Parent bPseudoExists = ( oForms.hasByName(._Name) ) End If Case OBJSUBFORM If Not IsNull(.DatabaseForm) And ._Name <> "" Then If .DatabaseForm.ImplementationName = "com.sun.star.comp.forms.ODatabaseForm" Then Set oForms = .DatabaseForm.Parent bPseudoExists = ( oForms.hasByName(._Name) ) End If End If Case OBJOPTIONGROUP bPseudoExists = ( .Count > 0 ) Case OBJCOMMANDBAR bPseudoExists = ( Not IsNull(._Window) ) Case OBJCOMMANDBARCONTROL bPseudoExists = ( Not IsNull(._ParentCommandBar) ) Case OBJEVENT bPseudoExists = ( Not IsNull(._EventSource) ) Case OBJPROPERTY bPseudoExists = ( ._Name <> "" ) Case OBJTABLEDEF bPseudoExists = ( ._Name <> "" And Not IsNull(.Table) ) Case OBJQUERYDEF bPseudoExists = ( ._Name <> "" And Not IsNull(.Query) ) Case OBJRECORDSET bPseudoExists = ( Not IsNull(.RowSet) ) Case OBJFIELD bPseudoExists = ( ._Name <> "" And Not IsNull(.Column) ) Case OBJTEMPVAR If ._Name <> "" Then bPseudoExists = ( _A2B_.hasItem(COLLTEMPVARS, ._Name) ) End If Case Else End Select End With _IsPseudo = ( bIsPseudo And bPseudoExists )
Exit_Function: Exit Function Exit_False: _IsPseudo = False Goto Exit_Function End Function |
Access2BaseDev |
Utils |
_IsScalar |
Basic |
_CheckArgument (Procedure) _PropertySet (Procedure) |
24 |
Private Function _IsScalar(ByVal pvArg As Variant, Byval pvType As Variant, ByVal Optional pvValid As Variant) As Boolean
_IsScalar = False
If IsArray(pvType) Then If Not _InList(VarType(pvArg), pvType) Then Exit Function ElseIf VarType(pvArg) <> pvType Then If pvType = vbBoolean And VarType(pvArg) = vbLong Then If pvArg < -1 And pvArg > 0 Then Exit Function Else Exit Function End If End If If Not IsMissing(pvValid) Then If Not _InList(pvArg, pvValid) Then Exit Function End If _IsScalar = True Exit_Function: Exit Function End Function |
Access2BaseDev |
Utils |
_PCase |
Basic |
Properties (Procedure) Properties (Procedure) _hasProperty (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) Execute (Procedure) Fields (Procedure) getProperty (Procedure) hasProperty (Procedure) OpenRecordset (Procedure) Properties (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) OpenRecordset (Procedure) Properties (Procedure) Properties (Procedure) setProperty (Procedure) Properties (Procedure) Properties (Procedure) Properties (Procedure) |
17 |
Public Function _PCase(ByVal psString As String) As String
Dim vSubStrings() As Variant, i As Integer, iLen As Integer vSubStrings = Split(psString, " ") For i = 0 To UBound(vSubStrings) iLen = Len(vSubStrings(i)) If iLen > 1 Then vSubStrings(i) = UCase(Left(vSubStrings(i), 1)) & LCase(Right(vSubStrings(i), iLen - 1)) ElseIf iLen = 1 Then vSubStrings(i) = UCase(vSubStrings(i)) End If Next i _PCase = Join(vSubStrings, " ") End Function |
Access2BaseDev |
Utils |
_PercentEncode |
Basic |
_URLEncode (Procedure) |
35 |
Private Function _PercentEncode(ByVal psChar As String) As String
Dim lChar As Long, sByte1 As String, sByte2 As String, sByte3 As String lChar = Asc(psChar) Select Case lChar Case 48 To 57, 65 To 90, 97 To 122 _PercentEncode = psChar Case Asc("-"), Asc("."), Asc("_"), Asc("~") _PercentEncode = psChar Case Asc("!"), Asc("$"), Asc("&"), Asc("'"), Asc("("), Asc(")"), Asc("*"), Asc("+"), Asc(","), Asc(";"), Asc("=") _PercentEncode = psChar Case Asc(" "), Asc("%") _PercentEncode = "%" & Right("00" & Hex(lChar), 2) Case 0 To 127 _PercentEncode = psChar Case 128 To 2047 sByte1 = "%" & Right("00" & Hex(Int(lChar / 64) + 192), 2) sByte2 = "%" & Right("00" & Hex((lChar Mod 64) + 128), 2) _PercentEncode = sByte1 & sByte2 Case 2048 To 65535 sByte1 = "%" & Right("00" & Hex(Int(lChar / 4096) + 224), 2) sByte2 = "%" & Right("00" & Hex(Int(lChar - (4096 * Int(lChar / 4096))) /64 + 128), 2) sByte3 = "%" & Right("00" & Hex((lChar Mod 64) + 128), 2) _PercentEncode = sByte1 & sByte2 & sByte3 Case Else _PercentEncode = psChar End Select Exit Function
End Function |
Access2BaseDev |
Utils |
_ReadFileIntoArray |
Basic |
_OutputToHTML (Procedure) |
39 |
Public Function _ReadFileIntoArray(ByVal psFileName) As Variant
Dim vLines() As Variant, iFile As Integer, sLine As String, iCount1 As Integer, iCount2 As Integer Const cstMaxLines = 16000 On Local Error GoTo Error_Function vLines = Array() _ReadFileIntoArray = Array() If psFileName = "" Then Exit Function
iFile = FreeFile() Open psFileName For Input Access Read Shared As #iFile iCount1 = 0 Do While Not Eof(iFile) And iCount1 < cstMaxLines Line Input #iFile, sLine iCount1 = iCount1 + 1 Loop Close #iFile
ReDim vLines(0 To iCount1 - 1) iFile = FreeFile() Open psFileName For Input Access Read Shared As #iFile iCount2 = 0 Do While Not Eof(iFile) And iCount2 < iCount1 Line Input #iFile, vLines(iCount2) iCount2 = iCount2 + 1 Loop Close #iFile
Exit_Function: _ReadFileIntoArray() = vLines() Exit Function Error_Function: vLines = Array() Resume Exit_Function End Function |
Access2BaseDev |
Utils |
_RegexSearch |
Basic |
_CVar (Procedure) _StrToPropValues (Procedure) Find (Procedure) _FindPattern (Procedure) |
49 |
Public Function _RegexSearch(ByRef psString As String _ , ByVal psRegex As String _ , Optional ByRef plStart As Long _ , Optional ByVal bForward As Boolean _ ) As String
Dim oTextSearch As Object Dim vOptions As Variant Dim lEnd As Long, vResult As Object
_RegexSearch = "" Set oTextSearch = _A2B_.TextSearch vOptions = _A2B_.SearchOptions vOptions.searchString = psRegex oTextSearch.setOptions(vOptions) If IsMissing(plStart) Then plStart = 1 If plStart <= 0 Or plStart > Len(psString) Then Exit Function If IsMissing(bForWard) Then bForward = True If bForward Then lEnd = Len(psString) vResult = oTextSearch.searchForward(psString, plStart - 1, lEnd) Else lEnd = 1 vResult = oTextSearch.searchForward(psString, plStart, lEnd - 1) End If With vResult If .subRegExpressions >= 1 Then Select Case bForward Case True plStart = .startOffset(0) + 1 lEnd = .endOffset(0) + 1 Case False plStart = .endOffset(0) + 1 lEnd = .startOffset(0) End Select _RegexSearch = Mid(psString, plStart, lEnd - plStart) Else plStart = 0 End If End With
End Function |
Access2BaseDev |
Utils |
_RegisterDialogEventScript |
Basic |
_PropertySet (Procedure) _PropertySet (Procedure) |
30 |
Public Function _RegisterDialogEventScript(poObject As Object _ , ByVal psEvent As String _ , ByVal psListener As String _ , ByVal psScriptCode As String _ ) As Boolean
Dim oEvents As Object, sEvent As String, sEventName As String, oEvent As Object
_RegisterDialogEventScript = False If Not _hasUNOMethod(poObject, "getEvents") Then Exit Function
Set oEvents = poObject.getEvents() sEvent = Utils._GetEventName(psEvent) sEventName = "com.sun.star.awt." & psListener & "::" & sEvent If oEvents.hasByName(sEventName) Then oEvents.removeByName(sEventName) Set oEvent = CreateUnoStruct("com.sun.star.script.ScriptEventDescriptor") With oEvent .ListenerType = psListener .EventMethod = sEvent .ScriptType = "Script" .ScriptCode = psScriptCode End With oEvents.insertByName(sEventName, oEvent)
_RegisterDialogEventScript = True
End Function |
Access2BaseDev |
Utils |
_RegisterEventScript |
Basic |
_PropertySet (Procedure) _PropertySet (Procedure) _PropertySet (Procedure) |
44 |
Public Function _RegisterEventScript(poObject As Object _ , ByVal psEvent As String _ , ByVal psListener As String _ , ByVal psScriptCode As String _ , ByVal psName As String _ , Optional ByVal pbExtendName As Boolean _ ) As Boolean
Dim i As Integer, oEvent As Object, sEvent As String, oParent As Object, iIndex As Integer, sName As String
_RegisterEventScript = False If Not _hasUNOMethod(poObject, "getParent") Then Exit Function
If IsMissing(pbExtendName) Then pbExtendName = False Set oParent = poObject.getParent() iIndex = -1 For i = 0 To oParent.getCount() - 1 sName = oParent.getByIndex(i).Name If (sName = psName) Or (pbExtendName And (sName = "MainForm" Or sName = "Form")) Then iIndex = i Exit For End If Next i If iIndex < 0 Then Exit Function
sEvent = Utils._GetEventName(psEvent) If psScriptCode = "" Then oParent.revokeScriptEvent(iIndex, psListener, sEvent, "") Else Set oEvent = CreateUnoStruct("com.sun.star.script.ScriptEventDescriptor") With oEvent .ListenerType = psListener .EventMethod = sEvent .ScriptType = "Script" .ScriptCode = psScriptCode End With oParent.registerScriptEvent(iIndex, oEvent) End If _RegisterEventScript = True
End Function |
Access2BaseDev |
Utils |
_ResetCalledSub |
Basic |
AllDialogs (Procedure) AllForms (Procedure) AllModules (Procedure) CloseConnection (Procedure) CommandBars (Procedure) Controls (Procedure) CurrentDb (Procedure) DAvg (Procedure) DCount (Procedure) DLookup (Procedure) DMax (Procedure) DMin (Procedure) DStDev (Procedure) DStDevP (Procedure) DSum (Procedure) DVar (Procedure) DVarP (Procedure) Events (Procedure) Forms (Procedure) HtmlEncode (Procedure) OpenConnection (Procedure) OpenDatabase (Procedure) SysCmd (Procedure) TempVars (Procedure) AddItem (Procedure) hasProperty (Procedure) Move (Procedure) Properties (Procedure) Refresh (Procedure) RemoveItem (Procedure) Requery (Procedure) SetFocus (Procedure) ApplyFilter (Procedure) mClose (Procedure) CopyObject (Procedure) FindNext (Procedure) FindRecord (Procedure) GetHiddenAttribute (Procedure) GoToControl (Procedure) GoToRecord (Procedure) Maximize (Procedure) Minimize (Procedure) MoveSize (Procedure) OpenForm (Procedure) OpenQuery (Procedure) OpenReport (Procedure) OpenSQL (Procedure) OpenTable (Procedure) OutputTo (Procedure) Quit (Procedure) RunApp (Procedure) RunCommand (Procedure) RunSQL (Procedure) SelectObject (Procedure) SendObject (Procedure) SetHiddenAttribute (Procedure) SetOrderBy (Procedure) ShowAllrecords (Procedure) mClose (Procedure) CreateQueryDef (Procedure) CreateTableDef (Procedure) DAvg (Procedure) DCount (Procedure) DLookup (Procedure) DMax (Procedure) DMin (Procedure) DStDev (Procedure) DStDevP (Procedure) DSum (Procedure) DVar (Procedure) DVarP (Procedure) getProperty (Procedure) OpenRecordset (Procedure) OutputTo (Procedure) Properties (Procedure) QueryDefs (Procedure) Recordsets (Procedure) RunSQL (Procedure) TableDefs (Procedure) _PropertyGet (Procedure) setProperty (Procedure) setValue (Procedure) _setProperty (Procedure) Item (Procedure) Add (Procedure) Delete (Procedure) getProperty (Procedure) Remove (Procedure) RemoveAll (Procedure) _PropertyGet (Procedure) getObject (Procedure) getOptionGroup (Procedure) getProperty (Procedure) getValue (Procedure) _getProperty (Procedure) _hasProperty (Procedure) _Properties (Procedure) IsLoaded (Procedure) OptionGroup (Procedure) mClose (Procedure) Controls (Procedure) CurrentDb (Procedure) getProperty (Procedure) Move (Procedure) Refresh (Procedure) Requery (Procedure) setFocus (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) DebugPrint (Procedure) OptionGroup (Procedure) Parent (Procedure) Controls (Procedure) getProperty (Procedure) Refresh (Procedure) Requery (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Controls (Procedure) getProperty (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) getProperty (Procedure) _PropertyGet (Procedure) getProperty (Procedure) _PropertyGet (Procedure) Properties (Procedure) AddItem (Procedure) Controls (Procedure) getProperty (Procedure) RemoveItem (Procedure) Requery (Procedure) setFocus (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) OptionGroup (Procedure) Properties (Procedure) Controls (Procedure) EndExecute (Procedure) Execute (Procedure) getProperty (Procedure) Move (Procedure) setProperty (Procedure) Start (Procedure) Terminate (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) AppendChunk (Procedure) GetChunk (Procedure) getProperty (Procedure) hasProperty (Procedure) Properties (Procedure) ReadAllBytes (Procedure) ReadAllText (Procedure) setProperty (Procedure) WriteAllBytes (Procedure) WriteAllText (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) CreateField (Procedure) Execute (Procedure) Fields (Procedure) getProperty (Procedure) hasProperty (Procedure) OpenRecordset (Procedure) Properties (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) AddNew (Procedure) CancelUpdate (Procedure) Clone (Procedure) mClose (Procedure) Delete (Procedure) Edit (Procedure) Fields (Procedure) getProperty (Procedure) GetRows (Procedure) hasProperty (Procedure) OpenRecordset (Procedure) Properties (Procedure) setProperty (Procedure) Update (Procedure) _Move (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) getProperty (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) CommandBarControls (Procedure) Controls (Procedure) getProperty (Procedure) Reset (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Execute (Procedure) getProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Lines (Procedure) ProcBodyLine (Procedure) ProcCountLines (Procedure) ProcOfLine (Procedure) ProcStartLine (Procedure) Properties (Procedure) Find (Procedure) getProperty (Procedure) hasProperty (Procedure) _PropertyGet (Procedure) |
8 |
Public Sub _ResetCalledSub(ByVal psSub As String) If IsEmpty(_A2B_) Then Call Application._RootInit() If _A2B_.CalledSub = psSub Then _A2B_.CalledSub = "" If _A2B_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel("Exiting") & " " & psSub & " ...", False) End Sub |
Access2BaseDev |
Utils |
_RunScript |
Basic |
Execute (Procedure) |
22 |
Public Function _RunScript(ByVal psScript As String, Optional pvArgs() As Variant) As Boolean
On Local Error Goto Error_Function _RunScript = False If IsNull(ThisComponent) Then Goto Exit_Function
Dim oSCriptProvider As Object, oScript As Object, vResult As Variant
Set oScriptProvider = ThisComponent.ScriptProvider() Set oScript = oScriptProvider.getScript(psScript) If IsMissing(pvArgs()) Then pvArgs() = Array() vResult = oScript.Invoke(pvArgs(), Array(), Array()) _RunScript = True
Exit_Function: Exit Function Error_Function: _RunScript = False Goto Exit_Function End Function |
Access2BaseDev |
Utils |
_SetCalledSub |
Basic |
AllDialogs (Procedure) AllForms (Procedure) AllModules (Procedure) CloseConnection (Procedure) CommandBars (Procedure) Controls (Procedure) CurrentDb (Procedure) DAvg (Procedure) DCount (Procedure) DLookup (Procedure) DMax (Procedure) DMin (Procedure) DStDev (Procedure) DStDevP (Procedure) DSum (Procedure) DVar (Procedure) DVarP (Procedure) Events (Procedure) Forms (Procedure) HtmlEncode (Procedure) OpenConnection (Procedure) OpenDatabase (Procedure) SysCmd (Procedure) TempVars (Procedure) AddItem (Procedure) hasProperty (Procedure) Move (Procedure) Properties (Procedure) Refresh (Procedure) RemoveItem (Procedure) Requery (Procedure) SetFocus (Procedure) _TraceArguments (Procedure) ApplyFilter (Procedure) mClose (Procedure) CopyObject (Procedure) FindNext (Procedure) FindRecord (Procedure) GetHiddenAttribute (Procedure) GoToControl (Procedure) GoToRecord (Procedure) Maximize (Procedure) Minimize (Procedure) MoveSize (Procedure) OpenForm (Procedure) OpenQuery (Procedure) OpenReport (Procedure) OpenSQL (Procedure) OpenTable (Procedure) OutputTo (Procedure) Quit (Procedure) RunApp (Procedure) RunCommand (Procedure) RunSQL (Procedure) SelectObject (Procedure) SendObject (Procedure) SetHiddenAttribute (Procedure) SetOrderBy (Procedure) ShowAllrecords (Procedure) mClose (Procedure) CreateQueryDef (Procedure) CreateTableDef (Procedure) DAvg (Procedure) DCount (Procedure) DLookup (Procedure) DMax (Procedure) DMin (Procedure) DStDev (Procedure) DStDevP (Procedure) DSum (Procedure) DVar (Procedure) DVarP (Procedure) getProperty (Procedure) OpenRecordset (Procedure) OpenSQL (Procedure) OutputTo (Procedure) Properties (Procedure) QueryDefs (Procedure) Recordsets (Procedure) RunSQL (Procedure) TableDefs (Procedure) _PropertyGet (Procedure) setProperty (Procedure) setValue (Procedure) _setProperty (Procedure) Item (Procedure) Add (Procedure) Delete (Procedure) getProperty (Procedure) Remove (Procedure) RemoveAll (Procedure) _PropertyGet (Procedure) getObject (Procedure) getOptionGroup (Procedure) getProperty (Procedure) getValue (Procedure) _getProperty (Procedure) _hasProperty (Procedure) _Properties (Procedure) IsLoaded (Procedure) OptionGroup (Procedure) mClose (Procedure) Controls (Procedure) CurrentDb (Procedure) getProperty (Procedure) Move (Procedure) Refresh (Procedure) Requery (Procedure) setFocus (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) DebugPrint (Procedure) OptionGroup (Procedure) Parent (Procedure) Controls (Procedure) getProperty (Procedure) Refresh (Procedure) Requery (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Controls (Procedure) getProperty (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) getProperty (Procedure) _PropertyGet (Procedure) getProperty (Procedure) _PropertyGet (Procedure) Properties (Procedure) AddItem (Procedure) Controls (Procedure) getProperty (Procedure) RemoveItem (Procedure) Requery (Procedure) setFocus (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) OptionGroup (Procedure) Properties (Procedure) Controls (Procedure) EndExecute (Procedure) Execute (Procedure) getProperty (Procedure) Move (Procedure) setProperty (Procedure) Start (Procedure) Terminate (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) AppendChunk (Procedure) GetChunk (Procedure) getProperty (Procedure) hasProperty (Procedure) Properties (Procedure) ReadAllBytes (Procedure) ReadAllText (Procedure) setProperty (Procedure) WriteAllBytes (Procedure) WriteAllText (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) CreateField (Procedure) Execute (Procedure) Fields (Procedure) getProperty (Procedure) hasProperty (Procedure) OpenRecordset (Procedure) Properties (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) AddNew (Procedure) CancelUpdate (Procedure) Clone (Procedure) mClose (Procedure) Delete (Procedure) Edit (Procedure) Fields (Procedure) getProperty (Procedure) GetRows (Procedure) hasProperty (Procedure) OpenRecordset (Procedure) Properties (Procedure) setProperty (Procedure) Update (Procedure) _Move (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) getProperty (Procedure) setProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) CommandBarControls (Procedure) Controls (Procedure) getProperty (Procedure) Reset (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Execute (Procedure) getProperty (Procedure) _PropertyGet (Procedure) _PropertySet (Procedure) Lines (Procedure) ProcBodyLine (Procedure) ProcCountLines (Procedure) ProcOfLine (Procedure) ProcStartLine (Procedure) Properties (Procedure) Find (Procedure) getProperty (Procedure) hasProperty (Procedure) _PropertyGet (Procedure) |
8 |
Public Sub _SetCalledSub(ByVal psSub As String) If IsEmpty(_A2B_) Then Call Application._RootInit() If _A2B_.CalledSub = "" Then _A2B_.CalledSub = psSub If _A2B_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel("Entering") & " " & psSub & " ...", False) End Sub |
Access2BaseDev |
Utils |
_Surround |
Basic |
CopyObject (Procedure) _getUpperShortcut (Procedure) Controls (Procedure) _Initialize (Procedure) Controls (Procedure) _Initialize (Procedure) Controls (Procedure) Controls (Procedure) |
20 |
Public Function _Surround(ByVal psName As String) As String
Const cstSquareOpen = "[" Const cstSquareClose = "]" Const cstDot = "." Dim sName As String
If InStr(psName, ".") > 0 Then sName = Join(Split(psName, cstDot), cstSquareClose & cstDot & cstSquareOpen) _Surround = cstSquareOpen & sName & cstSquareClose ElseIf InStr(psName, " ") > 0 Then _Surround = cstSquareOpen & psName & cstSquareClose Else _Surround = psName End If
End Function |
Access2BaseDev |
Utils |
_Trim |
Basic |
AllForms (Procedure) Forms (Procedure) _OptionGroup (Procedure) _DatabaseForm (Procedure) getObject (Procedure) Controls (Procedure) Controls (Procedure) Controls (Procedure) Controls (Procedure) _PropertyGet (Procedure) ProcStartLine (Procedure) |
17 |
Public Function _Trim(ByVal psString As String) As String Const cstSquareOpen = "[" Const cstSquareClose = "]" Dim sTrim As String sTrim = Trim(Replace(psString, vbTab, " ")) _Trim = sTrim If Len(sTrim) <= 2 Then Exit Function If Left(sTrim, 1) = cstSquareOpen Then If Right(sTrim, 1) = cstSquareClose Then _Trim = Mid(sTrim, 2, Len(sTrim) - 2) End If End If End Function |
Access2BaseDev |
Utils |
_TrimArray |
Basic |
AllDialogs (Procedure) AllModules (Procedure) _Initialize (Procedure) _PropertiesList (Procedure) |
34 |
Public Function _TrimArray(pvArray As Variant) As Variant
Dim sTrim As String, vTrim() As Variant, i As Integer, j As Integer, iCount As Integer vTrim = Null If Not IsArray(pvArray) Then If Len(Trim(pvArray)) > 0 Then vTrim = Array(pvArray) Else vTrim = Array() ElseIf UBound(pvArray) < LBound(pvArray) Then vTrim = Array() Else iCount = 0 For i = LBound(pvArray) To UBound(pvArray) If Len(Trim(pvArray(i))) = 0 Then iCount = iCount + 1 Next i If iCount = 0 Then vTrim() = pvArray() ElseIf iCount = UBound(pvArray) - LBound(pvArray) + 1 Then vTrim() = Array() Else ReDim vTrim(LBound(pvArray) To UBound(pvArray) - iCount) j = 0 For i = LBound(pvArray) To UBound(pvArray) If Len(Trim(pvArray(i))) > 0 Then vTrim(j) = pvArray(i) j = j + 1 End If Next i End If End If
_TrimArray() = vTrim()
End Function |
Access2BaseDev |
Utils |
_UpdateResultSetColumnValue |
Basic |
CopyObject (Procedure) |
74 |
Private Function _UpdateResultSetColumnValue(piRDBMS As Integer _ , poResultSet As Object _ , ByVal piColIndex As Integer _ , ByVal pvValue As Variant _ ) As Boolean Dim iType As Integer, vDateTime As Variant, oValue As Object Dim bNullable As Boolean, lSize As Long, iValueType As Integer, sValueTypeName As String Const cstMaxTextLength = 65535 Const cstMaxBinlength = 2 * 65535
On Local Error Goto 0 _UpdateResultSetColumnValue = False With com.sun.star.sdbc.DataType iType = poResultSet.MetaData.getColumnType(piColIndex) iValueType = VarType(pvValue) sValueTypeName = UCase(poResultSet.MetaData.getColumnTypeName(piColIndex)) bNullable = ( poResultSet.MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )
If bNullable And IsNull(pvValue) Then poResultSet.updateNull(piColIndex) Else Select Case iType Case .ARRAY, .DISTINCT, .OBJECT, .OTHER, .REF, .SQLNULL, .STRUCT poResultSet.updateNull(piColIndex) Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB poResultSet.updateBytes(piColIndex, pvValue) Case .BIT, .BOOLEAN : poResultSet.updateBoolean(piColIndex, pvValue) Case .DATE : vDateTime = CreateUnoStruct("com.sun.star.util.Date") vDateTime.Year = Year(pvValue) vDateTime.Month = Month(pvValue) vDateTime.Day = Day(pvValue) poResultSet.updateDate(piColIndex, vDateTime) Case .DECIMAL, .NUMERIC : poResultSet.updateDouble(piColIndex, pvValue) Case .DOUBLE, .REAL : poResultSet.updateDouble(piColIndex, pvValue) Case .FLOAT : poResultSet.updateFloat(piColIndex, pvValue) Case .INTEGER, .SMALLINT : poResultSet.updateInt(piColIndex, pvValue) Case .BIGINT : poResultSet.updateLong(piColIndex, pvValue) Case .DECIMAL, .NUMERIC : poResultSet.updateDouble(piColIndex, pvValue) Case .TINYINT : poResultSet.updateShort(piColIndex, pvValue) Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB If piRDBMS = DBMS_SQLITE And InStr(sValueTypeName, "BINARY") > 0 Then poResultSet.updateBytes(piColIndex, pvValue) Else poResultSet.updateString(piColIndex, pvValue) End If Case .TIME : vDateTime = CreateUnoStruct("com.sun.star.util.Time") vDateTime.Hours = Hour(pvValue) vDateTime.Minutes = Minute(pvValue) vDateTime.Seconds = Second(pvValue) poResultSet.updateTime(piColIndex, vDateTime) Case .TIMESTAMP : vDateTime = CreateUnoStruct("com.sun.star.util.DateTime") vDateTime.Year = Year(pvValue) vDateTime.Month = Month(pvValue) vDateTime.Day = Day(pvValue) vDateTime.Hours = Hour(pvValue) vDateTime.Minutes = Minute(pvValue) vDateTime.Seconds = Second(pvValue) poResultSet.updateTimestamp(piColIndex, vDateTime) Case Else If bNullable Then poResultSet.updateNull(piColIndex) End Select End If
End With _UpdateResultSetColumnValue = True End Function |
Access2BaseDev |
Utils |
_URLEncode |
Basic |
|
41 |
Private Function _URLEncode(ByVal psToEncode As String) As String
Dim sEncoded As String, sChar As String Dim lCurrentChar As Long, bQuestionMark As Boolean
sEncoded = "" bQuestionMark = False For lCurrentChar = 1 To Len(psToEncode) sChar = Mid(psToEncode, lCurrentChar, 1) Select Case sChar Case " ", "%" sEncoded = sEncoded & _PercentEncode(sChar) Case "?" If bQuestionMark Then sEncoded = sEncoded & _PercentEncode(sChar) Else sEncoded = sEncoded & sChar bQuestionMark = True End If Case "\" If bQuestionMark Then sEncoded = sEncoded & _PercentEncode(sChar) Else sEncoded = sEncoded & "/" End If Case Else If bQuestionMark Then sEncoded = sEncoded & _PercentEncode(sChar) Else sEncoded = sEncoded & _UTF8Encode(sChar) End If End Select Next lCurrentChar _URLEncode = sEncoded
End Function |
Access2BaseDev |
Utils |
_UTF8Encode |
Basic |
HtmlEncode (Procedure) _URLEncode (Procedure) _OutputStringToHTML (Procedure) |
23 |
Private Function _UTF8Encode(ByVal psChar As String) As String
Select Case psChar Case """" : _UTF8Encode = """ Case "&" : _UTF8Encode = "&" Case "<" : _UTF8Encode = "<" Case ">" : _UTF8Encode = ">" Case "'" : _UTF8Encode = "'" Case ":", "/", "?", "#", "[", "]", "@" _UTF8Encode = psChar Case Chr(13) : _UTF8Encode = "" Case Chr(10) : _UTF8Encode = " " Case < Chr(126) : _UTF8Encode = psChar Case "€" : _UTF8Encode = "€" Case Else : _UTF8Encode = "&#" & Asc(psChar) & ";" End Select
Exit Function
End Function |
Standard |
Module1 |
DBOpen |
Basic |
Access2Base.odb (Database) |
5 |
Sub DBOpen(Optional poEvent As Object) If GlobalScope.BasicLibraries.hasByName("Access2BaseDev") Then GlobalScope.BasicLibraries.loadLibrary("Access2BaseDev") End If End Sub |