Module cToolTipController.pkg
1Use Winuser.pkg
2Use Winkern.pkg
3Use GlobalFunctionsProcedures.pkg
4Use tWinStructs.pkg
5Use cImageList32.pkg
6Use Commctrl.pkg
7
8
9// cToolTipController:
10
11{ ClassLibrary=Windows }
12{ HelpTopic=cToolTipController }
13Class cToolTipController is a cObject
14
15 Procedure Construct_Object
16 Forward Send Construct_Object
17
18 // Set External_Class_Name 'DFToolTip' to 'Tooltips_Class32'
19
20 { Category=Behavior }
21 Property Boolean pbUseDDOStatusHelp True // Use the DDO's Status_Help setting for psToolTip in DEOs
22
23 { DesignTime=False }
24 Property Handle phToolTip 0 // Window handle to the ToolTip control.
25
26 { Visibility=Private }
27 Property Boolean pbActive_private True
28
29 { Visibility=Private }
30 Property Boolean pbBalloonStyle_private False
31
32 { Visibility=Private }
33 Property Boolean pbUseAnimation_private True
34
35 { Visibility=Private }
36 Property Boolean pbUseFading_private True
37
38 { Visibility=Private }
39 Property Boolean pbUsePrefix_private False
40
41 { Visibility=Private }
42 Property Integer piIcon_private TTI_NONE
43
44 { Visibility=Private }
45 Property String psTitle_private ""
46
47 { Visibility=Private }
48 Property String psIcon_private ""
49
50 Send CreateToolTipWindow
51 End_Procedure // Construct_Object
52
53
54 // pbActive:
55
56 // True if tooltips controled by this object are active, otherwise false.
57 { MethodType=Property }
58 { Category=Behavior }
59 { InitialValue=True }
60 Procedure Set pbActive Boolean bValue
61 Integer iVoid
62 Handle hToolTip
63 Get phToolTip to hToolTip
64 Set pbActive_private to bValue
65 Move (SendMessage(hToolTip, TTM_ACTIVATE, bValue, 0)) to iVoid
66 End_Procedure
67
68 { MethodType=Property }
69 Function pbActive Returns Boolean
70 Boolean bValue
71 Get pbActive_private to bValue
72 Function_Return bValue
73 End_Function // pbActive
74
75
76 // pbBalloonStyle:
77
78 // True if tooltips controled by this object are active, otherwise false.
79 { MethodType=Property }
80 { Category=Appearance }
81 { InitialValue=False }
82 Procedure Set pbBalloonStyle Boolean bValue
83 Boolean bOldValue
84 DWord dwStyle
85 Integer iRet iVoid
86 Handle hToolTip
87
88 Get pbBalloonStyle_private to bOldValue
89 If (bOldValue <> bValue) Begin
90 Set pbBalloonStyle_private to bValue
91
92 // Get the current window style and either add or remove the Balloon Style....
93 Get phToolTip to hToolTip
94 Move (GetWindowLong(hToolTip, GWL_STYLE)) to dwStyle
95
96 If (bValue) Begin
97 Move (AddBitValue(TTS_BALLOON, dwStyle)) to dwStyle
98 End
99 Else Begin
100 Move (RemoveBitValue(TTS_BALLOON, dwStyle)) to dwStyle
101 End
102
103 Move (SetLastError(0)) to iVoid // Clear the last error code
104 Move (SetWindowLong(hToolTip, GWL_STYLE, dwStyle)) to iRet
105
106 // Handle Errors....
107 If (iRet = 0) Begin
108 Move (ShowLastError()) to iVoid
109 End
110 End
111 End_Procedure
112
113 { MethodType=Property }
114 Function pbBalloonStyle Returns Boolean
115 Boolean bValue
116 Get pbBalloonStyle_private to bValue
117 Function_Return bValue
118 End_Function // pbBalloonStyle
119
120
121 // pbUseAnimation:
122
123 // True if tooltips controled by this object are active, otherwise false.
124 { MethodType=Property }
125 { Category=Appearance }
126 { InitialValue=True }
127 Procedure Set pbUseAnimation Boolean bValue
128 Boolean bOldValue
129 DWord dwStyle
130 Integer iRet iVoid
131 Handle hToolTip
132
133 Get pbUseAnimation_private to bOldValue
134 If (bOldValue <> bValue) Begin
135 Set pbUseAnimation_private to bValue
136
137 // Get the current window style and either add or remove the Balloon Style....
138 Get phToolTip to hToolTip
139 Move (GetWindowLong(hToolTip, GWL_STYLE)) to dwStyle
140
141 If (bValue) Begin
142 Move (RemoveBitValue(TTS_NOANIMATE, dwStyle)) to dwStyle
143 End
144 Else Begin
145 Move (AddBitValue(TTS_NOANIMATE, dwStyle)) to dwStyle
146 End
147
148 Move (SetLastError(0)) to iVoid // Clear the last error code
149 Move (SetWindowLong(hToolTip, GWL_STYLE, dwStyle)) to iRet
150
151 // Handle Errors....
152 If (iRet = 0) Begin
153 Move (ShowLastError()) to iVoid
154 End
155 End
156 End_Procedure
157
158 { MethodType=Property }
159 Function pbUseAnimation Returns Boolean
160 Boolean bValue
161 Get pbUseAnimation_private to bValue
162 Function_Return bValue
163 End_Function // pbUseAnimation
164
165
166 // pbUseFading:
167
168 // True if tooltips controled by this object are active, otherwise false.
169 { MethodType=Property }
170 { Category=Appearance }
171 { InitialValue=True }
172 Procedure Set pbUseFading Boolean bValue
173 DWord dwStyle
174 Integer iRet iVoid
175 Handle hToolTip
176 Boolean bOldValue
177
178 Get pbUseFading_private to bOldValue
179 If (bOldValue <> bValue) Begin
180 Set pbUseFading_private to bValue
181
182 // Get the current window style and either add or remove the Balloon Style....
183 Get phToolTip to hToolTip
184 Move (GetWindowLong(hToolTip, GWL_STYLE)) to dwStyle
185
186 If (bValue) Begin
187 Move (RemoveBitValue(TTS_NOFADE, dwStyle)) to dwStyle
188 End
189 Else Begin
190 Move (AddBitValue(TTS_NOFADE, dwStyle)) to dwStyle
191 End
192
193 Move (SetLastError(0)) to iVoid // Clear the last error code
194 Move (SetWindowLong(hToolTip, GWL_STYLE, dwStyle)) to iRet
195
196 // Handle Errors....
197 If (iRet = 0) Begin
198 Move (ShowLastError()) to iVoid
199 End
200 End
201 End_Procedure
202
203 { MethodType=Property }
204 Function pbUseFading Returns Boolean
205 Boolean bValue
206 Get pbUseFading_private to bValue
207 Function_Return bValue
208 End_Function // pbUseFading
209
210
211 // pbUsePrefix:
212
213 // True if tooltips controled by this object are active, otherwise false.
214 { MethodType=Property }
215 { Category=Appearance }
216 { InitialValue=False }
217 Procedure Set pbUsePrefix Boolean bValue
218 Boolean bOldValue
219 DWord dwStyle
220 Integer iRet iVoid
221 Handle hToolTip
222
223 Get pbUsePrefix_private to bOldValue
224 If (bOldValue <> bValue) Begin
225 Set pbUsePrefix_private to bValue
226
227 // Get the current window style and either add or remove the Balloon Style....
228 Get phToolTip to hToolTip
229 Move (GetWindowLong(hToolTip, GWL_STYLE)) to dwStyle
230
231 If (bValue) Begin
232 Move (RemoveBitValue(TTS_NOPREFIX, dwStyle)) to dwStyle
233 End
234 Else Begin
235 Move (AddBitValue(TTS_NOPREFIX, dwStyle)) to dwStyle
236 End
237
238 Move (SetLastError(0)) to iVoid // Clear the last error code
239 Move (SetWindowLong(hToolTip, GWL_STYLE, dwStyle)) to iRet
240
241 // Handle Errors....
242 If (iRet = 0) Begin
243 Move (ShowLastError()) to iVoid
244 End
245 End
246 End_Procedure
247
248 { MethodType=Property }
249 Function pbUsePrefix Returns Boolean
250 Boolean bValue
251 Get pbUsePrefix_private to bValue
252 Function_Return bValue
253 End_Function // pbUsePrefix
254
255
256 // piBkColor:
257
258 // Sets the background color in a ToolTip window.
259 { MethodType=Property }
260 { PropertyType=Color }
261 { EnumList="clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder, clInactiveBorder" }
262 { EnumList+="clAppWorkSpace, clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DDkShadow, cl3DLight, clInfoText, clInfoBk, clDefault, clNone" }
263 { EnumList+="clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
264 { Category=Appearance }
265 { InitialValue=clInfoBk }
266 Procedure Set piBkColor Integer iValue
267 Integer iVoid
268 Handle hToolTip
269 Get phToolTip to hToolTip
270 Move (SendMessage(hToolTip, TTM_SETTIPBKCOLOR, iValue, 0)) to iVoid
271 End_Procedure
272
273 { MethodType=Property }
274 Function piBkColor Returns Integer
275 Integer iValue
276 Handle hToolTip
277 Get phToolTip to hToolTip
278 Move (SendMessage(hToolTip, TTM_GETTIPBKCOLOR, 0, 0)) to iValue
279 Function_Return iValue
280 End_Function // Returns Integer
281
282
283 // Sets the text color in a ToolTip window.
284 { MethodType=Property }
285 { PropertyType=Color }
286 { EnumList="clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder, clInactiveBorder" }
287 { EnumList+="clAppWorkSpace, clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DDkShadow, cl3DLight, clInfoText, clInfoBk, clDefault, clNone" }
288 { EnumList+="clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
289 { Category=Appearance }
290 { InitialValue=clInfoText }
291 Procedure Set piTextColor Integer iValue
292 Integer iVoid
293 Handle hToolTip
294 Get phToolTip to hToolTip
295 Move (SendMessage(hToolTip, TTM_SETTIPTEXTCOLOR, iValue, 0)) to iVoid
296 End_Procedure
297
298 { MethodType=Property }
299 Function piTextColor Returns Boolean
300 Integer iValue
301 Handle hToolTip
302 Get phToolTip to hToolTip
303 Move (SendMessage(hToolTip, TTM_GETTIPTEXTCOLOR, 0, 0)) to iValue
304 Function_Return iValue
305 End_Function // piTextColor
306
307
308 // piDurationInitial:
309
310 // Sets the amount of time a pointer must remain stationary within a control's bounding rectangle before the ToolTip appears.
311 { MethodType=Property }
312 { Category=Behavior }
313 { InitialValue=-1 }
314 Procedure Set piDurationInitial Integer iValue
315 Integer iVoid
316 Handle hToolTip
317 Get phToolTip to hToolTip
318 Move (SendMessage(hToolTip, TTM_SETDELAYTIME, TTDT_INITIAL, iValue)) to iVoid
319 End_Procedure
320
321 { MethodType=Property }
322 Function piDurationInitial Returns Integer
323 Integer iValue
324 Handle hToolTip
325 Get phToolTip to hToolTip
326 Move (SendMessage(hToolTip, TTM_GETDELAYTIME, TTDT_INITIAL, 0)) to iValue
327 Function_Return iValue
328 End_Function // piDurationInitial
329
330
331 // piDurationReshow:
332
333 // Sets the amount of time it takes for subsequent ToolTip windows to appear as the pointer moves from one control to another.
334 { MethodType=Property }
335 { Category=Behavior }
336 { InitialValue=-1 }
337 Procedure Set piDurationReshow Integer iValue
338 Integer iVoid
339 Handle hToolTip
340 Get phToolTip to hToolTip
341 Move (SendMessage(hToolTip, TTM_SETDELAYTIME, TTDT_RESHOW, iValue)) to iVoid
342 End_Procedure
343
344 { MethodType=Property }
345 Function piDurationReshow Returns Integer
346 Integer iValue
347 Handle hToolTip
348 Get phToolTip to hToolTip
349 Move (SendMessage(hToolTip, TTM_GETDELAYTIME, TTDT_RESHOW, 0)) to iValue
350 Function_Return iValue
351 End_Function // piDurationReshow
352
353
354 // piDurationPopup:
355
356 // Sets the amount of time a ToolTip remains visible if the pointer is stationary within a control's bounding rectangle.
357 { MethodType=Property }
358 { Category=Behavior }
359 { InitialValue=-1 }
360 Procedure Set piDurationPopup Integer iValue
361 Integer iVoid
362 Handle hToolTip
363 Get phToolTip to hToolTip
364 Move (SendMessage(hToolTip, TTM_SETDELAYTIME, TTDT_AUTOPOP, iValue)) to iVoid
365 End_Procedure
366
367 { MethodType=Property }
368 Function piDurationPopup Returns Integer
369 Integer iValue
370 Handle hToolTip
371 Get phToolTip to hToolTip
372 Move (SendMessage(hToolTip, TTM_GETDELAYTIME, TTDT_AUTOPOP, 0)) to iValue
373 Function_Return iValue
374 End_Function // piDurationPopup
375
376
377 // piIcon:
378
379 // Used to Set a standard icon in the tooltip. See also LoadIcon.
380 { MethodType=Property }
381 { EnumList="TTI_NONE, TTI_INFO, TTI_WARNING, TTI_ERROR, TTI_INFO_LARGE, TTI_WARNING_LARGE, TTI_ERROR_LARGE" }
382 { Category=Appearance }
383 { InitialValue=TTI_NONE }
384 Procedure Set piIcon Integer iValue
385 Integer iVoid
386 String sTitle
387 Pointer lpsTitle
388 Handle hToolTip
389
390 // Icon does not work if title is blank. If title is blank, we will force it to "Set a Title"...
391 Get psTitle_private to sTitle
392 If (sTitle = "") Move "Title" to sTitle
393 Move (ToANSI(sTitle)) to sTitle
394 Move (AddressOf(sTitle)) to lpsTitle
395
396 Get phToolTip to hToolTip
397 Move (SendMessage(hToolTip, TTM_SETTITLE, iValue, lpsTitle)) to iVoid
398 Set piIcon_private to iValue // Set the icon ID
399 Set psIcon_private to "" // clear the icon filename
400 End_Procedure
401
402 { MethodType=Property }
403 Function piIcon Returns Integer
404 Integer iIcon
405 Get piIcon_private to iIcon
406 Function_Return iIcon
407 End_Function // piIcon
408
409
410 // piMarginBottom:
411
412 // Distance Between bottom border and bottom of ToolTip text, in pixels.
413 { MethodType=Property }
414 { Category=Appearance }
415 { InitialValue=0 }
416 Procedure Set piMarginBottom Integer iValue
417 Integer iVoid
418 Handle hToolTip
419 Pointer lpRect
420 tWinRect ARect
421
422 Get phToolTip to hToolTip
423 Move (AddressOf(ARect)) to lpRect
424 Move (SendMessage(hToolTip, TTM_GETMARGIN, 0, lpRect)) to iVoid // Get the current margins
425
426 Move iValue to ARect.bottom
427 Move (SendMessage(hToolTip, TTM_SETMARGIN, 0, lpRect)) to iVoid // Set the new margin value
428 End_Procedure
429
430 { MethodType=Property }
431 Function piMarginBottom Returns Integer
432 Integer iVoid
433 Handle hToolTip
434 Pointer lpRect
435 tWinRect ARect
436
437 Get phToolTip to hToolTip
438 Move (AddressOf(ARect)) to lpRect
439 Move (SendMessage(hToolTip, TTM_GETMARGIN, 0, lpRect)) to iVoid // Get the current margins
440 Function_Return ARect.bottom
441 End_Function // piMarginBottom
442
443
444 // piMarginLeft:
445
446 // Distance Between left border and left End of ToolTip text, in pixels.
447 { MethodType=Property }
448 { Category=Appearance }
449 { InitialValue=0 }
450 Procedure Set piMarginLeft Integer iValue
451 Integer iVoid
452 Handle hToolTip
453 Pointer lpRect
454 tWinRect ARect
455
456 Get phToolTip to hToolTip
457 Move (AddressOf(ARect)) to lpRect
458 Move (SendMessage(hToolTip, TTM_GETMARGIN, 0, lpRect)) to iVoid // Get the current margins
459
460 Move iValue to ARect.left
461 Move (SendMessage(hToolTip, TTM_SETMARGIN, 0, lpRect)) to iVoid // Set the new margin value
462 End_Procedure
463
464 { MethodType=Property }
465 Function piMarginLeft Returns Integer
466 Integer iVoid
467 Handle hToolTip
468 Pointer lpRect
469 tWinRect ARect
470
471 Get phToolTip to hToolTip
472 Move (AddressOf(ARect)) to lpRect
473 Move (SendMessage(hToolTip, TTM_GETMARGIN, 0, lpRect)) to iVoid // Get the current margins
474 Function_Return ARect.left
475 End_Function // piMarginLeft
476
477
478 // piMarginRight:
479
480 // Distance Between right border and right End of ToolTip text, in pixels.
481 { MethodType=Property }
482 { Category=Appearance }
483 { InitialValue=0 }
484 Procedure Set piMarginRight Integer iValue
485 Integer iVoid
486 Handle hToolTip
487 Pointer lpRect
488 tWinRect ARect
489
490 Get phToolTip to hToolTip
491 Move (AddressOf(ARect)) to lpRect
492 Move (SendMessage(hToolTip, TTM_GETMARGIN, 0, lpRect)) to iVoid // Get the current margins
493
494 Move iValue to ARect.right
495 Move (SendMessage(hToolTip, TTM_SETMARGIN, 0, lpRect)) to iVoid // Set the new margin value
496 End_Procedure
497
498 { MethodType=Property }
499 Function piMarginRight Returns Integer
500 Integer iVoid
501 Handle hToolTip
502 Pointer lpRect
503 tWinRect ARect
504
505 Get phToolTip to hToolTip
506 Move (AddressOf(ARect)) to lpRect
507 Move (SendMessage(hToolTip, TTM_GETMARGIN, 0, lpRect)) to iVoid // Get the current margins
508 Function_Return ARect.right
509 End_Function // piMarginRight
510
511
512 // piMarginTop:
513
514 // Distance Between top border and top of ToolTip text, in pixels.
515 { MethodType=Property }
516 { Category=Appearance }
517 { InitialValue=0 }
518 Procedure Set piMarginTop Integer iValue
519 Integer iVoid
520 Handle hToolTip
521 Pointer lpRect
522 tWinRect ARect
523
524 Get phToolTip to hToolTip
525 Move (AddressOf(ARect)) to lpRect
526 Move (SendMessage(hToolTip, TTM_GETMARGIN, 0, lpRect)) to iVoid // Get the current margins
527
528 Move iValue to ARect.top
529 Move (SendMessage(hToolTip, TTM_SETMARGIN, 0, lpRect)) to iVoid // Set the new margin value
530 End_Procedure
531
532 { MethodType=Property }
533 Function piMarginTop Returns Integer
534 Integer iVoid
535 Handle hToolTip
536 Pointer lpRect
537 tWinRect ARect
538
539 Get phToolTip to hToolTip
540 Move (AddressOf(ARect)) to lpRect
541 Move (SendMessage(hToolTip, TTM_GETMARGIN, 0, lpRect)) to iVoid // Get the current margins
542 Function_Return ARect.top
543 End_Function // piMarginTop
544
545
546 // piMaxWidth:
547
548 // Sets the maximum width for a ToolTip window. If a ToolTip String exceeds the maximum width,
549 // the control breaks the text into multiple lines.
550 { MethodType=Property }
551 { Category=Appearance }
552 { InitialValue=-1 }
553 Procedure Set piMaxWidth Integer iValue
554 Integer iVoid
555 Handle hToolTip
556 Get phToolTip to hToolTip
557 Move (SendMessage(hToolTip, TTM_SETMAXTIPWIDTH, 0, iValue)) to iVoid
558 End_Procedure
559
560 { MethodType=Property }
561 Function piMaxWidth Returns Integer
562 Integer iValue
563 Handle hToolTip
564 Get phToolTip to hToolTip
565 Move (SendMessage(hToolTip, TTM_GETMAXTIPWIDTH, 0, 0)) to iValue
566 Function_Return iValue
567 End_Function // piMaxWidth
568
569
570 // psTitle:
571
572 // Used to set a tooltip title.
573 { MethodType=Property }
574 { Category=Appearance }
575 { InitialValue="" }
576 Procedure Set psTitle String sTitle
577 Integer iVoid iIcon
578 Pointer lpsTitle
579 Handle hToolTip
580 String sIcon
581
582 Set psTitle_private to sTitle
583 Move (ToANSI(sTitle)) to sTitle
584
585 // Icon & title must be set together. Determine what the icon is so we can set it.
586 // It will be either an icon ID for a standard icon, or an icon filename....
587 Get piIcon to iIcon
588 If (iIcon <> TTI_NONE) Begin
589 Set piIcon to iIcon // this will set the icon & title.
590 Procedure_Return
591 End
592
593 // Test if an icon filename is set....
594 Get psIcon_private to sIcon
595 If (sIcon <> "") Begin
596 Send LoadIcon sIcon // this will set icon & title.
597 Procedure_Return
598 End
599
600 // If we got here then there is no icon, just set the title then....
601 Get phToolTip to hToolTip
602 Move (AddressOf(sTitle)) to lpsTitle
603 Move (SendMessage(hToolTip, TTM_SETTITLE, TTI_NONE, lpsTitle)) to iVoid
604 End_Procedure
605
606 { MethodType=Property }
607 Function psTitle Returns String
608 String sTitle
609 Get psTitle_private to sTitle
610 Function_Return sTitle
611 End_Function // psTitle
612
613
614 // AddToolTip:
615
616 // Send this to Add a UI Object's tooltip to the tooltip collection.
617 Procedure AddToolTip Pointer lpToolInfo
618 Integer iRet iVoid
619 Handle hToolTip
620
621 Get phToolTip to hToolTip
622 Move (SendMessage(hToolTip, TTM_ADDTOOL, 0, lpToolInfo)) to iRet
623
624 // Handle Errors....
625 If (iRet = 0) Begin
626 Move (ShowLastError()) to iVoid
627 End
628 End_Procedure // AddToolTip
629
630
631 // AdjustDurationProportions:
632
633 // Sets the piDurationInitial to the passed value then adjusts the remaining delay Time properties to their default proportions reltive to.
634 // the passed initial duration.
635 Procedure AdjustDurationProportions Integer iInitialDuration
636 Integer iVoid
637 Handle hToolTip
638 Get phToolTip to hToolTip
639 Move (SendMessage(hToolTip, TTM_SETDELAYTIME, TTDT_AUTOMATIC, iInitialDuration)) to iVoid
640 End_Procedure // AdjustDurationProportions
641
642
643 // CreateToolTipWindow:
644
645 // Creates the Tooltip control.
646 { Visibility=Private }
647 Procedure CreateToolTipWindow
648 Handle hWndToolTip
649 Integer iVoid
650 DWord dwStyle
651 String sClassName
652 Pointer lpClassName
653 Boolean bBalloonStyle bUseAnimation bUseFading bUsePrefix
654
655 Get pbBalloonStyle_private to bBalloonStyle
656 Get pbUseAnimation_private to bUseAnimation
657 Get pbUseFading_private to bUseFading
658 Get pbUsePrefix_private to bUsePrefix
659
660 // Create the Tooltip style....
661 Move (WS_POPUP ior TTS_ALWAYSTIP) to dwStyle
662
663 If (bBalloonStyle) Begin
664 Move (AddBitValue(TTS_BALLOON, dwStyle)) to dwStyle
665 End
666
667 If (not(bUseAnimation)) Begin
668 Move (AddBitValue(TTS_NOANIMATE, dwStyle)) to dwStyle
669 End
670
671 If (not(bUseFading)) Begin
672 Move (AddBitValue(TTS_NOFADE, dwStyle)) to dwStyle
673 End
674
675 If (not(bUsePrefix)) Begin
676 Move (AddBitValue(TTS_NOPREFIX, dwStyle)) to dwStyle
677 End
678
679 // Get the other information we need to create the window....
680 Move ("Tooltips_Class32" + (Character(0))) to sClassName
681 Move (AddressOf(sClassName)) to lpClassName
682
683 // Create the window....
684 Move (CreateWindowEx(0, lpClassName, 0, dwStyle, ;
685 CW_USEDEFAULT, CW_USEDEFAULT, ;
686 CW_USEDEFAULT, CW_USEDEFAULT, ;
687 0, 0, 0, 0)) to hWndToolTip
688
689 // Handle Errors....
690 If (hWndToolTip = 0) Begin
691 Move (ShowLastError()) to iVoid
692 End
693
694 Set phToolTip to hWndToolTip
695 Set pbUsePrefix to False // change the control's default value
696 End_Procedure // CreateToolTipWindow
697
698
699 // DeleteToolTip:
700
701 // Send this to remove a UI Object's tooltip from the tooltip collection.
702 Procedure DeleteToolTip Pointer lpToolInfo
703 Integer iRet iVoid
704 Handle hToolTip
705
706 Get phToolTip to hToolTip
707 Move (SendMessage(hToolTip, TTM_DELTOOL, 0, lpToolInfo)) to iRet
708
709 // Handle Errors....
710 If (iRet = 0) Begin
711 Move (ShowLastError()) to iVoid
712 End
713 End_Procedure // DeleteToolTip
714
715
716 // Destroy_Object:
717
718 // Augmented to destroy the ToolTip control.
719 { Visibility=Private }
720 Procedure Destroy_Object
721 Integer iRet iVoid
722 Handle hToolTip
723 String sLastError
724
725 Get phToolTip to hToolTip
726 Move (DestroyWindow(hToolTip)) to iRet
727
728 // Handle Errors....
729 If (iRet = 0) Begin
730 Move (ShowLastError()) to iVoid
731 End
732
733 Forward Send Destroy_Object
734 End_Procedure // Destroy_Object
735
736
737 // LoadIcon:
738
739 // Loads an icon from disk, or resource and sets piIcon to the icon handle of the loaded icon.
740 // Use this to display an icon that is not one of the system icons.
741 Procedure LoadIcon String sIcon
742 Integer iVoid
743 Handle hIcon hToolTip
744 String sTitle
745 Pointer lpsTitle
746
747 Move (LoadImage(GetModuleHandle(0), sIcon, IMAGE_ICON, 0, 0, LR_DEFAULTSIZE)) to hIcon
748
749 If (hIcon = 0) Begin // the bitmap was not in the EXE resource
750 Get_File_Path sIcon to sIcon // find path in DFPATH, if appropriate
751
752 If (sIcon <> "") Begin // The image was found!
753 Move (LoadImage(0, sIcon, IMAGE_ICON, 0, 0, LR_LOADFROMFILE + LR_DEFAULTSIZE)) to hIcon
754 End
755 End
756
757 If (hIcon <> 0) Begin
758 // Icon does not work if title is blank. If title is blank, we will force it to "Set a Title"...
759 Get psTitle_private to sTitle
760 If (sTitle = "") Move "Title" to sTitle
761 Move (ToANSI(sTitle)) to sTitle
762 Move (AddressOf(sTitle)) to lpsTitle
763
764 Get phToolTip to hToolTip
765 Move (SendMessage(hToolTip, TTM_SETTITLE, hIcon, lpsTitle)) to iVoid
766 Move (DestroyIcon(hIcon)) to iVoid
767
768 // Set the private properties....
769 Set piIcon_Private to TTI_NONE
770 Set psIcon_private to sIcon
771 End
772 End_Procedure // LoadIcon
773
774
775 // ToolTipCount
776
777 // Returns the number of tooltips currently in the tooltip collection.
778 Function ToolTipCount Returns Integer
779 Integer iCount
780 Handle hToolTip
781
782 Get phToolTip to hToolTip
783 Move (SendMessage(hToolTip, TTM_GETTOOLCOUNT, 0, 0)) to iCount
784 Function_Return iCount
785 End_Function // ToolTipCount
786
787
788 // UpdateToolTip:
789
790 // Send this to update a UI Object's tooltip in the tooltip collection.
791 Procedure UpdateToolTip Pointer lpToolInfo
792 Integer iRet iVoid
793 Handle hToolTip
794
795 Get phToolTip to hToolTip
796 Move (SendMessage(hToolTip, TTM_UPDATETIPTEXT, 0, lpToolInfo)) to iRet
797
798 // Handle Errors....
799 If (iRet = 0) Begin
800 Move (ShowLastError()) to iVoid
801 End
802 End_Procedure // UpdateToolTip
803End_Class // cToolTipController