Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Grid Cell setfocus on MouseMove (with Tooltips & Hilighter)

Grids

Grid Cell setfocus on MouseMove (with Tooltips & Hilighter)

by  AirCon  Posted    (Edited  )
An example of using Grid.GridHitTest() method. This method can be use to locate mouse cursor in grid.

Copy & Paste the code into a PRG and run it.


[color green]**************************************************[/color]

PUBLIC oform1

oform1=NEWOBJECT("form1")
oform1.Show
RETURN


[color green]**************************************************[/color]

DEFINE CLASS form1 AS form
Top = 0
Left = 0
Height = 323
Width = 337
DoCreate = .T.
ShowTips = .T.
Caption = " Grid with Tooltip"
browser = .NULL.
columnbold = ""
nrow = 0
ncol = 0
ncol2 = 0
nrow2 = 0
nrec = 0
ctooltip = ""
lEditMode = .T.
Name = "Form1"

ADD OBJECT grid1 AS grid WITH ;
ColumnCount = 3, HeaderHeight = 35, ;
Left = 0, Top = 0, ;
Height = 323, Width = 318, ;
Panel = 1, RowHeight = 24, ;
RecordSource = "test_data", ;
TabIndex = 11, ;
Name = "Grid1", ;
Column1.ControlSource = "test_data.usercode", ;
Column1.Width = 59, ;
Column1.Visible = .T., ;
Column1.Name = "Column1", ;
Column2.ControlSource = "test_data.prod_code", ;
Column2.Width = 87, ;
Column2.Visible = .T., ;
Column2.Name = "Column2", ;
Column3.ControlSource = "test_data.prod_name", ;
Column3.Width = 126, ;
Column3.Name = "Column3"

PROCEDURE Resize
This.grid1.Height = This.Height
This.grid1.Width = This.Width
ENDPROC

PROCEDURE Unload
Close databases all
Wait clear
ENDPROC

PROCEDURE Init

ENDPROC

PROCEDURE Load
Create cursor Test_Data ;
(UserCode C(3), UserName C(15), Prod_Code C(3), Prod_Name C(15), Prod_Info C(15))
Insert into Test_Data Values ;
('001', 'My Name', '001', 'Product #1', 'InfoTip #1')
Insert into Test_Data Values ;
('002', 'Your Name', '002', 'Product #2', 'InfoTip #2')
Insert into Test_Data Values ;
('003', 'His Name', '003', 'Product #3', 'InfoTip #3')
Insert into Test_Data Values ;
('004', 'Her Name', '004', 'Product #4', 'InfoTip #4')
Insert into Test_Data Values ;
('005', 'Whatever', '005', 'Product #5', 'InfoTip #5')
Insert into Test_Data Values ;
('006', 'Blah!', '006', 'Product #6', 'InfoTip #6')
Go top
ENDPROC


PROCEDURE grid1.Init
With This
.Column1.Header1.Caption = "User"
.Column2.Header1.Caption = "Product Code"
.Column3.Header1.Caption = "Product Name"
.Column1.RemoveObject('Text1')
.Column2.RemoveObject('Text1')
.Column3.RemoveObject('Text1')
.Column1.AddObject('Text1', 'GridText')
.Column2.AddObject('Text1', 'GridText')
.Column3.AddObject('Text1', 'GridText')

.SetAll('Alignment', 2, 'Header')
.SetAll('DynamicBackColor', ;
'iif(ThisForm.nRec == recno(), RGB(0,0,160), ' + ;
'This.BackColor)', 'Column')
.SetAll('DynamicForeColor', ;
'iif(ThisForm.nRec == recno(), RGB(255,255,0), ' + ;
'This.ForeColor)', 'Column')
EndWith
ThisForm.Height = This.Height
ThisForm.Width = This.Width
ENDPROC

PROCEDURE grid1.MouseMove
LPARAMETERS nButton, nShift, nXCoord, nYCoord
Local lnWhere, lnRelRow, lnRelCol, lnX, lcColumn
Store 0 to lnWhere, lnRelRow, lnRelCol

This.GridHitTest(nXCoord, nYCoord, @lnWhere, @lnRelRow, @lnRelCol)
With ThisForm
If .lEditMode
This.ToolTipText = '
If ((lnRelRow != .nrow) or (lnRelCol != .ncol) or ;
empty(.ctooltip)) and (lnWhere == 3) and ;
between(lnRelCol, 1, This.ColumnCount)

.nrow = lnRelRow
.ncol = lnRelCol
.LockScreen = .T.
This.ActivateCell(lnRelRow, lnRelCol)
Go recno()
.nrec = recno()
Do case
Case (lnRelCol == 1)
.ctooltip = ' ' + alltrim(UserName) + ' '
Case between(lnRelCol, 2, 3)
.ctooltip = ' ' + alltrim(Prod_Info) + ' '
EndCase
This.Columns[lnRelCol].Text1.ToolTipText = .ctooltip
This.Refresh()
.LockScreen = .F.
NoDefault
endif
else
If ((lnRelRow != .nrow2) or (lnRelCol != .ncol2)) and ;
(lnWhere = 3) and between(lnRelCol, 1, This.ColumnCount)

.nrow2 = lnRelRow
.ncol2 = lnRelCol
lnRec = recno()
.LockScreen = .T.
This.ActivateCell(lnRelRow, lnRelCol)
Go recno()
.nrec = recno()
This.ActivateCell(.nrow, .ncol)
This.Refresh()
.LockScreen = .F.
NoDefault
endif

endif
EndWith
ENDPROC

PROCEDURE grid1.Column1.MouseMove
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
ENDPROC

PROCEDURE grid1.Column2.MouseMove
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
ENDPROC

PROCEDURE grid1.Column3.MouseMove
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
ENDPROC
ENDDEFINE

[color green]**************************************************[/color]

DEFINE CLASS GridText AS textbox
Height = 23
Width = 100
Name = "Text"
Visible = .T.
BorderStyle = 1
Margin = 2

PROCEDURE Click
With ThisForm
If .lEditMode
Keyboard '{Home}' clear
.lEditMode = .F.
else
.nrow = .nrow2
.ncol = .ncol2
endif
.nrec = recno()
EndWith
ENDPROC

PROCEDURE MouseMove
LPARAMETERS nButton, nShift, nXCoord, nYCoord
This.Parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
ENDPROC

PROCEDURE KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl
ThisForm.lEditMode = .F.
ENDPROC

PROCEDURE LostFocus
If inlist(lastkey(), 5, 9, 13, 15, 24, 27)
ThisForm.lEditMode = .T.
endif
ENDPROC
ENDDEFINE

[color green]**************************************************[/color]
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top