Adding Checkbox to Grid header #VFP

* [Edited: modified version using ObjToClienT()]
* Source : Stefan Wuebbe – http://www.foxite.com/archives/0000331613.htm
LOCAL oForm as Form
oForm = CREATEOBJECT(‘TestForm’)
oForm.Show(1)
RETURN

DEFINE CLASS TestForm as Form
AutoCenter = .T.
Width = 500
Height = 600
MinWidth = 200
MinHeight = 100

PROCEDURE Load
CREATE CURSOR temp (f1 L, f2 L, f3 L, f4 C(30))
LOCAL i
FOR i = 1 TO 30
INSERT INTO temp VALUES (i%2=0, i%3=0, i%4=0, REPLICATE(TRANSFORM(i),10))
ENDFOR
GO TOP IN temp
ENDPROC

ADD OBJECT grdTest as Grid WITH ;
Left = 10, Top = 10, Width = 480, Height = 580, ;
DeleteMark = .F., RecordMark = .F., ;
Anchor = 15, RecordSource = ‘temp’
PROCEDURE grdTest.Init
STORE 75 TO This.Column1.Width, This.Column2.Width, This.Column3.Width

LOCAL loColumn as Column, loCheckbox as CheckBox
FOR EACH loColumn IN This.Columns
IF TYPE(‘EVALUATE(m.loColumn.ControlSource)’) = ‘L’

* Add Header CheckBox
*!* loColumn.Header1.Caption = “”
loColumn.AddProperty(‘myCheckbox’,SYS(2015))
Thisform.NewObject(m.loColumn.myCheckbox,’HeaderCheckbox’)
loCheckbox = GETPEM(Thisform,m.loColumn.myCheckbox)
loCheckbox.cColumnName = ‘Thisform.grdTest.’ + m.loColumn.Name
loCheckbox.AfterInit()
loCheckbox.Visible = .T.

* Add Column CheckBox
loColumn.AddObject(‘Check1′,’Checkbox’)
WITH loColumn.Check1 as CheckBox
.Caption = “”
.Visible = .T.
ENDWITH
loColumn.CurrentControl = ‘Check1′
loColumn.Sparse = .F.

ENDIF
NEXT
ENDPROC
ENDDEFINE

DEFINE CLASS HeaderCheckbox as Checkbox
Caption = “”
Value = .F.
Width = 15
cColumnName = “”

PROCEDURE AfterInit
LOCAL llSuccess, lcErrorMessage, ;
loColumn as Column, ;
loGrid as Grid, ;
loException as Exception
llSuccess = .T.
lcErrorMessage = “”
TRY
loColumn = EVALUATE(This.cColumnName)
loGrid = m.loColumn.Parent
FOR EACH loColumn IN m.loGrid.Columns
BINDEVENT(m.loColumn,’Resize’, This,’AutoPos’)
BINDEVENT(m.loColumn,’Moved’, This,’AutoPos’)
BINDEVENT(m.loColumn.Header1,’Click’, This,’AutoPos’)
BINDEVENT(m.loColumn.Header1,’MouseDown’, This,’AutoPos’)
BINDEVENT(m.loColumn.Parent,’Scrolled’, This,’AutoPos’)
NEXT
CATCH TO loException
llSuccess = .F.
lcErrorMessage = m.loException.Message
ENDTRY
ASSERT m.llSuccess MESSAGE m.lcErrorMessage

IF m.llSuccess
BINDEVENT(Thisform,’Resize’, This,’AutoPos’)
This.AutoPos()
ENDIF
ENDPROC

PROCEDURE AutoPos(dummy1, dummy2, dummy3, dummy3) && dummies for BindEvent(“MouseDown”/”Scrolled”)

LOCAL ;
llSuccess, lcErrorMessage, ;
loColumn as Column, loGrid as Grid, ;
lnTop, lnLeft, ;
loException as Exception
llSuccess = .T.
lcErrorMessage = “”
TRY
loColumn = EVALUATE(This.cColumnName)
loGrid = m.loColumn.Parent
lnTop = m.loGrid.Top + 2
lnLeft = OBJTOCLIENT(m.loColumn, 2)
IF m.lnLeft > 10
lnLeft = m.lnLeft + m.loColumn.Width – This.Width*2
ENDIF

IF BETWEEN(m.lnLeft, 11,m.loGrid.Width – SYSMETRIC(5))
This.Visible = .T.
This.Move(m.lnLeft,m.lnTop)
ELSE
This.Visible = .F.
ENDIF
CATCH TO loException
llSuccess = .F.
lcErrorMessage = m.loException.Message
ENDTRY
ASSERT m.llSuccess MESSAGE m.lcErrorMessage
ENDPROC

PROCEDURE Valid
LOCAL loColumn as Column, lcAlias, lnRecNo
loColumn = EVALUATE(This.cColumnName)
lcAlias = GETWORDNUM(m.loColumn.ControlSource,1,’.’)
lnRecNo = RECNO(m.lcAlias)
REPLACE (m.loColumn.ControlSource) WITH This.Value ALL IN (m.lcAlias)
GO RECORD (m.lnRecno) IN (m.lcAlias)

Thisform.SetAll(‘lAutoPos’,.T.)
ENDPROC

PROCEDURE Destroy
UNBINDEVENTS(This)
ENDPROC

lAutoPos = .F.
PROCEDURE lAutoPos_assign(tlNewVal)
IF m.tlNewVal
This.AutoPos()
ENDIF
ENDPROC
ENDDEFINE