Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Grid's tooltip
Message
 
 
Information générale
Forum:
Visual FoxPro
Catégorie:
Autre
Titre:
Versions des environnements
Visual FoxPro:
VFP 9 SP1
OS:
Windows XP SP2
Divers
Thread ID:
01109969
Message ID:
01227209
Vues:
41
Here is the code (I translated some of the comments and tried to isolate timer's code as a separate class with all the required functionality).
*** 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
If it's not broken, fix it until it is.


My Blog
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform