Mike Gagnon
|
Je crois que cette example fonctionne en VFP6. (Je n<ai plus VFP6 pour tester). Copie ce qui suit dans un prg et roule.
PUBLIC
oform1
oform1=NEWOBJECT("form1")
oform1.Show
RETURN
**************************************************
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
**************************************************
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
Mike Gagnon
|