Dialog.xba 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818
  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Dialog" script:language="StarBasic">
  4. REM =======================================================================================================================
  5. REM === The Access2Base library is a part of the LibreOffice project. ===
  6. REM === Full documentation is available on http://www.access2base.com ===
  7. REM =======================================================================================================================
  8. Option Compatible
  9. Option ClassModule
  10. Option Explicit
  11. REM -----------------------------------------------------------------------------------------------------------------------
  12. REM --- CLASS ROOT FIELDS ---
  13. REM -----------------------------------------------------------------------------------------------------------------------
  14. Private _Type As String &apos; Must be DIALOG
  15. Private _This As Object &apos; Workaround for absence of This builtin function
  16. Private _Parent As Object
  17. Private _Name As String
  18. Private _Shortcut As String
  19. Private _Dialog As Object &apos; com.sun.star.io.XInputStreamProvider
  20. Private _Storage As String &apos; GLOBAL or DOCUMENT
  21. Private _Library As String
  22. Private UnoDialog As Object &apos; com.sun.star.awt.XControl
  23. REM -----------------------------------------------------------------------------------------------------------------------
  24. REM --- CONSTRUCTORS / DESTRUCTORS ---
  25. REM -----------------------------------------------------------------------------------------------------------------------
  26. Private Sub Class_Initialize()
  27. _Type = OBJDIALOG
  28. Set _This = Nothing
  29. Set _Parent = Nothing
  30. _Name = &quot;&quot;
  31. Set _Dialog = Nothing
  32. _Storage = &quot;&quot;
  33. _Library = &quot;&quot;
  34. Set UnoDialog = Nothing
  35. End Sub &apos; Constructor
  36. REM -----------------------------------------------------------------------------------------------------------------------
  37. Private Sub Class_Terminate()
  38. On Local Error Resume Next
  39. Call Class_Initialize()
  40. End Sub &apos; Destructor
  41. REM -----------------------------------------------------------------------------------------------------------------------
  42. Public Sub Dispose()
  43. Call Class_Terminate()
  44. End Sub &apos; Explicit destructor
  45. REM -----------------------------------------------------------------------------------------------------------------------
  46. REM --- CLASS GET/LET/SET PROPERTIES ---
  47. REM -----------------------------------------------------------------------------------------------------------------------
  48. REM -----------------------------------------------------------------------------------------------------------------------
  49. Property Get Caption() As Variant
  50. Caption = _PropertyGet(&quot;Caption&quot;)
  51. End Property &apos; Caption (get)
  52. Property Let Caption(ByVal pvValue As Variant)
  53. Call _PropertySet(&quot;Caption&quot;, pvValue)
  54. End Property &apos; Caption (set)
  55. REM -----------------------------------------------------------------------------------------------------------------------
  56. Property Get Height() As Variant
  57. Height = _PropertyGet(&quot;Height&quot;)
  58. End Property &apos; Height (get)
  59. Property Let Height(ByVal pvValue As Variant)
  60. Call _PropertySet(&quot;Height&quot;, pvValue)
  61. End Property &apos; Height (set)
  62. REM -----------------------------------------------------------------------------------------------------------------------
  63. Property Get IsLoaded() As Boolean
  64. IsLoaded = _PropertyGet(&quot;IsLoaded&quot;)
  65. End Property
  66. REM -----------------------------------------------------------------------------------------------------------------------
  67. Property Get Name() As String
  68. Name = _PropertyGet(&quot;Name&quot;)
  69. End Property &apos; Name (get)
  70. Public Function pName() As String &apos; For compatibility with &lt; V0.9.0
  71. pName = _PropertyGet(&quot;Name&quot;)
  72. End Function &apos; pName (get)
  73. REM -----------------------------------------------------------------------------------------------------------------------
  74. Property Get ObjectType() As String
  75. ObjectType = _PropertyGet(&quot;ObjectType&quot;)
  76. End Property &apos; ObjectType (get)
  77. REM -----------------------------------------------------------------------------------------------------------------------
  78. Property Get OnFocusGained() As Variant
  79. OnFocusGained = _PropertyGet(&quot;OnFocusGained&quot;)
  80. End Property &apos; OnFocusGained (get)
  81. Property Let OnFocusGained(ByVal pvValue As Variant)
  82. Call _PropertySet(&quot;OnFocusGained&quot;, pvValue)
  83. End Property &apos; OnFocusGained (set)
  84. REM -----------------------------------------------------------------------------------------------------------------------
  85. Property Get OnFocusLost() As Variant
  86. OnFocusLost = _PropertyGet(&quot;OnFocusLost&quot;)
  87. End Property &apos; OnFocusLost (get)
  88. Property Let OnFocusLost(ByVal pvValue As Variant)
  89. Call _PropertySet(&quot;OnFocusLost&quot;, pvValue)
  90. End Property &apos; OnFocusLost (set)
  91. REM -----------------------------------------------------------------------------------------------------------------------
  92. Property Get OnKeyPressed() As Variant
  93. OnKeyPressed = _PropertyGet(&quot;OnKeyPressed&quot;)
  94. End Property &apos; OnKeyPressed (get)
  95. Property Let OnKeyPressed(ByVal pvValue As Variant)
  96. Call _PropertySet(&quot;OnKeyPressed&quot;, pvValue)
  97. End Property &apos; OnKeyPressed (set)
  98. REM -----------------------------------------------------------------------------------------------------------------------
  99. Property Get OnKeyReleased() As Variant
  100. OnKeyReleased = _PropertyGet(&quot;OnKeyReleased&quot;)
  101. End Property &apos; OnKeyReleased (get)
  102. Property Let OnKeyReleased(ByVal pvValue As Variant)
  103. Call _PropertySet(&quot;OnKeyReleased&quot;, pvValue)
  104. End Property &apos; OnKeyReleased (set)
  105. REM -----------------------------------------------------------------------------------------------------------------------
  106. Property Get OnMouseDragged() As Variant
  107. OnMouseDragged = _PropertyGet(&quot;OnMouseDragged&quot;)
  108. End Property &apos; OnMouseDragged (get)
  109. Property Let OnMouseDragged(ByVal pvValue As Variant)
  110. Call _PropertySet(&quot;OnMouseDragged&quot;, pvValue)
  111. End Property &apos; OnMouseDragged (set)
  112. REM -----------------------------------------------------------------------------------------------------------------------
  113. Property Get OnMouseEntered() As Variant
  114. OnMouseEntered = _PropertyGet(&quot;OnMouseEntered&quot;)
  115. End Property &apos; OnMouseEntered (get)
  116. Property Let OnMouseEntered(ByVal pvValue As Variant)
  117. Call _PropertySet(&quot;OnMouseEntered&quot;, pvValue)
  118. End Property &apos; OnMouseEntered (set)
  119. REM -----------------------------------------------------------------------------------------------------------------------
  120. Property Get OnMouseExited() As Variant
  121. OnMouseExited = _PropertyGet(&quot;OnMouseExited&quot;)
  122. End Property &apos; OnMouseExited (get)
  123. Property Let OnMouseExited(ByVal pvValue As Variant)
  124. Call _PropertySet(&quot;OnMouseExited&quot;, pvValue)
  125. End Property &apos; OnMouseExited (set)
  126. REM -----------------------------------------------------------------------------------------------------------------------
  127. Property Get OnMouseMoved() As Variant
  128. OnMouseMoved = _PropertyGet(&quot;OnMouseMoved&quot;)
  129. End Property &apos; OnMouseMoved (get)
  130. Property Let OnMouseMoved(ByVal pvValue As Variant)
  131. Call _PropertySet(&quot;OnMouseMoved&quot;, pvValue)
  132. End Property &apos; OnMouseMoved (set)
  133. REM -----------------------------------------------------------------------------------------------------------------------
  134. Property Get OnMousePressed() As Variant
  135. OnMousePressed = _PropertyGet(&quot;OnMousePressed&quot;)
  136. End Property &apos; OnMousePressed (get)
  137. Property Let OnMousePressed(ByVal pvValue As Variant)
  138. Call _PropertySet(&quot;OnMousePressed&quot;, pvValue)
  139. End Property &apos; OnMousePressed (set)
  140. REM -----------------------------------------------------------------------------------------------------------------------
  141. Property Get OnMouseReleased() As Variant
  142. OnMouseReleased = _PropertyGet(&quot;OnMouseReleased&quot;)
  143. End Property &apos; OnMouseReleased (get)
  144. Property Let OnMouseReleased(ByVal pvValue As Variant)
  145. Call _PropertySet(&quot;OnMouseReleased&quot;, pvValue)
  146. End Property &apos; OnMouseReleased (set)
  147. REM -----------------------------------------------------------------------------------------------------------------------
  148. Public Function OptionGroup(ByVal Optional pvGroupName As Variant) As Variant
  149. &apos; Return either an error or an object of type OPTIONGROUP based on its name
  150. &apos; A group is determined by the successive TabIndexes of the radio button
  151. &apos; The name of the group = the name of its first element
  152. Utils._SetCalledSub(&quot;Dialog.OptionGroup&quot;)
  153. If IsMissing(pvGroupName) Then Call _TraceArguments()
  154. If _ErrorHandler() Then On Local Error Goto Error_Function
  155. Set OptionGroup = Nothing
  156. If Not Utils._CheckArgument(pvGroupName, 1, vbString) Then Goto Exit_Function
  157. Dim iAllCount As Integer, iRadioLast As Integer, iGroupCount As Integer, iBegin As Integer, iEnd As Integer
  158. Dim oRadios() As Object, sGroupName As String
  159. Dim i As Integer, j As Integer, bFound As Boolean, ocControl As Object, oRadio As Object, iTabIndex As Integer
  160. Dim ogGroup As Object, vGroup() As Variant, vIndex() As Variant
  161. iAllCount = Controls.Count
  162. If iAllCount &gt; 0 Then
  163. iRadioLast = -1
  164. ReDim oRadios(0 To iAllCount - 1)
  165. For i = 0 To iAllCount - 1 &apos; Store all RadioButtons objects
  166. Set ocControl = Controls(i)
  167. If ocControl._SubType = CTLRADIOBUTTON Then
  168. iRadioLast = iRadioLast + 1
  169. Set oRadios(iRadioLast) = ocControl
  170. End If
  171. Next i
  172. Else
  173. Goto Error_Arg &apos; No control in dialog
  174. End If
  175. If iRadioLast &lt; 0 then Goto Error_Arg &apos; No radio buttons in the dialog
  176. &apos;Resort oRadio array based on tab indexes
  177. If iRadioLast &gt; 0 Then
  178. For i = 0 To iRadioLast - 1 &apos; Bubble sort
  179. For j = i + 1 To iRadioLast
  180. If oRadios(i).TabIndex &gt; oRadios(j).TabIndex Then
  181. Set oRadio = oRadios(i)
  182. Set oRadios(i) = oRadios(j)
  183. Set oRadios(j) = oRadio
  184. End If
  185. Next j
  186. Next i
  187. End If
  188. &apos;Scan Names to find match with argument
  189. bFound = False
  190. For i = 0 To iRadioLast
  191. If UCase(oRadios(i)._Name) = UCase(pvGroupName) Then
  192. Select Case i
  193. Case 0 : bFound = True
  194. Case Else
  195. If oRadios(i).TabIndex &gt; oRadios(i - 1).TabIndex + 1 Then
  196. bFound = True
  197. Else
  198. Goto Error_Arg &apos; same group as preceding item although name correct
  199. End If
  200. End Select
  201. If bFound Then
  202. iBegin = i
  203. iEnd = i
  204. sGroupName = oRadios(i)._Name
  205. End If
  206. ElseIf bFound Then
  207. If oRadios(i).TabIndex = oRadios(i - 1).TabIndex + 1 Then iEnd = i
  208. End If
  209. Next i
  210. If bFound Then &apos; Create OptionGroup
  211. iGroupCount = iEnd - iBegin + 1
  212. Set ogGroup = New OptionGroup
  213. ReDim vGroup(0 To iGroupCount - 1)
  214. ReDim vIndex(0 To iGroupCount - 1)
  215. With ogGroup
  216. ._This = ogGroup
  217. ._Name = sGroupName
  218. ._Count = iGroupCount
  219. ._ButtonsGroup = vGroup
  220. ._ButtonsIndex = vIndex
  221. For i = 0 To iGroupCount - 1
  222. Set ._ButtonsGroup(i) = oRadios(iBegin + i).ControlModel
  223. ._ButtonsIndex(i) = i
  224. Next i
  225. ._ParentType = CTLPARENTISDIALOG
  226. ._ParentComponent = UnoDialog
  227. End With
  228. Else Goto Error_Arg
  229. End If
  230. Set OptionGroup = ogGroup
  231. Exit_Function:
  232. Utils._ResetCalledSub(&quot;Dialog.OptionGroup&quot;)
  233. Exit Function
  234. Error_Arg:
  235. TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvGroupName))
  236. Goto Exit_Function
  237. Error_Function:
  238. TraceError(TRACEABORT, Err, &quot;Dialog.OptionGroup&quot;, Erl)
  239. GoTo Exit_Function
  240. End Function &apos; OptionGroup V0.9.1
  241. REM -----------------------------------------------------------------------------------------------------------------------
  242. Property Get Page() As Variant
  243. Page = _PropertyGet(&quot;Page&quot;)
  244. End Property &apos; Page (get)
  245. Property Let Page(ByVal pvValue As Variant)
  246. Call _PropertySet(&quot;Page&quot;, pvValue)
  247. End Property &apos; Page (set)
  248. REM -----------------------------------------------------------------------------------------------------------------------
  249. Public Function Parent() As Object
  250. Parent = _Parent
  251. End Function &apos; Parent (get) V6.4.0
  252. REM -----------------------------------------------------------------------------------------------------------------------
  253. Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
  254. &apos; Return
  255. &apos; a Collection object if pvIndex absent
  256. &apos; a Property object otherwise
  257. Const cstThisSub = &quot;Dialog.Properties&quot;
  258. Utils._SetCalledSub(cstThisSub)
  259. Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
  260. vPropertiesList = _PropertiesList()
  261. sObject = Utils._PCase(_Type)
  262. If IsMissing(pvIndex) Then
  263. vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
  264. Else
  265. vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
  266. vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
  267. End If
  268. Exit_Function:
  269. Set Properties = vProperty
  270. Utils._ResetCalledSub(cstThisSub)
  271. Exit Function
  272. End Function &apos; Properties
  273. REM -----------------------------------------------------------------------------------------------------------------------
  274. Property Get Visible() As Variant
  275. Visible = _PropertyGet(&quot;Visible&quot;)
  276. End Property &apos; Visible (get)
  277. Property Let Visible(ByVal pvValue As Variant)
  278. Call _PropertySet(&quot;Visible&quot;, pvValue)
  279. End Property &apos; Visible (set)
  280. REM -----------------------------------------------------------------------------------------------------------------------
  281. Property Get Width() As Variant
  282. Width = _PropertyGet(&quot;Width&quot;)
  283. End Property &apos; Width (get)
  284. Property Let Width(ByVal pvValue As Variant)
  285. Call _PropertySet(&quot;Width&quot;, pvValue)
  286. End Property &apos; Width (set)
  287. REM -----------------------------------------------------------------------------------------------------------------------
  288. REM --- CLASS METHODS ---
  289. REM -----------------------------------------------------------------------------------------------------------------------
  290. Public Function Controls(Optional ByVal pvIndex As Variant) As Variant
  291. &apos; Return a Control object with name or index = pvIndex
  292. If _ErrorHandler() Then On Local Error Goto Error_Function
  293. Utils._SetCalledSub(&quot;Dialog.Controls&quot;)
  294. Dim ocControl As Variant, sParentShortcut As String, iControlCount As Integer
  295. Dim oCounter As Variant, sControls() As Variant, i As Integer, bFound As Boolean, sIndex As String
  296. Dim j As Integer
  297. Set ocControl = Nothing
  298. If Not IsLoaded Then Goto Trace_Error_NotOpen
  299. Set ocControl = New Control
  300. Set ocControl._This = ocControl
  301. Set ocControl._Parent = _This
  302. ocControl._ParentType = CTLPARENTISDIALOG
  303. sParentShortcut = _Shortcut
  304. sControls() = UnoDialog.Model.getElementNames()
  305. iControlCount = UBound(sControls) + 1
  306. If IsMissing(pvIndex) Then &apos; No argument, return Collection object
  307. Set oCounter = New Collect
  308. Set oCounter._This = oCounter
  309. oCounter._CollType = COLLCONTROLS
  310. oCounter._Count = iControlCount
  311. Set oCounter._Parent = _This
  312. Set Controls = oCounter
  313. Goto Exit_Function
  314. End If
  315. If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
  316. &apos; Start building the ocControl object
  317. &apos; Determine exact name
  318. Select Case VarType(pvIndex)
  319. Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
  320. If pvIndex &lt; 0 Or pvIndex &gt; iControlCount - 1 Then Goto Trace_Error_Index
  321. ocControl._Name = sControls(pvIndex)
  322. Case vbString &apos; Check control name validity (non case sensitive)
  323. bFound = False
  324. sIndex = UCase(Utils._Trim(pvIndex))
  325. For i = 0 To iControlCount - 1
  326. If UCase(sControls(i)) = sIndex Then
  327. bFound = True
  328. Exit For
  329. End If
  330. Next i
  331. If bFound Then ocControl._Name = sControls(i) Else Goto Trace_NotFound
  332. End Select
  333. ocControl._Shortcut = sParentShortcut &amp; &quot;!&quot; &amp; Utils._Surround(ocControl._Name)
  334. Set ocControl.ControlModel = UnoDialog.Model.getByName(ocControl._Name)
  335. Set ocControl.ControlView = UnoDialog.getControl(ocControl._Name)
  336. ocControl._ImplementationName = ocControl.ControlModel.getImplementationName()
  337. ocControl._FormComponent = UnoDialog
  338. ocControl._Initialize()
  339. Set Controls = ocControl
  340. Exit_Function:
  341. Utils._ResetCalledSub(&quot;Dialog.Controls&quot;)
  342. Exit Function
  343. Trace_Error:
  344. TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(iArg, pvIndex))
  345. Set Controls = Nothing
  346. Goto Exit_Function
  347. Trace_Error_NotOpen:
  348. TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, , _Name)
  349. Set Controls = Nothing
  350. Goto Exit_Function
  351. Trace_Error_Index:
  352. TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
  353. Set Controls = Nothing
  354. Goto Exit_Function
  355. Trace_NotFound:
  356. TraceError(TRACEFATAL, ERRCONTROLNOTFOUND, Utils._CalledSub(), 0, , Array(pvIndex, pvIndex))
  357. Set Controls = Nothing
  358. Goto Exit_Function
  359. Error_Function:
  360. TraceError(TRACEABORT, Err, &quot;Dialog.Controls&quot;, Erl)
  361. Set Controls = Nothing
  362. GoTo Exit_Function
  363. End Function &apos; Controls
  364. REM -----------------------------------------------------------------------------------------------------------------------
  365. Public Sub EndExecute(ByVal Optional pvReturn As Variant)
  366. &apos; Stop executing the dialog
  367. If _ErrorHandler() Then On Local Error Goto Error_Sub
  368. Utils._SetCalledSub(&quot;Dialog.endExecute&quot;)
  369. If IsMissing(pvReturn) Then pvReturn = 0
  370. If Not Utils._CheckArgument(pvReturn, 1, Utils._AddNumeric(), , False) Then Goto Trace_Error
  371. Dim lExecute As Long
  372. lExecute = CLng(pvReturn)
  373. If IsNull(_Dialog) Then Goto Error_Execute
  374. If IsNull(UnoDialog) Then Goto Error_Not_Started
  375. Call UnoDialog.endDialog(lExecute)
  376. Exit_Sub:
  377. Utils._ResetCalledSub(&quot;Dialog.endExecute&quot;)
  378. Exit Sub
  379. Trace_Error:
  380. TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(&quot;1&quot;, Utils._CStr(pvReturn)))
  381. Goto Exit_Sub
  382. Error_Execute:
  383. TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0)
  384. Goto Exit_Sub
  385. Error_Not_Started:
  386. TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name)
  387. Goto Exit_Sub
  388. Error_Sub:
  389. TraceError(TRACEABORT, Err, &quot;Dialog.endExecute&quot;, Erl)
  390. GoTo Exit_Sub
  391. End Sub &apos; EndExecute
  392. REM -----------------------------------------------------------------------------------------------------------------------
  393. Public Function Execute() As Long
  394. &apos; Execute dialog
  395. &apos;If _ErrorHandler() Then On Local Error Goto Error_Function
  396. &apos;Seems smart not to trap errors: debugging of dialog events otherwise made very difficult !
  397. Utils._SetCalledSub(&quot;Dialog.Execute&quot;)
  398. Dim lExecute As Long
  399. If IsNull(_Dialog) Then Goto Error_Execute
  400. If IsNull(UnoDialog) Then Goto Error_Not_Started
  401. lExecute = UnoDialog.execute()
  402. Select Case lExecute
  403. Case 1 : Execute = dlgOK
  404. Case 0 : Execute = dlgCancel
  405. Case Else : Execute = lExecute
  406. End Select
  407. Exit_Function:
  408. Utils._ResetCalledSub(&quot;Dialog.Execute&quot;)
  409. Exit Function
  410. Error_Execute:
  411. TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0)
  412. Goto Exit_Function
  413. Error_Not_Started:
  414. TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name)
  415. Goto Exit_Function
  416. Error_Function:
  417. TraceError(TRACEABORT, Err, &quot;Dialog.Execute&quot;, Erl)
  418. GoTo Exit_Function
  419. End Function &apos; Execute
  420. REM -----------------------------------------------------------------------------------------------------------------------
  421. Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
  422. &apos; Return property value of psProperty property name
  423. Utils._SetCalledSub(&quot;Dialog.getProperty&quot;)
  424. If IsMissing(pvProperty) Then Call _TraceArguments()
  425. getProperty = _PropertyGet(pvProperty)
  426. Utils._ResetCalledSub(&quot;Dialog.getProperty&quot;)
  427. End Function &apos; getProperty
  428. REM -----------------------------------------------------------------------------------------------------------------------
  429. Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
  430. &apos; Return True if object has a valid property called pvProperty (case-insensitive comparison !)
  431. If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
  432. Exit Function
  433. End Function &apos; hasProperty
  434. REM -----------------------------------------------------------------------------------------------------------------------
  435. Public Function Move( ByVal Optional pvLeft As Variant _
  436. , ByVal Optional pvTop As Variant _
  437. , ByVal Optional pvWidth As Variant _
  438. , ByVal Optional pvHeight As Variant _
  439. ) As Variant
  440. &apos; Execute Move method
  441. Utils._SetCalledSub(&quot;Dialog.Move&quot;)
  442. On Local Error Goto Error_Function
  443. Move = False
  444. Dim iArgNr As Integer
  445. Select Case UCase(_A2B_.CalledSub)
  446. Case UCase(&quot;Move&quot;) : iArgNr = 1
  447. Case UCase(&quot;Dialog.Move&quot;) : iArgNr = 0
  448. End Select
  449. If IsMissing(pvLeft) Then pvLeft = -1
  450. If IsMissing(pvTop) Then pvTop = -1
  451. If IsMissing(pvWidth) Then pvWidth = -1
  452. If IsMissing(pvHeight) Then pvHeight = -1
  453. If Not Utils._CheckArgument(pvLeft, iArgNr + 1, Utils._AddNumeric()) Then Goto Exit_Function
  454. If Not Utils._CheckArgument(pvTop, iArgNr + 2, Utils._AddNumeric()) Then Goto Exit_Function
  455. If Not Utils._CheckArgument(pvWidth, iArgNr + 3, Utils._AddNumeric()) Then Goto Exit_Function
  456. If Not Utils._CheckArgument(pvHeight, iArgNr + 4, Utils._AddNumeric()) Then Goto Exit_Function
  457. Dim iArg As Integer, iWrong As Integer &apos; Check arguments values
  458. iArg = 0
  459. If pvHeight &lt; -1 Then
  460. iArg = 4 : iWrong = pvHeight
  461. ElseIf pvWidth &lt; -1 Then
  462. iArg = 3 : iWrong = pvWidth
  463. ElseIf pvTop &lt; -1 Then
  464. iArg = 2 : iWrong = pvTop
  465. ElseIf pvLeft &lt; -1 Then
  466. iArg = 1 : iWrong = pvLeft
  467. End If
  468. If iArg &gt; 0 Then
  469. TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(iArgNr + iArg, iWrong))
  470. Goto Exit_Function
  471. End If
  472. Dim iPosSize As Integer
  473. iPosSize = 0
  474. If pvLeft &gt;= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.X
  475. If pvTop &gt;= 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.Y
  476. If pvWidth &gt; 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.WIDTH
  477. If pvHeight &gt; 0 Then iPosSize = iPosSize + com.sun.star.awt.PosSize.HEIGHT
  478. If iPosSize &gt; 0 Then UnoDialog.setPosSize(pvLeft, pvTop, pvWidth, pvHeight, iPosSize)
  479. Move = True
  480. Exit_Function:
  481. Utils._ResetCalledSub(&quot;Dialog.Move&quot;)
  482. Exit Function
  483. Error_Function:
  484. TraceError(TRACEABORT, Err, &quot;Dialog.Move&quot;, Erl)
  485. GoTo Exit_Function
  486. End Function &apos; Move
  487. REM -----------------------------------------------------------------------------------------------------------------------
  488. Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
  489. &apos; Return True if property setting OK
  490. Utils._SetCalledSub(&quot;Dialog.setProperty&quot;)
  491. setProperty = _PropertySet(psProperty, pvValue)
  492. Utils._ResetCalledSub(&quot;Dialog.setProperty&quot;)
  493. End Function
  494. REM -----------------------------------------------------------------------------------------------------------------------
  495. Public Function Start() As Boolean
  496. &apos; Create dialog
  497. If _ErrorHandler() Then On Local Error Goto Error_Function
  498. Utils._SetCalledSub(&quot;Dialog.Start&quot;)
  499. Dim oStart As Object
  500. Start = False
  501. If IsNull(_Dialog) Then Goto Error_Start
  502. If Not IsNull(UnoDialog) Then Goto Error_Yet_Started
  503. Set oStart = CreateUnoDialog(_Dialog)
  504. If IsNull(oStart) Then
  505. Goto Error_Start
  506. Else
  507. Start = True
  508. Set UnoDialog = oStart
  509. With _A2B_
  510. If .hasItem(COLLALLDIALOGS, _Name) Then .Dialogs.Remove(_Name) &apos; Inserted to solve errors, when aborts between start and terminate
  511. .Dialogs.Add(UnoDialog, UCase(_Name))
  512. End With
  513. End If
  514. Exit_Function:
  515. Utils._ResetCalledSub(&quot;Dialog.Start&quot;)
  516. Exit Function
  517. Error_Start:
  518. TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0)
  519. Goto Exit_Function
  520. Error_Yet_Started:
  521. TraceError(TRACEWARNING, ERRDIALOGSTARTED, Utils._CalledSub(), 0)
  522. Goto Exit_Function
  523. Error_Function:
  524. TraceError(TRACEABORT, Err, &quot;Dialog.Start&quot;, Erl)
  525. GoTo Exit_Function
  526. End Function &apos; Start
  527. REM -----------------------------------------------------------------------------------------------------------------------
  528. Public Function Terminate() As Boolean
  529. &apos; Close dialog
  530. If _ErrorHandler() Then On Local Error Goto Error_Function
  531. Utils._SetCalledSub(&quot;Dialog.Terminate&quot;)
  532. Terminate = False
  533. If IsNull(_Dialog) Then Goto Error_Terminate
  534. If IsNull(UnoDialog) Then Goto Error_Not_Started
  535. UnoDialog.Dispose()
  536. Set UnoDialog = Nothing
  537. _A2B_.Dialogs.Remove(_Name)
  538. Terminate = True
  539. Exit_Function:
  540. Utils._ResetCalledSub(&quot;Dialog.Terminate&quot;)
  541. Exit Function
  542. Error_Terminate:
  543. TraceError(TRACEFATAL, ERRDIALOGUNDEFINED, Utils._CalledSub(), 0)
  544. Goto Exit_Function
  545. Error_Not_Started:
  546. TraceError(TRACEWARNING, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name)
  547. Goto Exit_Function
  548. Error_Function:
  549. TraceError(TRACEABORT, Err, &quot;Dialog.Terminate&quot;, Erl)
  550. GoTo Exit_Function
  551. End Function &apos; Terminate
  552. REM -----------------------------------------------------------------------------------------------------------------------
  553. REM --- PRIVATE FUNCTIONS ---
  554. REM -----------------------------------------------------------------------------------------------------------------------
  555. REM -----------------------------------------------------------------------------------------------------------------------
  556. Private Function _GetListener(ByVal psProperty As String) As String
  557. &apos; Return the X...Listener corresponding with the property in argument
  558. Select Case UCase(psProperty)
  559. Case UCase(&quot;OnFocusGained&quot;), UCase(&quot;OnFocusLost&quot;)
  560. _GetListener = &quot;XFocusListener&quot;
  561. Case UCase(&quot;OnKeyPressed&quot;), UCase(&quot;OnKeyReleased&quot;)
  562. _GetListener = &quot;XKeyListener&quot;
  563. Case UCase(&quot;OnMouseDragged&quot;), UCase(&quot;OnMouseMoved&quot;)
  564. _GetListener = &quot;XMouseMotionListener&quot;
  565. Case UCase(&quot;OnMouseEntered&quot;), UCase(&quot;OnMouseExited&quot;), UCase(&quot;OnMousePressed&quot;), UCase(&quot;OnMouseReleased&quot;)
  566. _GetListener = &quot;XMouseListener&quot;
  567. End Select
  568. End Function &apos; _GetListener V1.7.0
  569. REM -----------------------------------------------------------------------------------------------------------------------
  570. Private Function _PropertiesList() As Variant
  571. If IsLoaded Then
  572. _PropertiesList = Array(&quot;Caption&quot;, &quot;Height&quot;, &quot;IsLoaded&quot;, &quot;Name&quot; _
  573. , &quot;OnFocusGained&quot;, &quot;OnFocusLost&quot;, &quot;OnKeyPressed&quot;, &quot;OnKeyReleased&quot;, &quot;OnMouseDragged&quot; _
  574. , &quot;OnMouseEntered&quot;, &quot;OnMouseExited&quot;, &quot;OnMouseMoved&quot;, &quot;OnMousePressed&quot;, &quot;OnMouseReleased&quot; _
  575. , &quot;ObjectType&quot;, &quot;Page&quot;, &quot;Visible&quot;, &quot;Width&quot; _
  576. )
  577. Else
  578. _PropertiesList = Array(&quot;IsLoaded&quot;, &quot;Name&quot; _
  579. )
  580. End If
  581. End Function &apos; _PropertiesList
  582. REM -----------------------------------------------------------------------------------------------------------------------
  583. Private Function _PropertyGet(ByVal psProperty As String) As Variant
  584. &apos; Return property value of the psProperty property name
  585. If _ErrorHandler() Then On Local Error Goto Error_Function
  586. Utils._SetCalledSub(&quot;Dialog.get&quot; &amp; psProperty)
  587. Dim oDialogEvents As Object, sEventName As String
  588. &apos;Execute
  589. _PropertyGet = EMPTY
  590. Select Case UCase(psProperty)
  591. Case UCase(&quot;Name&quot;), UCase(&quot;IsLoaded&quot;)
  592. Case Else
  593. If IsNull(UnoDialog) Then Goto Trace_Error_Dialog
  594. End Select
  595. Select Case UCase(psProperty)
  596. Case UCase(&quot;Caption&quot;)
  597. _PropertyGet = UnoDialog.getTitle()
  598. Case UCase(&quot;Height&quot;)
  599. _PropertyGet = UnoDialog.getPosSize().Height
  600. Case UCase(&quot;IsLoaded&quot;)
  601. _PropertyGet = _A2B_.hasItem(COLLALLDIALOGS, _Name)
  602. Case UCase(&quot;Name&quot;)
  603. _PropertyGet = _Name
  604. Case UCase(&quot;ObjectType&quot;)
  605. _PropertyGet = _Type
  606. Case UCase(&quot;OnFocusGained&quot;), UCase(&quot;OnFocusLost&quot;), UCase(&quot;OnKeyPressed&quot;), UCase(&quot;OnKeyReleased&quot;) _
  607. , UCase(&quot;OnMouseDragged&quot;), UCase(&quot;OnMouseEntered&quot;), UCase(&quot;OnMouseExited&quot;), UCase(&quot;OnMouseMoved&quot;) _
  608. , UCase(&quot;OnMousePressed&quot;), UCase(&quot;OnMouseReleased&quot;)
  609. Set oDialogEvents = unoDialog.Model.getEvents()
  610. sEventName = &quot;com.sun.star.awt.&quot; &amp; _GetListener(psProperty) &amp; &quot;::&quot; &amp; Utils._GetEventName(psProperty)
  611. If oDialogEvents.hasByName(sEventName) Then
  612. _PropertyGet = oDialogEvents.getByName(sEventName).ScriptCode
  613. Else
  614. _PropertyGet = &quot;&quot;
  615. End If
  616. Case UCase(&quot;Page&quot;)
  617. _PropertyGet = UnoDialog.Model.Step
  618. Case UCase(&quot;Visible&quot;)
  619. _PropertyGet = UnoDialog.IsVisible()
  620. Case UCase(&quot;Width&quot;)
  621. _PropertyGet = UnoDialog.getPosSize().Width
  622. Case Else
  623. Goto Trace_Error
  624. End Select
  625. Exit_Function:
  626. Utils._ResetCalledSub(&quot;Dialog.get&quot; &amp; psProperty)
  627. Exit Function
  628. Trace_Error:
  629. TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
  630. _PropertyGet = EMPTY
  631. Goto Exit_Function
  632. Trace_Error_Dialog:
  633. TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name)
  634. _PropertyGet = EMPTY
  635. Goto Exit_Function
  636. Error_Function:
  637. TraceError(TRACEABORT, Err, &quot;Dialog._PropertyGet&quot;, Erl)
  638. _PropertyGet = EMPTY
  639. GoTo Exit_Function
  640. End Function &apos; _PropertyGet
  641. REM -----------------------------------------------------------------------------------------------------------------------
  642. Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
  643. Utils._SetCalledSub(&quot;Dialog.set&quot; &amp; psProperty)
  644. If _ErrorHandler() Then On Local Error Goto Error_Function
  645. _PropertySet = True
  646. Dim oDialogEvents As Object, sEventName As String, oEvent As Object, sListener As String, sEvent As String
  647. &apos;Execute
  648. Dim iArgNr As Integer
  649. If _IsLeft(_A2B_.CalledSub, &quot;Dialog.&quot;) Then iArgNr = 1 Else iArgNr = 2
  650. If IsNull(UnoDialog) Then Goto Trace_Error_Dialog
  651. Select Case UCase(psProperty)
  652. Case UCase(&quot;Caption&quot;)
  653. If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
  654. UnoDialog.setTitle(pvValue)
  655. Case UCase(&quot;Height&quot;)
  656. If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
  657. UnoDialog.setPosSize(0, 0, 0, pvValue, com.sun.star.awt.PosSize.HEIGHT)
  658. Case UCase(&quot;OnFocusGained&quot;), UCase(&quot;OnFocusLost&quot;), UCase(&quot;OnKeyPressed&quot;), UCase(&quot;OnKeyReleased&quot;) _
  659. , UCase(&quot;OnMouseDragged&quot;), UCase(&quot;OnMouseEntered&quot;), UCase(&quot;OnMouseExited&quot;), UCase(&quot;OnMouseMoved&quot;) _
  660. , UCase(&quot;OnMousePressed&quot;), UCase(&quot;OnMouseReleased&quot;)
  661. If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
  662. If Not Utils._RegisterDialogEventScript(UnoDialog.Model _
  663. , psProperty _
  664. , _GetListener(psProperty) _
  665. , pvValue _
  666. ) Then GoTo Trace_Error_Dialog
  667. Case UCase(&quot;Page&quot;)
  668. If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
  669. If pvValue &lt; 0 Then Goto Trace_Error_Value
  670. UnoDialog.Model.Step = pvValue
  671. Case UCase(&quot;Visible&quot;)
  672. If Not Utils._CheckArgument(pvValue, iArgNr, vbBoolean, , False) Then Goto Trace_Error_Value
  673. UnoDialog.setVisible(pvValue)
  674. Case UCase(&quot;Width&quot;)
  675. If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric()) Then Goto Trace_Error_Value
  676. UnoDialog.setPosSize(0, 0, pvValue, 0, com.sun.star.awt.PosSize.WIDTH)
  677. Case Else
  678. Goto Trace_Error
  679. End Select
  680. Exit_Function:
  681. Utils._ResetCalledSub(&quot;Dialog.set&quot; &amp; psProperty)
  682. Exit Function
  683. Trace_Error_Dialog:
  684. TraceError(TRACEFATAL, ERRDIALOGNOTSTARTED, Utils._CalledSub(), 0, 1, _Name)
  685. _PropertySet = False
  686. Goto Exit_Function
  687. Trace_Error:
  688. TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
  689. _PropertySet = False
  690. Goto Exit_Function
  691. Trace_Error_Value:
  692. TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
  693. _PropertySet = False
  694. Goto Exit_Function
  695. Error_Function:
  696. TraceError(TRACEABORT, Err, &quot;Dialog._PropertySet&quot;, Erl)
  697. _PropertySet = False
  698. GoTo Exit_Function
  699. End Function &apos; _PropertySet
  700. </script:module>