CheckBox in Grid Header

Local oForm As Form
oForm = CreateObject('HeaderCheckForm')
oForm.Show(1)
Return

Define Class HeaderCheckForm 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