Module Dftab_mx.pkg
1//************************************************************************
2// Confidential Trade Secret.
3// Copyright (c) 1997 Data Access Corporation, Miami Florida
4// as an unpublished work. All rights reserved.
5// DataFlex is a registered trademark of Data Access Corporation.
6//
7//************************************************************************
8//************************************************************************
9//
10// $File name : Dftab_mx.pkg
11// $File title : Tab mixin support for tab page and tab dialog
12// Notice :
13// $Author(s) : John Tuohy
14//
15// $Rev History
16//
17// 1/28/98 JJT Added rgb color support
18// JJT 9/4/97 Removed kEnter on_key. This is now handled by container panel.
19// JJT ??/??/9? File created
20//************************************************************************
21//
22// DfTab_mx.pkg - tab dialog mixin class and non deo tab dialog classes
23//
24// Defines:
25//
26// Tab_Dialog_Mixin is a Mixin // mixin for tab dialog
27// Tab_page_Mixin is a Mixin // mixin for tab page
28//
29// Skip_Button_Mode = 0 SBM_NEVER
30// = 1 SBM_ALWAYS
31// = 2 SBM_SMART ** dflt
32//
33// Pointer_Only_State = T/F ** F = dflt
34//
35// Events: Events can be keyboard or Mouse events
36//
37// t->t - Tab button to tab button navigation
38// o->ot - Non-tab to tab w/ old page navigation
39// o->nt - Non-tab to tab w/ new page navigation
40//
41// Mouse Kbd
42// t->t o->ot o->nt t->t o->ot o->nt
43// +------------------------------------------------+
44// skp=always /p=F ¦ B ¦ B ¦ B ¦¦ D ¦ D ¦ D ¦
45// +-------+-------+-------++-------+-------+-------¦
46// skp=always /p=t ¦ (D) ¦ D ¦ D ¦¦ (D) ¦ D ¦ D ¦
47// +-------+-------+-------++-------+-------+-------¦
48// skp=never /p=F ¦ B ¦ B ¦ B ¦¦ B ¦ B ¦ B ¦
49// +-------+-------+-------++-------+-------+-------¦
50// skp=never /p=T ¦ (D) ¦ D ¦ D ¦¦ (B) ¦ B ¦ B ¦
51// +-------+-------+-------++-------+-------+-------¦
52// skp=smart /P=F ¦ B ¦ B ¦ D ¦¦ B ¦ B ¦ D ¦
53// +-------+-------+-------++-------+-------+-------¦
54// skp=smart /P=T ¦ (B) ¦ D ¦ D ¦¦ (B) ¦ D ¦ D ¦
55// +------------------------------------------------+
56//
57// Use Windows
58//
59//
60// Dftab_mx.pkg - tab dialog mixin class and non deo tab dialog classes
61
62Use VDFBase.pkg
63Use cImageList.pkg // provide image-list support for tabpages
64
65
66
67//
68// Defines:
69// Tab_Dialog_Mixin is a Mixin // mixin for tab dialog
70// Tab_page_Mixin is a Mixin // mixin for tab page
71
72Type tTcItem
73 Field tTcItem.mask as dword
74 Field tTcItem.lpReserved1 as dword
75 Field tTcItem.lpReserved2 as dword
76 Field tTcItem.pszText as Pointer
77 Field tTcItem.cchTextMax as Dword
78 Field tTcItem.iImage as Dword
79 Field tTcItem.lParam as Dword
80End_Type
81
82
83DEFINE RM_None for 0
84DEFINE RM_Ring for 1
85DEFINE RM_Rotate_in_Ring for 2
86DEFINE RM_Rotate for 3
87
88Define SBM_NEVER for 0
89Define SBM_ALWAYS for 1
90Define SBM_SMART for 2
91
92Enum_List
93 Define twRaggedRight
94 Define twRightJustify
95 Define twFixedWidth
96End_Enum_List
97
98Enum_List //Tab Position (peTabPosition)
99 Define tpTop
100 Define tpBottom
101End_Enum_List
102
103Enum_List // Tab Styles (peTabStyle)
104 Define tsTabs
105 Define tsButtons
106 Define tsFlatButtons
107End_Enum_List
108
109
110Register_Function pointer_only_state returns integer
111Register_Function Skip_Button_Mode returns integer
112Register_function private_pbHighlightTab returns integer
113
114Class Tab_Dialog_Mixin IS A Mixin
115 { Visibility=Private }
116 Procedure Define_Tab_dialog_Mixin
117
118 set auto_top_item_state to 0 // don't change - keeps tab buttons
119 // from resetting to 0 each time they
120 // activated
121
122 { Category=Behavior }
123 Property Integer Default_Tab 0 // tab to start/return to. -1 means no default
124
125 // How to handle keyboard navigation
126 // SBM_NEVER = don't skip tab in kbd navigation
127 // SBM_ALWAYS = skip tab in kbd navigation.
128 // SBM_SMART = Use windows logic. If not on a tab and the page is
129 // changed go to page else goto tab
130 //
131 { EnumList="SBM_Never, SBM_Always, SBM_Smart" }
132 { Category=Behavior }
133 Property Integer Skip_Button_Mode SBM_Smart
134
135 // If Skip_Button is NOT smart this determines if mouse navigation
136 // always give the tab the focus or never gives it the focus. If
137 // smart, use same logic as above
138 { Category=Behavior }
139 { PropertyType=Boolean }
140 Property Integer Pointer_Only_State False
141
142 // tab pages use this as their default rotate mode
143 { EnumList="RM_None, RM_Ring, RM_Rotate_in_Ring, RM_Rotate" }
144 { Category=Behavior }
145 Property Integer Rotate_Mode RM_None
146
147 { Visibility=Private }
148 Property Integer In_Tab_Change_State False
149
150 // setting this to true will make your tab pages work like they did in VDF6. When a page
151 // is hidden, it will be removed from the focus tree. Only do this if you need to to get
152 // an old app working properly.
153 { Obsolete=True Visibility=Private }
154 Property Integer pbDeactivatePages False
155
156 // this is used by tab pages to determine sizes for anchoring. It is used in conjunction
157 // with piLastClientSize in the tab page
158 { Visibility=Private }
159 Property Integer piOriginalClientSize -1
160
161 // If entering via next navigation should we move to the Default_Tab tab page
162 { Category=Behavior }
163 { PropertyType=Boolean }
164 Property Integer pbResetPageOnActivate False
165
166 { Visibility=Private }
167 Property Integer Private.MultiLine_State False
168
169 { Visibility=Private }
170 Property Integer Private.TabWidth_Mode twRaggedRight
171
172 { Visibility=Private }
173 Property Integer private_peTabPosition tpTop
174
175 { Visibility=Private }
176 Property Integer private_peTabStyle tsTabs
177
178 { Visibility=Private }
179 Property Integer private_pbFlatSeparators False
180
181 { Category=Appearance }
182 { PropertyType=Boolean }
183 Property Integer pbHotTrack True // design-time only
184 { Category=Appearance }
185 Property Integer phoImageList // should be set to a cImageList instance to display images on tab-page labels. Design-time only
186
187 // Property integer Current_Tab -1
188 On_Key KLeftArrow Send request_Previous_Tab PRIVATE
189 On_Key KRightArrow Send request_next_tab PRIVATE
190
191 On_Key Key_Ctrl+Key_TAB Send Request_Next_Tab
192
193 // Should not be needed....but for now
194 On_Key KUpArrow Send None PRIVATE
195 On_Key KDownArrow Send None PRIVATE
196 End_Procedure
197
198 // This is a risky thing to do. Some of the packages (server.pkg) use
199 // client_area_state to figure out if the object is a client or a form.
200 // In order for internal activation of the tab items to work the real
201 // internal property client_area_state must be false. However, the
202 // external package standpoint client_area_state must be true. This seems
203 // to work because the internal client decisions (which uses the real
204 // client_area_state property) uses the internal property (it does not
205 // get the property by putting the message in the df message queue.
206 { Visibility=Private }
207 Function Client_Area_State returns integer
208 function_return 1
209 End_Function // Client_area_state
210
211 // Must Cancel. Values Are The Tab Items
212 { MethodType=Property Visibility=Private NoDoc=True }
213 Procedure Set Label String Val
214 End_Procedure
215
216 { MethodType=Event }
217 Procedure OnResize
218 End_Procedure
219
220 { Visibility=Private MethodType=Property }
221 Procedure Set GuiSize Integer cy Integer cx
222 Integer cxy iPage
223 Get GuiSize To cxy
224 Forward Set GuiSize to cy cx
225 If (BuildingObjectId=0 and Window_Handle(self) and ( Hi(cxy)<>cy or Low(cxy)<>cx) ) Begin
226 For iPage From 0 To (Item_Count(Self) -1)
227 Send Auto_Page (Aux_Value(self, iPage))
228 Loop
229
230 Send OnResize
231 End
232 End_Procedure
233
234 { Visibility=Private }
235 Procedure private_DoUpdateTabs
236 Integer iPage hoPage
237 If (phoImageList(self)) Send Windows_Message TCM_SetImageList 0 (phImageList(phoImageList(self)))
238
239 For iPage From 0 To (Item_Count(self) -1)
240 Get Tab_Page_Id iPage To hoPage
241 Send private_DoSetImage of hoPage
242 If (private_pbHighlightTab(hoPage)) Send Windows_Message TCM_HIGHLIGHTITEM iPage True
243 Loop
244
245 End_Procedure
246
247 { MethodType=Event }
248 Procedure OnDisplay
249 // Called when the control has just been created and a window-handle is available
250 End_Procedure
251
252 { MethodType=Event Visibility=Private }
253 Procedure Page Integer iState
254 If (iState =1) Begin
255 Set Window_Style To TCS_FORCEICONLEFT True // only used if fixed-width
256 Set Window_Style To TCS_MULTILINE (Private.MultiLine_State(self))
257 Set Window_Style To TCS_RIGHTJUSTIFY (Private.TabWidth_Mode(self) = twRightJustify)
258 Set Window_Style To TCS_RAGGEDRIGHT (Private.TabWidth_Mode(self) = twRaggedRight)
259 Set Window_Style To TCS_FIXEDWIDTH (Private.TabWidth_Mode(self) = twFixedWidth)
260 Set Window_Style To TCS_BOTTOM (private_peTabPosition(self) = tpBottom)
261 Set Window_Style To TCS_BUTTONS (private_peTabStyle(self) <> tsTabs)
262 Set Window_Style To TCS_FLATBUTTONS (private_peTabStyle(self) = tsFlatButtons)
263 Set Window_Style To TCS_HOTTRACK (pbHotTrack(self))
264 end
265
266 Forward Send Page iState
267
268 If (iState =1) Begin
269 If (private_pbFlatSeparators(self) =False) Send Windows_Message TCM_SETEXTENDEDSTYLE TCS_EX_FLATSEPARATORS 0 // windows creates flat separators by default, and we may not want them!
270 Send OnDisplay
271 Send private_DoUpdateTabs
272 Send OnResize
273 End
274 End_Procedure
275
276 { MethodType=Property }
277 { InitialValue=False }
278 { Category=Appearance }
279 { PropertyType=Boolean }
280 Procedure Set MultiLine_State Integer bMultiLine
281 Handle hWnd
282 Integer iStyle iVoid
283 Set Private.MultiLine_State To bMultiLine
284 Get Window_Handle To hWnd
285 If hWnd Begin
286 Move (GetWindowLong(hWnd, GWL_STYLE)) To iStyle
287 If bMultiLine Move (AddBitValue(TCS_MULTILINE, iStyle)) To iStyle
288 Else Move (RemoveBitValue(TCS_MULTILINE, iStyle)) To iStyle
289 Move (SetWindowLong(hWnd, GWL_STYLE, iStyle)) To iVoid
290 End
291 End_Procedure
292
293 { MethodType=Property }
294 Function MultiLine_State Returns Integer
295 Function_Return (Private.MultiLine_State(self))
296 End_Function
297
298 { MethodType=Property }
299 { EnumList="tpTop, tpBottom" }
300 { InitialValue=tpTop }
301 { Category=Appearance }
302 Procedure Set peTabPosition Integer eTabPosition
303 Handle hWnd
304 Integer iStyle iVoid
305 Integer iPage icPage
306
307 If (eTabPosition <> private_peTabPosition(self)) Begin
308 Set private_peTabPosition To eTabPosition
309 If (eTabPosition = tpBottom) Set peTabStyle To tsTabs // Windows error prevents buttons at the bottom
310 Get Window_Handle To hWnd
311 If hWnd Begin
312 Move (GetWindowLong(hWnd, GWL_STYLE)) To iStyle
313 If (eTabPosition = tpBottom) Move (AddBitValue(TCS_BOTTOM, iStyle)) To iStyle
314 Else Move (RemoveBitValue(TCS_BOTTOM, iStyle)) To iStyle
315 Move (SetWindowLong(hWnd, GWL_STYLE, iStyle)) To iVoid
316 // Now relocate the pages:
317 Get Item_Count To icPage
318 For iPage From 0 To (icPage -1)
319 Send Auto_Page (Aux_Value(self, iPage))
320 Loop
321 End
322
323 End
324 End_Procedure
325
326 { MethodType=Property }
327 Function peTabPosition Returns Integer
328 Function_Return (private_peTabPosition(self))
329 End_Function
330
331 { MethodType=Property }
332 { EnumList="tsTabs, tsButtons, tsFlatButtons" }
333 { InitialValue=tsTabs }
334 { Category=Appearance }
335 Procedure Set peTabStyle Integer eTabStyle
336 Handle hWnd
337 Integer iStyle iVoid
338 Integer iPage icPage
339
340 If (eTabStyle <> private_peTabStyle(self)) Begin
341 If (eTabStyle <> tsTabs) Begin
342 Set peTabPosition To tpTop // Buttons can only appear across the top!
343 End
344 Set private_peTabStyle To eTabStyle
345 Get Window_Handle To hWnd
346 If hWnd Begin
347 Move (GetWindowLong(hWnd, GWL_STYLE)) To iStyle
348 Move (RemoveBitValue(TCS_BUTTONS, iStyle)) to iStyle
349 Move (RemoveBitValue(TCS_FLATBUTTONS, iStyle)) to iStyle
350
351 If (eTabStyle <> tsTabs) Move (AddBitValue(TCS_BUTTONS, iStyle)) to iStyle
352 If (eTabStyle = tsFlatButtons) Move (AddBitValue(TCS_FLATBUTTONS, iStyle)) To iStyle
353 Move (SetWindowLong(hWnd, GWL_STYLE, iStyle)) To iVoid
354
355 If (eTabStyle = tsFlatButtons) Begin // windows creates flat separators by default, and we may not want them!
356 Send Windows_Message TCM_SETEXTENDEDSTYLE TCS_EX_FLATSEPARATORS (If(private_pbFlatSeparators(self), TCS_EX_FLATSEPARATORS, 0))
357 End
358 End
359 End
360 End_Procedure
361
362 { MethodType=Property }
363 Function peTabStyle Returns Integer
364 Function_Return (private_peTabStyle(self))
365 End_Function
366
367 { MethodType=Property Visibility=Private Obsolete=True }
368 Procedure Set Buttons_State Integer bButtons
369 // THIS IS NOW OBSOLETE. NO NOT USE
370 // If set to True, set peTabStyle To tsTabs instead.
371 If bButtons Set peTabStyle To tsButtons
372 End_Procedure
373
374 { MethodType=Property Visibility=Private Obsolete=True }
375 Function Buttons_State Returns Integer
376 Function_Return (private_peTabStyle(self) = tsButtons)
377 End_Function
378
379 { MethodType=Property }
380 { Category=Appearance }
381 { InitialValue=False }
382 { PropertyType=Boolean }
383 Procedure Set pbFlatSeparators Integer bFlatSeparators
384 // Flat Separators are only used if pbFlatButtons and peTabStyle = tsButtons
385 If (bFlatSeparators <> private_pbFlatSeparators(self)) Begin
386 Set private_pbFlatSeparators To bFlatSeparators
387 Send Windows_Message TCM_SETEXTENDEDSTYLE TCS_EX_FLATSEPARATORS (If(bFlatSeparators, TCS_EX_FLATSEPARATORS, 0))
388 End
389 End_Procedure
390
391 { MethodType=Property }
392 Function pbFlatSeparators Returns Integer
393 Function_Return (private_pbFlatSeparators(self))
394 End_Function
395
396 { MethodType=Property }
397 { EnumList="twRaggedRight, twRightJustify, twFixedWidth" }
398 { InitialValue=twRaggedRight }
399 { Category=Appearance }
400 Procedure Set TabWidth_Mode Integer iMode
401 Handle hWnd
402 Integer iStyle iVoid
403 Set Private.TabWidth_Mode To iMode
404 Get Window_Handle To hWnd
405 If hWnd Begin
406 Move (GetWindowLong(hWnd, GWL_STYLE)) To iStyle
407
408 Move (RemoveBitValue(TCS_RIGHTJUSTIFY, iStyle)) To iStyle
409 Move (RemoveBitValue(TCS_RAGGEDRIGHT, iStyle)) To iStyle
410 Move (RemoveBitValue(TCS_FIXEDWIDTH, iStyle)) To iStyle
411
412 If iMode eq twRightJustify Move (AddBitValue(TCS_RIGHTJUSTIFY, iStyle)) To iStyle
413 Else If iMode eq twRaggedRight Move (AddBitValue(TCS_RAGGEDRIGHT, iStyle)) To iStyle
414 Else If iMode eq twFixedWidth Move (AddBitValue(TCS_FIXEDWIDTH, iStyle)) To iStyle
415
416 Move (SetWindowLong(hWnd, GWL_STYLE, iStyle)) To iVoid
417 End
418 End_Procedure
419
420 { MethodType=Property }
421 Function TabWidth_Mode Returns Integer
422 Function_Return (Private.TabWidth_Mode(self))
423 End_Function
424
425 { MethodType=Property }
426 Function NumberOfRows Returns Integer
427 Handle hWnd
428 Get Window_Handle To hWnd
429 If hWnd Function_Return (SendMessage(hWnd, TCM_GetRowCount,0,0))
430 Else Function_Return -1
431 End_Function
432
433
434 // Add a tab page. Pass tab name and the page object Id.
435 // return the tab (item) number of the new page
436 //
437 { Visibility=Private }
438 Function Add_Tab_item String sLabel Integer tobjid returns integer
439 Integer iNumBtns
440 String sTcItem szText
441 Pointer lpsTcItem lpszText pVoid
442
443 Get Button_Count to iNumBtns
444 Send Add_item msg_none sLabel
445 Set Tab_Page_Id item iNumBtns to tobjid
446
447 // if active tab page - update the window control
448 If (Window_Handle(self)) Begin
449 Move (toAnsi(sLabel+Character(0))) to szText
450 GetAddress of szText To lpszText
451
452 ZeroType tTcItem to sTcItem
453 GetAddress of sTcItem To lpsTcItem
454 Put TCIF_TEXT To sTcItem At tTcItem.mask
455 Put lpszText To sTcItem At tTcItem.pszText
456 Send Windows_Message TCM_INSERTITEM iNumBtns lpsTcItem
457 End
458
459 Function_Return iNumBtns
460 End_Function
461
462 // Get/Set Tab_Page_Id identifies the page object associated with
463 // the tab item
464 //
465 { MethodType=Property }
466 Procedure Set Tab_Page_Id Integer item# Integer Obj#
467 Set Aux_Value item item# to Obj#
468 end_Procedure
469
470 { MethodType=Property }
471 Function Tab_Page_Id integer item# returns integer
472 function_return (Aux_Value(self,item#))
473 End_Function // Tab_page_id
474
475 // Button_Count: Number of tab buttons
476 //
477 { MethodType=Property }
478 Function Button_Count Returns Integer
479 Function_return (Item_Count(self))
480 end_Function
481
482 // The tab that is the current "active" tab. If the tab page is
483 // defined and it is not active the current_tab returns -1. If -1
484 // you can use item_count to find the tab that is rolled forward
485 //
486 { MethodType=Property }
487 Function Current_Tab returns integer
488 Integer id itm
489 If (item_count(self)) begin
490 Get current_item to itm
491 get tab_page_id item itm to id
492 // if no tab page or tab page is not active there
493 // can no current tab
494 if (Id=0 OR Active_State(id)=0) ;
495 Move -1 to itm
496 function_return itm
497 end
498 function_return -1
499 End_Function
500
501 // Replace current mouse behavior with out own. This give us more control
502 // over the switching behavior.
503 //
504 { MethodType=Event NoDoc=True }
505 Procedure Mouse_Down Integer iWindowNumber Integer iPosition
506 if iWindowNumber gt 0 ; // sometimes mouse down gets a 0 - should not happen
507 Send Request_Switch_to_Tab (iWindowNumber-1) 1 // 1=kbd
508 End_Procedure
509
510 { MethodType=Event NoDoc=True }
511 Procedure Mouse_Drag Integer iWindowNumber Integer iPosition //cancelled to stop rotation of tab-pages
512 End_Procedure
513
514
515 // No Param or 0 - Kbd Navigation
516 // 1 - Mouse Navigation
517 // 2 - Force to Button
518 // 3 - Force to Dialog
519 //
520 Procedure Request_Previous_Tab integer Mode
521 Integer tab# Mde oldTab#
522
523 If num_arguments eq 0 Move 0 to Mde
524 Else Move Mode to Mde
525
526 Get Current_item TO oldtab#
527 Move Oldtab# to tab#
528 Repeat
529 Decrement tab#
530 If tab# LT 0 Move (Button_Count(self)-1) TO tab#
531 If Tab# eq OldTab# procedure_Return
532 Until (Not(Item_Shadow_State(self,tab#)))
533 Send Request_Switch_to_Tab tab# Mde
534 End_Procedure
535
536 Procedure Request_Next_Tab integer Mode
537 Integer tab# oldtab# Mde
538
539 If num_arguments eq 0 Move 0 to Mde
540 Else Move Mode to Mde
541
542 Get Current_item TO oldtab#
543 Move OldTab# to tab#
544 Repeat
545 Increment tab#
546 If (tab#>=Button_Count(self)) Move 0 TO tab#
547 If Tab# eq OldTab# procedure_Return
548 Until (Not(Item_Shadow_State(self,tab#)))
549 Send Request_Switch_to_Tab tab# Mde
550 End_Procedure
551
552 // PonterMode parameter (required):
553 // 0 - Keyboard Navigation
554 // 1 - Mouse Navigation
555 // 2 - Force to Button
556 // 3 - Force to Dialog
557 //
558 Procedure Request_Switch_To_Tab Integer tab# integer PointerMode
559 Integer rval foc ctb Skipmode
560
561 If (Item_Shadow_State(self,tab#)) procedure_return
562 Get Skip_Button_Mode to SkipMode // 0 to button, 1=dialog, 1=smrt
563 If PointerMode eq 0 Begin // Kbd Navigation mode
564 If SkipMode eq SBM_SMART begin // if smartmode....figure it out
565 Get Focus of desktop to Foc
566 Get Current_Tab to ctb
567 If ( ctb=tab# OR Foc=self ) ;
568 Move 0 to PointerMode
569 else ;
570 Move 1 to PointerMode
571 end
572 else ;
573 Move SkipMode to PointerMode // 0 to button, 1=dialog
574 End
575 Else If PointerMode eq 1 Begin // Mouse Navigation
576 If SkipMode eq SBM_SMART begin // if smartmode....figure it out
577 Get Focus of desktop to Foc
578 Get Current_Tab to ctb
579 If ( ctb=tab# OR Foc=self ) ;
580 Move 0 to PointerMode
581 else ;
582 Move 1 to PointerMode
583 end
584 Else ;
585 get Pointer_only_State to PointerMode // 0=tab, 1=dialog
586 End
587 Else ; // its 2 or 3, if 3 to dialog, if 2 to button
588 Move (PointerMode=3) to Pointermode
589 get Tab_Change tab# PointerMode to rval
590 End_Procedure
591
592 // PointerMode: 0 - button takes focus
593 // 1 - dialog takes focus
594 // 2 - no-one takes focus, just add to focus tree
595 //
596 // Rule: If the tab dialog object has the focus ;
597 // give the keep the focus in the dialog object.
598 // else if switching pages
599 // Give the focus to the new page
600 // else (tab dialog<>focus, same page)
601 // give the tab the focus
602 //
603
604 Function Tab_Change Integer totab Integer PointerMode returns integer
605 Integer tabobj rval fromtab fromobj toobj focobj oldst
606 integer iCnt
607 string xx
608 Get In_Tab_Change_State to OldSt
609 set In_Tab_Change_State to true
610 Get current_Item to fromtab // from tab item
611
612 Get Item_Count to iCnt
613 If ICnt eq 0 Function_return 1
614 if (totab>iCnt) move fromtab to totab
615
616 Get tab_page_id item fromtab to fromobj // from tab page
617 Get tab_page_id item totab to toobj // to tab page
618
619 // Activate & Roll up correct Tab
620 If (FromTab<>ToTab) Begin
621 If (ContainsFocus(self)) ; // if focus is here, it is in the active page (from page). We
622 Get Msg_Activate to rval // need to move the focus to the safety of the tab dialog button
623 If not Rval Begin
624 Set Current_item to totab // first set to new tab
625 If (current_item(self)<>totab) Move 1 to rval
626 End
627 End
628
629 // deactivate existing tab page if required
630 If (rval=0 AND ;
631 fromobj AND fromObj<>toObj AND active_state(fromobj)) begin
632 Get Deactivate_Tab fromtab fromobj to rval
633 If rVal ; // if deactivate failed restore
634 Set Current_Item to fromTab // original tab and exit
635 End
636
637 // At this point new tab is current item (and maybe focus)
638 // and new page is not yet active
639
640 // before we can activate the page object we must make sure it is not hidden
641 If (rval=0 and ToObj) send DoHideTab ToObj False // this will set the active page as non shadowed (required to make kbd navigation work)
642
643 // Add focus of new tab page if required
644 If (rval=0 AND ;
645 toobj AND active_state(toobj)=0) begin
646 set focus_mode of toobj to focusable
647 get msg_add_focus of toobj self to rval
648 End
649 else Send rotate_up to toobj // this is the only change
650
651 // after new page appears, hide the old one
652 If (rval=0 and FromObj<>0 and FromObj<>ToObj) ;
653 send DoHideTab FromObj True // this will set the active page as non shadowed (required to make kbd navigation work)
654
655
656 // Activate either Tab dialog, Tab page, or nothing
657 //
658 if (rval=0 AND ;
659 pointerMode<>2) Begin
660 If (Toobj=0 OR PointerMode=0) ;
661 Move self to focObj
662 Else ;
663 Move ToObj to focobj
664
665 if (focus(desktop)<>focobj) ;
666 Get Msg_activate of focobj to rval
667 // If activate failed and we were trying to pass focus to an object in the page
668 // try to pass the focus to the page's button.
669 // this didn't work - JJT
670 //If (rval>0 And rVal<>5 AND FocObj<>Self) ;
671 // Get Msg_activate to rval // force button to take focus.
672
673 end
674 Set In_Tab_Change_State to OldSt
675
676 function_return rval
677 End_Function
678
679 { Visibility=Private }
680 Function Deactivate_Tab Integer tab# Integer tabpageobj Returns integer
681 Integer rval
682 // normally this is false and this procedure does nothing. If the property
683 // pbDeactivatePages is set true, the page is deactivated when it is hidden
684 // which is what previous VDFs did. Only do this if you have to.
685 If (pbDeactivatePages(self)) Get Msg_Deactivate of tabpageobj 0 to rval
686 Procedure_Return rval
687 End_Function
688
689 { Visibility=Private }
690 Procedure DoHideTab integer hPage integer bHide
691 // if page is not active (old style pages via pbDeactivatePages) then we
692 // don't do the hide step
693 If (Active_state(hPage)) send DoHideTab of hPage bHide
694 End_Procedure
695
696 // Display passed tab page. If no value (or -1) use default tab
697 // display = add to focus tree if needed, rotate up, do not activate
698 //
699 Procedure Request_Tab_Display integer iTab
700 Integer iTb bFail
701 If (button_count(self)) Begin
702 if (Num_arguments=0 OR iTab=-1) ;
703 Get default_tab to iTb // this can be -1, which means do nothing
704 else ;
705 move iTab to iTb
706 // if there is no default tab and we don't have any tab displayed
707 // then we will force the first tab to get displayed. Without this 1st
708 // time activatation may not display a page.
709 if (iTb<0 and current_tab(self)<0) ;
710 move 0 to iTb
711 if (iTb>=0) ;
712 get Tab_Change iTb 2 to bFail // 2 means don't take focus
713 end
714 End_procedure
715
716 // Augment to add the default tab page to the focus tree
717 //
718 { NoDoc=True }
719 Procedure Add_Focus Handle hoParent Returns Integer
720 Integer rval
721 forward get MSG_add_focus hoParent to rval
722 if not rval ;
723 Send Request_tab_display // make sure dflt tab is rotated up
724 procedure_return rval
725 end_procedure
726
727 // Most tab navigation events are controlled by the class and activate
728 // messages are sent in the middle of these events. When this occurs the
729 // private property In_tab_change_state is true. In some cases of
730 // keyboard navigation from outside the object activate is called directly.
731 // This should never happen with no active tab page (because add_focus
732 // takes care of this). In such a case, we must decide if activate should
733 // keep the focus (the tab) or give it to the page. If smart mode or always
734 // mode go the tab button else go to button (normal activate behavior)
735 //
736 { NoDoc=True }
737 Procedure Activate returns integer
738 Integer iTab iDflt bFail
739 If (active_state(self) AND Object_shadow_state(self)) ;
740 Procedure_return 1
741
742 Forward Get MSG_Activate to bFail // this will give button the focus
743 // if this is not part of tab_change we might want to give the page the
744 // focus
745 if (bFail=0 AND In_Tab_Change_State(self)=0) begin
746 Get current_tab to iTab
747 // If we need to reset the page on forward navigate (or activate)
748 // use the default tab as the page to move to
749 If (pbResetPageOnActivate(self)) begin
750 Get Default_tab to iDflt
751 if (iDflt>=0) Move iDflt to iTab
752 end
753 if (iTab>-1 AND ; // if tab is not yet active (should not happen)
754 (Skip_Button_Mode(self)<>SBM_NEVER ) ) begin
755 Send Request_switch_to_tab iTab 3 // force to page
756 end
757 end
758 procedure_return bFail
759 End_Procedure // Activate
760
761
762 { Visibility=Private }
763 Procedure Rebuild_Tab_Pointers
764 // after a delete (or in the future an insert) we can call this to
765 // make sure that pointers between dialog and pages is correct. This
766 // can be safely called at any point.
767 Integer iItm hTabPg iItems
768 Get Button_Count to iItems
769 Decrement iItems
770 For iItm from 0 to iItems
771 Get tab_page_id item iItm to hTabPg
772 Set Tab_Button_item of hTabPg to iItm
773 Loop
774 End_procedure
775
776 { Visibility=Private }
777 Procedure Delete_Tab_Item integer iTab
778 // The order that these messages are sent are important and somewhat trial and error.
779 // We must notify the windows control that the button has been removed.
780 Integer hTabPg iIc bOld
781 Get Item_Count to iIC
782 Decrement iIC
783 If (iIC>0) Begin // don't allow last tab to be deleted
784 // If activate is sent to the tab-dialog, this will force the button to take
785 // the focus by setting in_tab_change_state to true. See procedure activate in this class
786 get in_tab_change_state to bOld
787 set in_tab_change_state to true
788 get tab_page_id item iTab to hTabPg
789 Send windows_Message TCM_DELETEITEM iTab 0
790 Send Deactivate to hTabPg 0
791 send delete_item iTab
792 Send Rebuild_Tab_Pointers
793 // if not active, do switch tab (it does an activate). Note: The above windows message and
794 // deactivate will do nothing when the object is not active
795 If (active_state(self)) Begin
796 Send Request_Switch_to_Tab (if(iTab=iIC, iTab-1, iTab)) 3
797 set current_item to (current_item(self))
798 end
799 // this is a double check and should not happen. If the focus is in the page
800 // we are in trouble. If it is sending activate will force focus to tab dialog (button)
801 If (containsFocus(hTabPg)) send Activate
802 Send destroy of hTabPg
803 set in_tab_change_state to bOld
804 end
805 End_Procedure
806
807 { MethodType=Property Visibility=Private }
808 Procedure set WinValue integer iItem string sVal
809 // This must get called to change an active tab button.
810 String sTcItem szText
811 Pointer lpsTcItem lpszText
812 // if active tab page - update the window control
813 If (Window_Handle(self)) Begin
814 Move (toAnsi(sVal+Character(0))) to szText
815 GetAddress of szText To lpszText
816
817 ZeroType tTcItem to sTcItem
818 GetAddress of sTcItem To lpsTcItem
819 Put TVIF_TEXT To sTcItem At tTcItem.mask
820 Put lpszText To sTcItem At tTcItem.pszText
821 Send Windows_Message TCM_SETITEM iItem lpsTcItem
822 end
823 End_Procedure
824
825 // Private: this gets called to make sure that this page is active. Called during
826 // next/prior object id. For this to work the ID must be in the focus tree
827 //
828 { Visibility=Private }
829 Procedure DoActivePage handle hId
830 if not (Active_state(hid)) begin
831 set focus_mode of hId to focusable
832 send add_focus of hId self
833 Send DoHideTab hId True
834 end
835 end_procedure
836
837 // Return the Prior tab. Skip tab pages where the button is shadowed
838 //
839 { MethodType=Property Visibility=Private }
840 function PriorTabId returns handle
841 Integer iTab iFirstTab
842 Handle hId
843 Get Current_item TO iFirstTab
844 Move iFirstTab to iTab
845 Repeat
846 Decrement iTab
847 If (iTab<0) Move (Button_Count(self)-1)to iTab
848 If (iTab=iFirstTab) function_return 0 // loop, no next ID
849 Until (Not(Item_Shadow_State(self,iTab)))
850 Get Tab_page_Id iTab to hId
851 Send DoactivePage hId // make sure this is in the focus tree
852 function_return hId
853 End_Procedure
854
855 // Return the next tab. Skip tab pages where the button is shadowed
856 //
857 { MethodType=Property Visibility=Private }
858 function NextTabId returns handle
859 Integer iTab iFirstTab
860 Handle hId
861 Get Current_item TO iFirstTab
862 Move iFirstTab to iTab
863 Repeat
864 Increment iTab
865 If (iTab>=Button_Count(self)) Move 0 TO iTab
866 If (iTab=iFirstTab) function_return 0
867 Until (Not(Item_Shadow_State(self,iTab)))
868 Get Tab_page_Id iTab to hId
869 Send DoactivePage hId // make sure this is in the focus tree
870 function_return hId
871 End_Procedure
872
873 // augmented to create smarter next and previous behavior for tab buttons.
874 //
875 { NoDoc=True }
876 procedure Next
877 integer iItem eRotate
878 Handle hId
879 get current_item to iItem
880 forward send next // do normal next, try to give object in dialog the focus
881 // if focus is still on the same button, we failed...no object could take focus.
882 if (focus(desktop)=self and current_item(self)=iItem) Begin
883 // do the "next" befst thing. If rotatable, go to next tab button,
884 // else leave the tab dialog and go to next object
885 Get Rotate_mode to eRotate
886 if (eRotate=RM_Rotate_in_ring or ;
887 (eRotate=RM_Rotate and iItem<Button_count(self)-1)) ;
888 send request_next_tab // it is rotable, go to next tab page
889 else Begin
890 // navigate out of this tab dialog.
891 get next_object_id 1 to hId
892 if hID send activate of hId
893 end
894 end
895 end_procedure
896
897 { NoDoc=True }
898 procedure Previous
899 integer iItem eRotate
900 get current_item to iItem
901 Get Rotate_mode to eRotate
902 If (eRotate=RM_NONE or eRotate=RM_RING or iItem=0) ;
903 forward send previous
904 else ;
905 send request_previous_tab
906 end_procedure
907
908
909 // event called when Beginning_of_Panel is called by panel (usually view)
910 // by default, switch to the default tab (which is 0).
911 //
912 { MethodType=Event }
913 Procedure OnBeginningOfPanel integer hoPanel
914 if (Button_Count(self) and Default_Tab(self)>=0) ; // note if default tab is -1,
915 send Request_Tab_display // this behavior is stopped
916 end_procedure
917
918 // special for tab dialog. Note this must augment (and not replace) the next_object_id
919 // logic defined in standard_object_mixin,
920 // If descend (fg=0) we want to return
921 // the current tab page (it's the next object).
922 //
923 { Visibility=Private }
924 Function Next_Object_Id integer fg returns integer
925 integer hId rVal
926 if (fg=0) Begin // if descend, next object is current tab page
927 Get Current_tab to hId // there should almost always be a current tab (unless no tabs)
928 if (hId<>-1) ;
929 function_return (Tab_page_id(self,hId))
930 move 1 to fg // odd case of no current tab, do a next level id
931 end
932 forward get next_object_id FG to rval
933 function_return rval
934 End_Function // Next_object_id
935End_Class
936
937
938Class Tab_Page_Mixin is a Mixin
939
940 { Visibility=Private }
941 Procedure Define_Tab_Page_Mixin
942 Integer obj mode clr
943 handle hoTD
944
945 { DesignTime=False }
946 Property integer Tab_Button_Item -1
947
948 { Visibility=Private }
949 Property Integer Rotate_Mode RM_None
950
951 { Visibility=Private }
952 Property Integer private_piImageIndex
953
954 { Visibility=Private }
955 Property Integer private_pbHighlightTab
956
957 { Visibility=Private }
958 Property Integer pbInsideActivate False // system maintained, prevents activation recursion
959
960 Delegate Get Rotate_mode to Mode
961 Set Rotate_mode to Mode
962 Set Ring_state to True // do not change this
963
964 // system maintained. Determines if tab page is explicitly hidden within this dialog
965 { Visibility=Private }
966 Property Integer pbHidePage False
967
968 // private: see GetContainerSize for docs on this
969 { Visibility=Private }
970 property integer piLastClientSize -1
971
972 Set Border_Style to Border_None
973 Set Popup_State to True
974 Set Attach_parent_state to True
975
976 Delegate Get Color to clr
977 Set Color to Clr
978 Delegate Get TextColor to clr
979 Set TextColor to Clr
980
981 Move self to obj
982 Set Label to '' // forces tab button to get created
983
984 // handles case of dynamically create tab page
985 Get Parent to hoTD // the tab dialog
986 If (Active_state(hoTD) and Item_count(hoTD)=1) ;
987 Send Auto_Page Self
988 end_procedure
989
990 { MethodType=Event Visibility=Private }
991 Procedure Page Integer iState
992 Integer cxy
993
994 If (iState=1 and GuiLocation(self)=0) Send Auto_Page self
995 Forward Send Page iState
996 // if paging and we've not set the original tab dialog size, do it now.
997 If (iState =1) Begin
998 If (piOriginalClientSize(Parent(self)) = -1) Begin
999 Get Client_Size To cxy
1000 Delegate Set piOriginalClientSize To cxy // this is the first page, so store the size.
1001 End
1002 End
1003 End_Procedure
1004
1005
1006 // This needs to get the client size relative to the last time the object was un-paged. If an object
1007 // has never been unpaged, you need to get the size of the orignal tab dialog (the first time it was paged).
1008 // The first time a tab page is paged, the tab-dialog's original size is set in piOriginalClientSize. This
1009 // is what you want to use for any tab page the FIRST time it is paged (since all of the sizes of its
1010 // child objects are set relative to that size). Any time a tab page is unpaged, you want your new frame
1011 // of reference to be the size of client at the time the page is being unpaged (because that's what all of
1012 // the current size of the child objects are set to). So, anytime a tab page is removed (see remove_object)
1013 // the size of the client is recorded in piLastClientSize. This property defaults to -1, which means that
1014 // the object has never been paged (or resized) so you should use the original tab dialog size (see page).
1015 { MethodType=Property Visibility=Private }
1016 Function GetContainerClientSize Returns Integer
1017 integer iClientSize
1018 Get piLastClientSize to iClientSize // if anything but -1, this is our new starting point for anchors
1019 // if -1, we've never set it (never unpaged it)...so use the tab-dialog's orignal size
1020 if (iClientSize=-1) ;
1021 Delegate Get piOriginalClientSize to iClientSize
1022 Function_Return iClientSize
1023 End_Function
1024
1025 { NoDoc=True }
1026 Procedure Activate returns integer
1027 Integer bFail
1028 Integer iTab iCurTab
1029 Handle hId
1030 Get tab_button_item to iTab // this page's tab item #
1031 delegate get Current_item to iCurTab // the current tab number
1032 // If we have a button and it is not yet active then this
1033 // activate was sent directly. We need to make it go through
1034 // the dialog logic (which will send activate here again with
1035 // tab_active_state set true)
1036 if ( iTab>=0 AND iTab<>iCurTab ) ;
1037 delegate send Request_switch_to_tab iTab 0 // 0=kbd Navigation
1038 else begin
1039 // if the page already contains the focus and we are not already in the
1040 // middle of a tab change, then we want to give the focus to the button
1041 // if pbInsideActivate is true, then we tried to give an child object the focus but it failed
1042 If (pbInsideActivate(self) or (ContainsFocus(self) and In_tab_change_state(self)=0)) ;
1043 Delegate Get Tab_Change iTab 0 to bFail // 0=force to button
1044 else begin
1045 Set pbInsideActivate to True // recursion protection
1046 // Let's just see where the next focus would end up
1047 get next_object_id 0 to hId
1048 if (hId=0 or hId=Self or hId=parent(self)) ; // if nothing to take the focus, force to button
1049 Delegate Get Tab_Change iTab 0 to bFail // 0=force to button
1050 else ; // This can recurse if there are no focusable children. If it does above will force to button
1051 Get MSG_Activate of hId to bFail // do a normal page activate. Focus will be in page somehwere
1052 Set pbInsideActivate to False
1053 end
1054 end
1055 // we will return a success even if it fails. next/previous navigation should decide where the next object
1056 // should be. If this does not work, don't allow switch to keep trying
1057 Procedure_Return 0 //bFail
1058 End_procedure
1059
1060
1061 // Private: needed by navigation (next_object_id). Normally this checks to see if the object is
1062 // a container and if it contains the focus. If it does, navigation will keep looking for
1063 // another object to give the focus. With tab-pages a focus change will occur because activate
1064 // to a tab page means, try to go to the button. So we override the standard behavior here
1065 // and force it to say the focus will change.
1066 //
1067 { Visibility=Private }
1068 function ContainerFocusWillNotChange returns integer
1069 function_return 0
1070 end_function
1071
1072
1073 { MethodType=Property NoDoc=True }
1074 Procedure Set Value Integer iItem String sValue
1075 Integer co id
1076 Forward Set value item iItem to sValue
1077 Move self to co
1078 Get tab_button_item to id
1079 If id eq -1 begin
1080 delegate Get add_tab_item sValue co to id
1081 Set Tab_button_item to id
1082 end
1083 else ;
1084 delegate Set Value item id to sValue
1085 End_Procedure // set value
1086
1087 // This is called anytime navigation (next_object_id & proir_object_id) would
1088 // cause a "wrap" condition in a tab page. This function must return the object Id
1089 // to naviagte to.
1090 // Depending on the rotate_mode and skip_button_mode we need to return different target
1091 // IDs.
1092 //
1093 { MethodType=Event Visibility=Private }
1094 function OnChildWrapping integer hoDest integer bDown returns integer
1095 Integer eRotate eSkip
1096 integer iPage
1097 handle hId
1098 boolean bHasFoc
1099
1100 get rotate_mode to eRotate
1101 get Skip_button_mode to eSkip
1102 Delegate get current_Item to iPage
1103
1104 Get ContainsFocus to bHasFoc // does this tab page already conatin the focus?
1105
1106 // if not has focus and a ring, we have no focusable objects in here
1107 // either go to tab button or get out
1108 if not bHasFoc begin
1109 If (eSkip=SBM_ALWAYS) begin
1110 If bDown ;
1111 delegate Get Next_object_id 1 to hId
1112 else ;
1113 delegate Get Prior_object_id 0 to hId
1114 end
1115 else ;
1116 Move self to hId // will force to button
1117 function_return hId
1118 end
1119
1120 if (eRotate=RM_NONE) begin
1121 If bDown ; // if down, leave the tab dialog object
1122 delegate Get Next_Object_id 1 to hId
1123 else begin // if up either go to prior object, or, move to the tab button
1124 If (eSkip=SBM_ALWAYS) ;
1125 delegate Get Prior_Object_id 0 to hId
1126 else ;
1127 move self to hId // will force to button
1128 end
1129 end
1130
1131 else if (eRotate=RM_RING) Begin
1132 // with rings assume the tab buttons are skipped unless they are
1133 // specifically forced to tab button. So in this case, a sbm_smart w/
1134 // rings will skip the tab.
1135 If (eSkip<>SBM_NEVER) ;
1136 Move hoDest to hId // let next object Id do whatever it does normally
1137 else ;
1138 move self to hId // will force to button
1139 End
1140
1141 else Begin // if here either rotate or rotate in ring
1142 if bDown Begin
1143 If (eRotate=RM_Rotate_in_ring OR iPage< (Button_count(self)-1) ) ;
1144 Delegate Get NextTabId to hId
1145 Else ;
1146 delegate Get Next_Object_id 1 to hId
1147 end
1148 else begin // if up
1149 If (eSkip<>SBM_NEVER AND (eRotate=RM_Rotate_in_ring OR iPage>0)) begin
1150 Delegate Get PriorTabId to hId
1151 end
1152 else Begin
1153 If (eSkip=SBM_ALWAYS) ;
1154 delegate Get Prior_Object_id 0 to hId
1155 else ;
1156 Move self to hId // will force to button
1157 end
1158 end
1159 end
1160 function_return hid
1161 end_function
1162
1163 { MethodType=Property }
1164 { Category=Appearance }
1165 Procedure Set Tab_ToolTip_Value String Val
1166 Integer itm
1167 Get Tab_Button_Item to itm
1168 If itm ge 0 Delegate set tooltip_value item itm to val
1169 End_Procedure
1170
1171 { MethodType=Property }
1172 Function Tab_ToolTip_Value returns string
1173 Integer itm
1174 String rval
1175 Get Tab_Button_Item to itm
1176 Delegate Get tooltip_value item itm to rval
1177 function_return rval
1178 end_function
1179
1180 { MethodType=Property }
1181 { InitialValue=False }
1182 { Category=Appearance }
1183 { PropertyType=Boolean }
1184 Procedure Set Button_Shadow_State Integer iState
1185 Integer itm
1186 Get Tab_Button_Item to itm
1187 Delegate Set Item_Shadow_State item itm to iState
1188 End_Procedure // Set Button_Shadow_State
1189
1190 { MethodType=Property }
1191 Function Button_Shadow_State returns Integer
1192 Integer itm iState
1193 Get Tab_Button_Item to itm
1194 Delegate Get Item_Shadow_State item itm to iState
1195 Function_Return iState
1196 End_Function // Button_Shadow_State
1197
1198 // override for desktop in val_mx which does not work well with tab
1199 // pages. First make sure tab dialog has the focus (and that it worked)
1200 // then if page is not active or it is hidden, make this the active page
1201 // This is only sent during DEO validation and always sent via delegation
1202 //
1203 { Visibility=Private }
1204 Procedure Activate_Area Integer TakeFocusFg
1205 integer iTab
1206 Delegate Send Activate_Area False // make sure parent dialog is active and not hidden
1207 // if parent is not active or it is hidden, we've had an error. Stop. This should not happen
1208 If (Active_State(Parent(self))=0 OR implicit_Hidden_state(self) ) Procedure_return
1209
1210 // If here the parent tab dialog is active and ready. Now let's make sure that this page takes the focus
1211 // At this point the page cannot be implicitly hidden (we checked above), so it can only be explicitly hidden
1212 If (Active_State(self)=0 OR pbHidePage(self) ) Begin
1213 Get tab_button_item to iTab // this page's tab item #
1214 Send Request_tab_Display iTab // makes page active without taking focus.
1215 end
1216 End_Procedure
1217
1218 { Visibility=Private }
1219 Procedure Rotate_Up
1220 // We only want to rotate up a tab page if it is the current page.
1221 // This is needed when multiple tab pages remain in the focus tree
1222 Integer i
1223 delegate Get current_item to i
1224 If (tab_page_id(self,i)=self) ;
1225 forward send rotate_up
1226 End_Procedure
1227
1228 { NoDoc=True }
1229 Procedure Add_Focus Handle hoParent Returns Integer
1230 Integer iretVal
1231 Forward Get Msg_Add_Focus hoParent To iretVal
1232 Send Auto_Page self
1233 // support OnResize event
1234 Send OnResize
1235 Procedure_Return iRetVal
1236 End_Procedure
1237
1238 { Visibility=Private }
1239 Procedure private_DoSetImage
1240 String sTcItem
1241 Pointer lpsTcItem
1242 Integer iPage iImage
1243
1244 If (Window_Handle(Parent(self))) Begin
1245 Get private_piImageIndex To iImage
1246 Get Tab_Button_Item to iPage
1247
1248 ZeroType tTcItem to sTcItem
1249 Put TCIF_IMAGE To sTcItem at tTcItem.Mask
1250 Put iImage To sTcItem at tTcItem.iImage
1251 GetAddress of sTcItem To lpsTcItem
1252 Send Windows_Message of (parent(self)) TCM_SETITEM iPage lpsTcItem
1253 End
1254 End_Procedure
1255
1256 { MethodType=Property }
1257 { Category=Appearance }
1258 Procedure Set piImageIndex Integer iIndex
1259 Set private_piImageIndex To iIndex
1260 Send private_DoSetImage
1261 End_Procedure
1262
1263 { MethodType=Property }
1264 Function piImageIndex Returns Integer
1265 Function_Return (private_piImageIndex(self))
1266 End_Function
1267
1268 { MethodType=Property }
1269 { InitialValue=False }
1270 { Category=Appearance }
1271 { PropertyType=Boolean }
1272 Procedure Set pbHighlightTab Integer bHighlight
1273 Handle hwTabDialog
1274 Integer iPage
1275 If (bHighlight <> private_pbHighlightTab(self)) Begin
1276 Set private_pbHighlightTab To bHighlight
1277 Get Window_Handle of (parent(self)) To hwTabDialog
1278 If hwTabDialog Begin
1279 Get Tab_Button_Item to iPage
1280 Send Windows_Message of (parent(self)) TCM_HIGHLIGHTITEM iPage bHighlight
1281 End
1282 End
1283 End_Procedure
1284
1285 { MethodType=Property }
1286 Function pbHighlightTab Returns Integer
1287 Function_Return (private_pbHighlightTab(self))
1288 End_Function
1289
1290 { MethodType=Property }
1291 Procedure Set Label String sLabel
1292 Integer iPage hWnd iVoid
1293 String sTcItem
1294 Pointer lpsTcItem lpsLabel
1295
1296 Forward Set Label To sLabel
1297
1298 Get Window_Handle of (parent(self)) To hWnd
1299 If hWnd Begin
1300 Move (toAnsi(sLabel+Character(0))) to sLabel
1301 GetAddress of sLabel To lpsLabel
1302
1303 Get Tab_Button_Item to iPage
1304
1305 ZeroType tTcItem to sTcItem
1306 Put TCIF_TEXT To sTcItem at tTcItem.Mask
1307 Put lpsLabel To sTcItem At tTcItem.pszText
1308 GetAddress of sTcItem To lpsTcItem
1309 Move (SendMessage(hWnd, TCM_SETITEM, iPage, lpsTcItem)) To iVoid
1310 Move (InvalidateRect(hWnd, 0, 1)) To iVoid // force the window to be re-painted
1311
1312 End
1313 End_Procedure
1314
1315 // This explicitly hides/unhides this tab page.
1316 //
1317 { Visibility=Private }
1318 Procedure DoHideTab Integer bHide
1319 integer bHidden
1320 Set pbHidePage to bHide // set explicit hidden value
1321 Get Implicit_Hidden_State to bHidden // are we hidden by another parent tab page?
1322 If not bHidden ; // if it is already hidden by a parent, the children will not change...
1323 Broadcast Send DoImplicitTabHide bHide // else implicitly hide or un hide all decendants
1324 End_Procedure
1325
1326 // augment to only broadcast change if not already hidden by this page
1327 //
1328 { Visibility=Private }
1329 Procedure DoImplicitTabHide integer iState
1330 Set Private.Implicit_Hidden_State to iState // = hidden by a parent
1331 if not (pbHidePage(self)) ; // are we already hiding this page explicitly?
1332 Broadcast Send DoImplicitTabHide iState // if not, we tell everyone
1333 End_Procedure // DoImplicitTabHide
1334
1335
1336 // reverse any effects of hiding a tab. When removed, restore page
1337 // to original unhidden state. There were problems with dbGroups not
1338 // enabling themselves because the check current_shadow_state when they
1339 // are activated. Hidden states were getting in the way
1340 // Also, keep track of current clientsize for future paging and anchoring
1341 //
1342 { Visibility=Private }
1343 Procedure Remove_Object
1344 Set piLastClientSize to (client_size(self)) // will get used next time tab is paged
1345 If (pbHidePage(self)) Send DoHideTab False // if explicitly hidden, un hide it before removing it.
1346 forward send remove_object
1347 End_Procedure
1348
1349 { MethodType=Event }
1350 Procedure OnResize
1351 End_Procedure
1352
1353 { MethodType=Property Visibility=Private }
1354 Procedure Set GuiSize Integer cy Integer cx
1355 // support OnResize event
1356 Integer cxy
1357 Get GuiSize To cxy
1358 Forward Set GuiSize to cy cx
1359 If (BuildingObjectId=0 AND ;
1360 Window_Handle(self) AND ;
1361 ( Hi(cxy)<>cy or Low(cxy)<>cx) ) ;
1362 Send OnResize
1363 End_Procedure
1364End_class