12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084 |
- <?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="SF_DialogControl" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
- REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
- REM === The SFDialogs library is one of the associated libraries. ===
- REM === Full documentation is available on https://help.libreoffice.org/ ===
- REM =======================================================================================================================
- Option Compatible
- Option ClassModule
- Option Explicit
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- ''' SF_DialogControl
- ''' ================
- ''' Manage the controls belonging to a dialog defined with the Basic IDE
- ''' Each instance of the current class represents a single control within a dialog box
- '''
- ''' The focus is clearly set on getting and setting the values displayed by the controls of the dialog box,
- ''' not on their formatting. The latter is easily accessible via the XControlModel and XControlView
- ''' UNO objects.
- ''' Essentially a single property "Value" maps many alternative UNO properties depending each on
- ''' the control type.
- '''
- ''' A special attention is given to controls with types TreeControl and TableControl
- ''' It is easy with the API proposed in the current class to populate a tree, either
- ''' - branch by branch (CreateRoot and AddSubNode), or
- ''' - with a set of branches at once (AddSubtree)
- ''' Additionally populating a TreeControl can be done statically or dynamically
- '''
- ''' With the method SetTableData(), feed a tablecontrol with a sortable and selectable
- ''' array of data. Columns and rows may receive a header. Column widths are adjusted manually by the user or
- ''' with the same method. Alignments can be set as well by script.
- '''
- ''' Service invocation:
- ''' Dim myDialog As Object, myControl As Object
- ''' Set myDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", myLibrary, DialogName)
- ''' Set myControl = myDialog.Controls("myTextBox")
- ''' myControl.Value = "Dialog started at " & Now()
- ''' myDialog.Execute()
- ''' ' ... process the controls actual values
- ''' myDialog.Terminate()
- '''
- ''' Detailed user documentation:
- ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_dialogcontrol.html?DbPAR=BASIC
- '''
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- REM ================================================================== EXCEPTIONS
- Private Const CONTROLTYPEERROR = "CONTROLTYPEERROR"
- Private Const TEXTFIELDERROR = "TEXTFIELDERROR"
- REM ============================================================= PRIVATE MEMBERS
- Private [Me] As Object
- Private [_Parent] As Object
- Private ObjectType As String ' Must be DIALOGCONTROL
- Private ServiceName As String
- ' Control naming
- Private _Name As String
- Private _IndexOfNames As Long ' Index in ElementNames array. Used to access SF_Dialog._ControlCache
- Private _DialogName As String ' Parent dialog name
- ' Control UNO references
- Private _ControlModel As Object ' com.sun.star.awt.XControlModel
- Private _ControlView As Object ' com.sun.star.awt.XControl - stardiv.Toolkit.UnoDialogControl
- Private _TreeDataModel As Object ' com.sun.star.awt.tree.MutableTreeDataModel
- Private _GridColumnModel As Object ' com.sun.star.awt.grid.XGridColumnModel
- Private _GridDataModel As Object ' com.sun.star.awt.grid.XGridDataModel
- ' Control attributes
- Private _ImplementationName As String
- Private _ControlType As String ' One of the CTLxxx constants
- ' Tree control on-select and on-expand attributes
- ' Tree controls may be associated with events not defined in the Basic IDE
- Private _OnNodeSelected As String ' Script to invoke when a node is selected
- Private _OnNodeExpanded As String ' Script to invoke when a node is expanded
- Private _SelectListener As Object ' com.sun.star.view.XSelectionChangeListener
- Private _ExpandListener As Object ' com.sun.star.awt.tree.XTreeExpansionListener
- ' Table control attributes
- Private _ColumnWidths As Variant ' Array of column widths
- REM ============================================================ MODULE CONSTANTS
- Private Const CTLBUTTON = "Button"
- Private Const CTLCHECKBOX = "CheckBox"
- Private Const CTLCOMBOBOX = "ComboBox"
- Private Const CTLCURRENCYFIELD = "CurrencyField"
- Private Const CTLDATEFIELD = "DateField"
- Private Const CTLFILECONTROL = "FileControl"
- Private Const CTLFIXEDLINE = "FixedLine"
- Private Const CTLFIXEDTEXT = "FixedText"
- Private Const CTLFORMATTEDFIELD = "FormattedField"
- Private Const CTLGROUPBOX = "GroupBox"
- Private Const CTLIMAGECONTROL = "ImageControl"
- Private Const CTLLISTBOX = "ListBox"
- Private Const CTLNUMERICFIELD = "NumericField"
- Private Const CTLPATTERNFIELD = "PatternField"
- Private Const CTLPROGRESSBAR = "ProgressBar"
- Private Const CTLRADIOBUTTON = "RadioButton"
- Private Const CTLSCROLLBAR = "ScrollBar"
- Private Const CTLTABLECONTROL = "TableControl"
- Private Const CTLTEXTFIELD = "TextField"
- Private Const CTLTIMEFIELD = "TimeField"
- Private Const CTLTREECONTROL = "TreeControl"
- REM ====================================================== CONSTRUCTOR/DESTRUCTOR
- REM -----------------------------------------------------------------------------
- Private Sub Class_Initialize()
- Set [Me] = Nothing
- Set [_Parent] = Nothing
- ObjectType = "DIALOGCONTROL"
- ServiceName = "SFDialogs.DialogControl"
- _Name = ""
- _IndexOfNames = -1
- _DialogName = ""
- Set _ControlModel = Nothing
- Set _ControlView = Nothing
- Set _TreeDataModel = Nothing
- Set _GridColumnModel = Nothing
- Set _GridDataModel = Nothing
- _ImplementationName = ""
- _ControlType = ""
- _OnNodeSelected = ""
- _OnNodeExpanded = ""
- Set _SelectListener = Nothing
- Set _ExpandListener = Nothing
- _ColumnWidths = Array()
- End Sub ' SFDialogs.SF_DialogControl Constructor
- REM -----------------------------------------------------------------------------
- Private Sub Class_Terminate()
- Call Class_Initialize()
- End Sub ' SFDialogs.SF_DialogControl Destructor
- REM -----------------------------------------------------------------------------
- Public Function Dispose() As Variant
- Call Class_Terminate()
- Set Dispose = Nothing
- End Function ' SFDialogs.SF_DialogControl Explicit Destructor
- REM ================================================================== PROPERTIES
- REM -----------------------------------------------------------------------------
- Property Get Cancel() As Variant
- ''' The Cancel property specifies if a command button has or not the behaviour of a Cancel button.
- Cancel = _PropertyGet("Cancel", False)
- End Property ' SFDialogs.SF_DialogControl.Cancel (get)
- REM -----------------------------------------------------------------------------
- Property Let Cancel(Optional ByVal pvCancel As Variant)
- ''' Set the updatable property Cancel
- _PropertySet("Cancel", pvCancel)
- End Property ' SFDialogs.SF_DialogControl.Cancel (let)
- REM -----------------------------------------------------------------------------
- Property Get Caption() As Variant
- ''' The Caption property refers to the text associated with the control
- Caption = _PropertyGet("Caption", "")
- End Property ' SFDialogs.SF_DialogControl.Caption (get)
- REM -----------------------------------------------------------------------------
- Property Let Caption(Optional ByVal pvCaption As Variant)
- ''' Set the updatable property Caption
- _PropertySet("Caption", pvCaption)
- End Property ' SFDialogs.SF_DialogControl.Caption (let)
- REM -----------------------------------------------------------------------------
- Property Get ControlType() As String
- ''' Return the type of the actual control: "CheckBox", "TextField", "DateField", ...
- ControlType = _PropertyGet("ControlType")
- End Property ' SFDialogs.SF_DialogControl.ControlType
- REM -----------------------------------------------------------------------------
- Property Get CurrentNode() As Variant
- ''' The CurrentNode property returns the currently selected node
- ''' It returns Empty when there is no node selected
- ''' When there are several selections, it returns the topmost node among the selected ones
- CurrentNode = _PropertyGet("CurrentNode", "")
- End Property ' SFDialogs.SF_DialogControl.CurrentNode (get)
- REM -----------------------------------------------------------------------------
- Property Let CurrentNode(Optional ByVal pvCurrentNode As Variant)
- ''' Set a single selection in a tree control
- _PropertySet("CurrentNode", pvCurrentNode)
- End Property ' SFDialogs.SF_DialogControl.CurrentNode (let)
- REM -----------------------------------------------------------------------------
- Property Get Default() As Variant
- ''' The Default property specifies whether a command button is the default (OK) button.
- Default = _PropertyGet("Default", False)
- End Property ' SFDialogs.SF_DialogControl.Default (get)
- REM -----------------------------------------------------------------------------
- Property Let Default(Optional ByVal pvDefault As Variant)
- ''' Set the updatable property Default
- _PropertySet("Default", pvDefault)
- End Property ' SFDialogs.SF_DialogControl.Default (let)
- REM -----------------------------------------------------------------------------
- Property Get Enabled() As Variant
- ''' The Enabled property specifies if the control is accessible with the cursor.
- Enabled = _PropertyGet("Enabled")
- End Property ' SFDialogs.SF_DialogControl.Enabled (get)
- REM -----------------------------------------------------------------------------
- Property Let Enabled(Optional ByVal pvEnabled As Variant)
- ''' Set the updatable property Enabled
- _PropertySet("Enabled", pvEnabled)
- End Property ' SFDialogs.SF_DialogControl.Enabled (let)
- REM -----------------------------------------------------------------------------
- Property Get Format() As Variant
- ''' The Format property specifies the format in which to display dates and times.
- Format = _PropertyGet("Format", "")
- End Property ' SFDialogs.SF_DialogControl.Format (get)
- REM -----------------------------------------------------------------------------
- Property Let Format(Optional ByVal pvFormat As Variant)
- ''' Set the updatable property Format
- ''' NB: Format is read-only for formatted field controls
- _PropertySet("Format", pvFormat)
- End Property ' SFDialogs.SF_DialogControl.Format (let)
- REM -----------------------------------------------------------------------------
- Property Get ListCount() As Long
- ''' The ListCount property specifies the number of rows in a list box or a combo box
- ListCount = _PropertyGet("ListCount", 0)
- End Property ' SFDialogs.SF_DialogControl.ListCount (get)
- REM -----------------------------------------------------------------------------
- Property Get ListIndex() As Variant
- ''' The ListIndex property specifies which item is selected in a list box or combo box.
- ''' In case of multiple selection, the index of the first one is returned or only one is set
- ListIndex = _PropertyGet("ListIndex", -1)
- End Property ' SFDialogs.SF_DialogControl.ListIndex (get)
- REM -----------------------------------------------------------------------------
- Property Let ListIndex(Optional ByVal pvListIndex As Variant)
- ''' Set the updatable property ListIndex
- _PropertySet("ListIndex", pvListIndex)
- End Property ' SFDialogs.SF_DialogControl.ListIndex (let)
- REM -----------------------------------------------------------------------------
- Property Get Locked() As Variant
- ''' The Locked property specifies if a control is read-only
- Locked = _PropertyGet("Locked", False)
- End Property ' SFDialogs.SF_DialogControl.Locked (get)
- REM -----------------------------------------------------------------------------
- Property Let Locked(Optional ByVal pvLocked As Variant)
- ''' Set the updatable property Locked
- _PropertySet("Locked", pvLocked)
- End Property ' SFDialogs.SF_DialogControl.Locked (let)
- REM -----------------------------------------------------------------------------
- Property Get MultiSelect() As Variant
- ''' The MultiSelect property specifies whether a user can make multiple selections in a listbox
- MultiSelect = _PropertyGet("MultiSelect", False)
- End Property ' SFDialogs.SF_DialogControl.MultiSelect (get)
- REM -----------------------------------------------------------------------------
- Property Let MultiSelect(Optional ByVal pvMultiSelect As Variant)
- ''' Set the updatable property MultiSelect
- _PropertySet("MultiSelect", pvMultiSelect)
- End Property ' SFDialogs.SF_DialogControl.MultiSelect (let)
- REM -----------------------------------------------------------------------------
- Property Get Name() As String
- ''' Return the name of the actual control
- Name = _PropertyGet("Name")
- End Property ' SFDialogs.SF_DialogControl.Name
- REM -----------------------------------------------------------------------------
- Property Get OnActionPerformed() As Variant
- ''' Get the script associated with the OnActionPerformed event
- OnActionPerformed = _PropertyGet("OnActionPerformed")
- End Property ' SFDialogs.SF_DialogControl.OnActionPerformed (get)
- REM -----------------------------------------------------------------------------
- Property Get OnAdjustmentValueChanged() As Variant
- ''' Get the script associated with the OnAdjustmentValueChanged event
- OnAdjustmentValueChanged = _PropertyGet("OnAdjustmentValueChanged")
- End Property ' SFDialogs.SF_DialogControl.OnAdjustmentValueChanged (get)
- REM -----------------------------------------------------------------------------
- Property Get OnFocusGained() As Variant
- ''' Get the script associated with the OnFocusGained event
- OnFocusGained = _PropertyGet("OnFocusGained")
- End Property ' SFDialogs.SF_DialogControl.OnFocusGained (get)
- REM -----------------------------------------------------------------------------
- Property Get OnFocusLost() As Variant
- ''' Get the script associated with the OnFocusLost event
- OnFocusLost = _PropertyGet("OnFocusLost")
- End Property ' SFDialogs.SF_DialogControl.OnFocusLost (get)
- REM -----------------------------------------------------------------------------
- Property Get OnItemStateChanged() As Variant
- ''' Get the script associated with the OnItemStateChanged event
- OnItemStateChanged = _PropertyGet("OnItemStateChanged")
- End Property ' SFDialogs.SF_DialogControl.OnItemStateChanged (get)
- REM -----------------------------------------------------------------------------
- Property Get OnKeyPressed() As Variant
- ''' Get the script associated with the OnKeyPressed event
- OnKeyPressed = _PropertyGet("OnKeyPressed")
- End Property ' SFDialogs.SF_DialogControl.OnKeyPressed (get)
- REM -----------------------------------------------------------------------------
- Property Get OnKeyReleased() As Variant
- ''' Get the script associated with the OnKeyReleased event
- OnKeyReleased = _PropertyGet("OnKeyReleased")
- End Property ' SFDialogs.SF_DialogControl.OnKeyReleased (get)
- REM -----------------------------------------------------------------------------
- Property Get OnMouseDragged() As Variant
- ''' Get the script associated with the OnMouseDragged event
- OnMouseDragged = _PropertyGet("OnMouseDragged")
- End Property ' SFDialogs.SF_DialogControl.OnMouseDragged (get)
- REM -----------------------------------------------------------------------------
- Property Get OnMouseEntered() As Variant
- ''' Get the script associated with the OnMouseEntered event
- OnMouseEntered = _PropertyGet("OnMouseEntered")
- End Property ' SFDialogs.SF_DialogControl.OnMouseEntered (get)
- REM -----------------------------------------------------------------------------
- Property Get OnMouseExited() As Variant
- ''' Get the script associated with the OnMouseExited event
- OnMouseExited = _PropertyGet("OnMouseExited")
- End Property ' SFDialogs.SF_DialogControl.OnMouseExited (get)
- REM -----------------------------------------------------------------------------
- Property Get OnMouseMoved() As Variant
- ''' Get the script associated with the OnMouseMoved event
- OnMouseMoved = _PropertyGet("OnMouseMoved")
- End Property ' SFDialogs.SF_DialogControl.OnMouseMoved (get)
- REM -----------------------------------------------------------------------------
- Property Get OnMousePressed() As Variant
- ''' Get the script associated with the OnMousePressed event
- OnMousePressed = _PropertyGet("OnMousePressed")
- End Property ' SFDialogs.SF_DialogControl.OnMousePressed (get)
- REM -----------------------------------------------------------------------------
- Property Get OnMouseReleased() As Variant
- ''' Get the script associated with the OnMouseReleased event
- OnMouseReleased = _PropertyGet("OnMouseReleased")
- End Property ' SFDialogs.SF_DialogControl.OnMouseReleased (get)
- REM -----------------------------------------------------------------------------
- Property Get OnNodeExpanded() As Variant
- ''' Get the script associated with the OnNodeExpanded event
- OnNodeExpanded = _PropertyGet("OnNodeExpanded")
- End Property ' SFDialogs.SF_DialogControl.OnNodeExpanded (get)
- REM -----------------------------------------------------------------------------
- Property Let OnNodeExpanded(Optional ByVal pvOnNodeExpanded As Variant)
- ''' Set the updatable property OnNodeExpanded
- _PropertySet("OnNodeExpanded", pvOnNodeExpanded)
- End Property ' SFDialogs.SF_DialogControl.OnNodeExpanded (let)
- REM -----------------------------------------------------------------------------
- Property Get OnNodeSelected() As Variant
- ''' Get the script associated with the OnNodeSelected event
- OnNodeSelected = _PropertyGet("OnNodeSelected")
- End Property ' SFDialogs.SF_DialogControl.OnNodeSelected (get)
- REM -----------------------------------------------------------------------------
- Property Let OnNodeSelected(Optional ByVal pvOnNodeSelected As Variant)
- ''' Set the updatable property OnNodeSelected
- _PropertySet("OnNodeSelected", pvOnNodeSelected)
- End Property ' SFDialogs.SF_DialogControl.OnNodeSelected (let)
- REM -----------------------------------------------------------------------------
- Property Get OnTextChanged() As Variant
- ''' Get the script associated with the OnTextChanged event
- OnTextChanged = _PropertyGet("OnTextChanged")
- End Property ' SFDialogs.SF_DialogControl.OnTextChanged (get)
- REM -----------------------------------------------------------------------------
- Property Get Page() As Variant
- ''' A dialog may have several pages that can be traversed by the user step by step. The Page property of the Dialog object defines which page of the dialog is active.
- ''' The Page property of a control defines the page of the dialog on which the control is visible.
- ''' For example, if a control has a page value of 1, it is only visible on page 1 of the dialog.
- ''' If the page value of the dialog is increased from 1 to 2, then all controls with a page value of 1 disappear and all controls with a page value of 2 become visible.
- Page = _PropertyGet("Page")
- End Property ' SFDialogs.SF_DialogControl.Page (get)
- REM -----------------------------------------------------------------------------
- Property Let Page(Optional ByVal pvPage As Variant)
- ''' Set the updatable property Page
- _PropertySet("Page", pvPage)
- End Property ' SFDialogs.SF_DialogControl.Page (let)
- REM -----------------------------------------------------------------------------
- Property Get Parent() As Object
- ''' Return the Parent dialog object of the actual control
- Parent = _PropertyGet("Parent", Nothing)
- End Property ' SFDialogs.SF_DialogControl.Parent
- REM -----------------------------------------------------------------------------
- Property Get Picture() As Variant
- ''' The Picture property specifies a bitmap or other type of graphic to be displayed on the specified control
- Picture = _PropertyGet("Picture", "")
- End Property ' SFDialogs.SF_DialogControl.Picture (get)
- REM -----------------------------------------------------------------------------
- Property Let Picture(Optional ByVal pvPicture As Variant)
- ''' Set the updatable property Picture
- _PropertySet("Picture", pvPicture)
- End Property ' SFDialogs.SF_DialogControl.Picture (let)
- REM -----------------------------------------------------------------------------
- Property Get RootNode() As Variant
- ''' The RootNode property returns the last root node of a tree control
- RootNode = _PropertyGet("RootNode", "")
- End Property ' SFDialogs.SF_DialogControl.RootNode (get)
- REM -----------------------------------------------------------------------------
- Property Get RowSource() As Variant
- ''' The RowSource property specifies the data contained in a combobox or a listbox
- ''' as a zero-based array of string values
- RowSource = _PropertyGet("RowSource", "")
- End Property ' SFDialogs.SF_DialogControl.RowSource (get)
- REM -----------------------------------------------------------------------------
- Property Let RowSource(Optional ByVal pvRowSource As Variant)
- ''' Set the updatable property RowSource
- _PropertySet("RowSource", pvRowSource)
- End Property ' SFDialogs.SF_DialogControl.RowSource (let)
- REM -----------------------------------------------------------------------------
- Property Get Text() As Variant
- ''' The Text property specifies the actual content of the control like it is displayed on the screen
- Text = _PropertyGet("Text", "")
- End Property ' SFDialogs.SF_DialogControl.Text (get)
- REM -----------------------------------------------------------------------------
- Property Get TipText() As Variant
- ''' The TipText property specifies the text that appears in a screentip when you hold the mouse pointer over a control
- TipText = _PropertyGet("TipText", "")
- End Property ' SFDialogs.SF_DialogControl.TipText (get)
- REM -----------------------------------------------------------------------------
- Property Let TipText(Optional ByVal pvTipText As Variant)
- ''' Set the updatable property TipText
- _PropertySet("TipText", pvTipText)
- End Property ' SFDialogs.SF_DialogControl.TipText (let)
- REM -----------------------------------------------------------------------------
- Property Get TripleState() As Variant
- ''' The TripleState property specifies how a check box will display Null values
- ''' When True, the control will cycle through states for Yes, No, and Null values. The control appears dimmed (grayed) when its Value property is set to Null.
- ''' When False, the control will cycle through states for Yes and No values. Null values display as if they were No values.
- TripleState = _PropertyGet("TripleState", False)
- End Property ' SFDialogs.SF_DialogControl.TripleState (get)
- REM -----------------------------------------------------------------------------
- Property Let TripleState(Optional ByVal pvTripleState As Variant)
- ''' Set the updatable property TripleState
- _PropertySet("TripleState", pvTripleState)
- End Property ' SFDialogs.SF_DialogControl.TripleState (let)
- REM -----------------------------------------------------------------------------
- Property Get Value() As Variant
- ''' The Value property specifies the data contained in the control
- Value = _PropertyGet("Value", Empty)
- End Property ' SFDialogs.SF_DialogControl.Value (get)
- REM -----------------------------------------------------------------------------
- Property Let Value(Optional ByVal pvValue As Variant)
- ''' Set the updatable property Value
- _PropertySet("Value", pvValue)
- End Property ' SFDialogs.SF_DialogControl.Value (let)
- REM -----------------------------------------------------------------------------
- Property Get Visible() As Variant
- ''' The Visible property specifies if the control is accessible with the cursor.
- Visible = _PropertyGet("Visible", True)
- End Property ' SFDialogs.SF_DialogControl.Visible (get)
- REM -----------------------------------------------------------------------------
- Property Let Visible(Optional ByVal pvVisible As Variant)
- ''' Set the updatable property Visible
- _PropertySet("Visible", pvVisible)
- End Property ' SFDialogs.SF_DialogControl.Visible (let)
- REM -----------------------------------------------------------------------------
- Property Get XControlModel() As Object
- ''' The XControlModel property returns the model UNO object of the control
- XControlModel = _PropertyGet("XControlModel", Nothing)
- End Property ' SFDialogs.SF_DialogControl.XControlModel (get)
- REM -----------------------------------------------------------------------------
- Property Get XControlView() As Object
- ''' The XControlView property returns the view UNO object of the control
- XControlView = _PropertyGet("XControlView", Nothing)
- End Property ' SFDialogs.SF_DialogControl.XControlView (get)
- REM -----------------------------------------------------------------------------
- Property Get XGridColumnModel() As Object
- ''' The XGridColumnModel property returns the mutable data model UNO object of the tree control
- XGridColumnModel = _PropertyGet("XGridColumnModel", Nothing)
- End Property ' SFDialogs.SF_DialogControl.XGridColumnModel (get)
- REM -----------------------------------------------------------------------------
- Property Get XGridDataModel() As Object
- ''' The XGridDataModel property returns the mutable data model UNO object of the tree control
- XGridDataModel = _PropertyGet("XGridDataModel", Nothing)
- End Property ' SFDialogs.SF_DialogControl.XGridDataModel (get)
- REM -----------------------------------------------------------------------------
- Property Get XTreeDataModel() As Object
- ''' The XTreeDataModel property returns the mutable data model UNO object of the tree control
- XTreeDataModel = _PropertyGet("XTreeDataModel", Nothing)
- End Property ' SFDialogs.SF_DialogControl.XTreeDataModel (get)
- REM ===================================================================== METHODS
- REM -----------------------------------------------------------------------------
- Public Function AddSubNode(Optional ByRef ParentNode As Variant _
- , Optional ByVal DisplayValue As Variant _
- , Optional ByRef DataValue As Variant _
- ) As Variant
- ''' Return a new node of the tree control subordinate to a parent node
- ''' Args:
- ''' ParentNode: A node UNO object, of type com.sun.star.awt.tree.XMutableTreeNode
- ''' DisplayValue: the text appearing in the control box
- ''' DataValue: any value associated with the new node. Default = Empty
- ''' Returns:
- ''' The new node UNO object: com.sun.star.awt.tree.XMutableTreeNode
- ''' Examples:
- ''' Dim myTree As Object, myNode As Object, theRoot As Object
- ''' Set myTree = myDialog.Controls("myTreeControl")
- ''' Set theRoot = myTree.CreateRoot("Tree top")
- ''' Set myNode = myTree.AddSubNode(theRoot, "A branch ...")
- Dim oNode As Object ' Return value
- Const cstThisSub = "SFDialogs.DialogControl.AddSubNode"
- Const cstSubArgs = "ParentNode, DisplayValue, [DataValue=Empty]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Set oNode = Nothing
- Check:
- If IsMissing(DataValue) Then DataValue = Empty
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If _ControlType <> CTLTREECONTROL Then GoTo CatchType
- If Not ScriptForge.SF_Utils._Validate(ParentNode, "ParentNode", V_OBJECT) Then GoTo Catch
- If ScriptForge.SF_Session.UnoObjectType(ParentNode) <> "toolkit.MutableTreeNode" Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
- End If
- Try:
- With _TreeDataModel
- Set oNode = .createNode(DisplayValue, True)
- oNode.DataValue = DataValue
- ParentNode.appendChild(oNode)
- End With
- Finally:
- Set AddSubNode = oNode
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchType:
- ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "AddSubNode")
- GoTo Finally
- End Function ' SFDialogs.SF_DialogControl.AddSubNode
- REM -----------------------------------------------------------------------------
- Public Function AddSubTree(Optional ByRef ParentNode As Variant _
- , Optional ByRef FlatTree As Variant _
- , Optional ByVal WithDataValue As Variant _
- ) As Boolean
- ''' Return True when a subtree, subordinate to a parent node, could be inserted successfully in a tree control
- ''' If the parent node had already child nodes before calling this method, the child nodes are erased
- ''' Args:
- ''' ParentNode: A node UNO object, of type com.sun.star.awt.tree.XMutableTreeNode
- ''' FlatTree: a 2D array sorted on the columns containing the DisplayValues
- ''' Flat tree >>>> Resulting subtree
- ''' A1 B1 C1 |__ A1
- ''' A1 B1 C2 |__ B1
- ''' A1 B2 C3 |__ C1
- ''' A2 B3 C4 |__ C2
- ''' A2 B3 C5 |__ B2
- ''' A3 B4 C6 |__ C3
- ''' |__ A2
- ''' |__ B3
- ''' |__ C4
- ''' |__ C5
- ''' |__ A3
- ''' |__ B4
- ''' |__ C6
- ''' Typically, such an array can be issued by the GetRows method applied on the SFDatabases.Database service
- ''' when an array item containing the text to be displayed is = "" or is empty/null,
- ''' no new subnode is created and the remainder of the row is skipped
- ''' When AddSubTree() is called from a Python script, FlatTree may be an array of arrays
- ''' WithDataValue:
- ''' When False (default), every column of FlatTree contains the text to be displayed in the tree control
- ''' When True, the texts to be displayed (DisplayValue) are in columns 0, 2, 4, ...
- ''' while the DataValues are in columns 1, 3, 5, ...
- ''' Returns:
- ''' True when successful
- ''' Examples:
- ''' Dim myTree As Object, theRoot As Object, oDb As Object, vData As Variant
- ''' Set myTree = myDialog.Controls("myTreeControl")
- ''' Set theRoot = myTree.CreateRoot("By product category")
- ''' Set oDb = CreateScriptService("SFDatabases.Database", "/home/.../mydatabase.odb")
- ''' vData = oDb.GetRows("SELECT [Category].[Name], [Category].[ID], [Product].[Name], [Product].[ID] " _
- ''' & "FROM [Category], [Product] WHERE [Product].[CategoryID] = [Category].[ID] " _
- ''' & "ORDER BY [Category].[Name], [Product].[Name]")
- ''' myTree.AddSubTree(theRoot, vData, WithDataValue := True)
- Dim bSubTree As Boolean ' Return value
- Dim oNode As Object ' com.sun.star.awt.tree.XMutableTreeNode
- Dim oNewNode As Object ' com.sun.star.awt.tree.XMutableTreeNode
- Dim lChildCount As Long ' Number of children nodes of a parent node
- Dim iStep As Integer ' 1 when WithDataValue = False, 2 otherwise
- Dim iDims As Integer ' Number of dimensions of FlatTree
- Dim lMin1 As Long ' Lower bound (rows)
- Dim lMin2 As Long ' Lower bounds (cols)
- Dim lMax1 As Long ' Upper bound (rows)
- Dim lMax2 As Long ' Upper bounds (cols)
- Dim vFlatItem As Variant ' A single FlatTree item: FlatTree(i, j)
- Dim vFlatItem2 As Variant ' A single FlatTree item
- Dim bChange As Boolean ' When True, the item in FlatTree is different from the item above
- Dim sValue As String ' Alias for display values
- Dim i As Long, j As Long
- Const cstThisSub = "SFDialogs.DialogControl.AddSubTree"
- Const cstSubArgs = "ParentNode, FlatTree, [WithDataValue=False]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bSubTree = False
- Check:
- If IsMissing(WithDataValue) Or IsEmpty(WithDataValue) Then WithDataValue = False
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If _ControlType <> CTLTREECONTROL Then GoTo CatchType
- If Not ScriptForge.SF_Utils._Validate(ParentNode, "ParentNode", V_OBJECT) Then GoTo Catch
- If ScriptForge.SF_Session.UnoObjectType(ParentNode) <> "toolkit.MutableTreeNode" Then GoTo Catch
- If Not ScriptForge.SF_Utils._ValidateArray(FlatTree, "FlatTree") Then GoTo Catch ' Dimensions checked below
- If Not ScriptForge.SF_Utils._Validate(WithDataValue, "WithDataValue", V_BOOLEAN) Then GoTo Catch
- End If
- Try:
- With _TreeDataModel
- ' Clean subtree
- lChildCount = ParentNode.getChildCount()
- For i = 1 To lChildCount
- ParentNode.removeChildByIndex(0) ' This cleans all subtrees too
- Next i
- ' Determine bounds
- iDims = ScriptForge.SF_Array.CountDims(FlatTree)
- Select Case iDims
- Case -1, 0 : GoTo Catch
- Case 1 ' Called probably from Python
- lMin1 = LBound(FlatTree, 1) : lMax1 = UBound(FlatTree, 1)
- If Not IsArray(FlatTree(0)) Then GoTo Catch
- If UBound(FlatTree(0)) < LBound(FlatTree(0)) Then GoTo Catch ' No columns
- lMin2 = LBound(FlatTree(0)) : lMax2 = UBound(FlatTree(0))
- Case 2
- lMin1 = LBound(FlatTree, 1) : lMax1 = UBound(FlatTree, 1)
- lMin2 = LBound(FlatTree, 2) : lMax2 = UBound(FlatTree, 2)
- Case Else : GoTo Catch
- End Select
- ' Build a new subtree
- iStep = Iif(WithDataValue, 2, 1)
- For i = lMin1 To lMax1
- bChange = ( i = 0 )
- ' Restart from the parent node at each i-iteration
- Set oNode = ParentNode
- For j = lMin2 To lMax2 Step iStep ' Array columns
- If iDims = 1 Then vFlatItem = FlatTree(i)(j) Else vFlatItem = FlatTree(i, j)
- If vFlatItem = "" Or IsNull(vFlatItem) Or IsEmpty(vFlatItem) Then
- Set oNode = Nothing
- Exit For ' Exit j-loop
- End If
- If Not bChange Then
- If iDims = 1 Then vFlatItem2 = FlatTree(i - 1)(j) Else vFlatItem2 = FlatTree(i - 1, j)
- bChange = ( vFlatItem <> vFlatItem2 )
- End If
- If bChange Then ' Create new subnode at tree depth = j
- If VarType(vFlatItem) = V_STRING Then sValue = vFlatItem Else sValue = ScriptForge.SF_String.Represent(vFlatItem)
- Set oNewNode = .createNode(sValue, True)
- If WithDataValue Then
- If iDims = 1 Then vFlatItem2 = FlatTree(i)(j + 1) Else vFlatItem2 = FlatTree(i, j + 1)
- oNewNode.DataValue = vFlatItem2
- End If
- oNode.appendChild(oNewNode)
- Set oNode = oNewNode
- Else
- ' Position next current node on last child of actual current node
- lChildCount = oNode.getChildCount()
- If lChildCount > 0 Then Set oNode = oNode.getChildAt(lChildCount - 1) Else Set oNode = Nothing
- End If
- Next j
- Next i
- bSubTree = True
- End With
- Finally:
- AddSubTree = bSubTree
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchType:
- ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "AddSubTree")
- GoTo Finally
- End Function ' SFDialogs.SF_DialogControl.AddSubTree
- REM -----------------------------------------------------------------------------
- Public Function CreateRoot(Optional ByVal DisplayValue As Variant _
- , Optional ByRef DataValue As Variant _
- ) As Variant
- ''' Return a new root node of the tree control. The new tree root is inserted below pre-existing root nodes
- ''' Args:
- ''' DisplayValue: the text appearing in the control box
- ''' DataValue: any value associated with the root node. Default = Empty
- ''' Returns:
- ''' The new root node as a UNO object of type com.sun.star.awt.tree.XMutableTreeNode
- ''' Examples:
- ''' Dim myTree As Object, myNode As Object
- ''' Set myTree = myDialog.Controls("myTreeControl")
- ''' Set myNode = myTree.CreateRoot("Tree starts here ...")
- Dim oRoot As Object ' Return value
- Const cstThisSub = "SFDialogs.DialogControl.CreateRoot"
- Const cstSubArgs = "DisplayValue, [DataValue=Empty]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Set oRoot = Nothing
- Check:
- If IsMissing(DataValue) Then DataValue = Empty
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If _ControlType <> CTLTREECONTROL Then GoTo CatchType
- If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
- End If
- Try:
- With _TreeDataModel
- Set oRoot = .createNode(DisplayValue, True)
- oRoot.DataValue = DataValue
- .setRoot(oRoot)
- ' To be visible, a root must have contained at least 1 child. Create a fictive one and erase it.
- ' This behaviour does not seem related to the RootDisplayed property ??
- oRoot.appendChild(.createNode("Something", False))
- oRoot.removeChildByIndex(0)
- End With
- Finally:
- Set CreateRoot = oRoot
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchType:
- ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "CreateRoot")
- GoTo Finally
- End Function ' SFDialogs.SF_DialogControl.CreateRoot
- REM -----------------------------------------------------------------------------
- Public Function FindNode(Optional ByVal DisplayValue As String _
- , Optional ByRef DataValue As Variant _
- , Optional ByVal CaseSensitive As Boolean _
- ) As Object
- ''' Traverses the tree and find recursively, starting from the root, a node meeting some criteria
- ''' Either (1 match is enough):
- ''' having its DisplayValue like DisplayValue
- ''' having its DataValue = DataValue
- ''' Comparisons may be or not case-sensitive
- ''' The first matching occurrence is returned
- ''' Args:
- ''' DisplayValue: the pattern to be matched
- ''' DataValue: a string, a numeric value or a date or Empty (if not applicable)
- ''' CaseSensitive: applicable on both criteria. Default = False
- ''' Returns:
- ''' The found node of type com.sun.star.awt.tree.XMutableTreeNode or Nothing if not found
- ''' Examples:
- ''' Dim myTree As Object, myNode As Object
- ''' Set myTree = myDialog.Controls("myTreeControl")
- ''' Set myNode = myTree.FindNode("*Sophie*", CaseSensitive := True)
- Dim oNode As Object ' Return value
- Const cstThisSub = "SFDialogs.DialogControl.FindNode"
- Const cstSubArgs = "[DisplayValue=""""], [DataValue=Empty], [CaseSensitive=False]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Set oNode = Nothing
- Check:
- If IsMissing(DisplayValue) Or IsEmpty(DisplayValue) Then DisplayValue = ""
- If IsMissing(DataValue) Then DataValue = Empty
- If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If _ControlType <> CTLTREECONTROL Then GoTo CatchType
- If Not ScriptForge.SF_Utils._Validate(DisplayValue, "DisplayValue", V_STRING) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Catch
- End If
- Try:
- Set oNode = _FindNode(_TreeDataModel.getRoot(), DisplayValue, DataValue, CaseSensitive)
- Finally:
- Set FindNode = oNode
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchType:
- ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "FindNode")
- GoTo Finally
- End Function ' SFDialogs.SF_DialogControl.FindNode
- REM -----------------------------------------------------------------------------
- Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
- ''' Return the actual value of the given property
- ''' Args:
- ''' PropertyName: the name of the property as a string
- ''' Returns:
- ''' The actual value of the property
- ''' If the property does not exist, returns Null
- ''' Exceptions:
- ''' see the exceptions of the individual properties
- ''' Examples:
- ''' myModel.GetProperty("MyProperty")
- Const cstThisSub = "SFDialogs.DialogControl.GetProperty"
- Const cstSubArgs = ""
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- GetProperty = Null
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
- End If
- Try:
- GetProperty = _PropertyGet(PropertyName)
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDialogs.SF_DialogControl.GetProperty
- REM -----------------------------------------------------------------------------
- Public Function Methods() As Variant
- ''' Return the list of public methods of the Model service as an array
- Methods = Array( _
- "AddSubNode" _
- , "AddSubTree" _
- , "CreateRoot" _
- , "FindNode" _
- , "SetFocus" _
- , "WriteLine" _
- )
- End Function ' SFDialogs.SF_DialogControl.Methods
- REM -----------------------------------------------------------------------------
- Public Function Properties() As Variant
- ''' Return the list or properties of the Timer class as an array
- Properties = Array( _
- "Cancel" _
- , "Caption" _
- , "ControlType" _
- , "CurrentNode" _
- , "Default" _
- , "Enabled" _
- , "Format" _
- , "ListCount" _
- , "ListIndex" _
- , "Locked" _
- , "MultiSelect" _
- , "Name" _
- , "OnActionPerformed" _
- , "OnAdjustmentValueChanged" _
- , "OnFocusGained" _
- , "OnFocusLost" _
- , "OnItemStateChanged" _
- , "OnKeyPressed" _
- , "OnKeyReleased" _
- , "OnMouseDragged" _
- , "OnMouseEntered" _
- , "OnMouseExited" _
- , "OnMouseMoved" _
- , "OnMousePressed" _
- , "OnMouseReleased" _
- , "OnNodeExpanded" _
- , "OnNodeSelected" _
- , "OnTextChanged" _
- , "Page" _
- , "Parent" _
- , "Picture" _
- , "RootNode" _
- , "RowSource" _
- , "Text" _
- , "TipText" _
- , "TripleState" _
- , "Value" _
- , "Visible" _
- , "XControlModel" _
- , "XControlView" _
- , "XGridColumnModel" _
- , "XGridDataModel" _
- , "XTreeDataModel" _
- )
- End Function ' SFDialogs.SF_DialogControl.Properties
- REM -----------------------------------------------------------------------------
- Public Function SetFocus() As Boolean
- ''' Set the focus on the current Control instance
- ''' Probably called from after an event occurrence
- ''' Args:
- ''' Returns:
- ''' True if focusing is successful
- ''' Example:
- ''' Dim oDlg As Object, oControl As Object
- ''' Set oDlg = CreateScriptService(,, "myControl") ' Control stored in current document's standard library
- ''' Set oControl = oDlg.Controls("thisControl")
- ''' oControl.SetFocus()
- Dim bSetFocus As Boolean ' Return value
- Const cstThisSub = "SFDialogs.DialogControl.SetFocus"
- Const cstSubArgs = ""
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bSetFocus = False
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Parent]._IsStillAlive() Then GoTo Finally
- End If
- Try:
- If Not IsNull(_ControlView) Then
- _ControlView.setFocus()
- bSetFocus = True
- End If
- Finally:
- SetFocus = bSetFocus
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFControls.SF_DialogControl.SetFocus
- REM -----------------------------------------------------------------------------
- Public Function SetProperty(Optional ByVal PropertyName As Variant _
- , Optional ByRef Value As Variant _
- ) As Boolean
- ''' Set a new value to the given property
- ''' Args:
- ''' PropertyName: the name of the property as a string
- ''' Value: its new value
- ''' Exceptions
- ''' ARGUMENTERROR The property does not exist
- Const cstThisSub = "SFDialogs.DialogControl.SetProperty"
- Const cstSubArgs = "PropertyName, Value"
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- SetProperty = False
- Check:
- If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
- End If
- Try:
- SetProperty = _PropertySet(PropertyName, Value)
- Finally:
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDialogs.SF_DialogControl.SetProperty
- REM -----------------------------------------------------------------------------
- Public Function SetTableData(Optional ByRef DataArray As Variant _
- , Optional ByRef Widths As Variant _
- , Optional ByRef Alignments As Variant _
- ) As Boolean
- ''' Fill a table control with the given data. Preexisting data is erased
- ''' The Basic IDE allows to define if the control has a row and/or a column header
- ''' When it is the case, the array in argument should contain those headers resp. in the first
- ''' column and/or in the first row
- ''' A column in the control shall be sortable when the data (headers excluded) in that column
- ''' is homogeneously filled either with numbers or with strings
- ''' Columns containing strings will be left-aligned, those with numbers will be right-aligned
- ''' Args:
- ''' DataArray: the set of data to display in the table control, including optional column/row headers
- ''' Is a 2D array in Basic, is a tuple of tuples when called from Python
- ''' Widths: the column's relative widths as a 1D array, each element corresponding with a column
- ''' If the array is shorter than the number of columns, the last value is kept for the next columns.
- ''' Example:
- ''' Widths := Array(1, 2)
- ''' means that the first column is half as wide as all the other columns
- ''' When the argument is absent, the columns are evenly spread over the control
- ''' Alignments: the column's horizontal alignment as a string with length = number of columns.
- ''' Possible characters are:
- ''' L(EFT), C(ENTER), R(IGHT) or space (default behaviour)
- ''' Returns:
- ''' True when successful
- ''' Examples:
- ''' Dim myTable As Object, bSet As Boolean, vData As Variant
- ''' Set myTable = myDialog.Controls("myTableControl") ' This control has only column headers
- ''' vData = Array("Col1", "Col2", "Col3")
- ''' vData = SF_Array.AppendRow(vData, Array(1, 2, 3))
- ''' vData = SF_Array.AppendRow(vData, Array(4, 5, 6))
- ''' vData = SF_Array.AppendRow(vData, Array(7, 8, 9))
- ''' bSet = myTable.SetTableData(vData, Alignments := " C ")
- Dim bData As Boolean ' Return value
- Dim iDims As Integer ' Number of dimensions of DataArray
- Dim lMin1 As Long ' LBound1 of input array
- Dim lMax1 As Long ' UBound1 of input array
- Dim lMin2 As Long ' LBound2 of input array
- Dim lMax2 As Long ' UBound2 of input array
- Dim lControlWidth As Long ' Width of the table control
- Dim lMinW As Long ' lBound of Widths
- Dim lMaxW As Long ' UBound of vWidths
- Dim lMinRow As Long ' Row index of effective data subarray
- Dim lMinCol As Long ' Column index of effective data subarray
- Dim vRowHeaders As Variant ' Array of row headers
- Dim sRowHeader As String ' A single row header
- Dim vColHeaders As Variant ' Array of column headers
- Dim oColumn As Object ' com.sun.star.awt.grid.XGridColumn
- Dim dWidth As Double ' A single item of Widths
- Dim dRelativeWidth As Double ' Sum of Widths up to the number of columns
- Dim dWidthFactor As Double ' Factor to apply to relative widths to get absolute column widths
- Dim vDataRow As Variant ' A single row content in the tablecontrol
- Dim vDataItem As Variant ' A single DataArray item
- Dim sAlign As String ' Column's horizontal alignments (single chars: L, C, R, space)
- Dim lAlign As Long ' com.sun.star.style.HorizontalAlignment.XXX
- Dim i As Long, j As Long, k As Long
- Const cstRowHdrWidth = 12 ' Estimated width of the row header
- Const cstThisSub = "SFDialogs.DialogControl.SetTableData"
- Const cstSubArgs = "DataArray, [Widths=Array(1)], [Alignments=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bData = False
- Check:
- If IsMissing(Widths) Or IsEmpty(Widths) Then Widths = Array(1)
- If IsMissing(Alignments) Or IsEmpty(Alignments) Then Alignments = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If _ControlType <> CTLTABLECONTROL Then GoTo CatchType
- If Not ScriptForge.SF_Utils._ValidateArray(DataArray, "DataArray") Then GoTo Catch ' Dimensions are checked below
- If Not ScriptForge.SF_Utils._ValidateArray(Widths, "Widths", 1, ScriptForge.V_NUMERIC, True) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(Alignments, "Alignments", V_STRING) Then GoTo Catch
- End If
- Try:
- ' Erase any pre-existing data and columns
- _GridDataModel.removeAllRows()
- For i = _GridColumnModel.ColumnCount - 1 To 0 Step -1
- _GridColumnModel.removeColumn(i)
- Next i
- ' LBounds, UBounds - Basic or Pytho
- iDims = ScriptForge.SF_Array.CountDims(DataArray)
- Select Case iDims
- Case -1, 0 : GoTo Catch
- Case 1 ' Called probably from Python
- lMin1 = LBound(DataArray, 1) : lMax1 = UBound(DataArray, 1)
- If Not IsArray(DataArray(0)) Then GoTo Catch
- If UBound(DataArray(0)) < LBound(DataArray(0)) Then GoTo Catch ' No columns
- lMin2 = LBound(DataArray(0)) : lMax2 = UBound(DataArray(0))
- Case 2
- lMin1 = LBound(DataArray, 1) : lMax1 = UBound(DataArray, 1)
- lMin2 = LBound(DataArray, 2) : lMax2 = UBound(DataArray, 2)
- Case Else : GoTo Catch
- End Select
- ' Extract headers from data array
- lMinW = LBound(Widths) : lMaxW = UBound(Widths)
- With _ControlModel
- If .ShowColumnHeader Then
- lMinRow = lMin1 + 1
- If iDims = 1 Then
- vColHeaders = DataArray(lMin1)
- Else
- vColHeaders = ScriptForge.SF_Array.ExtractRow(DataArray, lMin1)
- End If
- Else
- lMinRow = lMin1
- vColHeaders = Array()
- End If
- If .ShowRowHeader Then
- lMinCol = lMin2 + 1
- If iDims = 1 Then
- vRowHeaders = Array()
- ReDim vRowHeaders(lMin1 To lMax1)
- For i = lMin1 To lMax1
- vRowHeaders(i) = DataArray(i)(lMin2)
- Next i
- Else
- vRowHeaders = ScriptForge.SF_Array.ExtractColumn(DataArray, lMin2)
- End If
- Else
- lMinCol = lMin2
- vRowHeaders = Array()
- End If
- End With
- ' Create the columns
- For j = lMinCol To lMax2
- Set oColumn = _GridColumnModel.createColumn()
- If _ControlModel.ShowColumnHeader Then oColumn.Title = vColHeaders(j)
- _GridColumnModel.addColumn(oColumn)
- Next j
- ' Size the columns. Column sizing cannot be done before all the columns are added
- If lMaxW >= lMinW Then ' There must be at least 1 width given as argument
- ' Size the columns proportionally with their relative widths
- dRelativeWidth = 0.0
- i = lMinW - 1
- ' Compute the sum of the relative widths
- For j = 0 To lMax2 - lMinCol
- i = i + 1
- If i >= lMinW And i <= lMaxW Then dRelativeWidth = dRelativeWidth + Widths(i) Else dRelativeWidth = dRelativeWidth + Widths(lMaxW)
- Next j
- ' Set absolute widths
- If dRelativeWidth > 0.0 Then dWidthFactor = CDbl((_ControlModel.Width - cstRowHdrWidth) / dRelativeWidth) Else dWidthFactor = 1.0
- i = lMinW - 1
- For j = 0 To lMax2 - lMinCol
- i = i + 1
- If i >= lMinW And i <= lMaxW Then dWidth = CDbl(Widths(i)) Else dWidth = CDbl(Widths(lMaxW))
- _GridColumnModel.Columns(j).ColumnWidth = CLng(dWidthFactor * dWidth)
- Next j
- Else
- ' Size all columns evenly
- For j = 0 To lMax2 - lMinCol
- _GridColumnModel.Columns(j).ColumnWidth = (_ControlModel.Width - cstRowHdrWidth) / (lMax2 - lMonCol + 1)
- Next j
- End If
- ' Initialize the column alignment
- If Len(Alignments) >= lMax2 - lMinCol + 1 Then sAlign = Alignments Else sAlign = Alignments & Space(lMax2 - lMinCol + 1 - Len(Alignments))
- ' Feed the table with data and define/confirm the column alignment
- vDataRow = Array()
- For i = lMinRow To lMax1
- ReDim vDataRow(0 To lMax2 - lMinCol)
- For j = lMinCol To lMax2
- If iDims = 1 Then vDataItem = DataArray(i)(j) Else vDataItem = DataArray(i, j)
- If VarType(vDataItem) = V_STRING Then
- ElseIf ScriptForge.SF_Utils._VarTypeExt(vDataItem) = ScriptForge.V_NUMERIC Then
- Else
- vDataItem = ScriptForge.SF_String.Represent(vDataItem)
- End If
- vDataRow(j - lMinCol) = vDataItem
- ' Store alignment while processing the first row of the array
- If i = lMinRow Then
- k = j - lMinCol + 1
- If Mid(sAlign, k, 1) = " " Then Mid(sAlign, k, 1) = Iif(VarType(vDataItem) = V_STRING, "L", "R")
- End If
- Next j
- If _ControlModel.ShowRowHeader Then sRowHeader = vRowHeaders(i) Else sRowHeader = ""
- _GridDataModel.addRow(sRowHeader, vDataRow)
- Next i
- ' Determine alignments of each column
- For j = 0 To lMax2 - lMinCol
- Select Case Mid(sAlign, j + 1, 1)
- Case "L", " " : lAlign = com.sun.star.style.HorizontalAlignment.LEFT
- Case "R" : lAlign = com.sun.star.style.HorizontalAlignment.RIGHT
- Case "C" : lAlign = com.sun.star.style.HorizontalAlignment.CENTER
- Case Else
- End Select
- _GridColumnModel.Columns(j).HorizontalAlign = lAlign
- Next j
- bData = True
- Finally:
- SetTableData = bData
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchType:
- ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, "SetTableData")
- GoTo Finally
- End Function ' SFDialogs.SF_DialogControl.SetTableData
- REM -----------------------------------------------------------------------------
- Public Function WriteLine(Optional ByVal Line As Variant) As Boolean
- ''' Add a new line to a multiline TextField control
- ''' Args:
- ''' Line: (default = "") the line to insert at the end of the text box
- ''' a newline character will be inserted before the line, if relevant
- ''' Returns:
- ''' True if insertion is successful
- ''' Exceptions
- ''' TEXTFIELDERROR Method applicable on multiline text fields only
- ''' Example:
- ''' Dim oDlg As Object, oControl As Object
- ''' Set oDlg = CreateScriptService(,, "myControl") ' Control stored in current document's standard library
- ''' Set oControl = oDlg.Controls("thisControl")
- ''' oControl.WriteLine("a new line")
- Dim bWriteLine As Boolean ' Return value
- Dim lTextLength As Long ' Actual length of text in box
- Dim oSelection As New com.sun.star.awt.Selection
- Dim sNewLine As String ' Newline character(s)
- Const cstThisSub = "SFDialogs.DialogControl.WriteLine"
- Const cstSubArgs = "[Line=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bWriteLine = False
- Check:
- If IsMissing(Line) Or IsEmpty(Line) Then Line = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Parent]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Line, "Line", V_STRING) Then GoTo Finally
- End If
- If ControlType <> CTLTEXTFIELD Then GoTo CatchField
- If _ControlModel.MultiLine = False Then GoTo CatchField
- Try:
- _ControlModel.HardLineBreaks = True
- sNewLine = ScriptForge.SF_String.sfNEWLINE
- With _ControlView
- lTextLength = Len(.getText())
- If lTextLength = 0 Then ' Text field is still empty
- oSelection.Min = 0 : oSelection.Max = 0
- .setText(Line)
- Else ' Put cursor at the end of the actual text
- oSelection.Min = lTextLength : oSelection.Max = lTextLength
- .insertText(oSelection, sNewLine & Line)
- End If
- ' Put the cursor at the end of the inserted text
- oSelection.Max = oSelection.Max + Len(sNewLine) + Len(Line)
- oSelection.Min = oSelection.Max
- .setSelection(oSelection)
- End With
- bWriteLine = True
- Finally:
- WriteLine = bWriteLine
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchField:
- ScriptForge.SF_Exception.RaiseFatal(TEXTFIELDERROR, _Name, _DialogName)
- GoTo Finally
- End Function ' SFControls.SF_DialogControl.WriteLine
- REM =========================================================== PRIVATE FUNCTIONS
- REM -----------------------------------------------------------------------------
- Private Function _FindNode(ByRef poNode As Object _
- , ByVal psDisplayValue As String _
- , ByRef pvDataValue As Variant _
- , ByVal pbCaseSensitive As Boolean _
- ) As Object
- ''' Traverses the tree and find recursively, starting from the root, a node meeting some criteria
- ''' Either (1 match is enough):
- ''' having its DisplayValue like psDisplayValue
- ''' having its DataValue = pvDataValue
- ''' Comparisons may be or not case-sensitive
- ''' The first matching occurrence is returned
- ''' Args:
- ''' poNode: the current node, the root at 1st call
- ''' psDisplayValue: the pattern to be matched
- ''' pvDataValue: a string, a numeric value or a date or Empty (if not applicable)
- ''' pbCaseSensitive: applicable on both criteria
- ''' Returns:
- ''' The found node of type com.sun.star.awt.tree.XMutableTreeNode
- Dim oChild As Object ' Child node com.sun.star.awt.tree.XMutableTreeNode
- Dim oFind As Object ' Found node com.sun.star.awt.tree.XMutableTreeNode
- Dim lChildCount As Long ' Number of children of a node
- Dim bFound As Boolean ' True when node found
- Dim i As Long
- Set _FindNode = Nothing
- On Local Error GoTo Finally ' Better not found than raise an error
- Check:
- ' Does the actual node match the criteria ?
- bFound = False
- If Len(psDisplayValue) > 0 Then
- bFound = ScriptForge.SF_String.IsLike(poNode.DisplayValue, psDisplayValue, pbCaseSensitive)
- End If
- If Not bFound And Not IsEmpty(poNode.DataValue) Then
- If Not IsEmpty(pvdataValue) Then bFound = ( ScriptForge.SF_Array._ValCompare(poNode.DataValue, pvDataB-Value, pbCaseSensitive) = 0 )
- End If
- If bFound Then
- Set _FindNode = poNode
- Exit Function
- End If
- Try:
- ' Explore sub-branches
- lChildCount = poNode.getChildCount
- If lChildCount > 0 Then
- For i = 0 To lChildCount - 1
- Set oChild = poNode.getChildAt(i)
- Set oFind = _FindNode(oChild, psDisplayValue, pvDataValue, pbCaseSensitive) ' Recursive call
- If Not IsNull(oFind) Then
- Set _FindNode = oFind
- Exit For
- End If
- Next i
- End If
- Finally:
- Exit Function
- End Function ' SFDialogs.SF_DialogControl._FindNode
- REM -----------------------------------------------------------------------------
- Private Function _FormatsList() As Variant
- ''' Return the allowed format entries as a zero-based array for Date and Time control types
- Dim vFormats() As Variant ' Return value
- Select Case _ControlType
- 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
-
- _FormatsList = vFormats
- End Function ' SFDialogs.SF_DialogControl._FormatsList
- REM -----------------------------------------------------------------------------
- Public Function _GetEventName(ByVal psProperty As String) As String
- ''' Return the LO internal event name derived from the SF property name
- ''' The SF property name is not case sensitive, while the LO name is case-sensitive
- ' Corrects the typo on ErrorOccur(r?)ed, if necessary
- Dim vProperties As Variant ' Array of class properties
- Dim sProperty As String ' Correctly cased property name
- vProperties = Properties()
- sProperty = vProperties(ScriptForge.SF_Array.IndexOf(vProperties, psProperty, SortOrder := "ASC"))
- _GetEventName = LCase(Mid(sProperty, 3, 1)) & Right(sProperty, Len(sProperty) - 3)
-
- End Function ' SFDialogs.SF_DialogControl._GetEventName
- REM -----------------------------------------------------------------------------
- Private Function _GetListener(ByVal psEventName As String) As String
- ''' Getting/Setting macros triggered by events requires a Listener-EventName pair
- ''' Return the X...Listener corresponding with the event name in argument
- Select Case UCase(psEventName)
- Case UCase("OnActionPerformed")
- _GetListener = "XActionListener"
- Case UCase("OnAdjustmentValueChanged")
- _GetListener = "XAdjustmentListener"
- 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"
- Case Else
- _GetListener = ""
- End Select
-
- End Function ' SFDialogs.SF_DialogControl._GetListener
- REM -----------------------------------------------------------------------------
- Public Sub _Initialize()
- ''' Complete the object creation process:
- ''' - Initialization of private members
- ''' - Collection of specific attributes
- ''' - synchronization with parent dialog instance
- Dim vServiceName As Variant ' Split service name
- Dim sType As String ' Last component of service name
- Try:
- _ImplementationName = _ControlModel.getImplementationName()
- ' Identify the control type
- vServiceName = Split(_ControlModel.getServiceName(), ".")
- sType = vServiceName(UBound(vServiceName))
- Select Case sType
- Case "UnoControlSpinButtonModel"
- _ControlType = "" ' Not supported
- Case "Edit" : _ControlType = CTLTEXTFIELD
- Case "TreeControlModel"
- ' Initialize the data model
- _ControlType = CTLTREECONTROL
- Set _ControlModel.DataModel = CreateUnoService("com.sun.star.awt.tree.MutableTreeDataModel")
- Set _TreeDataModel = _ControlModel.DataModel
- Case "UnoControlGridModel"
- _ControlType = CTLTABLECONTROL
- Set _GridColumnModel = _ControlModel.ColumnModel
- Set _GridDataModel = _ControlModel.GridDataModel
- Case Else : _ControlType = sType
- End Select
- ' Store the SF_DialogControl object in the parent cache
- Set _Parent._ControlCache(_IndexOfNames) = [Me]
- Finally:
- Exit Sub
- End Sub ' SFDialogs.SF_DialogControl._Initialize
- REM -----------------------------------------------------------------------------
- Private Function _PropertyGet(Optional ByVal psProperty As String _
- , Optional ByVal pvDefault As Variant _
- ) As Variant
- ''' Return the value of the named property
- ''' Args:
- ''' psProperty: the name of the property
- ''' pvDefault: the value returned when the property is not applicable on the control's type
- ''' Getting a non-existing property for a specific control type should
- ''' not generate an error to not disrupt the Basic IDE debugger
- Dim vGet As Variant ' Return value
- Static oSession As Object ' Alias of SF_Session
- Dim vSelection As Variant ' Alias of Model.SelectedItems or Model.Selection
- Dim vList As Variant ' Alias of Model.StringItemList
- Dim lIndex As Long ' Index in StringItemList
- Dim sItem As String ' A single item
- Dim vDate As Variant ' com.sun.star.util.Date or com.sun.star.util.Time
- Dim vValues As Variant ' Array of listbox values
- Dim oControlEvents As Object ' com.sun.star.container.XNameContainer
- Dim sEventName As String ' Internal event name
- Dim i As Long
- Dim cstThisSub As String
- Const cstSubArgs = ""
- cstThisSub = "SFDialogs.DialogControl.get" & psProperty
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
- If Not [_Parent]._IsStillAlive() Then GoTo Finally
- If IsMissing(pvDefault) Then pvDefault = Null
- _PropertyGet = pvDefault
- If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
- Select Case UCase(psProperty)
- Case UCase("Cancel")
- Select Case _ControlType
- Case CTLBUTTON
- If oSession.HasUNOProperty(_ControlModel, "PushButtonType") Then _PropertyGet = ( _ControlModel.PushButtonType = com.sun.star.awt.PushButtonType.CANCEL )
- Case Else : GoTo CatchType
- End Select
- Case UCase("Caption")
- Select Case _ControlType
- Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
- If oSession.HasUNOProperty(_ControlModel, "Label") Then _PropertyGet = _ControlModel.Label
- Case Else : GoTo CatchType
- End Select
- Case UCase("ControlType")
- _PropertyGet = _ControlType
- Case UCase("CurrentNode")
- Select Case _ControlType
- Case CTLTREECONTROL
- If oSession.HasUNOMethod(_ControlView, "getSelection") Then
- _PropertyGet = Empty
- If _ControlModel.SelectionType <> com.sun.star.view.SelectionType.NONE Then
- vSelection = _ControlView.getSelection()
- If IsArray(vSelection) Then
- If UBound(vSelection) >= 0 Then Set _PropertyGet = vSelection(0)
- Else
- Set _PropertyGet = vSelection
- End If
- End If
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("Default")
- Select Case _ControlType
- Case CTLBUTTON
- If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _PropertyGet = _ControlModel.DefaultButton
- Case Else : GoTo CatchType
- End Select
- Case UCase("Enabled")
- If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _PropertyGet = _ControlModel.Enabled
- Case UCase("Format")
- Select Case _ControlType
- Case CTLDATEFIELD
- If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then _PropertyGet = _FormatsList()(_ControlModel.DateFormat)
- Case CTLTIMEFIELD
- If oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then _PropertyGet = _FormatsList()(_ControlModel.TimeFormat)
- Case CTLFORMATTEDFIELD
- If oSession.HasUNOProperty(_ControlModel, "FormatsSupplier") And oSession.HasUNOProperty(_ControlModel, "FormatKey") Then
- _PropertyGet = _ControlModel.FormatsSupplier.getNumberFormats.getByKey(_ControlModel.FormatKey).FormatString
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("ListCount")
- Select Case _ControlType
- Case CTLCOMBOBOX, CTLLISTBOX
- If oSession.HasUNOProperty(_ControlModel, "StringItemList") Then _PropertyGet = UBound(_ControlModel.StringItemList) + 1
- Case CTLTABLECONTROL ' Returns zero when no table data yet
- If oSession.HasUNOProperty(_GridDataModel, "RowCount") Then _PropertyGet = _GridDataModel.RowCount
- Case Else : GoTo CatchType
- End Select
- Case UCase("ListIndex")
- Select Case _ControlType
- Case CTLCOMBOBOX
- _PropertyGet = -1 ' Not found, multiselection
- If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
- _PropertyGet = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, _ControlModel.Text, CaseSensitive := True)
- End If
- Case CTLLISTBOX
- _PropertyGet = -1 ' Not found, multiselection
- If oSession.HasUNOProperty(_ControlModel, "SelectedItems") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
- vSelection = _ControlModel.SelectedItems
- If UBound(vSelection) >= 0 Then _PropertyGet = vSelection(0)
- End If
- Case CTLTABLECONTROL
- _PropertyGet = -1 ' No row selected, no data, multiselection
- If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _
- And oSession.HasUNOProperty(_ControlView, "CurrentRow") Then
- ' Other selection types (multi, range) not supported
- If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE Then
- lIndex = _ControlView.CurrentRow
- If lIndex < 0 And oSession.HasUNOProperty(_ControlView, "SelectedRows") Then
- If UBound(_ControlView.SelectedRows) >= 0 Then lIndex = _ControlView.SelectedRows(0)
- End If
- _PropertyGet = lIndex
- End If
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("Locked")
- Select Case _ControlType
- Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _
- , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
- If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _PropertyGet = _ControlModel.ReadOnly
- Case Else : GoTo CatchType
- End Select
- Case UCase("MultiSelect")
- Select Case _ControlType
- Case CTLLISTBOX
- If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
- _PropertyGet = _ControlModel.MultiSelection
- ElseIf oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then ' Not documented: gridcontrols only TBC ??
- _PropertyGet = _ControlModel.MultiSelectionSimpleMode
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("Name")
- _PropertyGet = _Name
- Case UCase("OnActionPerformed"), UCase("OnAdjustmentValueChanged"), UCase("OnFocusGained"), UCase("OnFocusLost") _
- , UCase("OnItemStateChanged"), UCase("OnKeyPressed"), UCase("OnKeyReleased") _
- , UCase("OnMouseDragged"), UCase("OnMouseEntered"), UCase("OnMouseExited"), UCase("OnMouseMoved") _
- , UCase("OnMousePressed"), UCase("OnMouseReleased"), UCase("OnTextChanged")
- Set oControlEvents = _ControlModel.getEvents()
- sEventName = "com.sun.star.awt." & _GetListener(psProperty) & "::" & _GetEventName(psProperty)
- If oControlEvents.hasByName(sEventName) Then
- _PropertyGet = oControlEvents.getByName(sEventName).ScriptCode
- Else
- _PropertyGet = ""
- End If
- Case UCase("OnNodeExpanded")
- Select Case _ControlType
- Case CTLTREECONTROL
- _PropertyGet = _OnNodeExpanded
- Case Else : GoTo CatchType
- End Select
- Case UCase("OnNodeSelected")
- Select Case _ControlType
- Case CTLTREECONTROL
- _PropertyGet = _OnNodeSelected
- Case Else : GoTo CatchType
- End Select
- Case UCase("Page")
- If oSession.HasUnoProperty(_ControlModel, "Step") Then _PropertyGet = _ControlModel.Step
- Case UCase("Parent")
- Set _PropertyGet = [_Parent]
- Case UCase("Picture")
- Select Case _ControlType
- Case CTLBUTTON, CTLIMAGECONTROL
- If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _PropertyGet = ScriptForge.SF_FileSystem._ConvertFromUrl(_ControlModel.ImageURL)
- Case Else : GoTo CatchType
- End Select
- Case UCase("RootNode")
- Select Case _ControlType
- Case CTLTREECONTROL
- _PropertyGet = _TreeDataModel.getRoot()
- Case Else : GoTo CatchType
- End Select
- Case UCase("RowSource")
- Select Case _ControlType
- Case CTLCOMBOBOX, CTLLISTBOX
- If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then
- If IsArray(_ControlModel.StringItemList) Then _PropertyGet = _ControlModel.StringItemList Else _PropertyGet = Array(_ControlModel.StringItemList)
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("Text")
- Select Case _ControlType
- Case CTLCOMBOBOX, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLPATTERNFIELD, CTLTEXTFIELD
- If oSession.HasUnoProperty(_ControlModel, "Text") Then _PropertyGet = _ControlModel.Text
- Case Else : GoTo CatchType
- End Select
- Case UCase("TipText")
- If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _PropertyGet = _ControlModel.HelpText
- Case UCase("TripleState")
- Select Case _ControlType
- Case CTLCHECKBOX
- If oSession.HasUnoProperty(_ControlModel, "TriState") Then _PropertyGet = _ControlModel.TriState
- Case Else : GoTo CatchType
- End Select
- Case UCase("Value") ' Default values are set here by control type, not in the 2nd argument
- vGet = pvDefault
- Select Case _ControlType
- Case CTLBUTTON 'Boolean, toggle buttons only
- vGet = False
- If oSession.HasUnoProperty(_ControlModel, "Toggle") Then
- If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 )
- End If
- Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know
- If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = _ControlModel.State Else vGet = 2
- Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
- If oSession.HasUnoProperty(_ControlModel, "Text") Then vGet = _ControlModel.Text Else vGet = ""
- Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
- If oSession.HasUnoProperty(_ControlModel, "Value") Then vGet = _ControlModel.Value Else vGet = 0
- Case CTLDATEFIELD 'Date
- vGet = CDate(1)
- If oSession.HasUnoProperty(_ControlModel, "Date") Then
- If VarType(_ControlModel.Date) = ScriptForge.V_OBJECT Then ' com.sun.star.util.Date
- Set vDate = _ControlModel.Date
- vGet = DateSerial(vDate.Year, vDate.Month, vDate.Day)
- End If
- End If
- Case CTLFORMATTEDFIELD 'String or numeric
- If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then vGet = _ControlModel.EffectiveValue Else vGet = ""
- Case CTLLISTBOX 'String or array of strings depending on MultiSelection
- ' StringItemList is the list of the items displayed in the box
- ' SelectedItems is the list of the indexes in StringItemList of the selected items
- ' It can go beyond the limits of StringItemList
- ' It can contain multiple values even if the listbox is not multiselect
- If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
- And oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
- vSelection = _ControlModel.SelectedItems
- vList = _ControlModel.StringItemList
- If _ControlModel.MultiSelection Then vValues = Array()
- For i = 0 To UBound(vSelection)
- lIndex = vSelection(i)
- If lIndex >= 0 And lIndex <= UBound(vList) Then
- If Not _ControlModel.MultiSelection Then
- vValues = vList(lIndex)
- Exit For
- End If
- vValues = ScriptForge.SF_Array.Append(vValues, vList(lIndex))
- End If
- Next i
- vGet = vValues
- Else
- vGet = ""
- End If
- Case CTLPROGRESSBAR 'Numeric
- If oSession.HasUnoProperty(_ControlModel, "ProgressValue") Then vGet = _ControlModel.ProgressValue Else vGet = 0
- Case CTLRADIOBUTTON 'Boolean
- If oSession.HasUnoProperty(_ControlModel, "State") Then vGet = ( _ControlModel.State = 1 ) Else vGet = False
- Case CTLSCROLLBAR 'Numeric
- If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then vGet = _ControlModel.ScrollValue Else vGet = 0
- Case CTLTABLECONTROL
- vGet = Array() ' Default value when no row selected, no data, multiselection
- If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _
- And oSession.HasUNOProperty(_ControlView, "CurrentRow") Then
- ' Other selection types (multi, range) not supported
- If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE Then
- lIndex = _ControlView.CurrentRow
- If lIndex < 0 And oSession.HasUNOProperty(_ControlView, "SelectedRows") Then
- If UBound(_ControlView.SelectedRows) >= 0 Then lIndex = _ControlView.SelectedRows(0)
- End If
- If lIndex >= 0 Then vGet = _GridDataModel.getRowData(lIndex)
- End If
- End If
- Case CTLTIMEFIELD
- vGet = CDate(0)
- If oSession.HasUnoProperty(_ControlModel, "Time") Then
- If VarType(_ControlModel.Time) = ScriptForge.V_OBJECT Then ' com.sun.star.Util.Time
- Set vDate = _ControlModel.Time
- vGet = TimeSerial(vDate.Hours, vDate.Minutes, vDate.Seconds)
- End If
- End If
- Case Else : GoTo CatchType
- End Select
- _PropertyGet = vGet
- Case UCase("Visible")
- If oSession.HasUnoMethod(_ControlView, "isVisible") Then _PropertyGet = CBool(_ControlView.isVisible())
- Case UCase("XControlModel")
- Set _PropertyGet = _ControlModel
- Case UCase("XControlView")
- Set _PropertyGet = _ControlView
- Case UCase("XGridColumnModel")
- Set _PropertyGet = _GridColumnModel
- Case UCase("XGridDataModel")
- Set _PropertyGet = _GridDataModel
- Case UCase("XTreeDataModel")
- Set _PropertyGet = _TreeDataModel
- Case Else
- _PropertyGet = Null
- End Select
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchType:
- GoTo Finally
- End Function ' SFDialogs.SF_DialogControl._PropertyGet
- REM -----------------------------------------------------------------------------
- Private Function _PropertySet(Optional ByVal psProperty As String _
- , Optional ByVal pvValue As Variant _
- ) As Boolean
- ''' Set the new value of the named property
- ''' Args:
- ''' psProperty: the name of the property
- ''' pvValue: the new value of the given property
- Dim bSet As Boolean ' Return value
- Static oSession As Object ' Alias of SF_Session
- Dim vSet As Variant ' Value to set in UNO model or view property
- Dim vFormats As Variant ' Format property: output of _FormatsList()
- Dim iFormat As Integer ' Format property: index in vFormats
- Dim vSelection As Variant ' Alias of Model.SelectedItems
- Dim vList As Variant ' Alias of Model.StringItemList
- Dim lIndex As Long ' Index in StringItemList
- Dim sItem As String ' A single item
- Dim vCtlTypes As Variant ' Array of allowed control types
- Dim i As Long
- Dim cstThisSub As String
- Const cstSubArgs = "Value"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bSet = False
- cstThisSub = "SFDialogs.DialogControl.set" & psProperty
- ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
- If Not [_Parent]._IsStillAlive() Then GoTo Finally
- If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
- bSet = True
- Select Case UCase(psProperty)
- Case UCase("Cancel")
- Select Case _ControlType
- Case CTLBUTTON
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Cancel", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If oSession.HasUNOProperty(_ControlModel, "PushButtonType") Then
- If pvValue Then vSet = com.sun.star.awt.PushButtonType.CANCEL Else vSet = com.sun.star.awt.PushButtonType.STANDARD
- _ControlModel.PushButtonType = vSet
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("Caption")
- Select Case _ControlType
- Case CTLBUTTON, CTLCHECKBOX, CTLFIXEDLINE, CTLFIXEDTEXT, CTLGROUPBOX, CTLRADIOBUTTON
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Caption", V_STRING) Then GoTo Finally
- If oSession.HasUNOProperty(_ControlModel, "Label") Then _ControlModel.Label = pvValue
- Case Else : GoTo CatchType
- End Select
- Case UCase("CurrentNode")
- Select Case _ControlType
- Case CTLTREECONTROL
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Selection", ScriptForge.V_OBJECT) Then GoTo Finally
- If oSession.UnoObjectType(pvValue) <> "toolkit.MutableTreeNode" Then GoTo CatchType
- With _ControlView
- .clearSelection()
- If Not IsNull(pvValue) Then
- .addSelection(pvValue)
- ' Suspending temporarily the expansion listener avoids conflicts
- If Len(_OnNodeExpanded) > 0 Then _ControlView.removeTreeExpansionListener(_ExpandListener)
- .makeNodeVisible(pvValue) ' Expand parent nodes and put node in the display area
- If Len(_OnNodeExpanded) > 0 Then _ControlView.addTreeExpansionListener(_ExpandListener)
- End If
- End With
- Case Else : GoTo CatchType
- End Select
- Case UCase("Default")
- Select Case _ControlType
- Case CTLBUTTON
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Default", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If oSession.HasUNOProperty(_ControlModel, "DefaultButton") Then _ControlModel.DefaultButton = pvValue
- Case Else : GoTo CatchType
- End Select
- Case UCase("Enabled")
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Enabled", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "Enabled") Then _ControlModel.Enabled = pvValue
- Case UCase("Format")
- Select Case _ControlType
- Case CTLDATEFIELD, CTLTIMEFIELD
- vFormats = _FormatsList()
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Format", V_STRING, vFormats) Then GoTo Finally
- iFormat = ScriptForge.SF_Array.IndexOf(vFormats, pvValue, CaseSensitive := False)
- If oSession.HasUNOProperty(_ControlModel, "DateFormat") Then
- _ControlModel.DateFormat = iFormat
- ElseIf oSession.HasUNOProperty(_ControlModel, "TimeFormat") Then
- _ControlModel.TimeFormat = iFormat
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("ListIndex")
- If Not ScriptForge.SF_Utils._Validate(pvValue, "ListIndex", ScriptForge.V_NUMERIC) Then GoTo Finally
- Select Case _ControlType
- Case CTLCOMBOBOX
- If oSession.HasUNOProperty(_ControlModel, "Text") And oSession.HasUNOProperty(_ControlModel, "StringItemList") Then
- _ControlModel.Text = _ControlModel.StringItemList(CInt(pvValue))
- End If
- Case CTLLISTBOX
- If oSession.HasUNOProperty(_ControlModel, "SelectedItems") Then _ControlModel.SelectedItems = Array(CInt(pvValue))
- Case CTLTABLECONTROL
- If oSession.HasUNOProperty(_ControlModel, "SelectionModel") _
- And oSession.HasUNOMethod(_ControlView, "selectRow") Then
- ' Other selection types (multi, range) not supported
- If _ControlModel.SelectionModel = com.sun.star.view.SelectionType.SINGLE _
- And pvValue >= 0 And pvValue <= _GridDataModel.RowCount - 1 Then
- _ControlView.selectRow(pvValue)
- End If
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("Locked")
- Select Case _ControlType
- Case CTLCOMBOBOX, CTLCURRENCYFIELD, CTLDATEFIELD, CTLFILECONTROL, CTLFORMATTEDFIELD, CTLLISTBOX _
- , CTLNUMERICFIELD, CTLPATTERNFIELD, CTLTEXTFIELD, CTLTIMEFIELD
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Locked", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "ReadOnly") Then _ControlModel.ReadOnly = pvValue
- Case Else : GoTo CatchType
- End Select
- Case UCase("MultiSelect")
- Select Case _ControlType
- Case CTLLISTBOX
- If Not ScriptForge.SF_Utils._Validate(pvValue, "MultiSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then _ControlModel.MultiSelection = pvValue
- If oSession.HasUnoProperty(_ControlModel, "MultiSelectionSimpleMode") Then _ControlModel.MultiSelectionSimpleMode = pvValue
- If oSession.HasUnoProperty(_ControlModel, "SelectedItems") Then
- If Not pvValue And UBound(_ControlModel.SelectedItems) > 0 Then ' Cancel selections when MultiSelect becomes False
- lIndex = _ControlModel.SelectedItems(0)
- _ControlModel.SelectedItems = Array(lIndex)
- End If
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("OnNodeExpanded")
- Select Case _ControlType
- Case CTLTREECONTROL
- If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Finally
- ' If the listener was already set, then stop it
- If Len(_OnNodeExpanded) > 0 Then
- _ControlView.removeTreeExpansionListener(_ExpandListener)
- Set _ExpandListener = Nothing
- _OnNodeExpanded = ""
- End If
- ' Setup a new fresh listener
- If Len(pvValue) > 0 Then
- Set _ExpandListener = CreateUnoListener("_SFEXP_", "com.sun.star.awt.tree.XTreeExpansionListener")
- _ControlView.addTreeExpansionListener(_ExpandListener)
- _OnNodeExpanded = pvValue
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("OnNodeSelected")
- Select Case _ControlType
- Case CTLTREECONTROL
- If Not ScriptForge.SF_Utils._Validate(pvValue, psProperty, V_STRING) Then GoTo Finally
- ' If the listener was already set, then stop it
- If Len(_OnNodeSelected) > 0 Then
- _ControlView.removeSelectionChangeListener(_SelectListener)
- Set _SelectListener = Nothing
- _OnNodeSelected = ""
- End If
- ' Setup a new fresh listener
- If Len(pvValue) > 0 Then
- Set _SelectListener = CreateUnoListener("_SFSEL_", "com.sun.star.view.XSelectionChangeListener")
- _ControlView.addSelectionChangeListener(_SelectListener)
- _OnNodeSelected = pvValue
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("Page")
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Page", ScriptForge.V_NUMERIC) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "Step") Then _ControlModel.Step = CLng(pvValue)
- Case UCase("Picture")
- Select Case _ControlType
- Case CTLBUTTON, CTLIMAGECONTROL
- If Not ScriptForge.SF_Utils._ValidateFile(pvValue, "Picture") Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "ImageURL") Then _ControlModel.ImageURL = ScriptForge.SF_FileSystem._ConvertToUrl(pvValue)
- Case Else : GoTo CatchType
- End Select
- Case UCase("RowSource")
- Select Case _ControlType
- Case CTLCOMBOBOX, CTLLISTBOX
- If Not IsArray(pvValue) Then
- If Not ScriptForge.SF_Utils._Validate(pvValue, "RowSource", V_STRING) Then GoTo Finally
- pvArray = Array(pvArray)
- ElseIf Not ScriptForge.SF_Utils._ValidateArray(pvValue, "RowSource", 1, V_STRING, True) Then
- GoTo Finally
- End If
- If oSession.HasUnoProperty(_ControlModel, "StringItemList") Then _ControlModel.StringItemList = pvValue
- Case Else : GoTo CatchType
- End Select
- Case UCase("TipText")
- If Not ScriptForge.SF_Utils._Validate(pvValue, "TipText", V_STRING) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "HelpText") Then _ControlModel.HelpText = pvValue
- Case UCase("TripleState")
- Select Case _ControlType
- Case CTLCHECKBOX
- If Not ScriptForge.SF_Utils._Validate(pvValue, "TripleState", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "TriState") Then _ControlModel.TriState = pvValue
- Case Else : GoTo CatchType
- End Select
- Case UCase("Value")
- Select Case _ControlType
- Case CTLBUTTON 'Boolean, toggle buttons only
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "Toggle") And oSession.HasUnoProperty(_ControlModel, "State") Then
- _ControlModel.State = Iif(pvValue, 1, 0)
- End If
- Case CTLCHECKBOX '0 = Not checked, 1 = Checked, 2 = Don't know
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(ScriptForge.V_BOOLEAN, ScriptForge.V_NUMERIC), Array(0, 1, 2, True, False)) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "State") Then
- If VarType(pvValue) = ScriptForge.V_BOOLEAN Then pvValue = Iif(pvValue, 1, 0)
- _ControlModel.State = pvValue
- End If
- Case CTLCOMBOBOX, CTLFILECONTROL, CTLPATTERNFIELD, CTLTEXTFIELD 'String
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "Text") Then _ControlModel.Text = pvValue
- Case CTLCURRENCYFIELD, CTLNUMERICFIELD 'Numeric
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "Value") Then _ControlModel.Value = pvValue
- Case CTLDATEFIELD 'Date
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_DATE) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "Date") Then
- Set vSet = New com.sun.star.util.Date
- vSet.Year = Year(pvValue)
- vSet.Month = Month(pvValue)
- vSet.Day = Day(pvValue)
- _ControlModel.Date = vSet
- End If
- Case CTLFORMATTEDFIELD 'String or numeric
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "EffectiveValue") Then _ControlModel.EffectiveValue = pvValue
- Case CTLLISTBOX 'String or array of strings depending on MultiSelection
- ' StringItemList is the list of the items displayed in the box
- ' SelectedItems is the list of the indexes in StringItemList of the selected items
- ' It can go beyond the limits of StringItemList
- ' It can contain multiple values even if the listbox is not multiselect
- If oSession.HasUnoProperty(_ControlModel, "StringItemList") And oSession.HasUnoProperty(_ControlModel, "SelectedItems") _
- And oSession.HasUnoProperty(_ControlModel, "MultiSelection") Then
- vSelection = Array()
- If _ControlModel.MultiSelection Then
- If Not ScriptForge.SF_Utils._ValidateArray(pvValue, "Value", 1, V_STRING, True) Then GoTo Finally
- vList = _ControlModel.StringItemList
- For i = LBound(pvValue) To UBound(pvValue)
- sItem = pvValue(i)
- lIndex = ScriptForge.SF_Array.IndexOf(vList, sItem)
- If lIndex >= 0 Then vSelection = ScriptForge.SF_Array.Append(vSelection, lIndex)
- Next i
- Else
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_STRING) Then GoTo Finally
- lIndex = ScriptForge.SF_Array.IndexOf(_ControlModel.StringItemList, pvValue)
- If lIndex >= 0 Then vSelection = Array(lIndex)
- End If
- _ControlModel.SelectedItems = vSelection
- End If
- Case CTLPROGRESSBAR 'Numeric
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "ProgressValueMin") Then
- If pvValue < _ControlModel.ProgressValueMin Then pvValue = _ControlModel.ProgressValueMin
- End If
- If oSession.HasUnoProperty(_ControlModel, "ProgressValueMax") Then
- If pvValue > _ControlModel.ProgressValueMax Then pvValue = _ControlModel.ProgressValueMax
- End If
- If oSession.HasUnoProperty(_ControlModel, "ProgressValue") Then _ControlModel.ProgressValue = pvValue
- Case CTLRADIOBUTTON 'Boolean
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "State") Then _ControlModel.State = Iif(pvValue, 1, 0)
- Case CTLSCROLLBAR 'Numeric
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", ScriptForge.V_NUMERIC) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "ScrollValueMin") Then
- If pvValue < _ControlModel.ScrollValueMin Then pvValue = _ControlModel.ScrollValueMin
- End If
- If oSession.HasUnoProperty(_ControlModel, "ScrollValueMax") Then
- If pvValue > _ControlModel.ScrollValueMax Then pvValue = _ControlModel.ScrollValueMax
- End If
- If oSession.HasUnoProperty(_ControlModel, "ScrollValue") Then _ControlModel.ScrollValue = pvValue
- Case CTLTIMEFIELD
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Value", V_DATE) Then GoTo Finally
- If oSession.HasUnoProperty(_ControlModel, "Time") Then
- Set vSet = New com.sun.star.util.Time
- vSet.Hours = Hour(pvValue)
- vSet.Minutes = Minute(pvValue)
- vSet.Seconds = Second(pvValue)
- _ControlModel.Time = vSet
- End If
- Case Else : GoTo CatchType
- End Select
- Case UCase("Visible")
- If Not ScriptForge.SF_Utils._Validate(pvValue, "Visible", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If oSession.HasUnoMethod(_ControlView, "setVisible") Then
- If pvValue Then
- If oSession.HasUnoProperty(_ControlModel, "EnableVisible") Then _ControlModel.EnableVisible = True
- End If
- _ControlView.setVisible(pvValue)
- End If
- Case Else
- bSet = False
- End Select
- Finally:
- _PropertySet = bSet
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchType:
- ScriptForge.SF_Exception.RaiseFatal(CONTROLTYPEERROR, _Name, _DialogName, _ControlType, psProperty)
- GoTo Finally
- End Function ' SFDialogs.SF_DialogControl._PropertySet
- REM -----------------------------------------------------------------------------
- Private Function _Repr() As String
- ''' Convert the Model instance to a readable string, typically for debugging purposes (DebugPrint ...)
- ''' Args:
- ''' Return:
- ''' "[DIALOGCONTROL]: Name, Type (dialogname)
- _Repr = "[DIALOGCONTROL]: " & _Name & ", " & _ControlType & " (" & _DialogName & ")"
- End Function ' SFDialogs.SF_DialogControl._Repr
- REM ============================================ END OF SFDIALOGS.SF_DIALOGCONTROL
- </script:module>
|