Module cCJCommandBarSystem.pkg
1Use Windows.pkg
2Use cRegistry.pkg
3Use cCJCommandBars.pkg // loads CodeJock class
4
5// idle timer used for updates.
6{ Visibility=Private }
7Class cCJIdleHandler is a cIdleHandler
8 Procedure OnIdle
9 Delegate Send Update
10 End_Procedure
11End_Class
12
13
14// Used for key bindings along with the VK_ defintions
15Define xtpKey_None for 0
16Define xtpKey_Shift for 4
17Define xtpKey_Ctrl for 8
18Define xtpKey_Alt for 16
19
20Define ID_CommandBarsAutoStart for 20001 // start for auto assigned menu items
21Define ID_StatusBarsAutoStart for 10001 // start for auto assigned status panes
22Define ID_CommandBarIDAutoStart for 5000 // start for auto assigned commandbar BarIds
23Define ID_ImageAutoStart for 5000 // start for auto assigned image ids
24
25// options for loading and saving command bar layout
26Enum_List
27 Define rlNoSaveRestore // don't load or save anything
28 Define rlSaveRestoreLayout // just load and save the layout (position of toolbars)
29 Define rlSaveRestoreFullLayout // load/save layout plus addition info such as theme, large icons, etc.
30 Define rlSaveRestoreAll // load and save layout and the controls (useful if you customize)
31End_Enum_List
32
33Enum_List
34 Define stNoStretch
35 Define stStretch
36 Define stStretchShared
37End_Enum_List
38
39// special StatusBar Id valus (piID) values for statusbar panes.
40Enum_List
41 Define sbpIDAutoAssign for -1 // ID will be auto assigned during pane's end_construct_Object
42 Define sbpIDIdlePane for 0 // Used to display idle text and the DescriptionText of controls on mouse over.
43 Define sbpIDCapslock for 59137 // Indicates whether CAPS Lock is on or off.
44 Define sbpIDNumLock for 59138 // Indicates whether Num Lock is on or off.
45 Define sbpIDScrollLock for 59139 // Indicates whether Scroll Lock is on or off
46End_Enum_List
47
48// this keeps track of a global commandbars, which should be the Main menu's commandBars object
49// context menus use this to attach to commandbars
50Global_Variable Integer ghoCommandBars
51Move 0 to ghoCommandBars
52
53
54{ OverrideProperty=Border_Style DesignTime=False }
55{ OverrideProperty=Enabled_State DesignTime=False }
56{ OverrideProperty=Color DesignTime=False }
57{ OverrideProperty=Label DesignTime=False }
58{ OverrideProperty=Label_Col_Offset DesignTime=False }
59{ OverrideProperty=Label_Row_Offset DesignTime=False }
60{ OverrideProperty=Label_Justification_Mode DesignTime=False }
61
62{ OverrideProperty=Label_Color DesignTime=False }
63{ OverrideProperty=Label_FontItalics DesignTime=False }
64{ OverrideProperty=Label_FontSize DesignTime=False }
65{ OverrideProperty=Label_FontUnderline DesignTime=False }
66{ OverrideProperty=Label_FontWeight DesignTime=False }
67{ OverrideProperty=Label_TextColor DesignTime=False }
68{ OverrideProperty=Label_TypeFace DesignTime=False }
69{ OverrideProperty=Location DesignTime=False }
70{ OverrideProperty=Size DesignTime=False }
71{ OverrideProperty=peAnchors DesignTime=False }
72{ OverrideProperty=piMinSize DesignTime=False }
73{ OverrideProperty=TextColor DesignTime=False }
74{ OverrideProperty=Visible_state DesignTime=False }
75{ OverrideProperty=Attach_Parent_State DesignTime=False }
76{ OverrideProperty=Block_Mouse_state DesignTime=False }
77{ OverrideProperty=Delegation_Mode DesignTime=False }
78{ OverrideProperty=Client_Area_State DesignTime=False }
79{ OverrideProperty=Focus_Mode DesignTime=False }
80{ OverrideProperty=pbBindValue DesignTime=False }
81{ OverrideProperty=peAutoCreate DesignTime=False }
82{ OverrideProperty=peNeighborhood DesignTime=False }
83{ OverrideProperty=Popup_State DesignTime=False }
84{ OverrideProperty=Ring_State DesignTime=False }
85{ OverrideProperty=Search_Case DesignTime=False }
86{ OverrideProperty=Skip_State DesignTime=False }
87{ OverrideProperty=Scope_State DesignTime=False }
88{ OverrideProperty=Help_Id DesignTime=False }
89{ OverrideProperty=Help_Keyword DesignTime=False }
90{ OverrideProperty=psHtmlHelpTopic DesignTime=False }
91{ OverrideProperty=Status_Help DesignTime=False }
92{ OverrideProperty=Use_Parent_Status_Help DesignTime=False }
93{ OverrideProperty=psLicenseKey DesignTime=False }
94{ OverrideProperty=psProgId DesignTime=False }
95
96
97{ OverrideProperty=peNeighborhood InitialValue=nhPublic }
98{ DesignerClass = cDTCJCommandBarSystem }
99Class cCJCommandBarSystem is a cCJCommandBars
100
101 Procedure Construct_Object
102 Handle hoTimer hoMain
103 Forward Send Construct_Object
104
105 // do we save/restore command bars and if so how
106 { Category="Behavior" }
107 { EnumList="rlSaveRestoreAll, rlSaveRestoreLayout, rlSaveRestoreFullLayout, rlNoSaveRestore" }
108 Property Integer peRestoreLayout rlNoSaveRestore
109
110 // This allows developers to control when a load layout should not be used
111 // because it is out of date. Just keep incrementing this value when you change
112 // something that is not compatible
113 { Category="Behavior" }
114 Property Integer piLayoutBuild 1
115
116 // Name used to save a store commandbars. Can be changed to create
117 // custom setups.
118 { Category="Behavior" }
119 Property String psLayoutSection "CommandBars"
120
121 // if true this expects client area and a panel. Auto assigned
122 { Visibility=Private }
123 Property Boolean pbMDIMenu False
124
125 { DesignTime=False }
126 Property Handle phoStatusBar 0 // assigned automatically
127
128 { Visibility=Private }
129 Property Integer pePrivateVisualTheme xtpThemeWhidbey
130 { Visibility=Private }
131 Property Boolean pbPrivateEnableCustomization False
132 { Visibility=Private }
133 Property Boolean pbPrivateAltDragCustomization False
134 { Visibility=Private }
135 Property Integer pePrivateAnimation xtpAnimateWindowsDefault
136 { Visibility=Private }
137 Property Boolean pbPrivateLargeIcons False
138 { Visibility=Private }
139 Property Boolean pbPrivateShowTextBelowIcons False
140 { Visibility=Private }
141 Property Boolean pbPrivateAlwaysShowFullMenus True
142 { Visibility=Private }
143 Property Boolean pbPrivateShowFullAfterDelay True
144 { Visibility=Private }
145 Property Boolean pbPrivateOfficeStyleDisabledIcons False
146 { Visibility=Private }
147 Property Boolean pbPrivateIconsWithShadow True
148 { Visibility=Private }
149 Property Boolean pbPrivateToolBarScreenTips True
150 { Visibility=Private }
151 Property Boolean pbPrivateShowPopupBarToolTips False
152 { Visibility=Private }
153 Property Boolean pbPrivateToolBarAccelTips True
154 { Visibility=Private }
155 Property Boolean pbPrivateAutoHideUnusedPopups False
156 { Visibility=Private }
157 Property Boolean pbPrivateShowExpandButtonAlways False
158 { Visibility=Private }
159 Property Boolean pbPrivateSyncFloatingToolbars True
160 { Visibility=Private }
161 Property Boolean pbPrivateFloatToolbarsByDoubleClick False
162
163 { Category="Behavior" }
164 Property Boolean pbCustomizeShowKeyboardPage False
165 { Category="Behavior" }
166 Property Boolean pbCustomizeShowOptionsPage False
167
168 // these will not be exposed.
169 //Property Boolean pbShowIconsShadow // ????
170 //Property Boolean pbGenerateDisabledcIcons // ????
171 //Property Boolean pbUseFadedIcons
172 //Property Integer piExpandDelay
173 //Property Integer piExplandHoverDelay
174 //Property Integer peShowKbdCues
175 //Property Integer peUseKbdCues
176 //Property Integer piMaxPopupWidth
177 //Property Integer piIconsSize // folded??
178 //Property Integer piLargeIconSize
179 //Property Integer piPopupIconSize
180
181
182 { Visibility=Private }
183 Property Handle phoPrivateActions (Create(Self,U_cCJCommandBarActions))
184 { Visibility=Private }
185 Property Handle phoPrivateDesignerControls (Create(Self,U_cCJCommandBarControls))
186 { Visibility=Private }
187 Property Handle phoPrivateKeyBindings (Create(Self,U_cCJKeyBindings))
188 { Visibility=Private }
189 Property Handle phoPrivateOptions (Create(Self,U_cCJCommandBarsOptions))
190 { Visibility=Private }
191 Property Boolean pbPrivateTimerUpdate True
192
193 // array of all registered actions (i.e., actions that have a DF object and are COM instanciated)
194 { Visibility=Private }
195 Property Handle[] phoRegisteredActions
196
197 // array of actions that should actively updated via timer refresh
198 { Visibility=Private }
199 Property Handle[] phoActiveUpdates
200
201 // array of action IDs that can be reused. We do this because we cannot destroy actions
202 { Visibility=Private }
203 Property Integer[] piActionIdPool
204
205 // last auto assigned BarId
206 { Visibility=Private }
207 Property Integer piLastBarId ID_CommandBarIDAutoStart
208
209 // last auto assigned image ID
210 { Visibility=Private }
211 Property Integer piLastImageId ID_ImageAutoStart
212
213 // used to determine of Load should occur. When the count changes in the
214 // the action IDs or barIds it is not safe to reload things.
215 { Visibility=Private }
216 Property Integer piLastAssignedDesignTimeID 0
217 { Visibility=Private }
218 Property Integer piLastAssignedDesignTimeBarID 0
219
220 { Visibility=Private }
221 Property Handle phoTimer 0
222
223 Get Create U_cCJIdleHandler to hoTimer
224 Set phoTimer to hoTimer
225
226 Get Main_Panel_id to hoMain
227 Set peAutoCreate to acDeferredAutoCreate
228 Set peNeighborhood to nhPublic
229 // if commandbar is part of a focusable ring (like a view) we never want it to
230 // take the focus
231 Set Skip_State to True
232
233 Send AssignMDIMenu // determine if this is an MDI commandbar.
234
235
236
237 End_Procedure
238
239
240 // this will figure out if this is an MDI menu and assign the ghoCommandBars
241 // global variable if needed.
242 // We assume it is MDI if the main_panel_id is commandbars parent and it is MDI style
243 { Visibility=Private }
244 Procedure AssignMDIMenu
245 Handle hoMain hoParent
246 Boolean bIsMdi
247 Get parent to hoParent
248 Get Main_Panel_Id to hoMain
249 Move (hoMain and hoMain=hoParent and MDI_State(hoMain)) to bIsMdi
250 Set pbMDIMenu to bIsMdi
251 If bIsMdi Begin
252 Set phoCommandBars of hoMain to Self
253 Move Self to ghoCommandBars
254 End
255 End_Procedure
256
257 Function IsMDIMenu Returns Boolean
258 Boolean bMDI
259 Get pbMDIMenu to bMDI
260 Function_Return bMDI
261 End_Function
262
263 // returns the ClientArea DF object if this is an MDI style system.
264 Function ClientAreaObject Returns Handle
265 Boolean bMDI
266 Handle hoClientArea
267 Get IsMDIMenu to bMDI
268 If (bMDI) Begin
269 Get Client_Id of (Parent(Self)) to hoClientArea
270 End
271 Function_Return hoClientArea
272 End_Function
273
274 // Generic Get and Set property that is used to get and set a DF/COM options property.
275 // can be used by any integer or boolean property
276
277 { Visibility=Private }
278 Procedure SetComOptionsProperty Handle hmPrivateProperty Handle hmCOMProperty Integer iValue
279 Handle hoOptions
280 Set hmPrivateProperty to iValue
281 If (IsComObjectCreated(Self)) Begin
282 Get OptionsObject to hoOptions
283 Set hmCOMProperty of hoOptions to iValue
284 End
285 End_Procedure
286
287 { Visibility=Private }
288 Function GetComOptionsProperty Handle hmPrivateProperty Handle hmCOMProperty Returns Integer
289 Handle hoOptions
290 Integer iValue
291 If (IsComObjectCreated(Self)) Begin
292 Get OptionsObject to hoOptions
293 Get hmCOMProperty of hoOptions to iValue
294 End
295 Else Begin
296 Get hmPrivateProperty to iValue
297 End
298 Function_Return iValue
299 End_Function
300
301 // these are set in the cCJCommandBars object
302
303 { EnumList="xtpThemeNativeWinXP, xtpThemeOffice2000, xtpThemeOfficeXP, xtpThemeOffice2003, xtpThemeWhidbey, xtpThemeOffice2007, xtpThemeRibbon, xtpThemeVisualStudio2008" }
304 { MethodType=Property InitialValue=xtpThemeWhidbey }
305 { Category="Appearance" }
306 Procedure Set peVisualTheme Integer eValue
307 Set pePrivateVisualTheme to eValue
308 If (IsComObjectCreated(Self)) Begin
309 Set ComVisualTheme to eValue
310 End
311 End_Procedure
312
313 {MethodType=Property }
314 Function peVisualTheme Returns Integer
315 Integer eValue
316 If (IsComObjectCreated(Self)) Begin
317 Get ComVisualTheme to eValue
318 End
319 Else Begin
320 Get pePrivateVisualTheme to eValue
321 End
322 Function_Return eValue
323 End_Function
324
325
326 {MethodType=Property InitialValue=False }
327 { Category="Behavior" }
328 Procedure Set pbEnableCustomization Boolean bValue
329 Set pbPrivateEnableCustomization to bValue
330 If (IsComObjectCreated(Self)) Begin
331 Send ComEnableCustomization bValue
332 End
333 End_Procedure
334
335 {MethodType=Property }
336 Function pbEnableCustomization Returns Boolean
337 Boolean bValue
338 Get pbPrivateEnableCustomization to bValue
339 Function_Return bValue
340 End_Function
341
342
343 // these are set in the cCJCommandBars's Option object
344
345 { EnumList="xtpAnimateWindowsDefault, xtpAnimateRandom, xtpAnimateUnfold, xtpAnimateSlide, xtpAnimateFade, xtpAnimateNone" }
346 {MethodType=Property InitialValue=xtpAnimateWindowsDefault }
347 { Category="Behavior" }
348 Procedure Set peAnimation Integer eValue
349 Send SetComOptionsProperty set_pePrivateAnimation set_ComAnimation eValue
350 End_Procedure
351
352 {MethodType=Property }
353 Function peAnimation Returns Integer
354 Integer eValue
355 Get GetComOptionsProperty get_pePrivateAnimation get_ComAnimation to eValue
356 Function_Return eValue
357 End_Function
358
359
360 {MethodType=Property InitialValue=False }
361 { Category="Behavior" }
362 Procedure Set pbAlwaysShowFullMenus Boolean bValue
363 Send SetComOptionsProperty set_pbPrivateAlwaysShowFullMenus set_ComAlwaysShowFullMenus bValue
364 End_Procedure
365
366 {MethodType=Property }
367 Function pbAlwaysShowFullMenus Returns Boolean
368 Boolean bValue
369 Get GetComOptionsProperty get_pbPrivateAlwaysShowFullMenus get_ComAlwaysShowFullMenus to bValue
370 Function_Return bValue
371 End_Function
372
373 {MethodType=Property InitialValue=True }
374 { Category="Behavior" }
375 Procedure Set pbShowFullAfterDelay Boolean bValue
376 Send SetComOptionsProperty set_pbPrivateShowFullAfterDelay set_ComShowFullAfterDelay bValue
377 End_Procedure
378
379 {MethodType=Property }
380 Function pbShowFullAfterDelay Returns Boolean
381 Boolean bValue
382 Get GetComOptionsProperty get_pbPrivateShowFullAfterDelay get_ComShowFullAfterDelay to bValue
383 Function_Return bValue
384 End_Function
385
386 {MethodType=Property InitialValue=False }
387 { Category="Behavior" }
388 Procedure Set pbAutoHideUnusedPopups Boolean bValue
389 Send SetComOptionsProperty set_pbPrivateAutoHideUnusedPopups set_ComAutoHideUnusedPopups bValue
390 End_Procedure
391
392 {MethodType=Property }
393 Function pbAutoHideUnusedPopups Returns Boolean
394 Boolean bValue
395 Get GetComOptionsProperty get_pbPrivateAutoHideUnusedPopups get_ComAutoHideUnusedPopups to bValue
396 Function_Return bValue
397 End_Function
398
399 {MethodType=Property InitialValue=True }
400 { Category="Behavior" }
401 Procedure Set pbToolBarScreenTips Boolean bValue
402 Send SetComOptionsProperty set_pbPrivateToolBarScreenTips set_ComToolBarScreenTips bValue
403 End_Procedure
404
405 {MethodType=Property }
406 Function pbToolBarScreenTips Returns Boolean
407 Boolean bValue
408 Get GetComOptionsProperty get_pbPrivateToolBarScreenTips get_ComToolBarScreenTips to bValue
409 Function_Return bValue
410 End_Function
411
412 {MethodType=Property InitialValue=False }
413 { Category="Behavior" }
414 Procedure Set pbShowPopupBarToolTips Boolean bValue
415 Send SetComOptionsProperty set_pbPrivateShowPopupBarToolTips set_ComShowPopupBarToolTips bValue
416 End_Procedure
417
418 {MethodType=Property }
419 Function pbShowPopupBarToolTips Returns Boolean
420 Boolean bValue
421 Get GetComOptionsProperty get_pbPrivateShowPopupBarToolTips get_ComShowPopupBarToolTips to bValue
422 Function_Return bValue
423 End_Function
424
425 {MethodType=Property InitialValue=True }
426 { Category="Behavior" }
427 Procedure Set pbToolBarAccelTips Boolean bValue
428 Send SetComOptionsProperty set_pbPrivateToolBarAccelTips set_ComToolBarAccelTips bValue
429 End_Procedure
430
431 {MethodType=Property }
432 Function pbToolBarAccelTips Returns Boolean
433 Boolean bValue
434 Get GetComOptionsProperty get_pbPrivateToolBarAccelTips get_ComToolBarAccelTips to bValue
435 Function_Return bValue
436 End_Function
437
438 {MethodType=Property InitialValue=False }
439 { Category="Appearance" }
440 Procedure Set pbShowExpandButtonAlways Boolean bValue
441 Send SetComOptionsProperty set_pbPrivateShowExpandButtonAlways set_ComShowExpandButtonAlways bValue
442 End_Procedure
443
444 {MethodType=Property }
445 Function pbShowExpandButtonAlways Returns Boolean
446 Boolean bValue
447 Get GetComOptionsProperty get_pbPrivateShowExpandButtonAlways get_ComShowExpandButtonAlways to bValue
448 Function_Return bValue
449 End_Function
450
451 {MethodType=Property InitialValue=False }
452 { Category="Appearance" }
453 Procedure Set pbLargeIcons Boolean bValue
454 Send SetComOptionsProperty set_pbPrivateLargeIcons set_ComLargeIcons bValue
455 End_Procedure
456
457 {MethodType=Property }
458 Function pbLargeIcons Returns Boolean
459 Boolean bValue
460 Get GetComOptionsProperty get_pbPrivateLargeIcons get_ComLargeIcons to bValue
461 Function_Return bValue
462 End_Function
463
464 {MethodType=Property InitialValue=True }
465 { Category="Behavior" }
466 Procedure Set pbSyncFloatingToolbars Boolean bValue
467 Send SetComOptionsProperty set_pbPrivateSyncFloatingToolbars set_ComSyncFloatingToolbars bValue
468 End_Procedure
469
470 {MethodType=Property }
471 Function pbSyncFloatingToolbars Returns Boolean
472 Boolean bValue
473 Get GetComOptionsProperty get_pbPrivateSyncFloatingToolbars get_ComSyncFloatingToolbars to bValue
474 Function_Return bValue
475 End_Function
476
477 {MethodType=Property InitialValue=False }
478 { Category="Behavior" }
479 Procedure Set pbFloatToolbarsByDoubleClick Boolean bValue
480 Send SetComOptionsProperty set_pbPrivateFloatToolbarsByDoubleClick set_ComFloatToolbarsByDoubleClick bValue
481 End_Procedure
482
483 {MethodType=Property }
484 Function pbFloatToolbarsByDoubleClick Returns Boolean
485 Boolean bValue
486 Get GetComOptionsProperty get_pbPrivateFloatToolbarsByDoubleClick get_ComFloatToolbarsByDoubleClick to bValue
487 Function_Return bValue
488 End_Function
489
490 {MethodType=Property InitialValue=False }
491 { Category="Appearance" }
492 Procedure Set pbShowTextBelowIcons Boolean bValue
493 Send SetComOptionsProperty set_pbPrivateShowTextBelowIcons set_ComShowTextBelowIcons bValue
494 End_Procedure
495
496 {MethodType=Property }
497 Function pbShowTextBelowIcons Returns Boolean
498 Boolean bValue
499 Get GetComOptionsProperty get_pbPrivateShowTextBelowIcons get_ComShowTextBelowIcons to bValue
500 Function_Return bValue
501 End_Function
502
503 {MethodType=Property InitialValue=False }
504 { Category="Behavior" }
505 Procedure Set pbAltDragCustomization Boolean bValue
506 Send SetComOptionsProperty set_pbPrivateAltDragCustomization set_ComAltDragCustomization bValue
507 End_Procedure
508
509 {MethodType=Property }
510 Function pbAltDragCustomization Returns Boolean
511 Boolean bValue
512 Get GetComOptionsProperty get_pbPrivateAltDragCustomization get_ComAltDragCustomization to bValue
513 Function_Return bValue
514 End_Function
515
516 {MethodType=Property InitialValue=False }
517 { Category="Appearance" }
518 Procedure Set pbOfficeStyleDisabledIcons Boolean bValue
519 Send SetComOptionsProperty set_pbPrivateOfficeStyleDisabledIcons set_ComOfficeStyleDisabledIcons bValue
520 End_Procedure
521
522 {MethodType=Property }
523 Function pbOfficeStyleDisabledIcons Returns Boolean
524 Boolean bValue
525 Get GetComOptionsProperty get_pbPrivateOfficeStyleDisabledIcons get_ComOfficeStyleDisabledIcons to bValue
526 Function_Return bValue
527 End_Function
528
529 {MethodType=Property InitialValue=True }
530 { Category="Appearance" }
531 Procedure Set pbIconsWithShadow Boolean bValue
532 Send SetComOptionsProperty set_pbPrivateIconsWithShadow set_ComIconsWithShadow bValue
533 End_Procedure
534
535 {MethodType=Property }
536 Function pbIconsWithShadow Returns Boolean
537 Boolean bValue
538 Get GetComOptionsProperty get_pbPrivateIconsWithShadow get_ComIconsWithShadow to bValue
539 Function_Return bValue
540 End_Function
541
542 {MethodType=Property InitialValue=True }
543 { Category="Behavior" }
544 Procedure Set pbTimerUpdate Boolean bValue
545 Handle hoTimer
546 Set pbPrivateTimerUpdate to bValue
547 If (IsComObjectCreated(Self)) Begin
548 Get phoTimer to hoTimer
549 Set pbEnabled of hoTimer to bValue
550 End
551 End_Procedure
552
553 {MethodType=Property }
554 Function pbTimerUpdate Returns Boolean
555 Boolean bValue
556 Get pbPrivateTimerUpdate to bValue
557 Function_Return bValue
558 End_Function
559
560 // returns the CommandBars object handle, which is this object. All menu objects
561 // within a command bar will get this via delegation. The exception is context menus (and
562 // children of context menus) which uses the global commandbars variable instead.
563 Function CommandBarSystemObject Returns Handle
564 Function_Return Self
565 End_Function
566
567 // these are here to make life easier. These return a df-object attached to
568 // the following collecions and child objects. These are used enough that
569 // an easy access to them was provided.
570
571 Function ActionsCollection Returns Handle
572 Handle hoPrivate
573 Variant vCom
574 If (not(IsComObjectCreated(Self))) Begin
575 Function_Return 0
576 End
577
578 Get phoPrivateActions to hoPrivate
579 Get ComActions of hoPrivate to vCom
580 Set pvComObject of hoPrivate to vCom
581 Function_Return hoPrivate
582 End_Function
583
584 Function DesignerControlsCollection Returns Handle
585 Handle hoPrivate
586 Variant vCom
587 If (not(IsComObjectCreated(Self))) Begin
588 Function_Return 0
589 End
590
591 Get phoPrivateDesignerControls to hoPrivate
592 Get ComDesignerControls to vCom
593 Set pvComObject of hoPrivate to vCom
594 Function_Return hoPrivate
595 End_Function
596
597 Function KeyBindingsCollection Returns Handle
598 Handle hoPrivate
599 Variant vCom
600 If (not(IsComObjectCreated(Self))) Begin
601 Function_Return 0
602 End
603
604 Get phoPrivateKeyBindings to hoPrivate
605 Get ComKeyBindings to vCom
606 Set pvComObject of hoPrivate to vCom
607 Function_Return hoPrivate
608 End_Function
609
610 Function OptionsObject Returns Handle
611 Handle hoPrivate
612 Variant vCom
613 If (not(IsComObjectCreated(Self))) Begin
614 Function_Return 0
615 End
616
617 Get phoPrivateOptions to hoPrivate
618 Get ComOptions to vCom
619 Set pvComObject of hoPrivate to vCom
620 Function_Return hoPrivate
621 End_Function
622
623
624 // when a commandbars is deactivated, this is called.
625 // save layout as needed
626 // release all of the action objects in the various arrays
627 // make sure that all DF objects are released.
628 // One oddity is that at this point the object is deactivated and this causes the
629 // statubar's visibleState to always be false. We correct for this in the statusbar's pbVisible
630 Procedure ReleaseComObject
631 Handle[] hoObjects hoEmpty
632 Handle hoTimer hoObj
633 Integer i iCount
634 Variant vTab
635
636 Get phoTimer to hoTimer
637 Set pbEnabled of hoTimer to False
638
639 Send SaveEnvironment // save layout if needed
640
641 // clear the active updates array
642 Set phoActiveUpdates to hoEmpty
643
644 // release all actions attached to DF objects. This will release actions
645 // in context menus
646 Get phoRegisteredActions to hoObjects
647 Move (SizeOfArray(hoObjects)) to iCount
648 For i from 0 to (iCount-1)
649 // it's possible that we've got actions that have been already been destroyed during shut down (context menus)
650 Get Object_Id of hoObjects[i] to hoObj
651 If hoObj Begin
652 Send ReleaseComObject of hoObj
653 End
654 Loop
655 Set phoRegisteredActions to hoEmpty
656
657 // this should not be needed, but it can't hurt.
658 Broadcast Recursive_up Send ReleaseComObject
659 Send OnRelease
660 Forward Send ReleaseComObject
661 End_Procedure
662
663
664 // This sets all of the commandbars properties and the options properties
665 Procedure CreateCommandBars
666 Handle hWND hoClient hoMain hoOptions hoImageManager hoCommandBar hoTimer
667 Variant vToolbarObject vImageManager
668 Integer eVisualTheme eAnimation
669 Integer iLast
670 Boolean bMDIMEnu
671 Boolean bEnableCustomization bAltDragCustomization bLargeIcons bShowTextBelowIcons bAlwaysShowFullMenus bShowFullAfterDelay
672 Boolean bToolBarScreenTips bToolBarAccelTips bShowPopupBarToolTips bAutoHideUnusedPopups
673 Boolean bOfficeStyleDisabledIcons bFloatToolbarsByDoubleClick bSyncFloatingToolbars bShowExpandButtonAlways bIconsWithShadow
674 Boolean bTimer
675
676 Get pePrivateVisualTheme to eVisualTheme
677 Get pbPrivateEnableCustomization to bEnableCustomization
678 Get pbPrivateAltDragCustomization to bAltDragCustomization
679 Get pePrivateAnimation to eAnimation
680 Get pbPrivateLargeIcons to bLargeIcons
681 Get pbPrivateShowTextBelowIcons to bShowTextBelowIcons
682 Get pbPrivateAlwaysShowFullMenus to bAlwaysShowFullMenus
683 Get pbPrivateShowFullAfterDelay to bShowFullAfterDelay
684 Get pbPrivateToolBarScreenTips to bToolBarScreenTips
685 Get pbPrivateToolBarAccelTips to bToolBarAccelTips
686 Get pbPrivateShowPopupBarToolTips to bShowPopupBarToolTips
687 Get pbPrivateOfficeStyleDisabledIcons to bOfficeStyleDisabledIcons
688 Get pbPrivateIconsWithShadow to bIconsWithShadow
689 Get pbPrivateFloatToolbarsByDoubleClick to bFloatToolbarsByDoubleClick
690 Get pbPrivateSyncFloatingToolbars to bSyncFloatingToolbars
691 Get pbPrivateShowExpandButtonAlways to bShowExpandButtonAlways
692 Get pbPrivateAutoHideUnusedPopups to bAutoHideUnusedPopups
693
694 // attach to parent window. This should actually happen automatically
695 Get Parent to hoMain
696 Get Window_Handle of hoMain to hWND
697 Send ComAttachToWindow hWND
698
699 // if an MDI menu, find and set the client area
700 Get pbMDIMenu to bMDIMenu
701 If bMDIMEnu Begin
702 Get ClientAreaObject to hoClient
703 If hoClient Begin
704 If not (Active_State(hoClient)) Begin
705 Send Add_Focus of hoClient hoMain
706 End
707 Get Window_Handle of hoClient to hWND
708 Send ComSetMDIClient hWND
709 End
710 End
711
712 // make sure the first command bar is a main menu
713 Get Create U_cCJCommandBar to hoCommandBar
714 Get ComAddMenuBar "Main menu" to vToolbarObject
715 Set pvComObject of hoCommandBar to vToolbarObject
716 Set ComVisible of hoCommandBar to False
717 Send Destroy of hoCommandBar
718
719
720 // the following are set directly in the object
721 Set ComScaleMode to xtpScalePixel
722 Set ComVisualTheme to eVisualTheme
723 Send ComEnableCustomization bEnableCustomization
724
725 // the following are set in the options object
726 Get OptionsObject to hoOptions
727 // event is completely disabled
728 //Set ComUpdatePeriod of hoOptions to 0 // we don't use this method, shut off the timer
729 Set ComAltDragCustomization of hoOptions to bAltDragCustomization
730 Set ComAnimation of hoOptions to eAnimation
731 Set ComLargeIcons of hoOptions to bLargeIcons
732 Set ComShowTextBelowIcons of hoOptions to bShowTextBelowIcons
733 Set ComShowFullAfterDelay of hoOptions to bShowFullAfterDelay
734 Set ComAlwaysShowFullMenus of hoOptions to bAlwaysShowFullMenus
735 Set ComToolBarAccelTips of hoOptions to bToolBarAccelTips
736 Set ComToolBarScreenTips of hoOptions to bToolBarScreenTips
737 Set ComShowPopupBarToolTips of hoOptions to bShowPopupBarToolTips
738 Set ComOfficeStyleDisabledIcons of hoOptions to bOfficeStyleDisabledIcons
739 Set ComIconsWithShadow of hoOptions to bIconsWithShadow
740 Set ComFloatToolbarsByDoubleClick of hoOptions to bFloatToolbarsByDoubleClick
741 Set ComSyncFloatingToolbars of hoOptions to bSyncFloatingToolbars
742 Set ComShowExpandButtonAlways of hoOptions to bShowExpandButtonAlways
743 Get ComAutoHideUnusedPopups of hoOptions to bAutoHideUnusedPopups
744
745 Send ComEnableActions
746
747 // We must explicitly create an image list collection and add it to the object
748 Get Create U_cCJImageManager to hoImageManager
749 Send CreateComObject of hoImageManager
750 Get ComIcons of hoImageManager to vImageManager
751 Set ComIcons to vImageManager
752 Send destroy of hoImageManager
753
754 // event sent before any child objects are created.
755 Send OnCreateCommandBars
756
757 // this creates all of the actions and items
758 Broadcast Send CreateComInstance
759
760 // we keep track of the last action Id and last bar Id auto assigned.
761 // We use this to determine if a load environment can be safely done.
762 // Anything auto-assigned after this is considered to be dynamic.
763 Get LastAssignedId to iLast
764 Set piLastAssignedDesignTimeId to iLast
765 Get piLastBarId to iLast
766 Set piLastAssignedDesignTimeBarId to iLast
767
768 Send LoadEnvironment // load layout if needed
769
770 Get pbTimerUpdate to bTimer
771 If bTimer Begin
772 Get phoTimer to hoTimer
773 Set pbEnabled of hoTimer to True
774 End
775
776 Send ComRecalcLayout
777 End_Procedure
778
779 // Perform an Update. This can be called manually or via the timer
780 // it send update to the Statusbar and to all active actions
781 Procedure Update
782 Handle[] hoActions
783 Handle hoStatusBar
784 Integer i iActions
785 Variant vAction
786 If (IsComObjectCreated(Self)) Begin
787 Send OnUpdate // update event for commandbars
788 Get phoActiveUpdates to hoActions
789 Move (SizeOfArray(hoActions)) to iActions
790 For i from 0 to (iActions-1)
791 Send Update of hoActions[i]
792 Loop
793 Get phoStatusBar to hoStatusBar
794 If (hoStatusBar) Begin
795 Send Update of hoStatusBar
796 End
797 End
798 End_Procedure
799
800
801 Procedure UpdateAllActions
802 Handle[] hoActions
803 Integer i iActions
804 Variant vAction
805 Get phoRegisteredActions to hoActions
806 Move (SizeOfArray(hoActions)) to iActions
807 For i from 0 to (iActions-1)
808 Send Update of hoActions[i]
809 Loop
810 End_Procedure
811
812 { Visibility=Private }
813 Function LastAssignedId Returns Integer
814 Integer[] iActionIdPool
815 Integer iId iCount
816 Get piActionIdPool to iActionIdPool
817 Move (SizeOfArray(iActionIdPool)) to iCount
818 If (iCount=0) Begin
819 Move ID_CommandBarsAutoStart to iId
820 End
821 Else Begin
822 Move (iActionIdPool[0]) to iId
823 End
824 Function_Return iId
825 End_Function
826
827 { Visibility=Private }
828 Function AssignID Returns Integer // auto assign an Id. Callend in end_construct_object if needed
829 Integer[] iActionIdPool
830 Integer iId iCount
831 Get piActionIdPool to iActionIdPool
832 Move (SizeOfArray(iActionIdPool)) to iCount
833 If (iCount=0) Begin
834 Move ID_CommandBarsAutoStart to iId
835 Move iId to iActionIdPool[0]
836 End
837 Else If (iCount=1) Begin
838 Move (iActionIdPool[0]+1) to iId
839 Move iId to iActionIdPool[0]
840 End
841 Else Begin
842 Move iActionIdPool[iCount-1] to iId
843 Move (ResizeArray(iActionIdPool,iCount-1)) to iActionIdPool
844 End
845 Set piActionIdPool to iActionIdPool
846 Function_Return iId
847 End_Function
848
849 { Visibility=Private }
850 Procedure ReleaseID Integer iId // might be needed to maintain a pool of actions
851 Integer[] iActionIdPool
852 Integer iCount iIndex
853 Get piActionIdPool to iActionIdPool
854 // we must make sure that an action is never added to the pool more than once.
855 // this first value is a trick value (the highest number) so we allow a hit on
856 // that one. So -1 or 0 is ok
857 If (SearchArray(iId,iActionIdPool)<=0) Begin
858 Move (SizeOfArray(iActionIdPool)) to iCount
859 Move iId to iActionIdPool[iCount]
860 Set piActionIdPool to iActionIdPool
861 End
862 Else Begin
863 Error DFERR_PROGRAM "Assert: Duplicate released ID in commandbars"
864 End
865 End_Procedure
866
867 { Visibility=Private }
868 Function AssignBarId Returns Integer
869 Integer iId
870 Get piLastBarId to iId
871 Increment iId
872 Set piLastBarId to iId
873 Function_Return iId
874 End_Function
875
876 { Visibility=Private }
877 Procedure AddActiveAction Handle hoAction
878 Handle[] hoActiveActions
879 Get phoActiveUpdates to hoActiveActions
880 Move hoAction to hoActiveActions[SizeOfArray(hoActiveActions)]
881 Set phoActiveUpdates to hoActiveActions
882 End_Procedure
883
884 { Visibility=Private }
885 Procedure RegisterAction Handle hoAction
886 Boolean bActive
887 Handle[] hoActions
888 Get phoRegisteredActions to hoActions
889 Move hoAction to hoActions[SizeOfArray(hoActions)]
890 Set phoRegisteredActions to hoActions
891 Get pbActiveUpdate of hoAction to bActive
892 If bActive Begin
893 Send AddActiveAction hoAction
894 End
895 End_Procedure
896
897 // remove action from list of active actions.
898 { Visibility=Private }
899 Procedure RemoveActiveAction Handle hoAction
900 Handle[] hoActiveActions
901 Integer iIndex i iCount
902 Get phoActiveUpdates to hoActiveActions
903 Move (SearchArray(hoAction,hoActiveActions)) to iIndex
904 If (iIndex<>-1) Begin
905 Move (SizeOfArray(hoActiveActions)) to iCount
906 For i from iIndex to (iCount-2)
907 Move hoActiveActions[i+1] to hoActiveActions[i]
908 Loop
909 Move (ResizeArray(hoActiveActions,iCount-1)) to hoActiveActions
910 Set phoActiveUpdates to hoActiveActions
911 End
912 End_Procedure
913
914 // remove action from list of registered actions.
915 { Visibility=Private }
916 Procedure RemoveRegisteredAction Handle hoAction
917 Handle[] hoActiveActions
918 Boolean bActive
919 Integer iIndex i iCount
920 Get phoRegisteredActions to hoActiveActions
921 Move (SearchArray(hoAction,hoActiveActions)) to iIndex
922 If (iIndex<>-1) Begin
923 Move (SizeOfArray(hoActiveActions)) to iCount
924 For i from iIndex to (iCount-2)
925 Move hoActiveActions[i+1] to hoActiveActions[i]
926 Loop
927 Move (ResizeArray(hoActiveActions,iCount-1)) to hoActiveActions
928 Set phoRegisteredActions to hoActiveActions
929 End
930 Get pbActiveUpdate of hoAction to bActive
931 If bActive Begin
932 Send RemoveActiveAction hoAction
933 End
934 End_Procedure
935
936 // Adds an image to imagelist. Pass if bmp or icon, the image name and the Id and image type (normal, disabled, etc.)
937 // With Bitmaps this will first look for the resource then search for the file in the file path.
938 // With Icons it checks for the file first (explained below)
939 // return Image Id if success
940 Function AddImageType Boolean bIsIcon String sImage Integer iId Integer eImageType Returns Integer
941 Handle hBitmap
942 Variant vImageManager
943 Handle hoImageIcons
944 Integer iVoid
945 Boolean bOk
946 String sFileImage
947
948 If (iId=0) Begin
949 Get piLastImageId to iId
950 Increment iId
951 Set piLastImageId to iId
952 End
953
954 Get Create U_cCJImageManagerIcons to hoImageIcons
955 Get ComIcons to vImageManager
956 Set pvComObject of hoImageIcons to vImageManager
957
958 // if an icon we will always try to load from a file first. Loading from a file works better than
959 // the internal resource load because the internal load only finds the first image. If the ico has
960 // multiple images (which CJ can use) all of the extra images are lost
961
962 // if an Icon - load from file first then load from resource
963 If bIsIcon Begin
964 Get_File_Path sImage to sFileImage // find path in DFPATH, if appropriate
965 If (sFileImage<>"") Begin
966 Send ComLoadIcon of hoImageIcons sFileImage iId eImageType
967 Move True to bOk
968 End
969 Else Begin
970 Move (LoadImage(GetModuleHandle(0), sImage, IMAGE_ICON, 0, 0, 0)) to hBitmap
971 If hBitmap Begin
972 // this works with alpha blends - even when passed false
973 Send ComAddIconHandle hBitmap iId eImageType False
974 Move (DestroyIcon(hBitmap)) to iVoid
975 Move True to bOk
976 End
977 End
978 End
979 // if a bitmap - load from resource first then from file
980 Else Begin
981 Move (LoadImage(GetModuleHandle(0), sImage, IMAGE_BITMAP, 0, 0, 0)) to hBitmap
982 If (hBitmap=0) Begin // the bitmap was not in the EXE resource
983 Get_File_Path sImage to sFileImage // find path in DFPATH, if appropriate
984 If (sFileImage <>"") Begin // The image was found!
985 Move (LoadImage(0, sFileImage, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)) to hBitmap
986 End
987 End
988
989 If hBitmap Begin
990 Send ComAddBitmap of hoImageIcons hBitmap iId eImageType False
991 Move (DeleteObject(hBitmap)) to iVoid
992 Move True to bOk
993 End
994 End
995
996 Send destroy of hoImageIcons
997
998 Function_Return (If(bOk, iId, 0))
999 End_Procedure
1000
1001 // Adds an image to imagelist.
1002 // We assume that this is an icon unless the .bmp extension is passed.
1003 // return True if success
1004 Function AddImage String sImage Integer iId Integer eImageType Returns Integer
1005 Boolean bIsIcon
1006 Move (Pos(".bmp",Lowercase(sImage))=0) to bIsIcon
1007 Get AddImageType bIsIcon sImage iId eImageType to iId
1008 Function_Return iId
1009 End_Procedure
1010
1011 // Create a StateOptions object and set it as needed. This is used to save and
1012 // load settings. You could augment this to customize as needed.
1013 Function CreateStateOptions Integer eLayout Returns Handle
1014 Handle hoStateOptions
1015 Variant vStateOptions
1016
1017 Get Create U_cCJStateOptions to hoStateOptions
1018 Get ComCreateStateOptions to vStateOptions
1019 Set pvComObject of hoStateOptions to vStateOptions
1020
1021 Set ComLoadSilent of hoStateOptions to True
1022
1023 // If True, only CommandBars that have been customized will be saved.
1024 Set ComSaveOnlyCustomized of hoStateOptions to True
1025
1026 // If True, the original state of the CommandBars is saved along with the customized state
1027 // For example, if a button on a toolbar is moved, then both the original and modified states will be saved.
1028 Set ComSaveOriginalControls of hoStateOptions to True
1029
1030 Set ComSerializeDesignerControls of hoStateOptions to False
1031
1032 // If True, the controls in the CommandBars will be saved. If False, no controls will be saved,
1033 // regardless of the other settings.
1034 Set ComSerializeControls of hoStateOptions to (eLayout=rlSaveRestoreAll)
1035
1036 // If True, the images stored in the ImageManager will be saved.
1037 Set ComSerializeImages of hoStateOptions to False
1038
1039 // If True, the layout of the CommandBars will be saved. The Layout includes information such as
1040 // bar position, location, and size.
1041 Set ComSerializeLayout of hoStateOptions to (eLayout<>rlNoSaveRestore)
1042
1043 // If True, the setting on the Keyboard and Options pages of the Customize dialog will
1044 // be saved. This includes shortcut keys and CommandBar options like large icons and full menus.
1045 Set ComSerializeOptions of hoStateOptions to (eLayout=rlSaveRestoreAll or eLayout=rlSaveRestoreFullLayout)
1046
1047 // in our model, actions are never saved.
1048 Set ComSerializeActions of hoStateOptions to False
1049
1050 Function_Return hoStateOptions
1051 End_Function
1052
1053 Function CreatePropExchangeObject Returns Handle
1054 Handle hoPropExchange hoGlobal
1055 Variant vPropExchange vGlobal
1056
1057 If (not(IsComObjectCreated(Self))) Begin
1058 Error DFERR_PROGRAM "Cannot exchange Commands bars data. COM object not created"
1059 Function_Return 0
1060 End
1061
1062 Get Create U_cCJCommandBarsGlobalSettings to hoGlobal
1063 Get ComGlobalSettings to vGlobal
1064 Set pvComObject of hoGlobal to vGlobal
1065 Get ComCreatePropExchange of hoGlobal to vPropExchange
1066 Get Create U_cCJPropExchange to hoPropExchange
1067 Set pvComObject of hoPropExchange to vPropExchange
1068 Send Destroy of hoGlobal
1069 Function_Return hoPropExchange
1070 End_Function
1071
1072 // exchange the current commandbar layout with the prop exchange object.
1073 // pass the exchange object and the section name to save this under. The exchange
1074 // object contains information if this is a save or load (ComLoading).
1075 // can be called by any exchange object allowing developers to save a commandbar
1076 // structure as part of other information they may be saving and loading
1077
1078 Procedure ExchangeLayout Handle hoExchange String sSection Integer eLayout
1079 Variant vSection vOptions
1080 Handle hoExchangePref hoStatusBar hoStateOptions
1081 Integer iLast iLastBar iStatusBarVisible iBuild iIDBuild iIDCount iIDBarCount
1082 Boolean bLoad bSerializeControls
1083
1084 If (not(IsComObjectCreated(Self))) Begin
1085 Error DFERR_PROGRAM "Cannot exchange Commands bars data. COM object not created"
1086 Procedure_Return
1087 End
1088
1089 Get phoStatusBar to hoStatusBar
1090 Get ComLoading of hoExchange to bLoad
1091 Get piLastAssignedDesignTimeId to iLast
1092 Get piLastAssignedDesignTimeBarId to iLastBar
1093 Get piLayoutBuild to iBuild
1094
1095 Get CreateStateOptions eLayout to hoStateOptions
1096 Get ComSerializeControls of hoStateOptions to bSerializeControls
1097 Get pvComObject of hoStateOptions to vOptions
1098
1099 Get Create U_cCJPropExchange to hoExchangePref
1100
1101 Get ComGetSection of hoExchange sSection to vSection
1102 Set pvComObject of hoExchangePref to vSection
1103
1104 If (not(bLoad)) Begin
1105
1106 Send ComDoPropExchange vSection vOptions
1107 Send ComExchangeInt of hoExchangePref "IDCount" (&iLast) 0
1108 Send ComExchangeInt of hoExchangePref "BarIDCount" (&iLastBar) 0
1109 If (hoStatusBar) Begin
1110 Get pbVisible of hoStatusBar to iStatusBarVisible
1111 Send ComExchangeInt of hoExchangePref "IsStatusBarVisible" (&iStatusBarVisible) 1
1112 End
1113 Send ComExchangeInt of hoExchangePref "Build" (&iBuild) 0
1114 End
1115 Else Begin
1116 // get the build from the data. If it is not what we expect, don't load - it is out of date
1117 Send ComExchangeInt of hoExchangePref "Build" (&iIDBuild) 0
1118 If (iIDBuild=iBuild) Begin
1119 Send ComExchangeInt of hoExchangePref "IDCount" (&iIDCount) 0
1120 Send ComExchangeInt of hoExchangePref "BarIDCount" (&iIDBarCount) 0
1121 If (hoStatusBar) Begin
1122 Send ComExchangeInt of hoExchangePref "IsStatusBarVisible" (&iStatusBarVisible) 1
1123 Set pbVisible of hoStatusBar to iStatusBarVisible
1124 End
1125
1126 // do the load if we serialize controls and the control count is ok
1127 // and if the barId count is ok
1128 If ((not(bSerializeControls) or iLast=iIDCount) and iLastBar=iIDBarCount) Begin
1129 Send ComDoPropExchange vSection vOptions
1130 End
1131 Send ComRecalcLayout
1132 End
1133 End
1134
1135 Send destroy of hoExchangePref
1136 Send Destroy of hoStateOptions
1137 End_Procedure
1138
1139
1140 // saves and loads commands info to the registry.
1141 // While this is private. It provides a good model for how to do this kind of thing.
1142 Function LoadLayoutFromRegistry Integer eLayout String sKey Returns Boolean
1143 Handle hoExchange
1144 Boolean bOk
1145 String sSection sFullKey
1146
1147 If (eLayout=rlNoSaveRestore) Begin
1148 Function_Return True
1149 End
1150
1151 Move ("HKEY_CURRENT_USER\" - sKey) to sFullKey
1152 Get psLayoutSection to sSection
1153 Get CreatePropExchangeObject to hoExchange
1154
1155 Get ComCreateAsRegistry of hoExchange True sFullKey to bOk
1156
1157 If not (bOk) Begin
1158 Error DFERR_PROGRAM "Assert: Cannot load from registry"
1159 End
1160
1161 If bOk Begin
1162 Send ExchangeLayout hoExchange sSection eLayout
1163 Send ComRecalcLayout
1164 End
1165 Send destroy of hoExchange
1166 Function_Return bOk
1167 End_Function
1168
1169
1170 Procedure SaveLayoutToRegistry Integer eLayout String sKey
1171 Handle hoExchange hoRegistry
1172 Boolean bOk bExists bVoid
1173 String sSection sFullKey sShortKey
1174
1175 If (eLayout=rlNoSaveRestore) Begin
1176 Procedure_Return
1177 End
1178
1179 Move ("HKEY_CURRENT_USER\" - sKey) to sFullKey
1180 Get psLayoutSection to sSection
1181 Move (sKey - "\" - sSection) to sShortKey
1182
1183 If (sKey="" or sSection="") Begin
1184 Error DFERR_PROGRAM "Assert: Registry Key or Section name is invalid"
1185 End
1186
1187 Get CreatePropExchangeObject to hoExchange
1188 Get ComCreateAsRegistry of hoExchange False sFullKey to bOk
1189
1190 If not (bOk) Begin
1191 Error DFERR_PROGRAM "Assert: Cannot save layout to registry"
1192 End
1193
1194 If bOk Begin
1195 // delete the existing registry information for this section
1196 Get Create U_cRegistry to hoRegistry
1197 Set pbLazyWrite of hoRegistry to False
1198 Get KeyExists of hoRegistry sShortKey to bExists
1199 If bExists Begin
1200 Get DeleteKey of hoRegistry sShortKey to bVoid
1201 End
1202 Send Destroy of hoRegistry
1203
1204 Send ExchangeLayout hoExchange sSection eLayout
1205 End
1206
1207 Send destroy of hoExchange
1208 End_Procedure
1209
1210
1211 Function LoadLayoutFromXML Integer eLayout String sFileName Returns Boolean
1212 Handle hoExchange
1213 String sSection
1214 Boolean bOk
1215
1216 If (eLayout=rlNoSaveRestore) Begin
1217 Function_Return True
1218 End
1219
1220 Get psLayoutSection to sSection
1221 Get CreatePropExchangeObject to hoExchange
1222
1223 Get ComCreateAsXML of hoExchange True "Settings" to bOk
1224
1225 If not (bOk) Begin
1226 Error DFERR_PROGRAM "Assert: Cannot load layout from XML"
1227 End
1228
1229 If bOk Begin
1230 Get ComLoadFromFile of hoExchange sFileName to bOk
1231 If bOk Begin
1232 Send ExchangeLayout hoExchange sSection eLayout
1233 Send ComRecalcLayout
1234 End
1235 End
1236 Send destroy of hoExchange
1237 Function_Return bOk
1238 End_Function
1239
1240 Procedure SaveLayoutToXML Integer eLayout String sFileName
1241 Handle hoExchange
1242 String sSection
1243 Boolean bOk
1244
1245 If (eLayout=rlNoSaveRestore) Begin
1246 Procedure_Return
1247 End
1248
1249 Get psLayoutSection to sSection
1250 Get CreatePropExchangeObject to hoExchange
1251
1252 Get ComCreateAsXML of hoExchange False "Settings" to bOk
1253
1254 If not (bOk) Begin
1255 Error DFERR_PROGRAM "Assert: Cannot save XML layout"
1256 End
1257
1258 If bOk Begin
1259 Send ExchangeLayout hoExchange sSection eLayout
1260 Send ComSaveToFile of hoExchange sFileName
1261 End
1262 Send destroy of hoExchange
1263 End_Procedure
1264
1265 // needed in case where no application object is present
1266 Register_Function pbPreserveEnvironment Returns Boolean
1267 Register_Function RegistryKeyString Returns String
1268
1269 // Standard SaveEnvironment Behavior. This is called when the commandbar system
1270 // is closed. It will save environment if:
1271 // 1) application Object exists and pbPreserveEnvironment is true
1272 // 2) peRestoreLayout is not rlNoSaveRestore
1273 // This is good for augmentation if you wish to change the standard save
1274 Procedure SaveEnvironment
1275 Handle eLayout
1276 String sKey
1277 Boolean bPreserveEnvironment
1278
1279 If (ghoApplication=0) Begin
1280 Procedure_Return
1281 End
1282 Get pbPreserveEnvironment of ghoApplication to bPreserveEnvironment
1283 If bPreserveEnvironment Begin
1284 Get peRestoreLayout to eLayout
1285 Get RegistryKeyString of ghoApplication to sKey
1286 Send SaveLayoutToRegistry eLayout sKey
1287 End
1288 End_Procedure
1289
1290
1291 // Standard LoadEnvironment Behavior. This is called when the commandbar system
1292 // is created. It will load environment if:
1293 // 1) application Object exists and pbPreserveEnvironment is true
1294 // 2) peRestoreLayout is not rlNoSaveRestore
1295 // This is good for augmentation if you wish to change the standard load.
1296
1297 Procedure LoadEnvironment
1298 Handle eLayout
1299 String sKey
1300 Boolean bOk bPreserveEnvironment
1301
1302 If (ghoApplication=0) Begin
1303 Procedure_Return
1304 End
1305 Get pbPreserveEnvironment of ghoApplication to bPreserveEnvironment
1306 If bPreserveEnvironment Begin
1307 Get peRestoreLayout to eLayout
1308 Get RegistryKeyString of ghoApplication to sKey
1309 Get LoadLayoutFromRegistry eLayout sKey to bOk
1310 End
1311 End_Procedure
1312
1313
1314 Procedure RestoreLayout
1315 Variant vToolBarObject
1316 Send ComDeleteAll
1317 Get ComAddMenuBar "Main menu" to vToolbarObject
1318 //Broadcast Send CreateComCommandBarInstance
1319 Broadcast Send CreateComInstance
1320 Send ComRecalcLayout
1321 End_Procedure
1322
1323 // used to dock a commandbar, on the same row and to the right of another commandbar
1324 // used by pbDockNextTo property in toolbars
1325 { Visibility=Private }
1326 Procedure DockNextTo Variant vBarToDock Variant vBarOnLeft
1327 Integer iLeft iTop iRight iBottom iPosition
1328 Handle hoBarOnLeft
1329 Get Create U_cCJCommandBar to hoBarOnLeft
1330 Set pvComObject of hoBarOnLeft to vBarOnLeft
1331 Send ComRecalcLayout
1332 Send ComGetWindowRect of hoBarOnLeft (&iLeft) (&iTop) (&iRight) (&iBottom)
1333 Get ComPosition of hoBarOnLeft to iPosition
1334 Send ComDockToolBar vBarToDock (iLeft+1) ((iBottom + iTop)/2) iPosition
1335 Send Destroy of hoBarOnLeft
1336 End_Procedure
1337
1338 // This only works if this command bar is placed inside of BasicPanel or if the
1339 // command bar is in a modal dialog that is placed inside of a Panel
1340 { Visibility=Private }
1341 Function Is_Function Integer iMsgId Integer hoObjId Boolean bDelegateFg Returns Boolean
1342 Boolean bOk
1343 Handle hoMain
1344 // this should get resolved via delegation
1345 Get Main_Panel_id to hoMain
1346 If (hoObjId>Desktop and hoMain) ;
1347 Get Is_Function of hoMain iMsgId hoObjId bDelegateFg to bOk
1348 Function_Return bOk
1349 End_Function
1350
1351 // these must be registered if you are using this with a non-db application. If you are using this
1352 // with a non-db application, you should not be calling the DEOInformation method as you will get
1353 // a runtime programming error.
1354
1355 Register_Function Server Returns Integer
1356 Register_Function DEO_Object Returns Integer
1357 Register_Function DEO_Control_Object Returns Integer
1358 Register_Function File_Field_Index Integer iFile Integer iField Returns Integer
1359
1360 // returns information about the Focus object. If it returns True its a DEO. If a DEO the
1361 // server, hasRecord, changed and hasindex info will all be returned by ref.
1362 // If false, these are all unchanged.
1363 Function DEOInformation Handle ByRef hoServer Boolean ByRef bHasRecord Boolean ByRef bChanged Boolean ByRef bHasIndex Returns Boolean
1364 Handle hoFocus
1365 Boolean bISDeo bIsControl
1366 Integer iFile iField
1367 Get Focus of desktop to hoFocus
1368 Get Is_Function Get_Deo_Object hoFocus True to bIsDeo
1369 If bISDEO Begin
1370 Move False to bHasRecord
1371 Move False to bChanged
1372 Move False to bHasIndex
1373 Get Server of hoFocus to hoServer
1374 If hoServer Begin
1375 Get HasRecord of hoServer to bHasRecord
1376 Get Should_Save of hoServer to bChanged
1377 Get Is_Function Get_DEO_Control_Object hoFocus False to bIsControl
1378 If (bIsControl) Begin
1379 Get Data_File of hoFocus to iFile
1380 Get Data_Field of hoFocus to iField
1381 Move ( iFile>0 and File_Field_Index(hoServer,iFile,iField)>-1) to bHasIndex
1382 End
1383 End
1384 End
1385 Function_Return bISDeo
1386 End_Function
1387
1388 // Find all controls within this control with the passed Id.
1389 { Visibility=Private }
1390 Procedure ControlsInControl Integer iId Handle hoControl Variant[] ByRef ArrayOfvControls
1391 Variant vCommandBar
1392 Handle hoCommandBar
1393 Integer eType
1394 Get ComType of hoControl to eType
1395 If (eType=xtpControlPopup or eType=xtpControlButtonPopup or eType=xtpControlSplitButtonPopup) Begin
1396 Get Create U_cCJCommandBar to hoCommandbar
1397 Get ComCommandBar of hoControl to vCommandBar
1398 Set pvComObject of hoCommandBar to vCommandBar
1399 Send ControlsInCommandBar iId hoCommandBar (&ArrayOfvControls)
1400 Send Destroy of hoCommandBar
1401 End
1402 End_Procedure
1403
1404 // Find all controls within this commandbar with the passed Id.
1405 { Visibility=Private }
1406 Procedure ControlsInCommandBar Integer iId Handle hoCommandBar Variant[] ByRef ArrayOfvControls
1407 Variant vNewControl vNewControls
1408 Handle hoNewControl hoNewControls
1409 Integer iControls i iNewId
1410
1411 Get Create U_cCJCommandBarControls to hoNewControls
1412 Get Create U_cCJCommandBarPopup to hoNewControl
1413
1414 Get ComControls of hoCommandBar to vNewControls
1415 Set pvComObject of hoNewControls to vNewControls
1416
1417 Get ComCount of hoNewControls to iControls
1418 For i from 1 to iControls
1419 Get ComItem of hoNewControls i to vNewControl
1420 Set pvComObject of hoNewControl to vNewControl
1421
1422 Get ComId of hoNewControl to iNewId
1423 If (iNewId=iId) Begin
1424 Move vNewControl to ArrayOfvControls[SizeOfArray(ArrayOfvControls)]
1425 End
1426
1427 Send ControlsInControl iId hoNewControl (&ArrayOfvControls)
1428 Loop
1429
1430 Send Destroy of hoNewControl
1431 Send Destroy of hoNewControls
1432 End_Procedure
1433
1434 // Find all controls within the commandbarsystem with the passed Id.
1435 // This can be used to search for Ids within a popup menu item. You only need to use
1436 // this is there is a chance that there will be more than one control with this id.
1437 Function FindControls Integer iId Returns Variant[]
1438 Variant[] ArrayOfvControls
1439 Variant vCommandBar
1440 Integer iCommandBars i
1441 Handle hoCommandBar
1442
1443 Get Create U_cCJCommandBar to hoCommandbar
1444 Get ComCount to iCommandBars
1445 For i from 1 to iCommandBars
1446 Get ComItem i to vCommandBar
1447 Set pvComObject of hoCommandBar to vCommandBar
1448 Send ControlsInCommandBar iId hoCommandBar (&ArrayOfvControls)
1449 Loop
1450 Send Destroy of hoCommandBar
1451 Function_Return ArrayOfvControls
1452 End_Function
1453
1454
1455
1456 // this sends update to the action of all of the child menu items. Note these are the children
1457 // of visual control, not the children of the action. This is used to enable, disable all
1458 // menu items, etc.
1459
1460 { Visibility=Private }
1461 Procedure PopupInit Handle hoCommandBar Handle hoCommandBarControls
1462 Handle hoControl hoAction hoItem
1463 Variant vAction vControl
1464 Integer i iCount
1465
1466 Get Create U_cCJCommandBarControl to hoControl
1467 Get Create U_cCJCommandBarAction to hoAction
1468
1469 Get ComCount of hoCommandBarControls to iCount
1470 // for each control we must find its action and set the action, which in
1471 // turn will set this control (and any other control there might be with that action).
1472 For i from 1 to iCount
1473 Get ComItem of hoCommandBarControls i to vControl
1474 Set pvComObject of hoControl to vControl
1475 Get ComAction of hoControl to vAction
1476 // it is possible that there will be no action, in which case do nothing
1477 If not (IsNullComObject(vAction)) Begin
1478 Set pvComObject of hoAction to vAction
1479 Get ComTag of hoAction to hoItem
1480 If hoItem Begin
1481 Send Update of hoItem
1482 End
1483 End
1484 Loop
1485
1486 Send Destroy of hoAction
1487 Send Destroy of hoControl
1488 End_Procedure
1489
1490
1491 { MethodType=Event }
1492 { Visibility=Private } // make this private. Use OnCreateCommandBars for custom event
1493 Procedure OnCreate
1494 Forward Send OnCreate
1495 Send CreateCommandBars
1496 End_Procedure
1497
1498 { MethodType=Event }
1499 Procedure OnCreateCommandBars
1500 End_Procedure
1501
1502 { MethodType=Event }
1503 Procedure OnRelease
1504 End_Procedure
1505
1506 { MethodType=Event }
1507 Procedure OnUpdate
1508 End_Procedure
1509
1510 { MethodType=Event }
1511 Procedure OnComExecute Variant llControl
1512 Handle hoControl hoAction hoActionPointer
1513 Variant vAction
1514 Get Create U_cCJCommandBarControl to hoControl
1515 Get Create U_cCJCommandBarAction to hoAction
1516
1517 Set pvComObject of hoControl to llControl
1518 Get ComAction of hoControl to vAction
1519 // There should always be an action but it is possible that all
1520 // CJ controls will not use this. (colorselector). So we must test.
1521 If not (IsNullComObject(vAction)) Begin
1522 Set pvComObject of hoAction to vAction
1523 Get ComTag of hoAction to hoActionPointer
1524 End
1525 Send Destroy of hoAction
1526 Send Destroy of hoControl
1527
1528 If hoActionPointer Begin
1529 Send Execute of hoActionPointer llControl
1530 End
1531 Else Begin
1532 // if for some reason there is no action COM and/or DF object
1533 // we allow this to be handled by this class as an unhandled
1534 // execute
1535 Send OnUnhandledExecute llControl
1536 End
1537
1538 End_Procedure
1539
1540 // this happens when the execute control either has no COM action
1541 // or it has no DF action object. In such a case, we don't do anything other than
1542 // call this method. Note that there may be a valid action but fo rsome reason
1543 // the ComAction property did not get properly assigned by CJ. This seems to happen
1544 // with the color selector object.
1545 { MethodType=Event }
1546 Procedure OnUnhandledExecute Variant llControl
1547 End_Procedure
1548
1549
1550 { MethodType=Event }
1551 Procedure OnComControlSelected Variant llControl
1552 Handle hoControl hoAction hoActionPointer
1553 Variant vAction
1554 If (not(IsNullComObject(llControl))) Begin
1555 Get Create U_cCJCommandBarControl to hoControl
1556 Get Create U_cCJCommandBarAction to hoAction
1557
1558 Set pvComObject of hoControl to llControl
1559 Get ComAction of hoControl to vAction
1560 If (not(IsNullComObject(vAction))) Begin
1561 Set pvComObject of hoAction to vAction
1562 Get ComTag of hoAction to hoActionPointer
1563 End
1564 Send Destroy of hoAction
1565 Send Destroy of hoControl
1566
1567 If hoActionPointer Begin
1568 Send OnSelected of hoActionPointer llControl
1569 End
1570 Else Begin
1571 Send OnUnhandledControlSelected llControl
1572 End
1573 End
1574
1575 End_Procedure
1576
1577 { MethodType=Event }
1578 Procedure OnUnhandledControlSelected Variant llControl
1579 End_Procedure
1580
1581 { MethodType=Event }
1582 Procedure OnComInitCommandsPopup Variant llCommandBar
1583 Handle hoCommandBar hoAction hoActionPointer hoCommandBarControl hoCommandBarControls
1584 Variant vAction vCommandBarControl vCommandBarControls
1585 Integer eType
1586
1587 Get Create U_cCJCommandbar to hoCommandBar
1588 Get Create U_cCJCommandBarControls to hoCommandBarControls
1589
1590 Set pvComObject of hoCommandBar to llCommandBar
1591 Get ComControls of hoCommandBar to vCommandBarControls
1592 Set pvComObject of hoCommandBarControls to vCommandBarControls
1593
1594 Get ComType of hoCommandBar to eType
1595
1596 // if no parent it's a context menu. This is not handled here. It is handled by
1597 // the context menu during the popup
1598 Get ComParent of hoCommandBar to vCommandBarControl
1599 //If (eType=xtpBarTypePopup and (not(IsNullComObject(vCommandBarControl)))) Begin
1600 If (not(IsNullComObject(vCommandBarControl))) Begin
1601 // set all the child objects enabled and disabled
1602 Send PopupInit hoCommandBar hoCommandBarControls
1603
1604 Get Create U_cCJCommandbarControl to hoCommandBarControl
1605 Get Create U_cCJCommandbarAction to hoAction
1606
1607 Set pvComObject of hoCommandBarControl to vCommandBarControl
1608 Get ComAction of hoCommandBarControl to vAction
1609 // builtin menus like customize may not have actions
1610 If not (IsNullComObject(vAction)) Begin
1611 Set pvComObject of hoAction to vAction
1612 Get ComTag of hoAction to hoActionPointer
1613 End
1614
1615 Send Destroy of hoAction
1616 Send Destroy of hoCommandBarControl
1617
1618 If hoActionPointer Begin
1619 Send OnPopupInit of hoActionPointer vCommandBarControl hoCommandBarControls
1620 End
1621 Else Begin
1622 Send OnUnhandledInitCommandsPopup llCommandBar
1623 End
1624 End
1625
1626 Send Destroy of hoCommandBarControls
1627 Send Destroy of hoCommandBar
1628
1629 End_Procedure
1630
1631 { MethodType=Event }
1632 Procedure OnUnhandledInitCommandsPopup Variant llCommandBar
1633 End_Procedure
1634
1635
1636 { MethodType=Event }
1637 Procedure OnComCustomization Variant vCustomizeOptions
1638 Handle hoCustomize
1639 Boolean bShowKeyboardPage bShowOptionsPage
1640
1641 // directly support setting of keyboard and option tab pages.
1642 // any other customization should be done by developer
1643 Get pbCustomizeShowKeyboardPage to bShowKeyboardPage
1644 Get pbCustomizeShowOptionsPage to bShowOptionsPage
1645 Get Create U_cCJCustomizeOptions to hoCustomize
1646 Set pvComObject of hoCustomize to vCustomizeOptions
1647 Set ComShowKeyboardPage of hoCustomize to bShowKeyboardPage
1648 Set ComShowOptionsPage of hoCustomize to bShowOptionsPage
1649 Send Destroy of hoCustomize
1650
1651 Forward Send OnComCustomization vCustomizeOptions
1652 End_Procedure
1653
1654
1655
1656End_Class
1657
1658Class cCJCommandBarMixin is a Mixin
1659
1660 { Visibility=Private }
1661 Procedure Define_cCJCommandBarMixin
1662
1663 { Category="Behavior" }
1664 Property Integer piBarID 0
1665
1666 { Category="Appearance" }
1667 Property Boolean pbDockNextTo True
1668
1669 { Category="Appearance" }
1670 { EnumList="xtpBarTop, xtpBarBottom, xtpBarRight, xtpBarLeft, xtpBarFloating" }
1671 Property Integer peBarPosition xtpBarTop
1672
1673 { Category="Appearance" }
1674 Property Boolean pbEnableDocking True
1675 { Category="Appearance" }
1676 Property Boolean pbHideWrap False
1677 { Category="Appearance" }
1678 { EnumList="stNoStretch, stStretch, stStretchShared" }
1679 Property Integer peStretched stNoStretch
1680
1681 { Visibility=Private }
1682 Property Boolean pbPrivateCloseable True
1683 { Visibility=Private }
1684 Property Boolean pbPrivateCustomizable True
1685 { Visibility=Private }
1686 Property Boolean pbPrivateEnableAnimation False
1687 { Visibility=Private }
1688 Property Boolean pbPrivateShowExpandButton True
1689 { Visibility=Private }
1690 Property String psPrivateTitle "Toolbar"
1691 { Visibility=Private }
1692 Property Boolean pbPrivateVisible True
1693 { Visibility=Private }
1694 Property Integer piPrivateWidth 0
1695 { Visibility=Private }
1696 Property Boolean pbPrivateGripper True
1697
1698 Set peNeighborhood to nhNo
1699
1700 End_Procedure
1701
1702 // Generic Get and Set property that is used to get and set a DF/COM property.
1703 // can be used by any integer or boolean property
1704
1705 { Visibility=Private }
1706 Procedure SetComProperty Handle hmPrivateProperty Handle hmCOMProperty Integer iValue
1707 Set hmPrivateProperty to iValue
1708 If (IsComObjectCreated(Self)) Begin
1709 Set hmCOMProperty to iValue
1710 End
1711 End_Procedure
1712
1713 { Visibility=Private }
1714 Function GetComProperty Handle hmPrivateProperty Handle hmCOMProperty Returns Integer
1715 Integer iValue
1716 If (IsComObjectCreated(Self)) Begin
1717 Get hmCOMProperty to iValue
1718 End
1719 Else Begin
1720 Get hmPrivateProperty to iValue
1721 End
1722 Function_Return iValue
1723 End_Function
1724
1725 {MethodType=Property InitialValue=True }
1726 { Category="Behavior" }
1727 Procedure Set pbCloseable Boolean bValue
1728 Send SetComProperty set_pbPrivateCloseable set_ComCloseable bValue
1729 End_Function
1730
1731 {MethodType=Property }
1732 Function pbCloseable Returns Boolean
1733 Boolean bValue
1734 Get GetComProperty get_pbPrivateCloseable get_ComCloseable to bValue
1735 Function_Return bValue
1736 End_Function
1737
1738 {MethodType=Property InitialValue=True }
1739 { Category="Behavior" }
1740 Procedure Set pbCustomizable Boolean bValue
1741 Send SetComProperty set_pbPrivateCustomizable set_ComCustomizable bValue
1742 End_Function
1743
1744 {MethodType=Property }
1745 Function pbCustomizable Returns Boolean
1746 Boolean bValue
1747 Get GetComProperty get_pbPrivateCustomizable get_ComCustomizable to bValue
1748 Function_Return bValue
1749 End_Function
1750
1751 {MethodType=Property InitialValue=False }
1752 { Category="Behavior" }
1753 Procedure Set pbEnableAnimation Boolean bValue
1754 Send SetComProperty set_pbPrivateEnableAnimation set_ComEnableAnimation bValue
1755 End_Function
1756
1757 {MethodType=Property }
1758 Function pbEnableAnimation Returns Boolean
1759 Boolean bValue
1760 Get GetComProperty get_pbPrivateEnableAnimation get_ComEnableAnimation to bValue
1761 Function_Return bValue
1762 End_Function
1763
1764 {MethodType=Property InitialValue=True }
1765 { Category="Behavior" }
1766 Procedure Set pbShowExpandButton Boolean bValue
1767 Send SetComProperty set_pbPrivateShowExpandButton set_ComShowExpandButton bValue
1768 End_Function
1769
1770 {MethodType=Property }
1771 Function pbShowExpandButton Returns Boolean
1772 Boolean bValue
1773 Get GetComProperty get_pbPrivateShowExpandButton get_ComShowExpandButton to bValue
1774 Function_Return bValue
1775 End_Function
1776
1777 {MethodType=Property InitialValue=True }
1778 { Category="Behavior" }
1779 Procedure Set pbVisible Boolean bValue
1780 Send SetComProperty set_pbPrivateVisible set_ComVisible bValue
1781 End_Function
1782
1783 {MethodType=Property }
1784 Function pbVisible Returns Boolean
1785 Boolean bValue
1786 Get GetComProperty get_pbPrivateVisible get_ComVisible to bValue
1787 Function_Return bValue
1788 End_Function
1789
1790 // todo: see about removing this
1791 { Visibility=Private }
1792 {MethodType=Property InitialValue=0 }
1793 { Category="Behavior" }
1794 Procedure Set piWidth Integer iValue
1795 Send SetComProperty set_piPrivateWidth set_ComWidth iValue
1796 End_Function
1797
1798 // todo: see about removing this
1799 { Visibility=Private }
1800 {MethodType=Property }
1801 Function piWidth Returns Integer
1802 Integer iValue
1803 Get GetComProperty get_piPrivateWidth get_ComWidth to iValue
1804 Function_Return iValue
1805 End_Function
1806
1807 {MethodType=Property InitialValue=True }
1808 { Category="Appearance" }
1809 Procedure Set pbGripper Boolean bValue
1810 Set pbPrivateGripper to bValue
1811 If (IsComObjectCreated(Self)) Begin
1812 Send ComModifyStyle (If(not(bValue),xtp_CBRS_GRIPPER,0)) (If(bValue,xtp_CBRS_GRIPPER,0))
1813 End
1814 End_Procedure
1815
1816 {MethodType=Property }
1817 Function pbGripper Returns Boolean
1818 Boolean bValue
1819 Get pbPrivateGripper to bValue
1820 Function_Return bValue
1821 End_Function
1822
1823 {MethodType=Property InitialValue="ToolBar" }
1824 { Category="Appearance" }
1825 Procedure Set psTitle String sValue
1826 Set psPrivateTitle to sValue
1827 If (IsComObjectCreated(Self)) Begin
1828 Set ComTitle to sValue
1829 End
1830 End_Procedure
1831
1832 {MethodType=Property }
1833 Function psTitle Returns String
1834 String sValue
1835 If (IsComObjectCreated(Self)) Begin
1836 Get ComTitle to sValue
1837 End
1838 Else Begin
1839 Get psPrivateTitle to sValue
1840 End
1841 Function_Return sValue
1842 End_Function
1843
1844 // This may not be needed if we can treat commandbar objects as static
1845 //// use this to find the Commandbar COM control and attach this object to it.
1846 //// If a COM object cannot be found, this is an error and and error is declared.
1847 //Procedure AttachComObject
1848 //Handle hoCommandBars
1849 //Variant vCommandBar
1850 //Integer iBarId i iBars iComBarId
1851 //Get CommandBarSystemObject to hoCommandBars
1852 //Get piBarID to iBarId
1853 //Get ComCount of hoCommandBars to iBars
1854 //For i from 1 to iBars
1855 //Get ComItem of hoCommandBars i to vCommandBar
1856 //Set pvComObject to vCommandBar
1857 //Get ComBarID to iComBarId
1858 //If (iBarId=iComBarId) Begin
1859 //Procedure_Return
1860 //End
1861 //Loop
1862 //Send ReleaseComObject
1863 //Error DFERR_PROGRAM "Assert: AttachComObject failed to attach commandbar"
1864 //End_Procedure
1865
1866 { Visibility=Private }
1867 Procedure InitComInstance
1868 Handle hoCommandBars hoNextTo
1869 Variant vCommandBar vNextTo
1870 String sTitle
1871 Integer iBarId iWidth iDockFgs iBars eBarPosition
1872 Integer eNextToPosition eNextToType iDockingFlags eStretched
1873 Boolean bCloseable bCustomizable bEnableAnimation bShowExpandButton
1874 Boolean bVisible bEnableDocking bHideWrap
1875 Boolean bGripper bDockNextTo bNextToVisible
1876
1877 Get CommandBarSystemObject to hoCommandBars
1878
1879 Get psPrivateTitle to sTitle
1880 Get pbPrivateCloseable to bCloseable
1881 Get pbPrivateCustomizable to bCustomizable
1882 Get pbPrivateEnableAnimation to bEnableAnimation
1883 Get pbPrivateShowExpandButton to bShowExpandButton
1884 Get pbPrivateVisible to bVisible
1885 Get piPrivateWidth to iWidth
1886 Get pbEnableDocking to bEnableDocking
1887 Get pbHideWrap to bHideWrap
1888 Get peStretched to eStretched
1889
1890 Get pbPrivateGripper to bGripper
1891 Get piBarId to iBarId
1892 Get pbDockNextTo to bDockNextTo
1893 Get peBarPosition to eBarPosition
1894
1895
1896 Get CreateCommandBar to vCommandBar
1897
1898 Set pvComObject to vCommandBar
1899 Set ComTitle to sTitle
1900 Set ComCloseable to bCloseable
1901 Set ComCustomizable to bCustomizable
1902 Set ComEnableAnimation to bEnableAnimation
1903 Set ComShowExpandButton to bShowExpandButton
1904 Set ComVisible to bVisible
1905
1906 Send ComModifyStyle (If(not(bGripper),xtp_CBRS_GRIPPER,0)) (If(bGripper,xtp_CBRS_GRIPPER,0))
1907
1908 If (iBarId<>0) Begin
1909 Set ComBarID to iBarId
1910 End
1911 Else Begin
1912 Get ComBarId to iBarId
1913 Set piBarID to iBarId
1914 End
1915
1916 // enabled docking is determiend by iORing flags. We simplify docking to allow all or
1917 // none. In addition we support hidewrap and the two stretched flags.
1918 If bEnableDocking Begin
1919 Move (iDockingFlags ior xtpFlagAlignAny ior xtpFlagFloating) to iDockingFlags
1920 End
1921 If bHideWrap Begin
1922 Move (iDockingFlags ior xtpFlagHideWrap) to iDockingFlags
1923 End
1924 If (eStretched=stStretch) Begin
1925 Move (iDockingFlags ior xtpFlagStretched) to iDockingFlags
1926 End
1927 Else If (eStretched=stStretchShared) Begin
1928 Move (iDockingFlags ior xtpFlagStretchedShared) to iDockingFlags
1929 End
1930 Send ComEnableDocking iDockingFlags
1931
1932 If (iWidth>0) Begin
1933 Set ComWidth to iWidth
1934 End
1935
1936 // if we DockNextTo we want to doc "next" to the last command bar that is located
1937 // in the same position (e.g. top, bottom, left, right). "Next" is relative to the position
1938 // where top/bottom is Right-of and let/right is below. Menubars are excluded from this logic
1939 // if we DockNextTo we want to doc "next" to the last command bar that is located
1940 // in the same position (e.g. top, bottom, left, right). "Next" is relative to the position
1941 // where top/bottom is Right-of and let/right is below. Menubars are excluded from this logic
1942 If bDockNextTo Begin
1943 Get ComCount of hoCommandBars to iBars
1944 Get Create U_cCJCommandBar to hoNextTo
1945 While (iBars>1)
1946 Get ComItem of hoCommandBars (iBars-1) to vNextTo
1947 Set pvComObject of hoNextTo to vNextTo
1948 Get ComVisible of hoNextTo to bNextToVisible
1949 Get ComPosition of hoNextTo to eNextToPosition
1950 Get ComType of hoNextTo to eNextToType
1951 If (bNextToVisible and eNextToType=xtpBarTypeNormal and eNextToPosition=eBarPosition) Begin
1952 Send DockNextTo vCommandBar vNextTo
1953 Move 0 to iBars
1954 End
1955 Decrement iBars
1956 Loop
1957 Send Destroy of hoNextTo
1958 End
1959
1960 End_Procedure
1961
1962 // This is called when the commandbar is created and is bound to the commandbar object.
1963 { MethodType=Event }
1964 Procedure OnCreate
1965 End_Procedure
1966
1967 Procedure End_Construct_Object
1968 Integer iID
1969 Handle hoCommandBars
1970 Get piBarId to iID
1971 If (iID=0) Begin
1972 Get CommandBarSystemObject to hoCommandBars
1973 Get AssignBarId of hoCommandBars to iId
1974 Set piBarId to iID
1975 End
1976 Forward Send End_Construct_Object
1977 End_Procedure
1978
1979End_Class
1980
1981
1982
1983
1984
1985{ OverrideProperty=peAutoCreate DesignTime=False }
1986{ OverrideProperty=peNeighborhood DesignTime=False }
1987{ OverrideProperty=psLicenseKey DesignTime=False }
1988{ OverrideProperty=psProgId DesignTime=False }
1989{ OverrideProperty=peNeighborhood InitialValue=nhNo }
1990{ ClassType=Abstract }
1991Class cCJAbstractCommandBar is a cCJCommandBar
1992
1993 Import_Class_Protocol cCJCommandBarMixin
1994
1995 Procedure Construct_Object
1996 Forward Send Construct_Object
1997 Send Define_cCJCommandBarMixin
1998 End_Procedure
1999
2000 // Must be defined in a sub-class
2001 { Visibility=Private }
2002 Function CreateCommandBar Returns Variant
2003 Error DFERR_PROGRAM "Assert: CreateCommandBar not defined in superclass"
2004 End_Function
2005
2006 Procedure CreateComInstance
2007 Handle hoCommandBarControls
2008 Variant vCommandBarControls
2009
2010 Send InitComInstance // creates control and returns it attached
2011 Send OnCreate
2012
2013
2014 Get Create U_cCJCommandBarControls to hoCommandBarControls
2015 Get ComControls to vCommandBarControls
2016 Set pvComObject of hoCommandBarControls to vCommandBarControls
2017
2018 Broadcast Send CreateComInstance hoCommandBarControls
2019
2020 // after this command bar and all its children are created, we set this as the reset point.
2021 Send ComCreateOriginalControls of hoCommandBarControls
2022
2023 Send Destroy of hoCommandBarControls
2024
2025 // JJT: I think Commandbars are static and do not change based on loading and editing
2026 // If so, we will keep the objects bound. If this does not work we will need to
2027 // use the AttachComObject method.
2028 // Send ReleaseComObject
2029
2030 End_Procedure
2031
2032End_Class
2033
2034{ OverrideProperty=psTitle InitialValue="Main Menu" }
2035{ OverrideProperty=pbCloseable InitialValue=False }
2036{ OverrideProperty=pbGripper InitialValue=False }
2037{ OverrideProperty=pbEnableDocking InitialValue=False }
2038{ OverrideProperty=peStretched InitialValue=stStretch }
2039{ OverrideProperty=pbCustomizable InitialValue=False }
2040{ DesignerClass = cDTCJMenuBar }
2041Class cCJMenuBar is a cCJAbstractCommandBar
2042
2043 Procedure Construct_object
2044 Forward Send Construct_Object
2045 Set piBarId to 1 // menu is always 1
2046 Set psTitle to "Main Menu"
2047 Set pbCloseable to False
2048 Set pbGripper to False
2049 Set pbEnableDocking to False
2050 Set pbHideWrap to False
2051 Set peStretched to stStretch
2052 Set pbCustomizable to False
2053
2054 End_Procedure
2055
2056 { Visibility=Private }
2057 Function CreateCommandBar Returns Variant
2058 Variant vCommandBar
2059 Handle hoCommandBars
2060 Integer eBarPosition
2061 Get peBarPosition to eBarPosition
2062 Get CommandBarSystemObject to hoCommandBars
2063 Get ComActiveMenuBar of hoCommandBars to vCommandBar
2064 Set pvComObject to vCommandBar
2065 Set ComPosition to eBarPosition
2066 Function_Return vCommandBar
2067 End_Function
2068
2069End_Class
2070
2071{ DesignerClass = cDTCJToolBar }
2072Class cCJToolbar is a cCJAbstractCommandBar
2073
2074 { Visibility=Private }
2075 Function CreateCommandBar Returns Variant
2076 Variant vCommandBar
2077 Handle hoCommandBars
2078 Integer eBarPosition
2079 Get peBarPosition to eBarPosition
2080 Get CommandBarSystemObject to hoCommandBars
2081 Get ComAdd of hoCommandBars "Toolbar" eBarPosition to vCommandBar
2082 Function_Return vCommandBar
2083 End_Function
2084
2085End_Class
2086
2087{ OverrideProperty=peAutoCreate DesignTime=False }
2088{ OverrideProperty=peNeighborhood DesignTime=False }
2089{ OverrideProperty=psLicenseKey DesignTime=False }
2090{ OverrideProperty=psProgId DesignTime=False }
2091{ OverrideProperty=peNeighborhood InitialValue=nhNo }
2092
2093Class cCJTabToolBar is a cCJComTabToolBar
2094
2095 Import_Class_Protocol cCJCommandBarMixin
2096
2097 Procedure Construct_Object
2098 Forward Send Construct_Object
2099 Send Define_cCJCommandBarMixin
2100 { Visibility=Private }
2101 Property Boolean pbPrivateAllowReorder False
2102
2103 End_Procedure
2104
2105 {MethodType=Property InitialValue=False }
2106 { Category="Behavior" }
2107 Procedure Set pbAllowReorder Boolean bValue
2108 Send SetComProperty set_pbPrivateAllowReorder set_ComAllowReorder bValue
2109 End_Function
2110
2111 {MethodType=Property }
2112 Function pbAllowReorder Returns Boolean
2113 Boolean bValue
2114 Get GetComProperty get_pbPrivateAllowReorder get_ComAllowReorder to bValue
2115 Function_Return bValue
2116 End_Function
2117
2118
2119 { Visibility=Private }
2120 Function CreateCommandBar Returns Variant
2121 Variant vCommandBar
2122 Handle hoCommandBars
2123 Get CommandBarSystemObject to hoCommandBars
2124 Get ComAddTabToolBar of hoCommandBars "TabToolbar" to vCommandBar
2125 Function_Return vCommandBar
2126 End_Function
2127
2128 Procedure CreateComInstance
2129 Handle hoCommandBarControls
2130 Variant vCommandBarControls
2131 Boolean bAllowReorder
2132 Get pbPrivateAllowReorder to bAllowReorder
2133
2134 Send InitComInstance // creates control and returns it attached
2135
2136 Set ComAllowReorder to bAllowReorder
2137
2138 Send OnCreate
2139
2140
2141 Get Create U_cCJCommandBarControls to hoCommandBarControls
2142 Get ComControls to vCommandBarControls
2143 Set pvComObject of hoCommandBarControls to vCommandBarControls
2144
2145
2146 Broadcast Send CreateComInstance Self // we pass attached tabmenubar control to tab children
2147
2148 // after this command bar and all its children are created, we set this as the reset point.
2149 Send ComCreateOriginalControls of hoCommandBarControls
2150 Send ComUpdateTabs
2151 Send ComRedrawBar
2152 Send ComRecalcLayout
2153 Send Destroy of hoCommandBarControls
2154
2155 // JJT: I think Commandbars are static and do not change based on loading and editing
2156 // If so, we will keep the objects bound. If this does not work we will need to
2157 // use the AttachComObject method.
2158 //Send ReleaseComObject
2159
2160 End_Procedure
2161
2162 { Visibility=Private }
2163 Function FindByCategory String sName Returns Variant
2164 Boolean bAttached bOk
2165 Handle hoItem
2166 Variant vItem
2167 Integer i iCount
2168 String sCat
2169
2170 Move (IsComObjectCreated(Self)) to bAttached
2171 If not bAttached Begin
2172 Error DFERR_PROGRAM "Assert: Find by Category commandbar not attached"
2173 Function_Return (NullComObject())
2174 //Send AttachComObject
2175 End
2176
2177 Get Create U_cCJComTabControlItem to hoItem
2178 Get ComCategoryCount to iCount
2179 For i from 0 to (iCount-1)
2180 Get ComCategory i to vItem
2181 Set pvComObject of hoItem to vItem
2182 Get ComCaption of hoItem to sCat
2183 Move (sCat=sName) to bOk
2184 If bOk Break
2185 Loop
2186 Send destroy of hoItem
2187
2188 //If not bAttached Begin
2189 //Send ReleaseComObject
2190 //End
2191 If not bOk Begin
2192 Move (NullComObject()) to vItem
2193 End
2194 Function_Return vItem
2195 End_Function
2196
2197End_Class
2198
2199{ OverrideProperty=peAutoCreate DesignTime=False }
2200{ OverrideProperty=peNeighborhood DesignTime=False }
2201{ OverrideProperty=psLicenseKey DesignTime=False }
2202{ OverrideProperty=psProgId DesignTime=False }
2203{ OverrideProperty=peNeighborhood InitialValue=nhNo }
2204
2205Class cCJTabControlItem is a cCJComTabControlItem
2206
2207 Procedure Construct_Object
2208 Forward Send Construct_Object
2209 Property String psCategory ""
2210 Property String psToolTip ""
2211 { PropertyType=Image }
2212 Property String psImage ""
2213 Set peNeighborhood to nhNo
2214 End_Procedure
2215
2216 // This may not be needed if we can treat commandbar objects as static
2217 //// attach this object to its appropriate COM object.
2218 //Procedure AttachComObject
2219 //Variant vCat
2220 //String sName
2221 //Get psCategory to sName
2222 //Delegate Get FindByCategory sName to vCat
2223 //If (IsNullComObject(vCat)) Begin
2224 //Error DFERR_PROGRAM "Assert: AttachComObject failed to attach tabcontrolitem"
2225 //End
2226 //Else Begin
2227 //Set pvComObject to vCat
2228 //End
2229 //End_Procedure
2230
2231 Procedure CreateComInstance Handle hoTabToolBar
2232 Handle hoCommandBars hoCommandBarControls hoControl
2233 Variant vCommandBarControls vTab vControl
2234 String sCategory sTip sImage
2235 Integer iCount i iNewCount iId
2236 Boolean bOk
2237
2238 Get psCategory to sCategory
2239 Get psToolTip to sTip
2240 Get psImage to sImage
2241
2242 Get CommandBarSystemObject to hoCommandBars
2243
2244 Get ComCategoryCount of hoTabToolBar to iCount
2245 Get ComInsertCategory of hoTabToolbar iCount sCategory to vTab
2246 Set pvComObject to vTab
2247
2248 Set ComToolTip to sTip
2249
2250 If (sImage<>"") Begin
2251 Get AddImage of hoCommandBars sImage 0 xtpImageNormal to iId
2252 Set ComImage to iId
2253 End
2254
2255 If (iCount=0) Begin
2256 Set ComSelected to True
2257 End
2258
2259 Send OnCreate
2260
2261 Get Create U_cCJCommandBarControls to hoCommandBarControls
2262 Get ComControls of hoTabToolBar to vCommandBarControls
2263 Set pvComObject of hoCommandBarControls to vCommandBarControls
2264
2265 // before creating the child com controls, get the count of controls
2266 Get ComCount of hoCommandBarControls to iCount
2267
2268 Broadcast Send CreateComInstance hoCommandBarControls
2269
2270 // get the new count of controls. The difference are the new controls.
2271 Get ComCount of hoCommandBarControls to iNewCount
2272
2273 Get create U_cCJCommandBarControl to hoControl
2274 For i from (iCount+1) to iNewCount
2275 Get ComItem of hoCommandBarControls i to vControl
2276 Set pvComObject of hoControl to vControl
2277 Set ComCategory of hoControl to sCategory
2278 Loop
2279 Send Destroy of hoControl
2280 Send Destroy of hoCommandBarControls
2281
2282 // JJT: I think tab bar items are static and do not change based on loading and editing
2283 // If so, we will keep the objects bound. If this does not work we will need to
2284 // use the AttachComObject method.
2285 //Send ReleaseComObject
2286
2287 End_Procedure
2288
2289 { MethodType=Event }
2290 Procedure OnCreate
2291 End_Procedure
2292
2293End_Class
2294
2295
2296{ OverrideProperty=Delegation_Mode DesignTime=False }
2297{ OverrideProperty=peAutoCreate DesignTime=False }
2298{ OverrideProperty=peNeighborhood DesignTime=False }
2299{ OverrideProperty=psLicenseKey DesignTime=False }
2300{ OverrideProperty=psProgId DesignTime=False }
2301
2302{ DesignerClass = cDTCJContextMenu }
2303Class cCJContextMenu is a cCJCommandBar
2304
2305 Procedure Construct_Object
2306 Forward Send Construct_Object
2307 { Category="Behavior" }
2308 Property Boolean pbEnableAnimation False
2309 { Category="Behavior" }
2310 Property Boolean pbControlDoubleGripper False
2311 { Category="Behavior" }
2312 Property Boolean pbControlPopupToolBar False
2313
2314 { DesignTime=False }
2315 Property Handle phoCommandBars 0
2316 End_Procedure
2317
2318
2319 // context menus use a differnt logic for finding the commandbars. Normally it will just attach to
2320 // the global commandbars. However, a developer can choose attach this to a different commandbars by
2321 // setting phoCommandBars.
2322 Function CommandBarSystemObject Returns Handle
2323 Handle hoCommandBars
2324 Get phoCommandBars to hoCommandBars
2325 If (hoCommandBars=0) Begin
2326 Move ghoCommandBars to hoCommandBars
2327 End
2328 Function_Return hoCommandBars
2329 End_Function
2330
2331 { Visibility=Private }
2332 Function CreateCommandBar Returns Variant
2333 Variant vCommandBar
2334 Handle hoCommandBars
2335 Get CommandBarSystemObject to hoCommandBars
2336 Get ComAdd of hoCommandBars "Context Toolbar" xtpBarPopup to vCommandBar
2337 Function_Return vCommandBar
2338 End_Function
2339
2340 Procedure CreatePopupComInstance
2341 Handle hoCommandBars hoCommandBarControls
2342 Variant vCommandBar vCommandBarControls
2343 Boolean bEnableAnimation bDoubleGripper bPopupToolBar
2344
2345 Get CommandBarSystemObject to hoCommandBars
2346 Get pbEnableAnimation to bEnableAnimation
2347 Get pbControlDoubleGripper to bDoubleGripper
2348 Get pbControlPopupToolBar to bPopupToolBar
2349
2350 Get CreateCommandBar to vCommandBar
2351 Set pvComObject to vCommandBar
2352
2353 Set ComEnableAnimation to bEnableAnimation
2354 Set ComDoubleGripper to bDoubleGripper
2355 Send ComSetPopupToolBar bPopupToolBar
2356
2357 Send OnCreate
2358
2359 Get Create U_cCJCommandBarControls to hoCommandBarControls
2360 Get ComControls to vCommandBarControls
2361 Set pvComObject of hoCommandBarControls to vCommandBarControls
2362
2363 Broadcast Send CreateComInstance hoCommandBarControls
2364
2365 // This does the same thing OnComPopupInit does.
2366
2367 // this does all of the inital setting of enabled, etc.
2368 Send PopupInit of hoCommandBars Self hoCommandBarControls
2369 // user event to do whatever
2370 Send OnPopupInit vCommandBar hoCommandBarControls
2371
2372 Send Destroy of hoCommandBarControls
2373
2374 // we keep the control attached with popups or we lose it.
2375 End_Procedure
2376
2377
2378 Procedure Popup
2379 Handle hoCommandBars
2380 Integer iLoc iId iRet
2381 tWinPoint Pt
2382
2383 Get CommandBarSystemObject to hoCommandBars
2384 If (hoCommandBars=0) Begin
2385 Error DFERR_PROGRAM "Context menu not attached to commandbars"
2386 Procedure_Return
2387 End
2388
2389 // this will create the context menu and return it attached.
2390 Send CreatePopupComInstance
2391
2392 Move (GetCursorPos(addressOf(Pt))) to iRet // Get the mouse location (this technique supports -ve co-ordinates
2393 Get ComShowPopup OLE_VT_Empty Pt.x Pt.y to iID
2394
2395//JVH - This technique does not support -ve screen co-ordinates.
2396// Get Absolute_Mouse_Location of Desktop to iLoc
2397// Get ComShowPopup OLE_VT_Empty (low(iLoc)) (hi(iLoc)) to iID
2398
2399 // This releases all actions (which will still exist on the COM side)
2400 // and controls (controls should already be released on both DF and COM side)
2401 Broadcast Recursive_up Send ReleaseComObject
2402 Send ReleaseComObject // after popup CJ deletes the controls, so we release this
2403 End_Procedure
2404
2405 { MethodType=Event }
2406 Procedure OnCreate
2407 End_Procedure
2408
2409 // before called, self and all items IsEnabled, IsChecked and IsVisible are called
2410 // the first param is of no interest as it is this object which is already attached
2411 { MethodType=Event }
2412 Procedure OnPopupInit Variant vCommandBarControl Handle hoCommandBarControls
2413 End_Procedure
2414
2415End_Class
2416
2417// used for the Customize dialog
2418// This provides a way to add controls to the config menu that are not defined
2419// elsewhere in the menu
2420
2421{ OverrideProperty=peNeighborhood InitialValue=nhNo }
2422{ ClassLibrary=Windows }
2423Class cCJDesignerMenu is a cObject
2424
2425 Procedure Construct_Object
2426 Forward Send Construct_Object
2427 Set peNeighborhood to nhNo
2428 End_Procedure
2429
2430 // Get the Controls Collection for the designer and call all children
2431 Procedure CreateComInstance
2432 Handle hoCommandBarControls
2433 Get DesignerControlsCollection to hoCommandBarControls
2434 Broadcast Send CreateComInstance hoCommandBarControls
2435 End_Procedure
2436
2437End_Class
2438
2439// This creates an action object. It will normally not be directly instanciated but will be used
2440// as the superclass of the cCJMenuItem class.
2441
2442{ OverrideProperty=Delegation_Mode DesignTime=False }
2443{ OverrideProperty=peAutoCreate DesignTime=False }
2444{ OverrideProperty=peNeighborhood DesignTime=False }
2445{ OverrideProperty=psLicenseKey DesignTime=False }
2446{ OverrideProperty=psProgId DesignTime=False }
2447
2448{ OverrideProperty=peNeighborhood InitialValue=nhNo }
2449Class cCJAction is a cCJCommandBarAction
2450
2451 Procedure Construct_Object
2452 Forward Send Construct_Object
2453
2454 // normally auto assigned. It can be manually assigned.
2455 { Category="Behavior" }
2456 Property Integer piId 0
2457
2458 // determins if this action should be updated by the timer. You only set this true if
2459 // the checked state, enabled state or visible state will be changed by other actions
2460 // within the program.
2461 { Visibility=Private }
2462 Property Boolean pbPrivateActiveUpdate False
2463
2464 { Visibility=Private }
2465 Property Boolean pbPrivateChecked False
2466 { Visibility=Private }
2467 Property Boolean pbPrivateEnabled True
2468 { Visibility=Private }
2469 Property Boolean pbPrivateVisible True
2470 { Visibility=Private }
2471 Property String psPrivateCaption ""
2472 { Visibility=Private }
2473 Property String psPrivateCategory C_$CategoryOther
2474 { Visibility=Private }
2475 Property String psPrivateDescriptionText ""
2476 { Visibility=Private }
2477 Property String psPrivateTooltipText ""
2478 { Visibility=Private }
2479 Property String psPrivateShortcutText ""
2480 { Visibility=Private }
2481 Property Integer piPrivateShortCutKey 0
2482
2483 // These are just initial values, if the developer needs to dynamically change
2484 // images they should use the ComIconId to select the item they need from the image list
2485
2486 // normally only psImage needs to be set
2487 { Category="Image" }
2488 { PropertyType=Image }
2489 Property String psImage ""
2490 { Category="Image" }
2491 { PropertyType=Image }
2492 Property String psImageDisabled ""
2493 { Category="Image" }
2494 { PropertyType=Image }
2495 Property String psImageHot ""
2496 { Category="Image" }
2497 { PropertyType=Image }
2498 Property String psImageChecked ""
2499 { Category="Image" }
2500 { PropertyType=Image }
2501 Property String psImagePressed ""
2502
2503 { Visibility=Private}
2504 Property Integer piPrivateIconId 0
2505
2506 Set peNeighborhood to nhNo
2507 End_Procedure
2508
2509
2510 {MethodType=Property InitialValue=False }
2511 { Category="Behavior" }
2512 Procedure Set pbChecked Boolean bValue
2513 Set pbPrivateChecked to bValue
2514 If (IsComObjectCreated(Self)) Begin
2515 Set ComChecked to bValue
2516 End
2517 End_Procedure
2518
2519 {MethodType=Property }
2520 Function pbChecked Returns Boolean
2521 Boolean bValue
2522 If (IsComObjectCreated(Self)) Begin
2523 Get ComChecked to bValue
2524 End
2525 Else Begin
2526 Get pbPrivateChecked to bValue
2527 End
2528 Function_Return bValue
2529 End_Function
2530
2531 {MethodType=Property InitialValue=True }
2532 { Category="Behavior" }
2533 Procedure Set pbEnabled Boolean bValue
2534 Set pbPrivateEnabled to bValue
2535 If (IsComObjectCreated(Self)) Begin
2536 Set ComEnabled to bValue
2537 End
2538 End_Procedure
2539
2540 {MethodType=Property }
2541 Function pbEnabled Returns Boolean
2542 Boolean bValue
2543 If (IsComObjectCreated(Self)) Begin
2544 Get ComEnabled to bValue
2545 End
2546 Else Begin
2547 Get pbPrivateEnabled to bValue
2548 End
2549 Function_Return bValue
2550 End_Function
2551
2552 {MethodType=Property InitialValue=True }
2553 { Category="Behavior" }
2554 Procedure Set pbVisible Boolean bValue
2555 Set pbPrivateVisible to bValue
2556 If (IsComObjectCreated(Self)) Begin
2557 Set ComVisible to bValue
2558 End
2559 End_Procedure
2560
2561 {MethodType=Property }
2562 Function pbVisible Returns Boolean
2563 Boolean bValue
2564 If (IsComObjectCreated(Self)) Begin
2565 Get ComVisible to bValue
2566 End
2567 Else Begin
2568 Get pbPrivateVisible to bValue
2569 End
2570 Function_Return bValue
2571 End_Function
2572
2573
2574 {MethodType=Property InitialValue="" }
2575 { Category="Appearance" }
2576 Procedure Set psCaption String sValue
2577 Set psPrivateCaption to sValue
2578 If (IsComObjectCreated(Self)) Begin
2579 Set ComCaption to sValue
2580 End
2581 End_Procedure
2582
2583 {MethodType=Property }
2584 Function psCaption Returns String
2585 String sValue
2586 If (IsComObjectCreated(Self)) Begin
2587 Get ComCaption to sValue
2588 End
2589 Else Begin
2590 Get psPrivateCaption to sValue
2591 End
2592 Function_Return sValue
2593 End_Function
2594
2595 {MethodType=Property InitialValue=C_$CategoryOther }
2596 { Category="Behavior" }
2597 Procedure Set psCategory String sValue
2598 Set psPrivateCategory to sValue
2599 If (IsComObjectCreated(Self)) Begin
2600 Set ComCategory to sValue
2601 End
2602 End_Procedure
2603
2604 {MethodType=Property }
2605 Function psCategory Returns String
2606 String sValue
2607 If (IsComObjectCreated(Self)) Begin
2608 Get ComCategory to sValue
2609 End
2610 Else Begin
2611 Get psPrivateCategory to sValue
2612 End
2613 Function_Return sValue
2614 End_Function
2615
2616 {MethodType=Property InitialValue="" }
2617 { Category="Appearance" }
2618 Procedure Set psDescription String sValue
2619 Set psPrivateDescriptionText to sValue
2620 If (IsComObjectCreated(Self)) Begin
2621 Set ComDescriptionText to sValue
2622 End
2623 End_Procedure
2624
2625 {MethodType=Property }
2626 Function psDescription Returns String
2627 String sValue
2628 If (IsComObjectCreated(Self)) Begin
2629 Get ComDescriptionText to sValue
2630 End
2631 Else Begin
2632 Get psPrivateDescriptionText to sValue
2633 End
2634 Function_Return sValue
2635 End_Function
2636
2637 {MethodType=Property InitialValue="" }
2638 { Category="Appearance" }
2639 Procedure Set psToolTip String sValue
2640 Set psPrivateToolTipText to sValue
2641 If (IsComObjectCreated(Self)) Begin
2642 Set ComToolTipText to sValue
2643 End
2644 End_Procedure
2645
2646 {MethodType=Property }
2647 Function psToolTip Returns String
2648 String sValue
2649 If (IsComObjectCreated(Self)) Begin
2650 Get ComToolTipText to sValue
2651 End
2652 Else Begin
2653 Get psPrivateToolTipText to sValue
2654 End
2655 Function_Return sValue
2656 End_Function
2657
2658 {MethodType=Property InitialValue="" }
2659 { Category="Appearance" }
2660 Procedure Set psShortcut String sValue
2661 Set psPrivateShortcutText to sValue
2662 If (IsComObjectCreated(Self)) Begin
2663 Set ComShortcutText to sValue
2664 End
2665 End_Procedure
2666
2667 {MethodType=Property }
2668 Function psShortcut Returns String
2669 String sValue
2670 If (IsComObjectCreated(Self)) Begin
2671 Get ComShortcutText to sValue
2672 End
2673 Else Begin
2674 Get psPrivateShortcutText to sValue
2675 End
2676 Function_Return sValue
2677 End_Function
2678
2679
2680 {MethodType=Property InitialValue="0,0" FoldedProperty=True }
2681 { DesignTime=False }
2682 { Category="Behavior" }
2683 Procedure Set piShortCutKey Integer iExtra Integer iKey
2684 Set piPrivateShortCutKey to (iKey + (iExtra*65536))
2685 If (IsComObjectCreated(Self)) Begin
2686 Send BindKey iExtra iKey
2687 End
2688 End_Procedure
2689
2690 {MethodType=Property }
2691 Function piShortCutKey Returns Integer
2692 Integer iValue
2693 Get piPrivateShortCutKey to iValue
2694 Function_Return iValue
2695 End_Function
2696
2697 { Visibility=Private }
2698 Procedure BindKey Integer iExtra Integer iKey
2699 Integer iId
2700 Handle hoKeyBindings hoCommandBars
2701 Get CommandBarSystemObject to hoCommandBars
2702 Get piId to iId
2703 If (iId=0) Begin
2704 Error DFERR_PROGRAM "Assert: action Id zero in keybinding"
2705 Procedure_Return
2706 End
2707 Get KeyBindingsCollection of hoCommandBars to hoKeyBindings
2708
2709 Send ComAdd of hoKeyBindings iExtra iKey iId
2710 End_Procedure
2711
2712 {MethodType=Property InitialValue=False }
2713 { Category="Behavior" }
2714 Procedure Set pbActiveUpdate Boolean bValue
2715 Handle hoCommandBars
2716 Get CommandBarSystemObject to hoCommandBars
2717 Set pbPrivateActiveUpdate to bValue
2718 If (IsComObjectCreated(Self)) Begin
2719 If bValue Begin
2720 Send AddActiveAction of hoCommandBars Self
2721 End
2722 Else Begin
2723 Send RemoveActiveAction of hoCommandBars Self
2724 End
2725 End
2726 End_Procedure
2727
2728 {MethodType=Property }
2729 Function pbActiveUpdate Returns Integer
2730 Boolean bValue
2731 Get pbPrivateActiveUpdate to bValue
2732 Function_Return bValue
2733 End_Function
2734
2735 // normally this is zero and not changed. When zero the imageId used will be
2736 // the statusbarId and this is the ID that is used when the psImage method is used.
2737 // Using psImage is preferred as it adds the icon and assigns it to the object.
2738 // This can be used to change icons. Note 0=use StatusbarId
2739 { MethodType=Property InitialValue=0 }
2740 { Category="Image" }
2741 Procedure Set piIconId Integer iValue
2742 Set piPrivateIconId to iValue
2743 If (IsComObjectCreated(Self)) Begin
2744 Set ComIconId to iValue
2745 End
2746 End_Procedure
2747
2748 { MethodType=Property }
2749 Function piIconId Returns Integer
2750 Integer iValue
2751 If (IsComObjectCreated(Self)) Begin
2752 Get ComIconId to iValue
2753 End
2754 Else Begin
2755 Get piPrivateIconId to iValue
2756 End
2757 Function_Return iValue
2758 End_Function
2759
2760
2761
2762 // For augmentation. Return true if the item should be visible
2763 Function IsVisible Returns Boolean
2764 Boolean bBool
2765 Get pbVisible to bBool
2766 Function_Return bBool
2767 End_Function
2768
2769 // For augmentation. Return true if the item should be enabled
2770 Function IsEnabled Returns Boolean
2771 Boolean bBool
2772 Get pbEnabled to bBool
2773 Function_Return bBool
2774 End_Function
2775
2776 // For augmentation. Return true if the item should be checked
2777 Function IsChecked Returns Boolean
2778 Boolean bBool
2779 Get pbChecked to bBool
2780 Function_Return bBool
2781 End_Function
2782
2783 Procedure CreateComAction
2784 Variant vID vAction
2785 Handle hoCommandBars hoActions
2786 Handle[] hoActiveActions
2787 String sCaption sToolTip sDescriptionText sCategory sShortCutText
2788 String sIcon sIconDisabled sIconHot sIconChecked sIconPressed
2789 Integer iId iShortCut iIconId iAssignedId
2790 Boolean bVisible bChecked bEnabled bOk
2791
2792 Get CommandBarSystemObject to hoCommandBars
2793 Get piId to iID
2794 If (iId=0) Begin
2795 // this can happen with context menus defined before the Commandbars is created
2796 Get AssignId of hoCommandBars to iID
2797 Set piId to iID
2798 End
2799
2800 Get psPrivateCaption to sCaption
2801 Get psPrivateTooltipText to sToolTip
2802 Get psPrivateShortcutText to sShortCutText
2803 Get psPrivateDescriptionText to sDescriptionText
2804 Get psPrivateCategory to sCategory
2805 Get pbPrivateVisible to bVisible
2806 Get pbPrivateChecked to bChecked
2807 Get pbPrivateEnabled to bEnabled
2808 Get piPrivateShortCutKey to iShortCut
2809 Get psImage to sIcon
2810 Get psImageDisabled to sIconDisabled
2811 Get psImageHot to sIconHot
2812 Get psImageChecked to sIconChecked
2813 Get psImagePressed to sIconPressed
2814 Get piPrivateIconId to iIconId
2815
2816 Get CommandBarSystemObject to hoCommandBars // via delegation
2817 Get ActionsCollection of hoCommandBars to hoActions
2818 Get ComAdd of hoActions iID sCaption sToolTip sDescriptionText sCategory to vAction
2819 Set pvComObject to vAction
2820 Set ComEnabled to bEnabled
2821 Set ComVisible to bVisible
2822 Set ComChecked to bChecked
2823 Set ComShortcutText to sShortCutText
2824 Set piIconId to iIconId
2825 Set ComTag to Self // used as back pointer from com object to DF object
2826
2827 If (sIcon<>"") Begin
2828 Get AddImage of hoCommandBars sIcon iId xtpImageNormal to iAssignedId
2829 End
2830 If (sIconDisabled<>"") Begin
2831 Get AddImage of hoCommandBars sIconDisabled iId xtpImageDisabled to iAssignedId
2832 End
2833 If (sIconHot<>"") Begin
2834 Get AddImage of hoCommandBars sIconHot iId xtpImageHot to iAssignedId
2835 End
2836 If (sIconChecked<>"") Begin
2837 Get AddImage of hoCommandBars sIconChecked iId xtpImageChecked to iAssignedId
2838 End
2839 If (sIconPressed<>"") Begin
2840 Get AddImage of hoCommandBars sIconPressed iId xtpImagePressed to iAssignedId
2841 End
2842
2843 If (iShortCut<>0) Begin
2844 Send BindKey (hi(iShortCut)) (low(iShortCut))
2845 End
2846
2847 Send OnCreateAction
2848
2849 Send RegisterAction of hoCommandBars Self
2850
2851 End_Procedure
2852
2853 // called during initial activation to set all default actions.
2854 Procedure CreateComInstance
2855 Send CreateComAction
2856 // actions are flat. You don't look for child actions
2857 End_Procedure
2858
2859 // find the first control that matches this action's ID. This searches the entire
2860 // commandbar system and "first" is just the first one it happens to find.
2861 Function FindFirstControl Returns Variant
2862 Variant vControl
2863 Integer iId
2864 Handle hoCommandBars hoCommandBar
2865 Get CommandBarSystemObject to hoCommandBars
2866 Get piId to iId
2867 Get ComFindControl of hoCommandBars xtpControlError iId Nothing True to vControl
2868 If (IsNullComObject(vControl)) Begin
2869 // if not found this could be from our context menu. ComFindControl does not search
2870 // the active context menu. We will test the focused command bar to see if we can
2871 // find the object in there. This may create a duplicate search but it will not matter.
2872 Get ComFocusedCommandBar of hoCommandBars to vControl
2873 If (not(IsNullComObject(vControl))) Begin
2874 Get Create U_cCJCommandBar to hoCommandBar
2875 Set pvComObject of hoCommandBar to vControl
2876 Get ComFindControl of hoCommandBar xtpControlError iId Nothing True to vControl
2877 Send Destroy of hoCommandBar
2878 End
2879 End
2880 Function_Return vControl
2881 End_Function
2882
2883 // delete all com controls for this action
2884 { Visibility=Private}
2885 Procedure DeleteAllControlsForAction
2886 Handle hoCommandBars hoControl
2887 Variant vControl
2888 Get Create U_cCJCommandBarControl to hoControl
2889 Repeat
2890 Get FindFirstControl to vControl
2891 If not (IsNullComObject(vControl)) Begin
2892 Set pvComObject of hoControl to vControl
2893 Send ComDelete to hoControl
2894 End
2895 Until (IsNullComObject(vControl))
2896 Send Destroy of hoControl
2897 End_Procedure
2898
2899 // find all controls owned by this action anywhere in the commandbar system
2900 // returns a variant array. This is only needed if you expect that there will be
2901 // multiple hits such as could happen if you allow end user editing.
2902 // This was created because there is no COM message to do this. This is pretty low level
2903 // (like ComFindControl) and will not be used much.
2904 Function FindAllControls Returns Variant[]
2905 Variant[] ArrayofvControls
2906 Integer iId
2907 Handle hoCommandBars
2908 Get CommandBarSystemObject to hoCommandBars
2909 Get piId to iId
2910 Get FindControls of hoCommandBars iId to ArrayofvControls
2911 Function_Return ArrayofvControls
2912 End_Function
2913
2914 // Return the class for the passed control type. Good for augmentation
2915 Function ClassForControlType Integer eType Returns Integer
2916 Integer iClass
2917 Case Begin
2918 Case (eType=xtpControlButton)
2919 Case (eType=xtpControlCheckBox)
2920 Case (eType=xtpControlRadioButton)
2921 Case (eType=xtpControlLabel)
2922 Move U_cCJCommandBarButton to eType
2923 Case Break
2924 Case (eType=xtpControlPopup)
2925 Case (eType=xtpControlButtonPopup)
2926 Case (eType=xtpControlSplitButtonPopup)
2927 Move U_cCJCommandBarPopup to eType
2928 Case Break
2929 Case (eType=xtpControlComboBox)
2930 Move U_cCJCommandBarComboBox to eType
2931 Case Break
2932 Case (eType=xtpControlCustom)
2933 Move U_cCJCommandBarControlCustom to eType
2934 Case Break
2935 Case (eType=xtpControlEdit)
2936 Move U_cCJCommandBarEdit to eType
2937 Case Break
2938 Case (eType=xtpControlGallery)
2939 Move U_cCJCommandBarGallery to eType
2940 Case Break
2941 Case Else
2942 Move U_cCJCommandBarControl to eType
2943 Case End
2944 Function_Return eType
2945 End_Function
2946
2947 // Creates a DF object of the proper type and binds it to the COM object.
2948 Function CreateProxyControl Variant vControl Returns Handle
2949 Handle hoObj
2950 Integer eType iClass
2951 Get Create U_cCJCommandBarControl to hoObj
2952 Set pvComObject of hoObj to vControl
2953 Get ComType of hoObj to eType
2954 Send Destroy of hoObj
2955 Move 0 to hoObj
2956 Get ClassForControlType eType to iCLass
2957 If (iClass<>0) Begin
2958 Get Create iClass to hoObj
2959 Set pvComObject of hoObj to vControl
2960 End
2961 Function_Return hoObj
2962 End_Function
2963
2964 // use this to find the COM control and return a DF object. You must call this if
2965 // you don't already have the control pointer. You should only call this if you know that
2966 // there will only be one control attached to the action. Make no assumption about what "First" means. It's
2967 // the first one the COM control finds.
2968 Function CreateFirstProxyControl Returns Handle
2969 Variant vControl
2970 Handle hoControl
2971 Get FindFirstControl to vControl
2972 If (not(IsNullComObject(vControl))) Begin
2973 Get CreateProxyControl vControl to hoControl
2974 End
2975 Function_Return hoControl
2976 End_Function
2977
2978
2979 // when a manual destroy is sent we need to do some cleanup.
2980 // If an active action, it must be removed from the active action array
2981 // All menu controls for this action will be removed, wherever they are within the system
2982 // The Action Id will be added back to the pool for reuse. This is needed because the com
2983 // action is not destroyed (there is no interface for this).
2984 Procedure Destroy
2985 Handle hoCommandBars
2986 Integer iId
2987 Variant vControl
2988
2989 Get piId to iId
2990 // if no com object then this never got activated or another action object is
2991 // used for this (which doesn't really make sense).
2992 If (iId>0) Begin
2993 Get CommandBarSystemObject to hoCommandBars
2994 If (IsComObjectCreated(Self)) Begin
2995 Send DeleteAllControlsForAction
2996 End
2997 Send ReleaseId of hoCommandBars (piId(Self))
2998 End
2999 Forward Send Destroy
3000 End_Procedure
3001
3002 // if the action is being released we must remove it from the action pool. This is needed for
3003 // context menus which whose actions get created and released with each invocation. This will also
3004 // happen when an object is destroyed. If the com object is created, destroy will send ReleaseComObject
3005 Procedure ReleaseComObject
3006 Integer iId
3007 Handle hoCommandBars
3008 Get piId to iId
3009 If (iId>0 and IsComObjectCreated(Self)) Begin
3010 Get CommandBarSystemObject to hoCommandBars
3011 Send RemoveRegisteredAction of hoCommandBars Self
3012 End
3013 Forward Send ReleaseComObject
3014 End_Procedure
3015
3016
3017 // called when this action is selected. Only send OnExecute if the
3018 // action is enabled.
3019 Procedure Execute Variant vCommandBarControl
3020 Boolean bIsEnabled
3021 Variant vObject
3022 Get IsEnabled to bIsEnabled
3023 If bIsEnabled Begin
3024 // we will allow no parameter being passed. In such a case the developer probably sent
3025 // execute themselves and did not pass a com pointer (which you don't normally care about)
3026 // if this happens just pass a null com object to the OnExecute.
3027 If (Num_Arguments=0) Begin
3028 Move (NullComObject()) to vObject
3029 End
3030 Else Begin
3031 Move vCommandBarControl to vObject
3032 End
3033 Send OnExecute vObject
3034 Send Update
3035 End
3036 End_Procedure
3037
3038 // Updates the action. Can be called by timer when active update or
3039 // called when a menu pops up
3040 Procedure Update
3041 Set pbVisible to (IsVisible(Self))
3042 Set pbEnabled to (IsEnabled(Self))
3043 Set pbChecked to (IsChecked(Self))
3044 Send OnUpdate
3045 End_Procedure
3046
3047 // Event called to update the action
3048 { MethodType=Event }
3049 Procedure OnUpdate
3050 End_Procedure
3051
3052 // before this is called IsEnabled is called
3053 { MethodType=Event }
3054 Procedure OnExecute Variant vCommandBarControl
3055 End_Procedure
3056
3057 // when hover over
3058 { MethodType=Event }
3059 Procedure OnSelected Variant vCommandBarControl
3060 End_Procedure
3061
3062 // creation of action.
3063 { MethodType=Event }
3064 Procedure OnCreateAction
3065 End_Procedure
3066
3067 // before called, self and all items IsEnabled, IsChecked and IsVisible are called
3068 { MethodType=Event }
3069 Procedure OnPopupInit Variant vCommandBarControl Handle hoCommandBarControls
3070 End_Procedure
3071
3072 Procedure End_Construct_Object
3073 Integer iID
3074 Handle hoCommandBars
3075 Get piId to iID
3076 // if the ID is 0, auto-assign it.
3077 If (iID=0) Begin
3078 Get CommandBarSystemObject to hoCommandBars
3079 // context menus may not be able to assign an id until they are created.
3080 If (hoCommandBars<>0) Begin
3081 Get AssignId of hoCommandBars to iID
3082 Set piId to iID
3083 End
3084 End
3085 Forward Send End_Construct_Object
3086 End_Procedure
3087
3088
3089End_Class
3090
3091// can be used by all controls. Menu, toolbar and popups.
3092
3093
3094{ DesignerClass = cDTCJMenuItem }
3095Class cCJMenuItem is a cCJAction
3096
3097 Procedure Construct_Object
3098 Forward Send Construct_Object
3099
3100 // note that these properties are design time and initalize time only properties
3101 { EnumList="xtpControlButton, xtpControlPopup, xtpControlButtonPopup, xtpControlSplitButtonPopup, xtpControlComboBox, xtpControlEdit, xtpControlCustom, xtpControlLabel, xtpControlCheckBox, xtpControlGallery, xtpControlRadioButton" }
3102 { Category="Design-Time Control" }
3103 Property Integer peControlType xtpControlButton
3104
3105 { EnumList="xtpButtonAutomatic, xtpButtonCaption, xtpButtonIcon, xtpButtonIconAndCaption, xtpButtonIconAndCaptionBelow, xtpButtonCaptionAndDescription" }
3106 { Category="Design-Time Control" }
3107 Property Integer peControlStyle xtpButtonAutomatic
3108
3109 { Category="Design-Time Control" }
3110 Property Boolean pbControlBeginGroup False
3111 { Category="Design-Time Control" }
3112 Property Boolean pbControlCloseSubMenu True
3113 { Category="Design-Time Control" }
3114 Property Boolean pbControlFlagRightAlign False
3115 { Category="Design-Time Control" }
3116 Property Boolean pbControlFlagLeftPopup False
3117 { Category="Design-Time Control" }
3118 Property Boolean pbControlFlagNoMovable False
3119 { Category="Design-Time Control" }
3120 Property Boolean pbControlFlagControlStretched False
3121 { Category="Design-Time Control" }
3122 Property Boolean pbControlFlagShowPopupBarToolTip False
3123 { Category="Design-Time Control" }
3124 Property Boolean pbControlFlagWrapRow False
3125 { Category="Design-Time Control" }
3126 Property Boolean pbControlDoubleGripper False
3127 { Category="Design-Time Control" }
3128 Property Boolean pbControlPopupToolBar False
3129
3130 { Category="Behavior" }
3131 Property Boolean pbAddToDesignerMenu False
3132
3133 // Used to redirect an action to a different object.
3134 { Category="Behavior" }
3135 Property Integer phoAction Self
3136
3137 { Visibility=Private }
3138 Property Boolean pbInCreateTempInstance False
3139
3140 End_Procedure
3141
3142 // returns true if the control is a popup type - i.e., it will have child menu items. Good for Augmentation
3143 Function IsPopup Returns Boolean
3144 Integer eType
3145 Get peControlType to eType
3146 Function_Return (eType=xtpControlPopup or eType=xtpControlButtonPopup or eType=xtpControlSplitButtonPopup)
3147 End_Function
3148
3149
3150
3151 // must create action and then the visual control
3152 Procedure CreateComInstance Handle hoControls
3153 Variant vNewControl vNewControls vCommandBar
3154 Handle hoNewControl hoNewControls hoCommandBar hoAction hoDesignerControls
3155 Integer iId
3156 Boolean bPopup
3157
3158 Send AssignAction
3159 Get CreateComControl hoControls to vNewControl
3160 If (IsNullComObject(vNewControl)) Begin
3161 Procedure_Return
3162 End
3163
3164 Get piId to iId
3165
3166 Get Create U_cCJCommandBarPopup to hoNewControl
3167 Get Create U_cCJCommandBar to hoCommandbar
3168 Get Create U_cCJCommandBarControls to hoNewControls
3169
3170 Set pvComObject of hoNewControl to vNewControl
3171
3172 Get IsPopup to bPopup
3173 If (bPopup) Begin
3174
3175 Get ComCommandBar of hoNewControl to vCommandBar
3176 Set pvComObject of hoCommandBar to vCommandBar
3177 Get ComControls of hoCommandBar to vNewControls
3178 Set pvComObject of hoNewControls to vNewControls
3179
3180 Broadcast Send CreateComInstance hoNewControls
3181
3182 End
3183
3184 // if add to designer, create another instance of this control and add it to the designer
3185 // controls. This uses the same action as the regular control. We do this after the child controls
3186 // are created so that menus will contain all of their children.
3187 If (pbAddToDesignerMenu(Self)) Begin
3188 Get DesignerControlsCollection to hoDesignerControls
3189 // if a designer control for this action already exists, we will not add it again.
3190 Get ComFind of hoDesignerControls xtpControlError iId Nothing True to vNewControl
3191 If (IsNullComObject(vNewControl)) Begin
3192 Get CreateComControl hoDesignerControls to vNewControl
3193 Set pvComObject of hoNewControl to vNewControl
3194 If (bPopup) Begin
3195 Get ComCommandBar of hoNewControl to vCommandBar
3196 Set pvComObject of hoCommandBar to vCommandBar
3197 Get ComControls of hoCommandBar to vNewControls
3198 Set pvComObject of hoNewControls to vNewControls
3199 // note that it is safe to do this because the actions will not get
3200 // created again. Only the controls will get created.
3201 Broadcast Send CreateComInstance hoNewControls
3202 End
3203 End
3204 End
3205
3206 Send Destroy of hoNewControls
3207 Send Destroy of hoCommandBar
3208 Send Destroy of hoNewControl
3209
3210 End_Procedure
3211
3212 // handle action for this menu-item. If the item is the action, make sure a com instance is created
3213 // if this is not the action, attach to the action which should be created
3214 // lots of assertions if there is a problem
3215 { Visibility=Private }
3216 Procedure AssignAction
3217 Handle hoAction
3218 Integer iId
3219
3220 Get phoAction to hoAction
3221
3222 If not hoAction Begin
3223 Error DFERR_PROGRAM "Assert: action object is not assigned for menu item"
3224 Procedure_Return
3225 End
3226
3227 // If the action object is self (normal) then we create an action com object if needed.
3228 // it is possible that the action will already be created. If so, do nothing.
3229 If (hoAction=Self) Begin
3230 If not (IsComObjectCreated(Self)) Begin
3231 Send CreateComAction
3232 End
3233 Get piId to iId
3234 End
3235 // if the action is some other object, we will assume it has already been created and just assign
3236 // its id.
3237 Else Begin
3238 Get piId of hoAction to iId
3239 Set piId to iId
3240 End
3241
3242 If (iId=0) Begin
3243 Error DFERR_PROGRAM "Assert: Action ID is zero"
3244 Procedure_Return
3245 End
3246
3247 If not (IsComObjectCreated(hoAction)) Begin
3248 Error DFERR_PROGRAM "Assert: Action com object not created"
3249 Procedure_Return
3250 End
3251 End_Procedure
3252
3253 Function AddDynamicControl Handle hoControls Returns Variant
3254 Variant vNewControl vCommandBar vNewControls
3255 Boolean bOldTemp bPopup
3256 Handle hoNewControl hoCommandBar hoNewControls
3257
3258 Get pbInCreateTempInstance to bOldTemp
3259 Set pbInCreateTempInstance to True
3260
3261 Send AssignAction
3262 Get CreateComControl hoControls to vNewControl // if null, an assertion will be declared
3263
3264 Get IsPopup to bPopup
3265 If (bPopup) Begin
3266
3267 Get Create U_cCJCommandBarPopup to hoNewControl
3268 Get Create U_cCJCommandBar to hoCommandbar
3269 Get Create U_cCJCommandBarControls to hoNewControls
3270
3271 Set pvComObject of hoNewControl to vNewControl
3272
3273 Get ComCommandBar of hoNewControl to vCommandBar
3274 Set pvComObject of hoCommandBar to vCommandBar
3275 Get ComControls of hoCommandBar to vNewControls
3276 Set pvComObject of hoNewControls to vNewControls
3277
3278 Broadcast Send CreateComInstance hoNewControls
3279
3280 Send Destroy of hoNewControls
3281 Send Destroy of hoCommandBar
3282 Send Destroy of hoNewControl
3283
3284 End
3285
3286
3287 Set pbInCreateTempInstance to bOldTemp
3288
3289 Function_Return vNewControl
3290 End_Function
3291
3292 // used to actually create the desired control and add it to the passed commandbars
3293 Function CreateCommandBarControl Handle hoControls Integer eType Integer iId Boolean bInCreateTempInstance Returns Variant
3294 Variant vControl
3295 Get ComAdd of hoControls eType iId "" Nothing bInCreateTempInstance to vControl
3296 Function_Return vControl
3297 End_Function
3298
3299 // create the menu item control. Return a DataFlex object for this control
3300 // This assumes that an action ID exiss and that a com action object is created.
3301
3302 Function CreateComControl Handle hoControls Returns Variant
3303 Handle hoObj hoCommandBar hoCommandBars
3304 Variant vControl vCommandbar
3305 Integer iId eType eStyle eFlags iClass
3306 Boolean bPopup bBegin bClose bDoubleGripper bPopupToolBar
3307 Boolean bFlagStretch bFlagLeftPopup bFlagNoMove bFlagRightAlign bFlagShowTip bFlagWrap
3308 Boolean bInCreateTempInstance
3309
3310
3311 Get pbInCreateTempInstance to bInCreateTempInstance
3312
3313 Get piId to iId
3314 Get peControlType to eType
3315 Get peControlStyle to eStyle
3316 Get pbControlBeginGroup to bBegin
3317 Get pbControlCloseSubMenu to bClose
3318 Get pbControlFlagControlStretched to bFlagStretch
3319 Get pbControlFlagLeftPopup to bFlagLeftPopup
3320 Get pbControlFlagNoMovable to bFlagNoMove
3321 Get pbControlFlagRightAlign to bFlagRightAlign
3322 Get pbControlFlagShowPopupBarToolTip to bFlagShowTip
3323 Get pbControlDoubleGripper to bDoubleGripper
3324 Get pbControlPopupToolBar to bPopupToolBar
3325 Get pbControlFlagWrapRow to bFlagWrap
3326 // assemble the COMFlags from the flag properties.
3327 Move (If(bFlagStretch,xtpFlagControlStretched,0) + ;
3328 If(bFlagLeftPopup,xtpFlagLeftPopup,0) +;
3329 If(bFlagNoMove,xtpFlagNoMovable,0) +;
3330 If(bFlagRightAlign,xtpFlagRightAlign,0) +;
3331 If(bFlagShowTip,xtpFlagShowPopupBarTip,0) +;
3332 If(bFlagWrap,xtpFlagWrapRow,0) ) to eFlags
3333
3334 Get CreateCommandBarControl hoControls eType iId bInCreateTempInstance to vControl
3335
3336 If (IsNullComObject(vControl)) Begin
3337 Error DFERR_PROGRAM ("Assert: could not create com control: Type" - String(eType) - ", iId=" - String(iId))
3338 Function_Return vControl
3339 End
3340
3341 Get IsPopup to bPopup
3342 Get ClassForControlType eType to iClass
3343 Get Create iClass to hoObj
3344 Set pvComObject of hoObj to vControl
3345 Set ComStyle of hoObj to eStyle
3346 Set ComBeginGroup of hoObj to bBegin
3347 Set ComCloseSubMenuOnClick of hoObj to bClose
3348 Set ComFlags of hoObj to eFlags
3349
3350 If bPopup Begin
3351 Get Create U_cCJCommandBar to hoCommandbar
3352 Get ComCommandBar of hoObj to vCommandBar
3353
3354 // it appears that it is possible to have a popup that does not get assigned
3355 // a commandbar. If that happens we will add a commandbar to the control
3356 // the hard way.
3357 If (IsNullComObject(vCommandbar)) Begin
3358 Get CommandBarSystemObject to hoCommandBars
3359 Get ComAdd of hoCommandBars "Popup" xtpBarPopup to vCommandBar
3360 Set ComCommandBar of hoObj to vCommandBar
3361 End
3362
3363 Set pvComObject of hoCommandBar to vCommandBar
3364
3365 If (bDoubleGripper) Begin
3366 Set ComDoubleGripper of hoCommandBar to True
3367 End
3368 If (bPopupToolBar) Begin
3369 Send ComSetPopupToolBar of hoCommandBar True
3370 End
3371
3372 Send Destroy of hoCommandBar
3373 End
3374
3375 Send OnCreateControl hoObj
3376
3377 Send destroy of hoObj
3378
3379 Function_Return vControl
3380
3381 End_Function
3382
3383 { MethodType=Event }
3384 Procedure OnCreateControl Handle hoObj
3385 End_Procedure
3386
3387End_Class
3388
3389{ OverrideProperty=Delegation_Mode DesignTime=False }
3390{ OverrideProperty=peAutoCreate DesignTime=False }
3391{ OverrideProperty=peNeighborhood DesignTime=False }
3392{ OverrideProperty=psLicenseKey DesignTime=False }
3393{ OverrideProperty=psProgId DesignTime=False }
3394{ OverrideProperty=peNeighborhood InitialValue=nhNo }
3395
3396{ DesignerClass = cDTCJStatusBar }
3397Class cCJStatusBar is a cCJComStatusBar
3398
3399 Procedure Construct_Object
3400 Boolean bMDI
3401 Handle hoCommandBars
3402 Forward Send Construct_Object
3403
3404 { Visibility=Private }
3405 Property Boolean pbPrivateDrawDisabledText True
3406 { Visibility=Private }
3407 Property String psPrivateIdleText ''
3408 { Visibility=Private }
3409 Property Boolean pbPrivateVisible True
3410
3411 { Visibility=Private }
3412 Property Integer piStatusBarId ID_StatusBarsAutoStart
3413
3414 { Category="Behavior" }
3415 Property Integer phoViewPane 0
3416
3417 Set peNeighborhood to nhNo
3418
3419
3420 End_Procedure
3421
3422 { MethodType=Property InitialValue=True }
3423 { Category="Behavior" }
3424 Procedure Set pbDrawDisabledText Boolean bValue
3425 Set pbPrivateDrawDisabledText to bValue
3426 If (IsComObjectCreated(Self)) Begin
3427 Set ComDrawDisabledText to bValue
3428 End
3429 End_Procedure
3430
3431 { MethodType=Property }
3432 Function pbDrawDisabledText Returns Boolean
3433 Boolean bValue
3434 If (IsComObjectCreated(Self)) Begin
3435 Get ComDrawDisabledText to bValue
3436 End
3437 Else Begin
3438 Get pbPrivateDrawDisabledText to bValue
3439 End
3440 Function_Return bValue
3441 End_Function
3442
3443 { MethodType=Property InitialValue=True }
3444 { Category="Behavior" }
3445 Procedure Set pbVisible Boolean bValue
3446 Set pbPrivateVisible to bValue
3447 If (IsComObjectCreated(Self)) Begin
3448 Set ComVisible to bValue
3449 End
3450 End_Procedure
3451
3452 { MethodType=Property }
3453 Function pbVisible Returns Boolean
3454 Boolean bValue
3455 // for some reason visible state of statusbar is set false when
3456 // commandbarsystem is not active. So we also check active_state
3457 If (IsComObjectCreated(Self) and Active_State(Self)) Begin
3458 Get ComVisible to bValue
3459 End
3460 Else Begin
3461 Get pbPrivateVisible to bValue
3462 End
3463 Function_Return bValue
3464 End_Function
3465
3466 { MethodType=Property InitialValue="" }
3467 { Category="Behavior" }
3468 Procedure Set psIdleText String sValue
3469 Set psPrivateIdleText to sValue
3470 If (IsComObjectCreated(Self)) Begin
3471 Set ComIdleText to sValue
3472 End
3473 End_Procedure
3474
3475 { MethodType=Property }
3476 Function psIdleText Returns String
3477 String sValue
3478 If (IsComObjectCreated(Self)) Begin
3479 Get ComIdleText to sValue
3480 End
3481 Else Begin
3482 Get psPrivateIdleText to sValue
3483 End
3484 Function_Return sValue
3485 End_Function
3486
3487
3488 Procedure CreateComInstance
3489 Handle hoCommandBars
3490 Variant vStatusBar
3491 String sTitle
3492 Integer iBarId iWidth iDockFgs
3493 Boolean bDrawDisabledText bVisible bMDI
3494 String sIdleText
3495
3496 // if already created, we don't do anything. This could happen during
3497 // a restore
3498 If (IsComObjectCreated(Self)) Begin
3499 Procedure_Return
3500 End
3501
3502 Get CommandBarSystemObject to hoCommandBars
3503
3504 // if this is an MDI command bar, we will define this as the main Status bar
3505 Get pbMDIMenu of hoCommandBars to bMDI
3506 If bMDI Begin
3507 Set Statusbar_Id to Self
3508 End
3509 Set phoStatusBar of hoCommandBars to Self
3510
3511 Get pbPrivateDrawDisabledText to bDrawDisabledText
3512 Get pbPrivateVisible to bVisible
3513 Get psPrivateIdleText to sIdleText
3514 Get ComStatusBar of hoCommandBars to vStatusBar
3515 Set pvComObject to vStatusBar
3516 Set ComDrawDisabledText to bDrawDisabledText
3517 Set ComVisible to bVisible
3518 Set ComIdleText to sIdleText
3519
3520 Send OnCreate
3521
3522 Broadcast Send CreateComInstance Self
3523
3524 End_Procedure
3525
3526 // display "main" status help. Usually provided from DD.
3527 Procedure Show_Status_Help String sStatusHelp
3528 Set psIdleText to sStatusHelp
3529 End_Procedure
3530
3531 // show the view name in the pane if a phoViewPane exists
3532 Procedure Show_View_Name String sName
3533 Handle hoPane
3534 Get phoViewPane to hoPane
3535 If (hoPane) Begin
3536 Set psText of hoPane to sName
3537 End
3538 End_Procedure
3539
3540 // legacy from old status bar
3541 { Visibility=Private }
3542 Procedure Exit_Menu
3543 End_Procedure
3544
3545 // returns an array of all pane objects (these are the DF objects, if additional COM panes were
3546 // created they are not here)
3547 Function PaneObjects Returns Handle[]
3548 Handle[] hoPanes
3549 Broadcast Send RegisterStatusPaneObject (&hoPanes)
3550 Function_Return hoPanes
3551 End_Function
3552
3553 // Find the DF object for the passed COM object. Returns 0 if none found
3554 Function FindPaneObject Variant vPane Returns Handle
3555 Handle hoPane
3556 Handle[] hoPanes
3557 Integer i iPanes iId
3558 Get Create U_cCJComStatusBarPane to hoPane
3559 Set pvComObject of hoPane to vPane
3560 Get ComId of hoPane to iId
3561 Send destroy of hoPane
3562 Get PaneObjects to hoPanes // get all df pane objects
3563 Move (SizeOfArray(hoPanes)) to iPanes
3564 For i from 0 to (iPanes-1)
3565 If (iId=piId(hoPanes[i])) Begin // search for DF object with same ID as com object
3566 Function_Return hoPanes[i]
3567 End
3568 Loop
3569 Function_Return 0
3570 End_Function
3571
3572 // this returns the width, in pixels, needed to display a string.
3573 { Visibility=Private }
3574 Function PaneTextWidth String sText Returns Integer
3575 Handle hWnd hDC
3576 Integer cx bOK
3577 Pointer lpsText lpsPoint
3578 String sPoint
3579
3580 Get Window_Handle to hWnd
3581 Move (GetDC(hWnd)) to hDC
3582
3583 ZeroType tPoint to sPoint
3584 GetAddress of sPoint to lpsPoint
3585 GetAddress of sText to lpsText
3586
3587 Move (GetTextExtent(hDC, lpsText, length(sText), lpsPoint)) to bOk
3588
3589 Move (ReleaseDC(hWnd, hDC)) to hDC
3590
3591 GetBuff from sPoint At tPoint.x to cx
3592
3593 Function_Return cx
3594 End_Function
3595
3596 { Visibility=Private }
3597 Procedure Update
3598 Send OnUpdate
3599 End_Procedure
3600
3601 { MethodType=Event }
3602 Procedure OnUpdate
3603 End_Procedure
3604
3605 { MethodType=Event }
3606 Procedure OnCreate
3607 End_Procedure
3608
3609 { MethodType=Event }
3610 Procedure OnComPaneClick Variant llPane
3611 Handle hoPane
3612 Get FindPaneObject llPane to hoPane
3613 If hoPane Begin
3614 Send onClick of hoPane
3615 End
3616 End_Procedure
3617
3618 { MethodType=Event }
3619 Procedure OnComPaneDblClick Variant llPane
3620 Handle hoPane
3621 Get FindPaneObject llPane to hoPane
3622 If hoPane Begin
3623 Send onDblClick of hoPane
3624 End
3625 End_Procedure
3626
3627End_Class
3628
3629{ OverrideProperty=Delegation_Mode DesignTime=False }
3630{ OverrideProperty=peAutoCreate DesignTime=False }
3631{ OverrideProperty=peNeighborhood DesignTime=False }
3632{ OverrideProperty=psLicenseKey DesignTime=False }
3633{ OverrideProperty=psProgId DesignTime=False }
3634{ OverrideProperty=peNeighborhood InitialValue=nhNo }
3635
3636{ DesignerClass = cDTCJStatusBarPane }
3637Class cCJStatusBarPane is a cCJComStatusBarPane
3638
3639 Procedure Construct_Object
3640 Forward Send Construct_Object
3641 { Visibility=Private}
3642 Property Integer pePrivateAlignment xtpAlignmentLeft
3643 { Visibility=Private}
3644 Property Integer piPrivateBackGroundColor clNone
3645 { Visibility=Private}
3646 Property Integer piPrivateTextColor clNone
3647 { Visibility=Private}
3648 Property String psPrivateText ''
3649 { Visibility=Private}
3650 Property String psPrivateTooltip ''
3651 { Visibility=Private}
3652 Property Boolean pbPrivateVisible True
3653 { Visibility=Private}
3654 Property Integer piPrivateWidth 0
3655 { Visibility=Private}
3656 Property Integer pbPrivateStyleNoBorders False
3657 { Visibility=Private}
3658 Property Integer pbPrivateStyleDisabled False
3659 { Visibility=Private}
3660 Property Integer pbPrivateStyleStretch False
3661 { Visibility=Private}
3662 Property Integer piPrivateIconId 0
3663
3664 { Category="Image" }
3665 { PropertyType=Image }
3666 Property String psImage ''
3667
3668 { Category="Behavior" }
3669 { EnumList="sbpIDAutoAssign, sbpIDIdlePane, sbpIDCapslock, sbpIDNumLock, sbpIDScrollLock" }
3670 Property Integer piId sbpIDAutoAssign
3671
3672 Set peNeighborhood to nhNo
3673 End_Procedure
3674
3675 { MethodType=Property InitialValue=True }
3676 { Category="Behavior" }
3677 Procedure Set pbVisible Boolean bValue
3678 Set pbPrivateVisible to bValue
3679 If (IsComObjectCreated(Self)) Begin
3680 Set ComVisible to bValue
3681 End
3682 End_Procedure
3683
3684 { MethodType=Property }
3685 Function pbVisible Returns Boolean
3686 Boolean bValue
3687 If (IsComObjectCreated(Self)) Begin
3688 Get ComVisible to bValue
3689 End
3690 Else Begin
3691 Get pbPrivateVisible to bValue
3692 End
3693 Function_Return bValue
3694 End_Function
3695
3696 { MethodType=Property InitialValue=clNone PropertyType=Color }
3697 { Category="Appearance" }
3698 { EnumList="clNone,clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
3699 Procedure Set piBackgroundColor Integer iValue
3700 Set piPrivateBackgroundColor to iValue
3701 If (IsComObjectCreated(Self)) Begin
3702 Set ComBackgroundColor to iValue
3703 End
3704 End_Procedure
3705
3706 { MethodType=Property }
3707 Function piBackgroundColor Returns Integer
3708 Integer iValue
3709 If (IsComObjectCreated(Self)) Begin
3710 Get ComBackgroundColor to iValue
3711 End
3712 Else Begin
3713 Get piPrivateBackgroundColor to iValue
3714 End
3715 Function_Return iValue
3716 End_Function
3717
3718 { MethodType=Property InitialValue=clNone PropertyType=Color }
3719 { Category="Appearance" }
3720 { EnumList="clNone,clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
3721 Procedure Set piTextColor Integer iValue
3722 Set piPrivateTextColor to iValue
3723 If (IsComObjectCreated(Self)) Begin
3724 Set ComTextColor to iValue
3725 End
3726 End_Procedure
3727
3728 { MethodType=Property }
3729 Function piTextColor Returns Integer
3730 Integer iValue
3731 If (IsComObjectCreated(Self)) Begin
3732 Get ComTextColor to iValue
3733 End
3734 Else Begin
3735 Get piPrivateTextColor to iValue
3736 End
3737 Function_Return iValue
3738 End_Function
3739
3740 { MethodType=Property InitialValue=0 }
3741 { Category="Appearance" }
3742 Procedure Set piWidth Integer iValue
3743 Set piPrivateWidth to iValue
3744 If (IsComObjectCreated(Self)) Begin
3745 Set ComWidth to iValue
3746 End
3747 End_Procedure
3748
3749 { MethodType=Property }
3750 Function piWidth Returns Integer
3751 Integer iValue
3752 If (IsComObjectCreated(Self)) Begin
3753 Get ComWidth to iValue
3754 End
3755 Else Begin
3756 Get piPrivateWidth to iValue
3757 End
3758 Function_Return iValue
3759 End_Function
3760
3761 { EnumList="xtpAlignmentLeft, xtpAlignmentCenter, xtpAlignmentRight" }
3762 { MethodType=Property InitialValue=xtpAlignmentLeft }
3763 { Category="Appearance" }
3764 Procedure Set peAlignment Integer eValue
3765 Set pePrivateAlignment to eValue
3766 If (IsComObjectCreated(Self)) Begin
3767 Set ComAlignment to eValue
3768 End
3769 End_Procedure
3770
3771 { MethodType=Property }
3772 Function peAlignment Returns Integer
3773 Integer eValue
3774 If (IsComObjectCreated(Self)) Begin
3775 Get ComAlignment to eValue
3776 End
3777 Else Begin
3778 Get pePrivateAlignment to eValue
3779 End
3780 Function_Return eValue
3781 End_Function
3782
3783 { Visibility=Private }
3784 Procedure SetPaneStyle Integer iMask Boolean bValue Handle hmMessage
3785 Integer eValue
3786 Set hmMessage to bValue
3787 If (IsComObjectCreated(Self)) Begin
3788 Set ComStyle to eValue
3789 If (bValue) Begin
3790 Move (AddBitValue(iMask,eValue)) to eValue
3791 End
3792 Else Begin
3793 Move (RemoveBitValue(iMask,eValue)) to eValue
3794 End
3795 Set ComStyle to eValue
3796 End
3797 End_Procedure
3798
3799 { Visibility=Private }
3800 Function GetPaneStyle Integer iMask Handle hmMessage Returns Boolean
3801 Integer eValue
3802 Boolean bValue
3803 If (IsComObjectCreated(Self)) Begin
3804 Get ComStyle to eValue
3805 Move (eValue iand iMask) to bValue
3806 End
3807 Else Begin
3808 Get hmMessage to bValue
3809 End
3810 Function_Return bValue
3811 End_Function
3812
3813 { MethodType=Property InitialValue=False }
3814 { Category="Appearance" }
3815 Procedure Set pbStyleNoBorders Boolean bValue
3816 Send SetPaneStyle SBPS_NOBORDERS bValue set_pbPrivateStyleNoBorders
3817 End_Procedure
3818
3819 { MethodType=Property }
3820 Function pbStyleNoBorders Returns Boolean
3821 Boolean bValue
3822 Get GetPaneStyle SBPS_NOBORDERS get_pbPrivateStyleNoBorders to bValue
3823 Function_Return bValue
3824 End_Function
3825
3826 { MethodType=Property InitialValue=False }
3827 { Category="Appearance" }
3828 Procedure Set pbStyleDisabled Boolean bValue
3829 Send SetPaneStyle SBPS_DISABLED bValue set_pbPrivateStyleDisabled
3830 End_Procedure
3831
3832 { MethodType=Property }
3833 Function pbStyleDisabled Returns Boolean
3834 Boolean bValue
3835 Get GetPaneStyle SBPS_DISABLED get_pbPrivateStyleDisabled to bValue
3836 Function_Return bValue
3837 End_Function
3838
3839 { MethodType=Property InitialValue=False }
3840 { Category="Appearance" }
3841 Procedure Set pbStyleStretch Boolean bValue
3842 Send SetPaneStyle SBPS_STRETCH bValue Set_pbPrivateStyleStretch
3843 End_Procedure
3844
3845 { MethodType=Property }
3846 Function pbStyleStretch Returns Boolean
3847 Boolean bValue
3848 Get GetPaneStyle SBPS_STRETCH get_pbPrivateStyleStretch to bValue
3849 Function_Return bValue
3850 End_Function
3851
3852
3853 { MethodType=Property InitialValue="" }
3854 { Category="Appearance" }
3855 Procedure Set psText String sValue
3856 Set psPrivateText to sValue
3857 If (IsComObjectCreated(Self)) Begin
3858 Set ComText to sValue
3859 End
3860 End_Procedure
3861
3862 { MethodType=Property }
3863 Function psText Returns String
3864 String sValue
3865 If (IsComObjectCreated(Self)) Begin
3866 Get ComText to sValue
3867 End
3868 Else Begin
3869 Get psPrivateText to sValue
3870 End
3871 Function_Return sValue
3872 End_Function
3873
3874 { MethodType=Property InitialValue="" }
3875 { Category="Appearance" }
3876 Procedure Set psToolTip String sValue
3877 Set psPrivateToolTip to sValue
3878 If (IsComObjectCreated(Self)) Begin
3879 Set ComToolTip to sValue
3880 End
3881 End_Procedure
3882
3883 { MethodType=Property }
3884 Function psToolTip Returns String
3885 String sValue
3886 If (IsComObjectCreated(Self)) Begin
3887 Get ComToolTip to sValue
3888 End
3889 Else Begin
3890 Get psPrivateToolTip to sValue
3891 End
3892 Function_Return sValue
3893 End_Function
3894
3895 // normally this is zero and not changed. When zero the imageId used will be
3896 // the statusbarId and this is the ID that is used when the psImage method is used.
3897 // Using psImage is preferred as it adds the icon and assigns it to the object.
3898 // This can be used to change icons. Note 0=use StatusbarId
3899 { MethodType=Property InitialValue=0 }
3900 { Category="Image" }
3901 Procedure Set piIconId Integer iValue
3902 Set piPrivateIconId to iValue
3903 If (IsComObjectCreated(Self)) Begin
3904 Set ComIconIndex to iValue
3905 End
3906 End_Procedure
3907
3908 { MethodType=Property }
3909 Function piIconId Returns Integer
3910 Integer iValue
3911 If (IsComObjectCreated(Self)) Begin
3912 Get ComIconIndex to iValue
3913 End
3914 Else Begin
3915 Get piPrivateIconId to iValue
3916 End
3917 Function_Return iValue
3918 End_Function
3919
3920 { Visibility=Private }
3921 Procedure CreateComInstance Handle hoStatusBar
3922 Variant vStatusBarPane
3923 String sImage sText sToolTip
3924 Integer iWidth eAlignment eStyle iBackGroundColor iTextColor iId iIconId iNewIconid
3925 Boolean bVisible bOk bStyleStretch bStyleDisabled bStyleNoBorders
3926 Handle hoCommandBars
3927
3928 Get CommandBarSystemObject to hoCommandBars
3929
3930 Get pePrivateAlignment to eAlignment
3931 Get pbPrivateVisible to bVisible
3932 Get psPrivateText to sText
3933 Get psPrivateTooltip to sToolTip
3934 Get piPrivateBackGroundColor to iBackGroundColor
3935 Get piPrivateTextColor to iTextColor
3936 Get psImage to sImage
3937 Get piPrivateWidth to iWidth
3938 Get pbPrivateStyleStretch to bStyleStretch
3939 Get pbPrivateStyleNoBorders to bStyleNoBorders
3940 Get pbPrivateStyleDisabled to bStyleDisabled
3941 Get piPrivateIconId to iIconId
3942
3943 Get piId to iId
3944
3945 // this check is added because a duplicate ID throws an exception error
3946 Get ComFindPane of hoStatusBar iId to vStatusBarPane
3947 If (not(IsNullComObject(vStatusBarPane))) Begin
3948 Error DFERR_PROGRAM ("Cannot add status pane. Duplicate Id (" - String(iId) - ")")
3949 Procedure_Return
3950 End
3951
3952 Get ComAddPane of hoStatusBar iId to vStatusBarPane
3953 Set pvComObject to vStatusBarPane
3954 Set ComAlignment to eAlignment
3955 If (sText<>"") Begin
3956 Set ComText to sText
3957 End
3958 Set ComToolTip to sToolTip
3959 If (iBackGroundColor<>clNone) Begin
3960 Set ComBackgroundColor to iBackGroundColor
3961 End
3962 If (iTextColor<>clNone) Begin
3963 Set ComTextColor to iTextColor
3964 End
3965
3966 Move (If(bStyleDisabled,SBPS_DISABLED,0) + ;
3967 If(bStyleNoBorders,SBPS_NOBORDERS,0) + ;
3968 If(bStyleStretch,SBPS_STRETCH,0)) to eStyle
3969 Set ComStyle to eStyle
3970
3971 If (sImage<>"") Begin
3972 Get AddImage of hoCommandBars sImage iId xtpImageNormal to iNewIconid
3973 Set ComIconIndex to iId
3974 End
3975 If (iIconId<>0) Begin
3976 Set ComIconIndex to iIconId
3977 End
3978
3979 Set ComVisible to bVisible
3980 Set ComWidth to iWidth
3981
3982 Send OnCreate
3983
3984 End_Procedure
3985
3986 { Visibility=Private }
3987 Procedure RegisterStatusPaneObject Handle[] ByRef hoPanes
3988 Move Self to hoPanes[SizeOfArray(hoPanes)]
3989 End_Procedure
3990
3991 // auto assign an Id for the status bar. Called in end_construct_object if needed
3992 { Visibility=Private }
3993 Function AssignStatusBarID Returns Integer
3994 Integer iId
3995 Get piStatusBarId to iId
3996 Set piStatusBarId to (iId + 1)
3997 Function_Return iId
3998 End_Function
3999
4000 { MethodType=Event }
4001 Procedure OnCreate
4002 End_Procedure
4003
4004 { MethodType=Event }
4005 Procedure OnClick
4006 End_Procedure
4007
4008 { MethodType=Event }
4009 Procedure OnDblClick
4010 End_Procedure
4011
4012 Procedure End_Construct_Object
4013 Integer iID
4014 Get piId to iID
4015 If (iID=sbpIDAutoAssign) Begin
4016 Get AssignStatusBarID to iID
4017 Set piId to iID
4018 End
4019 Forward Send End_Construct_Object
4020 End_Procedure
4021
4022
4023
4024End_Class
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040