12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501 |
- <?xml version="1.0" encoding="UTF-8"?>
- <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
- <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Control" script:language="StarBasic">
- REM =======================================================================================================================
- REM === The Access2Base library is a part of the LibreOffice project. ===
- REM === Full documentation is available on http://www.access2base.com ===
- REM =======================================================================================================================
- Option Compatible
- Option ClassModule
- Option Explicit
- REM -----------------------------------------------------------------------------------------------------------------------
- REM --- CLASS ROOT FIELDS ---
- REM -----------------------------------------------------------------------------------------------------------------------
- Private _Type As String ' Must be CONTROL
- Private _This As Object ' Workaround for absence of This builtin function
- Private _Parent As Object
- Private _ImplementationName As String
- Private _ClassId As Integer
- Private _ParentType As String ' One of CTLPARENTISxxxx constants
- Private _Shortcut As String
- Private _Name As String
- Private _FormComponent As Object ' com.sun.star.text.TextDocument
- Private _MainForm As String ' To be propagated to all subcontrols
- Private _DocEntry As Integer ' Doc- and DbContainer entries in Root structure
- Private _DbEntry As Integer
- Private _ControlType As Integer
- Private _ThisProperties As Variant ' Buffer for properties list
- Private _SubType As String
- Private ControlModel As Object ' com.sun.star.comp.forms.XXXModel
- Private ControlView As Object ' com.sun.star.comp.forms.XXXControl (NULL if form open in edit mode)
- Private BoundField As Object ' com.sun.star.sdb.ODataColumn
- Private LabelControl As Object ' com.sun.star.form.component.FixedText or com.sun.star.form.component.GroupBox
- REM -----------------------------------------------------------------------------------------------------------------------
- REM --- CONSTRUCTORS / DESTRUCTORS ---
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Sub Class_Initialize()
- _Type = OBJCONTROL
- Set _This = Nothing
- Set _Parent = Nothing
- _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 ' Constructor
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Sub Class_Terminate()
- On Local Error Resume Next
- Call Class_Initialize()
- End Sub ' Destructor
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Sub Dispose()
- Call Class_Terminate()
- End Sub ' Explicit destructor
- REM -----------------------------------------------------------------------------------------------------------------------
- REM --- CLASS GET/LET/SET PROPERTIES ---
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get BackColor() As Variant
- BackColor = _PropertyGet("BackColor")
- End Property ' BackColor (get)
- Property Let BackColor(ByVal pvValue As Variant)
- Call _PropertySet("BackColor", pvValue)
- End Property ' BackColor (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get BorderColor() As Variant
- BorderColor = _PropertyGet("BorderColor")
- End Property ' BorderColor (get)
- Property Let BorderColor(ByVal pvValue As Variant)
- Call _PropertySet("BorderColor", pvValue)
- End Property ' BorderColor (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get BorderStyle() As Variant
- BorderStyle = _PropertyGet("BorderStyle")
- End Property ' BorderStyle (get)
- Property Let BorderStyle(ByVal pvValue As Variant)
- Call _PropertySet("BorderStyle", pvValue)
- End Property ' BorderStyle (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Cancel() As Variant
- Cancel = _PropertyGet("Cancel")
- End Property ' Cancel (get)
- Property Let Cancel(ByVal pvValue As Variant)
- Call _PropertySet("Cancel", pvValue)
- End Property ' Cancel (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Caption() As Variant
- Caption = _PropertyGet("Caption")
- End Property ' Caption (get)
- Property Let Caption(ByVal pvValue As Variant)
- Call _PropertySet("Caption", pvValue)
- End Property ' Caption (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get ControlSource() As Variant
- ControlSource = _PropertyGet("ControlSource")
- End Property ' ControlSource (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get ControlTipText() As Variant
- ControlTipText = _PropertyGet("ControlTipText")
- End Property ' ControlTipText (get)
- Property Let ControlTipText(ByVal pvValue As Variant)
- Call _PropertySet("ControlTipText", pvValue)
- End Property ' ControlTipText (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get ControlType() As Variant
- ControlType = _PropertyGet("ControlType")
- End Property ' ControlType (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Default() As Variant
- Default = _PropertyGet("Default")
- End Property ' Default (get)
- Property Let Default(ByVal pvValue As Variant)
- Call _PropertySet("Default", pvValue)
- End Property ' Default (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get DefaultValue() As Variant
- DefaultValue = _PropertyGet("DefaultValue")
- End Property ' DefaultValue (get)
- Property Let DefaultValue(ByVal pvValue As Variant)
- Call _PropertySet("DefaultValue", pvValue)
- End Property ' DefaultValue (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Enabled() As Variant
- Enabled = _PropertyGet("Enabled")
- End Property ' Enabled (get)
- Property Let Enabled(ByVal pvValue As Variant)
- Call _PropertySet("Enabled", pvValue)
- End Property ' Enabled (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get FontBold() As Variant
- FontBold = _PropertyGet("FontBold")
- End Property ' FontBold (get)
- Property Let FontBold(ByVal pvValue As Variant)
- Call _PropertySet("FontBold", pvValue)
- End Property ' FontBold (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get FontItalic() As Variant
- FontItalic = _PropertyGet("FontItalic")
- End Property ' FontItalic (get)
- Property Let FontItalic(ByVal pvValue As Variant)
- Call _PropertySet("FontItalic", pvValue)
- End Property ' FontItalic (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get FontName() As Variant
- FontName = _PropertyGet("FontName")
- End Property ' FontName (get)
- Property Let FontName(ByVal pvValue As Variant)
- Call _PropertySet("FontName", pvValue)
- End Property ' FontName (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get FontSize() As Variant
- FontSize = _PropertyGet("FontSize")
- End Property ' FontSize (get)
- Property Let FontSize(ByVal pvValue As Variant)
- Call _PropertySet("FontSize", pvValue)
- End Property ' FontSize (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get FontUnderline() As Variant
- FontUnderline = _PropertyGet("FontUnderline")
- End Property ' FontUnderline (get)
- Property Let FontUnderline(ByVal pvValue As Variant)
- Call _PropertySet("FontUnderline", pvValue)
- End Property ' FontUnderline (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get FontWeight() As Variant
- FontWeight = _PropertyGet("FontWeight")
- End Property ' FontWeight (get)
- Property Let FontWeight(ByVal pvValue As Variant)
- Call _PropertySet("FontWeight", pvValue)
- End Property ' FontWeight (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get ForeColor() As Variant
- ForeColor = _PropertyGet("ForeColor")
- End Property ' ForeColor (get)
- Property Let ForeColor(ByVal pvValue As Variant)
- Call _PropertySet("ForeColor", pvValue)
- End Property ' ForeColor (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Form() As Variant
- Form = _PropertyGet("Form")
- End Property ' Form (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Format() As Variant
- Format = _PropertyGet("Format")
- End Property ' Format (get)
- Property Let Format(ByVal pvValue As Variant)
- Call _PropertySet("Format", pvValue)
- End Property ' Format (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get ItemData(ByVal Optional pvIndex As Variant) As Variant
- If IsMissing(pvIndex) Then ItemData = _PropertyGet("ItemData") Else ItemData = _PropertyGet("ItemData", pvIndex)
- End Property ' ItemData (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get ListCount() As Variant
- ListCount = _PropertyGet("ListCount")
- End Property ' ListCount (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get ListIndex() As Variant
- ListIndex = _PropertyGet("ListIndex")
- End Property ' ListIndex (get)
- Property Let ListIndex(ByVal pvValue As Variant)
- Call _PropertySet("ListIndex", pvValue)
- End Property ' ListIndex (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Locked() As Variant
- Locked = _PropertyGet("Locked")
- End Property ' Locked (get)
- Property Let Locked(ByVal pvValue As Variant)
- Call _PropertySet("Locked", pvValue)
- End Property ' Locked (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get MultiSelect() As Variant
- MultiSelect = _PropertyGet("MultiSelect")
- End Property ' MultiSelect (get)
- Property Let MultiSelect(ByVal pvValue As Variant)
- Call _PropertySet("MultiSelect", pvValue)
- End Property ' MultiSelect (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Name() As String
- Name = _PropertyGet("Name")
- End Property ' Name (get)
- Public Function pName() As String ' For compatibility with < V0.9.0
- pName = _PropertyGet("Name")
- End Function ' pName (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get ObjectType() As String
- ObjectType = _PropertyGet("ObjectType")
- End Property ' ObjectType (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnActionPerformed() As Variant
- OnActionPerformed = _PropertyGet("OnActionPerformed")
- End Property ' OnActionPerformed (get)
- Property Let OnActionPerformed(ByVal pvValue As Variant)
- Call _PropertySet("OnActionPerformed", pvValue)
- End Property ' OnActionPerformed (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnAdjustmentValueChanged() As Variant
- OnAdjustmentValueChanged = _PropertyGet("OnAdjustmentValueChanged")
- End Property ' OnAdjustmentValueChanged (get)
- Property Let OnAdjustmentValueChanged(ByVal pvValue As Variant)
- Call _PropertySet("OnAdjustmentValueChanged", pvValue)
- End Property ' OnAdjustmentValueChanged (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnApproveAction() As Variant
- OnApproveAction = _PropertyGet("OnApproveAction")
- End Property ' OnApproveAction (get)
- Property Let OnApproveAction(ByVal pvValue As Variant)
- Call _PropertySet("OnApproveAction", pvValue)
- End Property ' OnApproveAction (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnApproveReset() As Variant
- OnApproveReset = _PropertyGet("OnApproveReset")
- End Property ' OnApproveReset (get)
- Property Let OnApproveReset(ByVal pvValue As Variant)
- Call _PropertySet("OnApproveReset", pvValue)
- End Property ' OnApproveReset (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnApproveUpdate() As Variant
- OnApproveUpdate = _PropertyGet("OnApproveUpdate")
- End Property ' OnApproveUpdate (get)
- Property Let OnApproveUpdate(ByVal pvValue As Variant)
- Call _PropertySet("OnApproveUpdate", pvValue)
- End Property ' OnApproveUpdate (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnChanged() As Variant
- OnChanged = _PropertyGet("OnChanged")
- End Property ' OnChanged (get)
- Property Let OnChanged(ByVal pvValue As Variant)
- Call _PropertySet("OnChanged", pvValue)
- End Property ' OnChanged (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnErrorOccurred() As Variant
- OnErrorOccurred = _PropertyGet("OnErrorOccurred")
- End Property ' OnErrorOccurred (get)
- Property Let OnErrorOccurred(ByVal pvValue As Variant)
- Call _PropertySet("OnErrorOccurred", pvValue)
- End Property ' OnErrorOccurred (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnFocusGained() As Variant
- OnFocusGained = _PropertyGet("OnFocusGained")
- End Property ' OnFocusGained (get)
- Property Let OnFocusGained(ByVal pvValue As Variant)
- Call _PropertySet("OnFocusGained", pvValue)
- End Property ' OnFocusGained (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnFocusLost() As Variant
- OnFocusLost = _PropertyGet("OnFocusLost")
- End Property ' OnFocusLost (get)
- Property Let OnFocusLost(ByVal pvValue As Variant)
- Call _PropertySet("OnFocusLost", pvValue)
- End Property ' OnFocusLost (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnItemStateChanged() As Variant
- OnItemStateChanged = _PropertyGet("OnItemStateChanged")
- End Property ' OnItemStateChanged (get)
- Property Let OnItemStateChanged(ByVal pvValue As Variant)
- Call _PropertySet("OnItemStateChanged", pvValue)
- End Property ' OnItemStateChanged (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnKeyPressed() As Variant
- OnKeyPressed = _PropertyGet("OnKeyPressed")
- End Property ' OnKeyPressed (get)
- Property Let OnKeyPressed(ByVal pvValue As Variant)
- Call _PropertySet("OnKeyPressed", pvValue)
- End Property ' OnKeyPressed (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnKeyReleased() As Variant
- OnKeyReleased = _PropertyGet("OnKeyReleased")
- End Property ' OnKeyReleased (get)
- Property Let OnKeyReleased(ByVal pvValue As Variant)
- Call _PropertySet("OnKeyReleased", pvValue)
- End Property ' OnKeyReleased (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnMouseDragged() As Variant
- OnMouseDragged = _PropertyGet("OnMouseDragged")
- End Property ' OnMouseDragged (get)
- Property Let OnMouseDragged(ByVal pvValue As Variant)
- Call _PropertySet("OnMouseDragged", pvValue)
- End Property ' OnMouseDragged (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnMouseEntered() As Variant
- OnMouseEntered = _PropertyGet("OnMouseEntered")
- End Property ' OnMouseEntered (get)
- Property Let OnMouseEntered(ByVal pvValue As Variant)
- Call _PropertySet("OnMouseEntered", pvValue)
- End Property ' OnMouseEntered (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnMouseExited() As Variant
- OnMouseExited = _PropertyGet("OnMouseExited")
- End Property ' OnMouseExited (get)
- Property Let OnMouseExited(ByVal pvValue As Variant)
- Call _PropertySet("OnMouseExited", pvValue)
- End Property ' OnMouseExited (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnMouseMoved() As Variant
- OnMouseMoved = _PropertyGet("OnMouseMoved")
- End Property ' OnMouseMoved (get)
- Property Let OnMouseMoved(ByVal pvValue As Variant)
- Call _PropertySet("OnMouseMoved", pvValue)
- End Property ' OnMouseMoved (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnMousePressed() As Variant
- OnMousePressed = _PropertyGet("OnMousePressed")
- End Property ' OnMousePressed (get)
- Property Let OnMousePressed(ByVal pvValue As Variant)
- Call _PropertySet("OnMousePressed", pvValue)
- End Property ' OnMousePressed (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnMouseReleased() As Variant
- OnMouseReleased = _PropertyGet("OnMouseReleased")
- End Property ' OnMouseReleased (get)
- Property Let OnMouseReleased(ByVal pvValue As Variant)
- Call _PropertySet("OnMouseReleased", pvValue)
- End Property ' OnMouseReleased (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnResetted() As Variant
- OnResetted = _PropertyGet("OnResetted")
- End Property ' OnResetted (get)
- Property Let OnResetted(ByVal pvValue As Variant)
- Call _PropertySet("OnResetted", pvValue)
- End Property ' OnResetted (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnTextChanged() As Variant
- OnTextChanged = _PropertyGet("OnTextChanged")
- End Property ' OnTextChanged (get)
- Property Let OnTextChanged(ByVal pvValue As Variant)
- Call _PropertySet("OnTextChanged", pvValue)
- End Property ' OnTextChanged (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OnUpdated() As Variant
- OnUpdated = _PropertyGet("OnUpdated")
- End Property ' OnUpdated (get)
- Property Let OnUpdated(ByVal pvValue As Variant)
- Call _PropertySet("OnUpdated", pvValue)
- End Property ' OnUpdated (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get OptionValue() As Variant
- OptionValue = _PropertyGet("OptionValue")
- End Property ' OptionValue (get)
- Property Let OptionValue(ByVal pvValue As Variant)
- Call _PropertySet("OptionValue", pvValue)
- End Property ' OptionValue (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Page() As Variant
- Page = _PropertyGet("Page")
- End Property ' Page (get)
- Property Let Page(ByVal pvValue As Variant)
- Call _PropertySet("Page", pvValue)
- End Property ' Page (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function Parent() As Object
- Parent = _PropertyGet("Parent")
- End Function ' Parent (get) V0.9.1
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Picture() As Variant
- Picture = _PropertyGet("Picture")
- End Property ' Picture (get)
- Property Let Picture(ByVal pvValue As Variant)
- Call _PropertySet("Picture", pvValue)
- End Property ' Picture (set) V1.5.0
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
- ' Return
- ' a Collection object if pvIndex absent
- ' a Property object otherwise
- 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, _This, vPropertiesList)
- Else
- vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
- vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
- End If
-
- Exit_Function:
- Set Properties = vProperty
- Utils._ResetCalledSub("Control.Properties")
- Exit Function
- End Function ' Properties
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Required() As Variant
- Required = _PropertyGet("Required")
- End Property ' Required (get)
- Property Let Required(ByVal pvValue As Variant)
- Call _PropertySet("Required", pvValue)
- End Property ' Required (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get RowSource() As Variant
- RowSource = _PropertyGet("RowSource")
- End Property ' RowSource (get)
- Property Let RowSource(ByVal pvValue As Variant)
- Call _PropertySet("RowSource", pvValue)
- End Property ' RowSource (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get RowSourceType() As Variant
- RowSourceType = _PropertyGet("RowSourceType")
- End Property ' RowSourceType (get)
- Property Let RowSourceType(ByVal pvValue As Variant)
- Call _PropertySet("RowSourceType", pvValue)
- End Property ' RowSourceType (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Selected(ByVal Optional pvIndex As Variant) As Variant
- If IsMissing(pvIndex) Then Selected = _PropertyGet("Selected") Else Selected = _PropertyGet("Selected", pvIndex)
- End Property ' Selected (get)
- Property Let Selected(ByVal pvValue As Variant) ' , ByVal Optional pvIndex As Variant)
- ' If IsMissing(pvIndex) Then Call _PropertySet("Selected", pvValue) Else Call _PropertySet("Selected", pvValue, pvIndex)
- Call _PropertySet("Selected", pvValue)
- End Property ' Selected (set)
- Public Function SelectedI(ByVal pvValue As variant, ByVal pvIndex As Variant)
- Call _PropertySet("Selected", pvValue, pvIndex)
- End Function
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get SelLength() As Variant
- SelLength = _PropertyGet("SelLength")
- End Property ' SelLength (get)
- Property Let SelLength(ByVal pvValue As Variant)
- Call _PropertySet("SelLength", pvValue)
- End Property ' SelLength (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get SelStart() As Variant
- SelStart = _PropertyGet("SelStart")
- End Property ' SelStart (get)
- Property Let SelStart(ByVal pvValue As Variant)
- Call _PropertySet("SelStart", pvValue)
- End Property ' SelStart (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get SelText() As Variant
- SelText = _PropertyGet("SelText")
- End Property ' SelText (get)
- Property Let SelText(ByVal pvValue As Variant)
- Call _PropertySet("SelText", pvValue)
- End Property ' SelText (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get SpecialEffect() As Variant
- SpecialEffect = _PropertyGet("SpecialEffect")
- End Property ' SpecialEffect (get)
- Property Let SpecialEffect(ByVal pvValue As Variant)
- Call _PropertySet("SpecialEffect", pvValue)
- End Property ' SpecialEffect (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get SubType() As Variant
- SubType = _PropertyGet("SubType")
- End Property ' SubType (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get TabIndex() As Variant
- TabIndex = _PropertyGet("TabIndex")
- End Property ' TabIndex (get)
- Property Let TabIndex(ByVal pvValue As Variant)
- Call _PropertySet("TabIndex", pvValue)
- End Property ' TabIndex (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get TabStop() As Variant
- TabStop = _PropertyGet("TabStop")
- End Property ' TabStop (get)
- Property Let TabStop(ByVal pvValue As Variant)
- Call _PropertySet("TabStop", pvValue)
- End Property ' TabStop (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Tag() As Variant
- Tag = _PropertyGet("Tag")
- End Property ' Tag (get)
- Property Let Tag(ByVal pvValue As Variant)
- Call _PropertySet("Tag", pvValue)
- End Property ' Tag (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Text() As Variant
- Text = _PropertyGet("Text")
- End Property ' Text (get)
- Public Function pText() As Variant
- pText = _PropertyGet("Text")
- End Function ' pText (get)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get TextAlign() As Variant
- TextAlign = _PropertyGet("TextAlign")
- End Property ' TextAlign (get)
- Property Let TextAlign(ByVal pvValue As Variant)
- Call _PropertySet("TextAlign", pvValue)
- End Property ' TextAlign (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get TripleState() As Variant
- TripleState = _PropertyGet("TripleState")
- End Property ' TripleState (get)
- Property Let TripleState(ByVal pvValue As Variant)
- Call _PropertySet("TripleState", pvValue)
- End Property ' TripleState (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Value() As Variant
- Value = _PropertyGet("Value")
- End Property ' Value (get)
- Property Let Value(ByVal pvValue As Variant)
- Call _PropertySet("Value", pvValue)
- End Property ' Value (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- Property Get Visible() As Variant
- Visible = _PropertyGet("Visible")
- End Property ' Visible (get)
- Property Let Visible(ByVal pvValue As Variant)
- Call _PropertySet("Visible", pvValue)
- End Property ' Visible (set)
- REM -----------------------------------------------------------------------------------------------------------------------
- REM --- CLASS METHODS ---
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function AddItem(ByVal Optional pvItem As Variant, ByVal Optional pvIndex) As Boolean
- ' Add an item in a Listbox
- 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 ' AddItem V0.9.1
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
- ' Return a Control object with name or index = pvIndex
- 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 ' No argument, return Collection pseudo-object
- Set oCounter = New Collect
- Set oCounter._This = oCounter
- oCounter._CollType = COLLCONTROLS
- Set oCounter._Parent = _This
- oCounter._Count = iControlCount
- Set Controls = oCounter
- Goto Exit_Function
- End If
-
- If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
-
- ' Start building the ocControl object
- ' Determine exact name
- Set ocControl = New Control
- Set ocControl._This = ocControl
- Set ocControl._Parent = _This
- 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 ' Check control name validity (non case sensitive)
- 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 ' getImplementationName aborts for subcontrols !?
- ._FormComponent = ParentComponent
- ._MainForm = _MainForm
- If Utils._hasUNOProperty(.ControlModel, "ClassId") Then ._ClassId = .ControlModel.ClassId
- ' Complex bypass to find View of grid subcontrols !
- If Not IsNull(ControlView) Then ' Anticipate absence of ControlView in grid controls when edit mode
- 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 ' Controls
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function getProperty(Optional ByVal pvProperty As Variant, ByVal Optional pvIndex As Variant) As Variant
- ' Return property value of psProperty property name
- 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 ' getProperty
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
- ' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
- If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
- Exit Function
-
- End Function ' hasProperty
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function RemoveItem(ByVal Optional pvIndex) As Boolean
- ' Remove an item from a Listbox
- ' Index may be a string value or an index-position
- 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 ' Remove only 1st occurrence of string
- 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 ' https://forum.openoffice.org/en/forum/viewtopic.php?f=47&t=75008
- 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 ' RemoveItem V0.9.1
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function Requery() As Boolean
- ' Refresh data displayed in a form, subform, combobox or listbox
- 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 ' Requery
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function SetFocus() As Boolean
- ' Execute setFocus method
- 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 'setFocus method does not work on controlviews in grid ?!?
- ' Find column position of control
- iColPosition = -1
- ocGrid = getObject(_getUpperShortcut(_Shortcut, _Name)) ' return containing grid
- 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 ' Skip if hidden
- If oGridModel.GetByIndex(i).Name = _Name Then
- iColPosition = j
- Exit For
- End If
- Next i
- If iColPosition >= 0 Then
- ocGrid.ControlView.setFocus() 'Set first focus on grid itself
- ocGrid.ControlView.setCurrentColumnPosition(iColPosition) 'Deprecated but no alternative found
- 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 ' SetFocus V0.9.0
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean
- ' Return True if property setting OK
- 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 ' setProperty
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function SetSelected(ByVal Optional pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean
- ' Workaround for limitation of Basic: Property Let does not accept optional arguments
- If IsMissing(pvValue) Then Call _TraceArguments()
- If IsMissing(pvIndex) Then
- SetSelected = _PropertySet("Selected", pvValue)
- Else
- SetSelected = _PropertySet("Selected", pvValue, pvIndex)
- End If
- End Function ' SetSelected
- REM -----------------------------------------------------------------------------------------------------------------------
- REM --- PRIVATE FUNCTIONS ---
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Function _Formats(ByVal psControlType As String) As Variant
- ' Return allowed format entries for Date and Time control types
- 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 ' _Formats V0.9.1
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Function _GetListener(ByVal psProperty As String) As String
- ' Return the X...Listener corresponding with the property in argument
- 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 ' _GetListener V1.7.0
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Sub _Initialize()
- ' Initialize new Control
- ' ControlModel, ParentType, Name, Shortcut, ControlView, ImplementationName, ClassId (if parent <> dialog)
- ' are presumed preexisting
- ' Identify SubType and ControlView
- 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)))
- ' Manage homonyms
- 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
- 'Is ClassId one of the properties ?
- If _ClassId > 0 Then ' All control types have a ClassId except subforms
- _SubType = sControlTypes(_ClassId - 1)
- _ControlType = _ClassId
- If _SubType = CTLTEXTFIELD Then ' Formatted fields belong to the TextField family
- 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 ' When in datagrid
- _SubType = CTLFORMATTEDFIELD
- _ControlType = acFormattedField
- End If
- End If
- Else ' Initialize subform Control
- If ControlModel.ImplementationName = "com.sun.star.comp.forms.ODatabaseForm" Then
- _SubType = CTLSUBFORM
- _ControlType = acSubform
- End If
- End If
- End Select
- End Sub ' _Initialize
- REM -----------------------------------------------------------------------------------------------------------------------
- Public Function _ListboxBound() As Boolean
- ' Return True if listbox has a bound column
- 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 ' MultiSelect behaviour changed in OpenOffice >= 3.3
- 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 ' _ListboxBound V0.9.0
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Function _PropertiesList() As Variant
- ' Based on ControlProperties.ods analysis
- Dim vFullPropertiesList() As Variant
- 'List established only once
- 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
- ' To be duplicated from above !!!
- 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 ' _PropertiesList
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Function _PropertyGet(ByVal psProperty As String, ByVal Optional pvIndex As Variant) As Variant
- ' Return property value of the psProperty property name
- Dim iArg As Integer
- If _ErrorHandler() Then On Local Error Goto Error_Function
- Utils._SetCalledSub("Control.get" & psProperty)
- _PropertyGet = EMPTY
- 'Check Index argument
- 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 ' AOO and LO <= 4.1
- vDefaultValue = ControlModel.DefaultDate
- _PropertyGet = DateSerial(Left(vDefaultValue, 4), Mid(vDefaultValue, 5, 2), Right(vDefaultValue, 2))
- Case vbObject ' LO >= 4.2 com.sun.star.Util.Date
- Set oDefaultValue = ControlModel.DefaultDate
- _PropertyGet = 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 ' Is array initialized ?
- iIndex = UBound(ControlModel.StringItemList)
- If vDefaultValue(0) >= 0 And vDefaultValue(0) <= iIndex Then _PropertyGet = ControlModel.StringItemList(vDefaultValue(0))
- ' Only first default value is considered
- 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 ' AOO and LO <= 4.1
- _PropertyGet = ControlModel.DefaultTime
- Case vbObject ' LO >= 4.2 com.sun.star.Util.Time
- 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 ' Start building the SUBFORM object
- With ofSubForm
- Set ._This = 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 ' Either Multiple selections or no selection at all
- 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 ' Multiselection or synonyms rejected
- End If
- Case CTLLISTBOX ' No mean found to access bound column !! See mail Lionel 10/5/2013 for improvement
- If Not Utils._hasUNOProperty(ControlModel, "SelectedItems") Then Goto Trace_Error
- If UBound(ControlModel.SelectedItems) > 0 Then ' Several items selected
- Else ' Mono selection
- If _ParentType <> CTLPARENTISDIALOG Then ' getCurrentValue not found in dialog listboxes ??
- vCurrentValue = ControlModel.getCurrentValue() ' Space or uninitialized array if no selection at all
- If IsArray(vCurrentValue) Then ' Is an array if MultiSelect
- vListboxValue = ""
- If UBound(vCurrentValue) = 0 Then vListboxValue = vCurrentValue(0)
- Else
- vListboxValue = vCurrentValue
- End If
- If vListboxValue <> "" Then ' Speed up search PM Pastim 12/02/2013
- 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 ' Boolean in OO, Integer (0, 1 or 2) in VBA
- ElseIf Utils._hasUNOProperty(ControlModel, "MultiSelectionSimpleMode") Then ' Not documented: only for GridControls !? Changed in OO >= 3,3 !?
- _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 = _Parent
- 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 ' Do nothing if listbox empty
- _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 ' probably control does not have focus
- 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 ' probably control does not have focus
- 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 ' AOO and LO <= 4.1
- vDate = DateSerial(Left(ControlModel.Date, 4), Mid(ControlModel.Date, 5, 2), Right(ControlModel.Date, 2))
- Case vbObject ' LO >= 4.2
- 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 ' AOO and LO <= 4.1
- _PropertyGet = Format(ControlModel.Time, "HH:MM:SS")
- Case vbObject ' LO >= 4.2 com.sun.star.Util.Time
- 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 ' AOO and LO <= 4.1
- vValue = ControlModel.Date
- vGet = DateSerial(Left(vValue, 4), Mid(vValue, 5, 2), Right(vValue, 2))
- Case vbObject ' LO >= 4.2 com.sun.star.Util.Date
- 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 ' Several items selected
- vGet = EMPTY ' Listbox has no value, only an array of Selected flags to identify values
- Else ' Mono selection
- 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
- 'getCurrentValue does not return any significant value anymore
- ' Speed up getting value PM PASTIM 12/02/2013
- If Ubound(ControlModel.SelectedItems) >= 0 Then lListIndex = Controlmodel.Selecteditems(0) Else lListIndex = -1
- ' If listbox has hidden column = real bound field, then explore ValueItemList
- If _ListboxBound() Then
- If lListIndex > -1 Then vGet = ControlModel.ValueItemList(lListIndex) ' PASTIM
- Else
- If lListIndex > -1 Then vGet = ControlModel.getItemText(lListIndex)
- 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 ' AOO and LO <= 4.1
- vGet = ControlModel.Time
- Case vbObject ' LO >= 4.2 com.sun.star.Util.Time
- 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 ' Give getCurrentValue an additional try
- 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 ' _PropertyGet V0.9.1
- REM -----------------------------------------------------------------------------------------------------------------------
- Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant, ByVal Optional pvIndex As Variant) As Boolean
- ' Return True if property setting OK
- If _ErrorHandler() Then On Local Error Goto Error_Function
- Utils._SetCalledSub("Control.set" & psProperty)
- _PropertySet = True
- 'Check Index argument
- If Not IsMissing(pvIndex) Then
- If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric()) Then Goto Exit_Function
- End If
- 'Execute
- 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 ' 0 = No border, 1 = 3D border, 2 = Normal border
- 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 ' AOO and LO <= 4.1
- ControlModel.DefaultDate = Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue)
- Case vbObject ' LO >= 4.2 com.sun.star.Util.Date
- 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 ' 0 = Not checked 1 = Checked 2 = don't know
- 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 ' 0 = Not checked 1 = Checked
- 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 ' AOO and LO <= 4.1
- ControlModel.DefaultTime = pvValue
- Case vbObject ' LO >= 4.2 com.sun.star.Util.Time
- 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 ' Thanks, PASTIM
- 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 ' Iif construction does not work !
- 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 ' Iif construction does not work !
- 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 ' Iif construction does not work !
- 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() ' Cancel selections when MultiSelect becomes False
- 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 ' Check existence of table or query and find its correct (case-sensitive) name
- 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 ' Forbidden for COMBOBOX !
- 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") ' Refresh done when RowSource changes, not 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 ' Full boolean array passed
- 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) ' Count True values
- 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 ' iSelectedItems maps OO internals (size = # of selected items)
- Else
- ControlModel.SelectedItems = Array()
- End If
- Else ' Single boolean value passed
- 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) ' bSelected maps VBA internals (size = # of displayed items)
- If Not bMultiSelect Then ' Set all other values to False
- For i = 0 To lListCount - 1
- If i = pvIndex Then
- bSelected(i) = pvValue ' All entries = False except one
- 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 ' Rebuild SelectedItems
- 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 ' Also reset length to 0
- 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) ' Case sensitive !
- 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 ' 0 = None, 1 = Look3D, 2 = Flat
- 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 ' 0 = Left, 1 = Center, 2 = Right
- 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 ' 0 = Not checked 1 = Checked 2 = don't know
- 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" ' AOO and LO <= 4.1
- 'ControlModel.Date = Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue) ' Gives error in dialogs ?!?
- ControlModel.setPropertyValue("Date", Year(pvValue) * 10000 + Month(pvValue) * 100 + Day(pvValue))
- Case "com.sun.star.util.Date" ' LO >= 4.2
- 'Direct assignment of ControlModel.Date.Xxx has no effect ?!?
- 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 ' PASTIM
- If IsArray(pvValue) Then Goto Trace_Error_Value ' Setting the value on a listbox is allowed only if single value and value in the list
- ' Check ValueItemList
- bFound = False
- Select Case _ParentType
- Case CTLPARENTISDIALOG
- vItemList = ControlModel.StringItemList
- Case Else
- If _ListboxBound() Then ' Performance improvement (PASTIM PM 9 Feb 2013)
- 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" ' AOO and LO <= 4.0
- ControlModel.Time = CLng(pvValue)
- Case "com.sun.star.util.Time" ' LO >= 4.1
- 'Direct assignment of ControlModel.Time.Xxx gives error ?!?
- 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
- ' FINAL COMMITMENT
- If Utils._hasUNOMethod(ControlModel, "commit") Then ControlModel.commit() ' f.i. checkboxes have no commit method ?? [PASTIM]
- Case UCase("Visible")
- If _SubType = CTLHIDDENCONTROL Then Goto Trace_Error ' Hidden remains hidden !!
- 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 ' _PropertySet V1.1.0
- </script:module>
|