*** Tooltip in grid example by Igor Korolev Create Table test1 (nId I, cName C(180), cMemo M) For I = 1 To 20 Insert Into test1 (nId, cName, cMemo) Values (Int (Rand ()*1000000), ; "Long record" + Replicate (Transform (Rand()*100000000000) + " ", 5)+ " last word", ; "Very long memo record " + Replicate (Transform (Rand()*100000000000) + " ", 10) + " one last word") Endfor Go Top In test1 Public oform1 oform1=Newobject("form1") oform1.Show Return ************************************************** *-- Form: form1 *-- ParentClass: form *-- BaseClass: form *-- Time Stamp: 04/16/02 02:33:05 PM Define Class form1 As Form Top = 0 Height = 240 Width = 372 Caption = "Form1" Name = "Form1" Add Object grid1 As Grid With ; ColumnCount = -1, ; Height = 240, ; Left = 0, ; Top = 0, ; Width = 372, ; Name = "Grid1", ; RowSource = "test1" Add Object _tooltipengine1 As _tooltipengine PROCEDURE Init thisform._tooltipengine1.oGridObj = thisform.grid1 ENDPROC Procedure Resize Thisform.grid1.Width = Thisform.Width Thisform.grid1.Height = Thisform.Height Endproc Enddefine ************************************************** *-- Class: _TooltipEngine *-- ParentClass: timer *-- BaseClass: timer *-- Time Stamp: 04/07/02 04:01:14 PM *-- Timer to show multi-line tooltip Define Class _tooltipengine As Timer Height = 0 Width = 0 Interval = 200 *-- Width of the tooltip if the control doesn't explicitly set _nTooltipWidth nDefaultWidth = 100 *-- Do we want to show tooltip? lShowTips = .T. *-- Tooltip window object reference oToolTip = NULL * Grid object reference oGridObj = NULL Name = "_tooltipengine" Procedure Init If Version (5) < 700 Return .F. Endif Declare Integer GetWindowRect In WIN32API ; INTEGER HWnd, String @ lpRect If This.lShowTips This.AddProperty ("cLastObjPath", "") Thisform.ShowTips = .F. This.oToolTip = Newobject ("_TooltipWindow", This.ClassLibrary) This.oToolTip.Move (-1000, -1000, 0, 0) This.oToolTip.Show () Thisform.Show () If Type ("ThisForm._ñTooltipUniqID") # "C" Thisform.AddProperty ("_cTooltipUniqID", Sys(2015)) Endif Endif ENDPROC Procedure Timer Local lcRect, lnTop, lnLeft Local Array laTmp (4) If Thisform.LockScreen Or _Screen.LockScreen Or !Thisform.Visible Or !This.lShowTips Return Endif If Amouseobj (laTmp, 1) = 4 And Type ("m.laTmp(2)._cTooltipUniqID") == "C" And ; m.laTmp(2)._cTooltipUniqID = Thisform._cTooltipUniqID And ; TYPE ("m.laTmp(1)") == "O" And !Isnull (m.laTmp(1)) If This.cLastObjPath == Sys (1272, laTmp(1)) * Show tooltip lcRect = Space (16) = GetWindowRect (Thisform.HWnd, @m.lcRect) If Lower (m.laTmp(2).BaseClass) == "toolbar" lnTop = m.laTmp (4) + Asc (Substr (m.lcRect, 5)) + 2^8 * Asc (Substr(m.lcRect, 6)) + ; 2^16 * Asc (Substr (m.lcRect, 7)) + 2^24 * Asc (Substr (m.lcRect, 8))+ ; IIF (m.laTmp(2).Docked, 0, Sysmetric (34) + Sysmetric (4)) + 8 lnLeft = m.laTmp (3) + Asc (m.lcRect) + 2^8 * Asc (Substr (m.lcRect,2)) + ; 2^16 * Asc (Substr (m.lcRect, 3)) + 2^24 * Asc (Substr (m.lcRect, 4)) +; IIF (m.laTmp(2).Docked, Sysmetric (10), Sysmetric (3)) + 2 Else && Form lnTop = laTmp (4) + Asc (Substr (m.lcRect, 5)) + 2^8 * Asc (Substr(m.lcRect, 6)) + ; 2^16 * Asc (Substr (m.lcRect, 7)) + 2^24 * Asc (Substr (m.lcRect, 8))+ ; IIF (laTmp(2).TitleBar = 1, Iif (laTmp(2).HalfHeightCaption,Sysmetric (34), Sysmetric (9)), 0) + 12 - ; ThisForm.ViewPortTop lnLeft = laTmp (3) + Asc (m.lcRect) + 2^8 * Asc (Substr (m.lcRect,2)) + ; 2^16 * Asc (Substr (m.lcRect, 3)) + 2^24 * Asc (Substr (m.lcRect, 4))+ ; + 4 - Thisform.ViewPortLeft Endif Local lnWhat, lnRow, lnCol, lcCaption lcCaption = "" Thisform.LockScreen = .T. If This.oGridObj.GridHitTest (m.laTmp (3), m.laTmp (4), ; @m.lnWhat, @m.lnRow, @m.lnCol) If m.lnWhat = 3 m.lnCol = m.lnCol + This.oGridObj.LeftColumn - 1 If This.oGridObj.RelativeRow # 0 lnRow = m.lnRow - This.oGridObj.RelativeRow If m.lnRow # 0 Skip m.lnRow In This.oGridObj.RecordSource lcCaption = ; TRANSFORM (Evaluate (This.oGridObj.Columns(m.lnCol).ControlSource)) Skip -m.lnRow In This.oGridObj.RecordSource Else lcCaption = ; TRANSFORM (Evaluate (This.oGridObj.Columns(m.lnCol).ControlSource)) Endif Else Mouse Click Left lcCaption = ; TRANSFORM (Evaluate(This.oGridObj.Columns(m.lnCol).ControlSource)) Endif Else * We're not on the column with data lcCaption = "Nothing to display" Endif Endif This.oToolTip.lblText.Caption = Left (Alltrim (m.lcCaption),255) Thisform.LockScreen = .F. This.oToolTip.lblText.Width = Iif (Type ("m.laTmp(1)._nTooltipWidth") == "N" And ; !Empty (m.laTmp(1)._nTooltipWidth), ; laTmp(1)._nTooltipWidth, This.nDefaultWidth) _Screen.LockScreen = .T. This.oToolTip.lblText.Visible = .F. This.oToolTip.lblText.Visible = .T. lnWidth = This.oToolTip.lblText.Width lnHeight = This.oToolTip.lblText.Height This.oToolTip.Move (m.lnLeft, m.lnTop, m.lnWidth, m.lnHeight) _Screen.LockScreen = .F. Else This.cLastObjPath = Sys (1272, m.laTmp(1)) This.oToolTip.Move (-1000, -1000, 0, 0) Endif Else * Hide tooltip This.cLastObjPath = "" This.oToolTip.Move (-1000, -1000, 0, 0) Endif Endproc Enddefine ************************************************** *-- Class: _tooltipwindow *-- ParentClass: form *-- BaseClass: form *-- Time Stamp: 04/07/02 03:54:05 PM *-- Window to show tooltip Define Class _tooltipwindow As Form Desktop = .T. ShowWindow = 1 BorderStyle = 1 Caption = "" TabStop = .F. TitleBar = 0 AlwaysOnTop = .T. Name = "_tooltipwindow" Add Object lblText As Label With ; AutoSize = .T., ; FontSize = 8, ; WordWrap = .T., ; BackStyle = 0, ; Caption = "TooltipText", ; Name = "lblText" Procedure Init Declare Integer GetSysColor In WIN32API Integer This.BackColor = GetSysColor (24) && TooltipBackColor This.lblText.ForeColor = GetSysColor (23) && TooltipForeColor Endproc Procedure lblText.MouseMove Lparameters nButton, nShift, nXCoord, nYCoord Thisform.Move (-1000, -1000, 0 ,0) Endproc Procedure lblText.Click Thisform.Move (-1000, -1000, 0 ,0) Endproc ENDDEFINE ** The most dificult task, as you can see, *** was to figure out how to find the field's content *** where the mouse cursor is located *** In case the cell is in the invisible part of the grid *** (as a result of scrolling), it's almost impossible to find the cell value, *** that's why I added MOUSE CLICK for such cases. ** I would appreciate your comments ** WBR, Igor Korolev