Clear all
Use products in 0
Use employee in 0
oForm  = createobject('myForm')
With oForm
  .Addobject('myGrid','myGrid')
  .Addobject('myButton','myButton')
  .MyButton.visible = .t.
  With .myGrid
    .Top=oForm.MyButton.Height + 10
    .Left = 10
    .Height = oForm.Height - (.Top+20)
    .Width = oForm.Width - 20
    .SetSource('products')
    .Visible = .t.
  Endwith
  .Show
Endwith
Read events

Define class myForm as Form
  Height = 400
  Width = 600
  ShowTips = .T.
  Procedure SampleShortCut
  Lparameters oTarget
Define POPUP shortcut shortcut RELATIVE FROM MROW(),MCOL()
Define BAR _MED_CUT OF shortcut PROMPT "Cut"
Define BAR _MED_COPY OF shortcut PROMPT "Copy"
Define BAR _MED_PASTE OF shortcut PROMPT "Paste"
Define BAR 4 OF shortcut PROMPT "Copy Object value"
Define BAR 5 OF shortcut PROMPT "Change column color"
On SELECTION BAR 4 OF shortcut _cliptext = oTarget.Value && Alternative copy
On SELECTION BAR 5 OF shortcut oTarget.SwitchColor()
Activate POPUP shortcut
Endproc

  Procedure queryunload
  Clear events
Endproc
Enddefine

Define class MyButton as CommandButton
  Caption = 'Switch source'
  Procedure click
  With thisform.myGrid
    .SetSource(iif(upper(.Recordsource)='EMPLOYEE','products','employee'))
  Endwith
Endproc
Enddefine

Define class myGrid as grid
  DeleteMark = .F.
  ReadOnly = .T.
  RecordMark = .F.
  ScrollBars = 3
  SplitBar = .F.
  Highlight = .F.
  HighlightRow = .F.
  Name = "grdMyGrid"
  FreeTable = .t.

  Procedure addcolumn
  Lparameters nIndex, cAlias, cField, cCaption
  Nodefault
  This.addobject("clm"+cField,"myColumn", cAlias+"."+cField,nIndex)
Endproc

  Procedure SetSource
  Lparameters tcRecordsource
  With this
    .recordsource = ''
    .Columncount = -1
    .recordsource = tcRecordsource
    .FreeTable = empty(cursorgetprop("Database",tcRecordsource))
    If !.FreeTable
      Open database (cursorgetprop("Database",tcRecordsource))
    Endif
    nOldColCount = .columncount
    For ix = 1 to fcount(tcRecordsource)
      .AddColumn(ix, tcRecordsource,field(ix,tcRecordsource))
    Endfor
    For ix = nOldColCount to 1 step -1
      .RemoveObject(.Columns(ix).name)
    Endfor
    .SetAll('Visible',.t.)
  Endwith
Endproc
Enddefine

Define class myColumn as column
  Resizable = .F.
  Movable = .F.
  Procedure init
  Lparameters cControlSource, nIndex
  With this
    .controlsource = cControlSource
    .ColumnOrder = nIndex
    .RemoveObject('Header1')
    .Addobject('myHeader','myHeader')
    If type(cControlSource)='L'
      .AddObject("myControl","myGridChkBox")
    Else
      .AddObject("myControl","myGridTxtBox")
    Endif
    .CurrentControl = "myControl"
    .Sparse = .F.
  Endwith
Endproc
  Procedure resize
  This.myControl.Resize
Endproc

  Procedure MouseMove
  Lparameters nButton, nShift, nXCoord, nYCoord
  With this.Parent
    lnActiveRow = ceiling( ;
      ( nYCoord - (.top + .headerheight) ) / .rowheight )
    lnActivecol = this.Columnorder - this.Parent.LeftColumn + 1
    .ActivateCell(lnActiveRow,lnActivecol)
  Endwith
  With this
    If type(.controlsource)$'CM'
      .myControl.Tooltiptext = ;
        iif(type(.controlsource)='C',  eval(.Controlsource),;
        iif(type(.controlsource)='M',  mline(eval(.Controlsource),1),''))
    Endif
  Endwith
Endproc
Enddefine

Define class myGridTxtBox as TextBox
  Name = "Text1"
  Procedure init
  This.BorderStyle = 0
Endproc
  Procedure click
  This.setfocus()
Endproc
  Procedure SwitchColor
  With this.Parent
    .DynamicBackColor = ;
      'iif('+.Controlsource+'="M",'+str(int(rand()*0xFFFFFF))+','+str(.BackColor)+')'
    .Parent.Refresh
  Endwith
Endproc

  Procedure Rightclick
  If this.parent.Columnorder = 3
    *Do myshortcut.mpr with this
    Thisform.SampleShortCut(this)
  Endif
Endproc

Enddefine

Define class myGridChkBox as Container
  Width = 14
  Height = 17
  BackStyle = 0
  BorderWidth = 0
  Name = "grdcheckbox"
  Add OBJECT check1 AS checkbox WITH ;
    Top = 0, ;
    Left = 0, ;
    Height = 17, ;
    Width = 13, ;
    BackStyle = 0, ;
    Caption = "", ;
    Name = "Check1"
  Procedure Init
  With this
    .check1.Controlsource = .parent.controlsource
    .Resize()
  Endwith
Endproc
  Procedure Resize
  With this.check1
    .Left = (this.Parent.Width - .Width)/2
  Endwith
Endproc
Enddefine


Define class myHeader as Header
  BackColor = 0
  ForeColor = rgb(255,255,0)
  Procedure init
  With this
    If !.parent.parent.FreeTable and ;
        !empty(dbgetprop(.parent.controlsource,"Field","Caption"))
      .Caption = dbgetprop(.parent.controlsource,"Field","Caption")
    Else
      .Caption = substr(.parent.controlsource,at('.',.parent.controlsource)+1)
    Endif
  Endwith
Endproc
Enddefine