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 EnddefineCetin