VFP Grid cosmetics partII
I have already made a cosmetic grid partI and this is the following continuation.
in this code i build a vfp grid with
-altering initial cursor (selected from customer.dbf, here as demo) and adding a first column dedied to icons or images
The icons are populated with the property grid.dynamicFontShadow (can be dynamicBackcolor,.....).its specifies a logical expression that evaluates to True (.T.) or False (.F.).
The expression is reevaluated at run time each time the Grid control is refreshed.it attach to each cell an ico (image).
-The icons or images better must be in an individual folder.must point in code to the folder location and icons(images) extension(*.png,*.ico;*.bmp..).
-if the image column is empty , its filled with some image in disc as replacement.
Note: its the main attraction in this post.
-the property grid.themes=.f. allows to color the headers (here randomly backcolor)
-can choose the second color in expresion of dynamicBackcolor to rebuild the grid (choose a lighten color from color dialog is better).
-can draw the gridLines (0,1,2,3).
-can hide or show form titlebar (the form is resized).
*Important: this code is tested under VFP9SP2 and win10 pro.
Click on code to select [then copy] -click outside to deselect
*1*
Publi yform
yform=Newobject("ygrid")
yform.Show
Read Events
*
Define Class ygrid As Form
Height = 600
Width = 973
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = ""
BackColor = Rgb(0,0,0)
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 15, ;
Height = 573, ;
Left = 0, ;
Top = 27, ;
Width = 972, ;
Name = "Grid1"
Add Object shape1 As Shape With ;
Top = 1, ;
Left = 864, ;
Height = 18, ;
Width = 18, ;
Anchor = 768, ;
Curvature = 10, ;
MousePointer = 15, ;
ToolTipText = "Header random backcolor", ;
SpecialEffect = 0, ;
BackColor = Rgb(0,255,0), ;
Name = "Shape1"
Add Object shape2 As Shape With ;
Top = 1, ;
Left = 839, ;
Height = 18, ;
Width = 18, ;
Anchor = 768, ;
Curvature = 10, ;
MousePointer = 15, ;
ToolTipText = "GridLines 0-1-2-3", ;
SpecialEffect = 0, ;
BackColor = Rgb(255,128,0), ;
Name = "Shape2"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 18, ;
BackStyle = 0, ;
Caption = "Grid cosmetics PartII", ;
Height = 32, ;
Left = 320, ;
Top = -3, ;
Width = 242, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"
Add Object shape3 As Shape With ;
Top = 1, ;
Left = 891, ;
Height = 18, ;
Width = 18, ;
Anchor = 768, ;
Curvature = 10, ;
MousePointer = 15, ;
ToolTipText = "Form titlebar", ;
SpecialEffect = 0, ;
BackColor = Rgb(255,255,0), ;
Name = "Shape3"
Add Object shape4 As Shape With ;
Top = 1, ;
Left = 818, ;
Height = 18, ;
Width = 18, ;
Anchor = 768, ;
Curvature = 10, ;
MousePointer = 15, ;
ToolTipText = "Dynamicbakcolor", ;
SpecialEffect = 0, ;
BackColor = Rgb(0,255,255), ;
Name = "Shape4"
Procedure Process
Lparameters xObject
xObject.Picture = Nvl(ycurs.ximg,"")
Endproc
Procedure Init
With Thisform.grid1
.RecordSource="ycurs"
Locate
.column2.width=.column2.width+25
With .Column1
.header1.Caption=""
.Width=35
.AddObject("myimage","image" )
.CurrentControl="myimage"
.Sparse=.F.
With .myimage
.Stretch=0
.BackStyle=0
.ToolTipText=.Picture &&dont work on vfp9
.Visible=.T.
Endwith
.DynamicFontShadow = 'thisform.process(thisform.grid1.'+.Name+'.myimage)'
.header1.Picture=Home(1)+"Graphics\Icons\Elements\sun.ico"
Endwith
.Themes=.F.
.GridLines=0
.HeaderHeight=39
.RowHeight=35
.DeleteMark=.F.
.RecordMark=.F.
For i=1 To .ColumnCount
.Columns(i).header1.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
Endfor
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0,RGB(200,206,180),RGB(255,255,255))", "Column")
.SetAll("fontbold",.T.,"header")
.SetAll("fontsize",14,"header")
Endwith
Endproc
Procedure Load
Close Data All
Local m.cImagePath,m.cType
m.cImagePath=Home(1)+"graphics\icons\misc\" &&any folder dedied to png images,bmp,ico... 16x16 or 32x32 for ex
m.cType="*.ico" &&install the extension cibled
Create Cursor myImageList (icoName m)
For ix=1 To Adir(aImageList, Addbs(m.cImagePath)+m.cType)
Insert Into myImageList Values (Fullpath(Addbs(m.cImagePath)+aImageList[ix,1]))
Endfor
Locate
*brow
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs0 Readwrite
Alter Table ycurs0 Add Column ximg c(80)
Sele ycurs0
Local m.x
m.x="ximg"
For i=1 To Fcount()-1
m.x=m.x+","+Field(i)
Endfor
TEXT to m.myvar textmerge noshow
sele <<m.x>> from ycurs0 into cursor ycurs Readwrite
ENDTEXT
=Execscript(m.myvar)
Use In ycurs0
Sele ycurs
Scan
If Vartype(myImageList.icoName)="C" And ! Empty(myImageList.icoName)
Repl ximg With myImageList.icoName
Else
Repl ximg With Upper(Home(1)+"GRAPHICS\ICONS\MISC\MISC15.ICO") &&complete if absent
Endi
Sele myImageList
Try
Skip
Catch
Endtry
Sele ycurs
Endscan
Sele ycurs
*brow
Locate
Endproc
Procedure shape1.Click
Thisform.LockScreen=.T.
With Thisform.grid1
For i=1 To Thisform.grid1.ColumnCount
.Columns(i).header1.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
Endfor
Endwith
Thisform.LockScreen=.F.
Endproc
Procedure shape2.Click
With Thisform.grid1
Try
.GridLines=.GridLines+1
Catch
.GridLines=0
Endtry
Endwith
Endproc
Procedure shape3.Click
With Thisform
.TitleBar=Iif(.TitleBar=1,0,1)
.Height=Iif(.TitleBar=0,.Height,.Height+Sysmetric(9)+Sysmetric(4))
Endwith
Endproc
Procedure shape4.Click
Local m.xcolor,xexp
m.xcolor=Getcolor()
If m.xcolor=-1
Return .F.
Endi
With Thisform.grid1
m.xexp="IIF(MOD(RECNO( ), 2)=0,"+Trans(m.xcolor)+",RGB(255,255,255))"
.SetAll("DynamicBackColor",m.xexp, "Column")
.Refresh
Endwith
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*
*-- EndDefine: ygrid
Click on code to select [then copy] -click outside to deselect
*2* added 31 january 2016 01:05:23 AM *-- A method for sorting the grid by a column when the column header is clicked if there is an index tag on the column's * controlSource *the grid is created as class grdBase.it uses the click on headers to sort the cursor ascending or descending *the solution uses the bindevent() function. *the original class is adapted from free source of Marcia Akins * Close Data All Set Safe Off Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs Sele ycurs Local m.myvar For i=1 To Fcount() &&here sort all cursor fields (each field have a tag) TEXT to m.myvar textmerge noshow index on <<field(i)>> tag <<field(i)>> ENDTEXT Execscript(m.myvar) Endfor Locate *rebuild images (sorting ascending/descending) local m.myvar text to m.myvar noshow Qk02AQAAAAAAAHYAAAAoAAAAEgAAABAAAAABAAQAAAAAAMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAICAgADAwMAAAAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP/////P/////wAAAP////zM/////wAAAP///8zMz////wAAAP///MzMzP///wAAAP//zMzMzM///wAAAP/8zMzMzMz//wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAA== endtext strtofile(strconv(m.myvar,14),"down.bmp") text to m.myvar noshow Qk02AQAAAAAAAHYAAAAoAAAAEgAAABAAAAABAAQAAAAAAMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAICAgADAwMAAAAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP/8zMzMzMz//wAAAP//zMzMzM///wAAAP///MzMzP///wAAAP///8zMz////wAAAP////zM/////wAAAP/////P/////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAA== endtext strtofile(strconv(m.myvar,14),"up.bmp") Publi yform yform=Newobject("asup") yform.Show Read Events Retu Define Class asup As Form Top = 0 Left = 0 Height = 601 Width = 710 ShowWindow=2 autocenter=.t. Caption = "BindEvent Grid Sample Form" Visible = .T. Name = "Form1" Add Object grid1 As grdbase With ; anchor=15,; FontName = "arial",; FontSize = 10, ; Height = 549, ; Left = 14, ; RecordSource = "ycurs", ; RowHeight = 22, ; headerHeight=25,; Top = 27, ; Width = 683, ; backcolor=Rgb(212,208,200),; Name = "grid1" procedure init with thisform.grid1 dodefault() .setall("dynamicBackcolor","iif(mod(recno()=2,rgb(255,255,255),Rgb(212,208,200)","column") .setall("backcolor",rgb(0,255,0),"header") .refresh endwith Procedure Destroy Clea Events Endproc Enddefine ********************************* Define Class grdbase As Grid DeleteMark = .F. Height = 200 themes=.f. HighlightRow = .F. Width = 320 HighlightStyle = 2 AllowCellSelection = .F. *-- Contains the field name that is currently controlling the sort order csortfield = "" Name = "grdbase" Procedure Init This.SetGrid() Endproc *-- Called from the grid's Init to handle setting it up properly Procedure SetGrid Local lnFgColor, lnBgColor, loColumn, loControl, lnCol, lnAlignment *** Set up for highlighting current row Declare Integer GetSysColor In "user32" Integer nIndex lnBgColor = GetSysColor( 13 ) lnFgColor = GetSysColor( 14 ) *** Setup grid highlighing. We do not want a 50% gradient With This .HighlightBackColor = lnBgColor .HighlightForeColor = lnFgColor Endwith *** now make sure that the dblclick method of all the contained text boxes *** delegate to the grid's dblclick() For lnCol = 1 To This.ColumnCount loColumn = This.Columns[ lnCol ] *** Set up the grid so that we we click on a column header *** we sort the grid where appropriate For Each loControl In loColumn.Controls If Lower( loControl.BaseClass ) = 'header' Bindevent( loControl, 'Click', This, 'SortGrid' ) Else If Pemstatus( loControl, [dblClick], 5 ) Bindevent( loControl, 'dblClick', This, 'dblClick' ) Endif Endif Endfor Endfor This.AutoFit() Endproc *-- A method for sorting the grid by a column when the column header is clicked if there is an index tag on the column's controlSource Procedure sortgrid Local laEvents[ 1 ], loHeader, lcField, loColumn, lcSortOrder, loControl Local llFoundColumn, llAllowCellSelection, lnRecNo llAllowCellSelection = This.AllowCellSelection *** First of all, see which column fired off this event Aevents( laEvents, 0 ) loHeader = laEvents[ 1 ] If Vartype( loHeader ) = 'O' *** First See if a ControlsSource was set for the column With loHeader.Parent lcField = '' If Not Empty( .ControlSource ) *** Cool. Use it to decide how to sort the grid If Not Empty( .ControlSource ) And ( '.' $ .ControlSource ) And Not( '(' $ .ControlSource ) lcField = Justext( .ControlSource ) Endif Endif Endwith If Empty( lcField ) *** Try to find the field in the underlying data *** This code assumes that the *** The underlying cursor will be in natural order For lnCol = 1 To This.ColumnCount If This.Columns[ lnCol ].Name = loHeader.Parent.Name lcField = Field( lnCol, This.RecordSource ) Exit Endif Endfor Endif This.csortfield = [] *** we have a field - let's see if it already has a sort order set *** if it does, it will have the appropriate picture in the header lcSortOrder = '' If Not Empty( loHeader.Picture ) lcSortOrder = Iif( Lower( Justfname( loHeader.Picture ) ) == 'down.bmp', '', 'DESC' ) Else *** See if there is a visual cue on any of the other grid *** column headers and remove it if there is For Each loColumn In This.Columns For Each loControl In loColumn.Controls If Lower( loControl.BaseClass ) == [header] If Not Empty( loControl.Picture ) llFoundColumn = .T. loControl.Picture = [] loControl.FontBold = .F. Exit Endif Endif Endfor If llFoundColumn Exit Endif Endfor Endif *** if we have a field - let's sort If Not Empty( lcField ) *** Check to see if the tag exists assume *** that if there is a tag on this field, it has the same name as the field *IF IsTag( lcField, This.RecordSource ) This.csortfield = lcField lnRecNo = Recno( This.RecordSource ) *** Go ahead and set the order for the table Select ( This.RecordSource ) If Not Empty( lcSortOrder ) Set Order To ( lcField ) Descending Else Set Order To ( lcField ) Endif This.SetFocus() If lnRecNo # 0 Go lnRecNo In ( This.RecordSource ) Endif *** And set the visual cues on the header loHeader.Picture = Iif( Empty( lcSortOrder ), [up.bmp], [down.bmp] ) loHeader.FontBold = .T. loHeader.Parent.SetFocus() Endif * ENDIF Endif Endproc Enddefine * *-- EndDefine: grdbase *************************
Click on code to select [then copy] -click outside to deselect
*3* grid alignments *added on wednesday 3 february 2016; 22:37:20 Publi yform yform=Newobject("asup") yform.Show Read Events Retu * Define Class asup As Form Height = 467 Width = 830 showWindow=2 AutoCenter = .T. Caption = "Grid contents alignment" Name = "Form1" Add Object grid1 As Grid With ; Anchor = 15, ; Height = 396, ; Left = 12, ; Top = 12, ; Width = 804, ; Name = "Grid1" Add Object combo1 As ComboBox With ; Anchor = 768, ; Height = 25, ; Left = 24, ; Top = 432, ; Width = 109, ; Name = "Combo1" Add Object yhelp AS label with ; Anchor=768 ,; AutoSize = .T., ; FontBold = .T., ; FontSize = 20, ; BackStyle = 0, ; Caption = "?" , ; Height = 35, ; Left = 147, ; MousePointer = 15, ; Top = 425, ; Width = 19, ; ForeColor = RGB(255,0,0), ; Name = "yhelp" PROCEDURE yhelp.Click Local M.MYVAR TEXT TO M.MYVAR NOSHOW For a TextBox control in a column, the column's Alignment setting determines alignment of text in the text box. 0 Left. Aligns text flush left. 1 Right. Aligns text flush right. 2 Center. Aligns text in the horizontally and vertically centered on the control. 3 Automatic. (Default) the textbox alignment dont solve the problem because its fired on gotfocus and concerns the selected cell only. ENDTEXT Messagebox(m.MYVAR,0+32+4096,'Text alignment in grid') ENDPROC Procedure Load Set Date Long Close Data All Sele cust_id,company,maxordamt,fax From Home(1)+"samples\data\customer" Into Cursor ycurs Readwrite Alter Table ycurs Add Column ydate d Sele ycurs Repl All ydate With Date() *brow Locate Endproc Procedure Init With This.grid1 .Themes=.F. .RecordSource="ycurs" .DeleteMark=.F. .GridLines=0 .HeaderHeight=25 .SetAll("fontbold",.T.,"header") .SetAll("backcolor",Rgb(0,255,0),"header") .column4.Width=170 .SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(205,200,195), RGB(250,255,220))", "Column") .Refresh Endwith Endproc Procedure Destroy Clea Events Endproc Procedure combo1.Init With This .AddItem("0. left ") .AddItem("2. center ") .AddItem("1.right ") .AddItem("3.automatic ") .ListIndex=1 Style=2 Endwith *0 Left. Aligns text flush left. *1 Right. Aligns text flush right. *2 Center. Aligns text in the horizontally and vertically centered on the control. *3 Automatic. (Default) Endproc Procedure combo1.Click x=Int(Val(Substr(This.Value,1,1))) With Thisform.grid1 .SetAll("alignment",m.x,'column') .Refresh Endwith Endproc Enddefine * *-- EndDefine: asup
Click on code to select [then copy] -click outside to deselect
*4* added on thursday 11 february 2016; 11:45:51
*this code makes each column,column.text1 with a mousepointer between satndard vfp mousepointers (1,17)
*in column1 the mousepointer is an icon (mouseicon property+mousepointer=99)
publi oform
oform=newObject("asup")
oform.show
read events
retu
*
DEFINE CLASS asup AS form
Height = 324
Width = 963
AutoCenter = .T.
Caption = "MouseMove or focus on any grid cell"
Name = "Form1"
ADD OBJECT grid1 AS grid WITH ;
Anchor = 15, ;
Height = 301, ;
Left = 8, ;
Top = 12, ;
Width = 948, ;
Name = "Grid1"
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE grid1.Init
close data all
sele * from home(1)+"samples\data\customer.dbf" into cursor ycurs readwrite
with this
.recordsource="ycurs"
.recordsourcetype=1
.deletemark=.f.
.gridlines=0
.themes=.f.
.headerHeight=27
.setall("fontbold",.t.,"header")
.setall("fontsize",14,"header")
.setall("forecolor",rgb(0,255,0),"header")
.setall("backcolor",0,"header")
locate
for i=1 to .columncount
if between (i,2,17) &&all standard vfp mousepointers
.columns(i).text1.mousepointer=i
else
.columns(i).text1.mouseIcon=home(1)+"GRAPHICS\ICONS\ARROWS\POINT05.ICO"
.columns(i).text1.mousepointer=99
endi
endfor
endwith
ENDPROC
ENDDEFINE
Click on code to select [then copy] -click outside to deselect
*5*
*a semi transparent grid (really the transparency is applied on top level form )can be any form showWindow =0,1 but with desktop=.t.
*see the help button on form .
_Screen.WindowState=1
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
BorderStyle = 0
Height = 611
Width = 952
ShowWindow = 2
AutoCenter = .T.
Caption = ""
KeyPreview = .T.
TitleBar = 0
AlwaysOnTop = .T.
BackColor = Rgb(0,0,0)
TitleBar=1
yalpha = 220
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 15, ;
Height = 528, ;
Left = 24, ;
Top = 48, ;
Width = 901, ;
Name = "Grid1"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 20, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "X", ;
Height = 35, ;
Left = 900, ;
MousePointer = 15, ;
Top = 10, ;
Width = 20, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Segoe Script", ;
FontSize = 20, ;
BackStyle = 0, ;
Caption = "This is a semi transparent form", ;
Height = 47, ;
Left = 197, ;
Top = 0, ;
Width = 464, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label2"
Add Object label3 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 20, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "?", ;
Height = 35, ;
Left = 784, ;
MousePointer = 15, ;
Top = 11, ;
Width = 19, ;
ForeColor = Rgb(0,255,0), ;
Name = "Label3"
Add Object optiongroup1 As OptionGroup With ;
AutoSize = .T., ;
ButtonCount = 1, ;
BackStyle = 0, ;
BorderStyle = 0, ;
Value = 1, ;
Height = 27, ;
Left = 708, ;
Top = 12, ;
Width = 71, ;
Name = "Optiongroup1", ;
Option1.FontBold = .T., ;
Option1.FontSize = 10, ;
Option1.BackStyle = 0, ;
Option1.Caption = "Color", ;
Option1.Value = 1, ;
Option1.Height = 17, ;
Option1.Left = 5, ;
Option1.MousePointer = 15, ;
Option1.Top = 5, ;
Option1.Width = 61, ;
Option1.ForeColor = Rgb(255,255,255), ;
Option1.Name = "Option1"
Procedure RightClick
#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
Thisform.yalpha=Int(Val(Inputbox("Alpha 0-255","",Trans(Thisform.yalpha))))
If Empty(Thisform.yalpha)
Thisform.yalpha=220
Endi
= SetLayeredWindowAttributes(Thisform.HWnd, Thisform.BackColor,Thisform.yalpha,LWA_ALPHA)
Endproc
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
Thisform.Release
Endi
Endproc
Procedure Init
Thisform.TitleBar=0
Publi m.yrep0
m.yrep0=Addbs(Justpath(Sys(16,1)))
Local nExStyle, nRgb, nAlpha, nFlags
#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
#Define GWL_EXSTYLE -20
#Define WS_EX_LAYERED 0x80000
nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
= SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)
= SetLayeredWindowAttributes(Thisform.HWnd, Thisform.BackColor,Thisform.yalpha,LWA_ALPHA)
Endproc
Procedure Load
Declare Integer GetWindowLong In user32;
INTEGER HWnd, Integer nIndex
Declare Integer SetWindowLong In user32;
INTEGER HWnd, Integer nIndex, Integer dwNewLong
Declare Integer SetLayeredWindowAttributes In user32;
INTEGER HWnd, Integer crKey,;
SHORT bAlpha, Integer dwFlags
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
If !Thisform.WindowState=2
lnHandle = Thisform.HWnd
param1 = 274
param2 = 0xF012
Declare Integer ReleaseCapture In WIN32API
Declare Integer SendMessage In WIN32API Integer, Integer, Integer, Integer
bb=ReleaseCapture()
bb=SendMessage(lnHandle, param1, param2,0)
Endi
Endproc
Procedure DblClick
Thisform.Release
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure grid1.Init
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
With This
.RecordSource="ycurs"
.DeleteMark=.F.
.GridLines=0
.FontBold=.T.
.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(145,55,105) , RGB(100,255,40))", "Column")
.AutoFit
Locate
Endwith
Endproc
Procedure label1.Click
Thisform.Release
Endproc
Procedure label2.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
This.Parent.MouseDown()
Endproc
Procedure label3.Click
Local m.myvar
TEXT to m.myvar noshow
-The form is movable by mousedown
-Adjust by rightclick on form transparency (above 170 until 255)---make grid readable.
-Adjust form.backcolor
ENDTEXT
Messagebox(m.myvar,0+32+4096)
Endproc
Procedure optiongroup1.Click
Local m.xcolor
m.xcolor=Getcolor()
If !m.xcolor=-1
Thisform.BackColor=m.xcolor
Endi
Endproc
Procedure optiongroup1.AddObject
Lparameters cName, cClass
Endproc
Enddefine
*
*-- EndDefine: asup
Click on code to select [then copy] -click outside to deselect
*6* *added on tuesday 8 march 2016; 14:48:05
*this demo code loads a cursor in a grid with textbox support(grid.column..text1)
*if the field is too long relative to its length its transformed on an editbox to edit complet field text.
*in this demo simply click on the grid header to expand/collapse the textbox into editbox or the inverse.
*assuming also have segoe "script" installed(at your choice) .
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
*
Define Class asup As Form
Height = 374
Width = 362
AutoCenter = .T.
Caption = "Click on header to expand /hide editbox"
ycl = .F.
yrh = .F.
Name = "Form1"
Add Object grid1 As Grid With ;
Height = 361, ;
Left = 0, ;
Top = 12, ;
Width = 360, ;
Name = "Grid1"
Procedure my
Lparameters nButton, nShift, nXCoord, nYCoord
Sele ycurs
Thisform.ycl=Iif(Thisform.ycl=.F.,.T.,.F.)
Do Case
Case Thisform.ycl=.T. &&browse editbox
With Thisform.grid1
With .Column1
Try
.AddObject("yedit","editbox" ) &&if yedit member exits jumps this step
Catch
Endtry
.CurrentControl="yedit"
.Sparse=.F.
With .yedit
.Height=95
.Parent.Parent.RowHeight=95
.Value=.Parent.text1.Value
.FontName="segoe script"
.forecolor=255
.fontbold=.t.
.Visible=.T.
Endwith
Endwith
.Refresh
Endwith
Case Thisform.ycl=.F. && browse textbox
With Thisform.grid1
With .Column1
.RemoveObject("yedit")
.CurrentControl="text1"
.Sparse=.F.
DoDefault()
With .text1
.Height=Thisform.yrh
.Parent.Parent.RowHeight=Thisform.yrh
.Visible=.T.
Endwith
.Refresh
Endwith
Endwith
Endcase
Endproc
Procedure Init
With Thisform.grid1
.RecordSource="ycurs"
.RecordSourceType=2
.Column1.Width=350
.Anchor=15
.DeleteMark=.F.
.GridLines=0
.RowHeight=20
.Parent.yrh=.RowHeight
.Themes=.F.
.FontName="arial"
.SetAll("backcolor",0,"header")
.SetAll("forecolor",Rgb(0,255,0),"header")
.SetAll("fontbold",.T.,"header")
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(212,208,200), RGB(140,255,100))", "Column")
Locate
Endwith
Bindevent(Thisform.grid1.Column1.header1,"mousedown",Thisform,"my")
Endproc
Procedure Load
Create Cursor ycurs (comments c(250))
Local m.myvar
For i=1 To 20
TEXT to m.myvar textmerge noshow
<<trans(i)>>. Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
nulla.
*end
ENDTEXT
Insert Into ycurs Values (m.myvar)
Endfor
*brow
Locate
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*
*-- EndDefine: asup
Click on code to select [then copy] -click outside to deselect
*7* added on tuesday 8 march 2016; 15:50:20
*this code build a grid at runtime to request data in cursors from a source table (dont opened)
*a timer makes this request all 4 seconds.The source table could also changes its data.
*can stop or start the timer work in a button
*can resize the form (or maximize it)
Publi yform
yform=Newobject("ygrid_runtime_viewer")
yform.Show
Read Events
Retu
*
Define Class ygrid_runtime_viewer As Form
Height = 444
Width = 770
ShowWindow = 2
AutoCenter = .T.
Caption = "View refreshed with requested random data all 4 seconds."
BackColor = Rgb(0,0,0)
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 15, ;
Height = 408, ;
Left = 0, ;
Top = 36, ;
Width = 768, ;
Name = "Grid1"
Add Object timer1 As Timer With ;
Top = 0, ;
Left = 648, ;
Height = 23, ;
Width = 23, ;
Interval = 4000, ;
Name = "Timer1"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontName = "Segoe Script", ;
FontSize = 12, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "", ;
Height = 29, ;
Left = 12, ;
Top = 2, ;
Width = 2, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"
Add Object command1 As CommandButton With ;
AutoSize = .T., ;
Top = 4, ;
Left = 689, ;
Height = 27, ;
Width = 80, ;
FontBold = .T., ;
Caption = "Stop", ;
MousePointer = 15, ;
BackColor = Rgb(255,128,0), ;
Name = "Command1"
Procedure yrequest
Rand(-1)
Sele * From Home(1)+"samples\data\customer.dbf" Into Cursor ycurs &&for ex customer.dbf can change dynamically
Sele ycurs
Local m.x,m.v
m.x=""
For i=1 To 5 &&fcount()
m.v=Int((Fcount())*Rand( ) + 1)
If i=1
m.x=m.x+Field(v)
Else
m.x=m.x+','+Field(v)
Endi
Endfor
With Thisform.label1
.Caption=m.x
.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
Endwith
TEXT to m.xsql textmerge noshow
sele <<m.x>> from home(1)+"samples\data\customer" into cursor zcurs
ENDTEXT
=Execscript(m.xsql)
With Thisform.grid1
.RecordSource=""
.RecordSource="zcurs"
.RecordSourceType=1
.Anchor=15
.DeleteMark=.F.
.GridLines=0
.RowHeight=20
.Themes=.F.
.SetAll("width" ,Thisform.Width/5,"column")
.SetAll("backcolor",0,"header")
.SetAll("forecolor",Rgb(0,255,0),"header")
.SetAll("fontbold",.T.,"header")
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(212,208,200), RGB(140,255,100))", "Column")
.Refresh
Endwith
Endproc
Procedure Init
Thisform.yrequest()
Thisform.timer1.Enabled=.T.
Endproc
Procedure timer1.Timer
Thisform.yrequest()
Endproc
Procedure command1.Click
Thisform.timer1.Enabled=!Thisform.timer1.Enabled
This.Caption=Iif(Thisform.timer1.Enabled=.T.,"Stop","Start")
Endproc
Procedure destroy
clea events
endproc
Enddefine
*
*-- EndDefine: ygrid_runtime_viewer
Click on code to select [then copy] -click outside to deselect
*8*
*created on 28 of december 2016
*testing the grid scrollbars dynamically.Appearing at demand.
*scrollbars appear when needed only
*!* sysmetric() function gives thes values for the Horizontal and Vertcial scrollbars:
*!* sysmetric(7) Width of scroll arrows on horizontal scroll bar
*!* sysmetric(8) Height of scroll arrows on horizontal scroll bar
*!* sysmetric(5) Width of scroll arrows on vertical scroll bar
*!* sysmetric(6) Height of scroll arrows on vertical scroll bar
*!* When summing columns and lines of the grid horizontally must add
*!* deletemark +recormark widths ( only if enabled)
_Screen.WindowState=1
Publi myform
myform=Newobject("yscroll")
myform.Show
Read Events
Retu
*
Define Class yscroll As Form
Height = 346
Width = 759
ShowWindow = 2
AutoCenter = .T.
Caption = "Testing scrollbars dynamically."
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 15, ;
Height = 277, ;
Left = 11, ;
ScrollBars = 0, ;
Top = 5, ;
Width = 733, ;
Name = "Grid1"
Add Object command1 As CommandButton With ;
Top = 307, ;
Left = 183, ;
Height = 27, ;
Width = 84, ;
Anchor = 768, ;
Caption = "No scrollbars", ;
BackColor = Rgb(128,255,0), ;
Name = "Command1"
Add Object optiongroup1 As OptionGroup With ;
AutoSize = .T., ;
ButtonCount = 4, ;
Anchor = 768, ;
Value = 1, ;
Height = 27, ;
Left = 305, ;
Top = 307, ;
Width = 264, ;
Name = "Optiongroup1", ;
Option1.Caption = "Test1", ;
Option1.Value = 1, ;
Option1.Height = 17, ;
Option1.Left = 5, ;
Option1.Style = 0, ;
Option1.Top = 5, ;
Option1.Width = 61, ;
Option1.AutoSize = .F., ;
Option1.Name = "Option1", ;
Option2.Caption = "Test2", ;
Option2.Height = 17, ;
Option2.Left = 68, ;
Option2.Style = 0, ;
Option2.Top = 5, ;
Option2.Width = 61, ;
Option2.AutoSize = .F., ;
Option2.Name = "Option2", ;
Option3.Caption = "Test3", ;
Option3.Height = 17, ;
Option3.Left = 131, ;
Option3.Style = 0, ;
Option3.Top = 5, ;
Option3.Width = 61, ;
Option3.AutoSize = .F., ;
Option3.Name = "Option3", ;
Option4.Caption = "Test4", ;
Option4.Height = 17, ;
Option4.Left = 198, ;
Option4.Top = 5, ;
Option4.Width = 61, ;
Option4.Name = "Option4"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
Anchor = 768, ;
Caption = "Grdid.scrollbars=0", ;
Height = 18, ;
Left = 587, ;
Top = 309, ;
Width = 117, ;
ForeColor = Rgb(255,0,0), ;
BackColor = Rgb(255,255,128), ;
Name = "Label1"
Procedure yscroll
Local m.x,m.y
With Thisform.grid1
m.x=0
For i=1 To .ColumnCount
m.x=m.x+.Columns(i).Width
Endfor
m.x=m.x+.ColumnCount*.GridLineWidth+2*Sysmetric(7)
m.y=(.RowHeight+.GridLineWidth)*Reccount()+Sysmetric(6)
Do Case
Case m.x<.Width And m.y<.Height
.ScrollBars=0
Case m.x<.Width And m.y>.Height
.ScrollBars=2
Case m.x>.Width And m.y<.Height
.ScrollBars=1
Case m.x>.Width And m.y>.Height
.ScrollBars=3
Endcase
.Refresh
Endwith
Endproc
Procedure Load
Close Data All
Endproc
Procedure grid1.Init
With This
.RecordSource=""
.GridLines=0
.DeleteMark=.F.
.RecordMark=.F.
.RecordMark=.F.
.ScrollBars=0
.Refresh
Endwith
Endproc
Procedure command1.Click
Thisform.grid1.ScrollBars=0
Endproc
Procedure optiongroup1.InteractiveChange
Thisform.label1.Caption="Grid.scrollbars="+Trans(Thisform.grid1.ScrollBars)
Endproc
Procedure optiongroup1.Option1.Click
Sele * From Home(1)+"samples\data\customer" Where Recn()<5 Into Cursor ycurs
With Thisform.grid1
.RecordSource="ycurs"
.Refresh
Endwith
Thisform.yscroll()
Endproc
Procedure optiongroup1.Option2.Click
Sele fax,address From Home(1)+"samples\data\customer" Into Cursor ycurs
With Thisform.grid1
.RecordSource="ycurs"
.Refresh
Endwith
Thisform.yscroll()
Endproc
Procedure optiongroup1.Option3.Click
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
With Thisform.grid1
.RecordSource="ycurs"
.Refresh
Endwith
Thisform.yscroll()
Endproc
Procedure optiongroup1.Option4.Click
Sele fax,address From Home(1)+"samples\data\customer" Where Recno()<6Into Cursor ycurs
With Thisform.grid1
.RecordSource="ycurs"
.Refresh
Endwith
Thisform.yscroll()
Endproc
Procedure destroy
clea events
endproc
Enddefine
*
*-- EndDefine: yscroll
Click on code to select [then copy] -click outside to deselect
*9* created on 10 of january 2017
*this code presents 4 stylised grids used in vfp wizard (used in any grid builder).
*each style is defined relative to style.
Close Data All
Publi yform
yform=Newobject("ygridstyle")
yform.Show
Read Events
Retu
*
Define Class ygridstyle As Form
Height = 600
Width = 737
ShowWindow = 2
AutoCenter = .T.
BackColor=0
Caption = "professional grid"
Name = "Form1"
Add Object combo1 As ComboBox With ;
anchor=768,;
left=10,;
top=1,;
width=110,;
height=25,;
rowsourcetype=0,;
name="combo1"
Add Object grid1 As Grid With ;
Anchor = 15, ;
Height = 600, ;
Left = 9, ;
Top =38, ;
anchor=15,;
Width = 721, ;
Name = "Grid1"
Procedure combo1.Init
With This
.AddItem("Professional")
.AddItem("Ledger")
.AddItem("Embossed")
.AddItem("Standard")
.ListIndex=1
.Value=1
.Style=2
Endwith
Procedure grid1.Init
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
Thisform.combo1.InteractiveChange()
Endproc
Procedure combo1.InteractiveChange()
Do Case
Case Thisform.combo1.Value=1
With Thisform.grid1
.Themes=.T.
.RecordSource="ycurs"
.BackColor = Rgb(192,192,192)
.ForeColor = Rgb(0,0,0)
.GridLineColor = Rgb(255,255,255)
.GridLineWidth = 1
.GridLines = 1
.HeaderHeight = 20
.DeleteMark = .F.
.RecordMark = .F.
.ScrollBars = 3
For i=1 To .ColumnCount
.Columns(i).Alignment = 0
.Columns(i).DynamicBackColor = ""
.Columns(i).FontBold = .F.
.Columns(i).FontName = "Arial"
.Columns(i).FontSize = 8
.Columns(i).header1.BackColor = Rgb(0,0,0)
.Columns(i).header1.ForeColor = Rgb(255,255,255)
.Columns(i).header1.FontBold = .T.
.Columns(i).header1.FontName = "Arial"
.Columns(i).header1.FontSize = 10
.Columns(i).header1.Alignment = 0
.Columns(i).header1.Caption = Proper(Field(i))
Locate
.Refresh
Endfor
Endwith
Case Thisform.combo1.Value=2
With Thisform.grid1
.Themes=.T.
.RecordSource="ycurs"
.Width=.Parent.Width
.Height=.Parent.Height
.Anchor=15
.GridLineColor = Rgb(0,128,128)
.GridLineWidth = 1
.GridLines = 0
.HeaderHeight = 20
.DeleteMark = .F.
.RecordMark = .F.
.ScrollBars = 0
.ForeColor = Rgb(0,0,0)
.BackColor = Rgb(255,255,255)
For i=1 To .ColumnCount
.Columns(i).FontName = "MS Sans Serif"
.Columns(i).FontSize = 8
.Columns(i).FontBold = .T.
.Columns(i).Alignment = 0
.Columns(i).DynamicBackColor = "IIF(MOD(RECNO(),2)=1,RGB(255,255,255),RGB(192,220,192))"
.Columns(i).header1.FontName = "MS Sans Serif"
.Columns(i).header1.FontSize = 10
.Columns(i).header1.FontBold = .T.
.Columns(i).header1.BackColor = Rgb(192,220,192)
.Columns(i).header1.ForeColor = Rgb(0,0,0)
.Columns(i).header1.Alignment = 0
Endfor
Locate
.AutoFit()
.Refresh
Endwith
Case Thisform.combo1.Value=3
With Thisform.grid1
.Themes=.T.
.RecordSource="ycurs"
.BackColor = Rgb(255,255,255)
.ForeColor = Rgb(0,0,0)
.GridLineColor = Rgb(0,0,0)
.GridLineWidth = 1
.GridLines =3
.HeaderHeight = 20
.DeleteMark = .F.
.RecordMark = .F.
.ScrollBars = 3
For i=1 To .ColumnCount
.Columns(i).Alignment = 0
.Columns(i).DynamicBackColor = ""
.Columns(i).FontBold = .F.
.Columns(i).FontName = "Arial"
.Columns(i).FontSize = 8
.Columns(i).header1.BackColor = Rgb(192,192,192)
.Columns(i).header1.ForeColor = Rgb(0,0,0)
.Columns(i).header1.FontBold = .T.
.Columns(i).header1.FontName = "Arial"
.Columns(i).header1.FontSize = 10
.Columns(i).header1.Alignment = 2
.Columns(i).DynamicBackColor = ""
.Columns(i).header1.Caption = Proper(Field(i))
Locate
.Refresh
Endfor
Endwith
Case Thisform.combo1.Value=4
With Thisform.grid1
.Themes=.T.
.RecordSource="ycurs"
.BackColor = Rgb(255,255,255)
.ForeColor = Rgb(0,0,0)
.GridLineColor = Rgb(0,0,0)
.GridLineWidth = 1
.GridLines =3
.HeaderHeight = 20
.DeleteMark = .F.
.RecordMark = .F.
.ScrollBars = 3
For i=1 To .ColumnCount
.Columns(i).Alignment = 2
.Columns(i).DynamicBackColor = ""
.Columns(i).FontBold = .F.
.Columns(i).FontName = "MS Sans Serif"
.Columns(i).FontSize = 8
.Columns(i).header1.BackColor = Rgb(198,198,198)
.Columns(i).header1.ForeColor = Rgb(0,0,0)
.Columns(i).header1.FontBold = .F.
.Columns(i).header1.FontName = "Arial"
.Columns(i).header1.FontSize = 10
.Columns(i).header1.Alignment = 0
.Columns(i).DynamicBackColor = ""
.Columns(i).header1.Caption = Proper(Field(i))
Locate
.Refresh
Endfor
Endwith
Endcase
Thisform.grid1.Refresh
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*
*-- EndDefine: ygridstyle
4 stylized grids: professional-ledger-embossed-standard
Click on code to select [then copy] -click outside to deselect
*10* grid lines created on 26 of january 2017
*!* Grid.gridlines=0,1,2,3 make lines horizontal,vertical or both on grid (0 for no lines).
*!* Grid.gridlinecolor colors these lines with a given color (getcolor()).
*!* Grid.gridLineWidth adjust the with of these lines.
*!* this is another way to set lines with adding containers.its some difficult to build but the lines appears
*!* better than the native ones.its a special effect.
Publi yform
yform=Newobject("ygrid")
yform.Show
Read Events
Retu
*
Define Class ygrid As Form
Height = 524
Width = 758
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "Grid line colors special effects"
KeyPreview = .T.
ybord = .F.
ybordw = 1
yoffset=0
Name = "Form1"
Add Object grid1 As Grid With ;
FontSize = 10, ;
Anchor = 15, ;
AllowHeaderSizing = .F., ;
AllowRowSizing = .F., ;
DeleteMark = .F., ;
GridLines = 0, ;
Height = 419, ;
Left = 2, ;
RowHeight = 19, ;
Top = 1, ;
Width = 757, ;
AllowAutoColumnFit = 0, ;
Name = "Grid1"
Add Object container1 As ycont With ;
Anchor = 768, ;
Top = 489, ;
Left = 12, ;
Width = 744, ;
Height = 37, ;
BackStyle = 0, ;
BorderWidth = 1, ;
Name = "Container1"
Procedure ybuild
With Thisform.grid1
.RecordSource="ycurs"
.GridLines=3 &&can use 1,2,3 to obtain other effects
.Anchor=15
.Left=0
.Top=0
.Width=.Parent.Width
.Height=.Parent.Height-45
.Themes=.F.
.HeaderHeight=27
.GridLines=Thisform.container1.spinner3.Value
.GridLineColor=Thisform.ybord
.RowHeight=Thisform.container1.spinner2.Value
For i=1 To .ColumnCount
With .Columns(i)
With .header1
.BackColor=0
.ForeColor=Rgb(255,255,255)
.FontSize=14
Endwith
Try && if already exists
.AddObject("container1","container")
.RemoveObject(.text1.Name)
.CurrentControl="container1"
Catch
Endtry
Rand(-1)
With .container1
.BorderColor=Thisform.ybord
.BorderWidth=Thisform.ybordw
.BackStyle=1
.Anchor=15
.Left=0
.Top=0
.Width=.Parent.Width
.Name="container1"
Try
.AddObject("text1","textbox")
.Refresh
.Visible=.F.
Catch
Endtry
With .text1
.BorderStyle=1
.SpecialEffect=1
.BackStyle=0
.Anchor=15
.left=thisform.yoffset
.top=thisform.yoffset
.width= .parent.parent.width-2*thisform.yoffset
.height=.parent.height-2*thisform.yoffset
.ControlSource=.Parent.Parent.ControlSource
.Refresh
.Visible=.T.
Endwith
.Refresh
Endwith
.Sparse=.F.
.Refresh
Endwith
Bindevent(.Columns(i),"resize",Thisform,"ybuild")
Endfor
Locate
.SetFocus
Endwith
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure Resize
Thisform.ybuild
Thisform.container1.Width=This.Width
Endproc
Procedure Init
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
Thisform.ybord=Rgb(0,255,0)
Thisform.ybuild
Endproc
Enddefine
*
*-- EndDefine: ygrid
Define Class ycont As Container
Anchor = 768
Top = 489
Left = 5
Width = 744
Height = 37
BackStyle = 1
BorderWidth = 1
BackColor = Rgb(0,0,0)
Name = "ycont"
Add Object command1 As CommandButton With ;
AutoSize = .T., ;
Top = 6, ;
Left = 7, ;
Height = 27, ;
Width = 105, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Grid lines color", ;
MousePointer = 15, ;
SpecialEffect = 2, ;
BackColor = Rgb(128,255,0), ;
Name = "Command1"
Add Object spinner2 As Spinner With ;
Anchor = 768, ;
Height = 24, ;
KeyboardHighValue = 30, ;
KeyboardLowValue = 15, ;
Left = 118, ;
SpinnerHighValue = 30.00, ;
SpinnerLowValue = 15.00, ;
ToolTipText = "Adjust grid.rowheight", ;
Top = 9, ;
Width = 79, ;
Value = 20, ;
Name = "Spinner2"
Add Object check1 As Checkbox With ;
Top = 16, ;
Left = 610, ;
Height = 17, ;
Width = 43, ;
FontBold = .T., ;
Anchor = 768, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Bold", ;
ForeColor = Rgb(255,255,0), ;
Name = "Check1"
Add Object spinner1 As Spinner With ;
Anchor = 768, ;
Height = 24, ;
KeyboardHighValue = 5, ;
KeyboardLowValue = 0, ;
Left = 212, ;
SpinnerHighValue = 5.00, ;
SpinnerLowValue = 0.00, ;
ToolTipText = "Adjust container.borderwidth", ;
Top = 9, ;
Width = 71, ;
Value = 1, ;
Name = "Spinner1"
Add Object command2 As CommandButton With ;
Top = 8, ;
Left = 453, ;
Height = 25, ;
Width = 75, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Forecolor", ;
MousePointer = 15, ;
BackColor = Rgb(128,255,0), ;
Name = "Command2"
Add Object command3 As CommandButton With ;
Top = 8, ;
Left = 658, ;
Height = 25, ;
Width = 37, ;
FontName = "Webdings", ;
FontSize = 12, ;
Caption = "6", ;
MousePointer = 15, ;
ToolTipText = "Navigation Down", ;
BackColor = Rgb(128,255,0), ;
Name = "Command3"
Add Object command4 As CommandButton With ;
Top = 8, ;
Left = 699, ;
Height = 25, ;
Width = 37, ;
FontName = "Webdings", ;
FontSize = 14, ;
Caption = "5", ;
MousePointer = 15, ;
ToolTipText = "Navigation UP", ;
BackColor = Rgb(128,255,0), ;
Name = "Command4"
Add Object spinner3 As Spinner With ;
Anchor = 768, ;
Height = 24, ;
KeyboardHighValue = 3, ;
KeyboardLowValue = 0, ;
Left = 297, ;
SpinnerHighValue = 3.00, ;
SpinnerLowValue = 0.00, ;
ToolTipText = "Gridlines 0,1,2,3", ;
Top = 9, ;
Width = 71, ;
Value = 0, ;
Name = "Spinner3"
Add Object spinner4 As Spinner With ;
Anchor = 768, ;
Height = 24, ;
KeyboardHighValue = 4, ;
KeyboardLowValue = 0, ;
Left = 381, ;
SpinnerHighValue = 4.00, ;
SpinnerLowValue = 0.00, ;
ToolTipText = "Adjust container offset", ;
Top = 9, ;
Width = 71, ;
Value = 2, ;
Name = "Spinner4"
Add Object command5 As CommandButton With ;
Top = 8, ;
Left = 527, ;
Height = 25, ;
Width = 75, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Backcolor", ;
MousePointer = 15, ;
BackColor = Rgb(128,255,0), ;
Name = "Command5"
Procedure command1.Click
Thisform.ybord=Getcolor()
Thisform.ybuild()
Endproc
Procedure spinner2.InteractiveChange
*thisform.grid1.rowheight=this.value
Thisform.ybuild
Endproc
Procedure check1.Click
With Thisform.grid1
For i=1 To .ColumnCount
.Columns(i).container1.SetAll("fontbold",This.Value,"textbox")
Endfor
.Refresh
Endwith
Endproc
Procedure spinner1.InteractiveChange
Thisform.ybordw=This.Value
Thisform.ybuild
Endproc
Procedure command2.Click
Local m.xcolor
m.xcolor=Getcolor()
If !m.xcolor=-1
With Thisform.grid1
For i=1 To .ColumnCount
.Columns(i).container1.SetAll("forecolor",m.xcolor,"textbox")
Endfor
.Refresh
Endwith
Endi
Endproc
Procedure command3.Click
Sele ycurs
If !Eof()
Skip
Endi
Thisform.grid1.SetFocus
Endproc
Procedure command4.Click
Sele ycurs
If !Bof()
Skip-1
Endi
Thisform.grid1.SetFocus
Endproc
Procedure spinner3.InteractiveChange
Thisform.ybuild
Endproc
Procedure spinner4.InteractiveChange
Thisform.yoffset=This.Value
Thisform.ybuild
Endproc
Procedure command5.Click
Local m.xcolor
m.xcolor=Getcolor()
If !m.xcolor=-1
Thisform.grid1.BackColor=m.xcolor
Endi
Endproc
Enddefine
*
*-- EndDefine: asup
can set some parameters to adjust the grid lines.one problem: we lost the arrows navigation.i replaced them with 2 buttons below the form.
Click on code to select [then copy] -click outside to deselect
*11*created on 07 of februaary 2017
*Question originally asked in foxite.
*why a grid embedding an editbox (instead text1 control) dont wordWrap the contents (as text) (editbox) height originally small?
*without integrating an editbox in a grid column, you have this behavior.i suppose its native.
*the editbox have a built in property wordwrap=.t. (always)
*test this code and increase the spinner.value (until 38 it wordwrap,at 39 the vertical scrollbar appears).
*for your problem, simply increase the grid.rowHeight (edit1.height) until wordwrap begin working.
local oform
oform=Newobject( "asup")
oform.Show(1)
*
Define Class asup As Form
Height = 153
Width = 499
AutoCenter = .T.
Caption = "Form1"
Name = "Form1"
Add Object edit1 As EditBox With ;
Height = 20, ;
Left = 12, ;
Top = 12, ;
Width = 445, ;
scrollbars=2, ;
Name = "Edit1"
Add Object spinner1 As Spinner With ;
Height = 24, ;
KeyboardHighValue = 50, ;
KeyboardLowValue = 20, ;
Left = 192, ;
SpinnerHighValue = 50.00, ;
SpinnerLowValue = 20.00, ;
Top = 84, ;
Width = 85, ;
Value = 20, ;
Name = "Spinner1"
Add Object label1 As Label With ;
AutoSize = .T., ;
Caption = "edit1 height", ;
Height = 17, ;
Left = 108, ;
Top = 88, ;
Width = 66, ;
Name = "Label1"
Procedure edit1.Init
TEXT to this.value pretext 7 noshow
*begin*- Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci.*end*.
ENDTEXT
Endproc
Procedure spinner1.InteractiveChange
With Thisform.edit1
.Height=This.Value
.Refresh
Endwith
Endproc
Enddefine
*
*-- EndDefine: asup
Click on code to select [then copy] -click outside to deselect
*12*
*created on 11 of february 2017
*question asked from a user on dynamicBackcolor speed if records>500 .
*dynamicBackcolor applied to grid colums
*The speed is normal for VFP9 and dont slow visibilly. VFP8 might have the same behavior.
*added a timer to draw dynamically the grid with some dynamicColor property (random color)
*i reload the recordsource also each time (5 times).
Publi oform
oform=Newobject("asup")
oform.Show
Read Events
Retu
*
Define Class asup As Form
Top = 0
Left = 0
Height = 429
Width = 880
AutoCenter=.T.
ShowWindow=2
ycount=0
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 15, ;
Height = 433, ;
Left = 1, ;
Top = 0, ;
Width = 877, ;
Name = "Grid1"
Add Object timer1 As Timer With ;
interval=5000,;
name="timer1"
Procedure Destroy
Use In Select("ycurs")
Dele File ycurs.Dbf
Clea Events
Endproc
Procedure timer1.Timer
Rand(-1)
Sele ycurs
With Thisform
.ycount=.ycount+1
If .ycount>5
This.Enabled=.F.
Endi
Wait Window Trans(.ycount) Nowait
Endwith
With Thisform.grid1
.RecordSource=""
.Refresh
.RecordSource="ycurs"
.RecordSourceType=1
.DeleteMark=.F.
.GridLines=0
.AutoFit()
Local m.x
m.x=Trans(Rgb(255*Rand(),255*Rand(),255*Rand()))
.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(212,210,208) , "+m.x+")","column")
.Column3.DynamicBackColor = "rgb(255,164,164)"
.column5.DynamicBackColor ="rgb(255,255,0)"
.Column3.FontBold=.T.
.Column3.ForeColor=Rgb(128,0,64)
Locate
.Parent.Caption=Trans(Reccount())+ " records loaded"
.Refresh
Endwith
Endproc
Procedure grid1.Init
_Screen.WindowState=1
Close Data All
Sele * From Home(1)+"samples\data\customer" Into Table ycurs1
Sele * From Home(1)+"samples\data\customer" Into Table ycurs2
Sele * From Home(1)+"samples\data\customer" Into Table ycurs3
Sele * From Home(1)+"samples\data\customer" Into Table ycurs4
Sele * From Home(1)+"samples\data\customer" Into Table ycurs5
Sele * From Home(1)+"samples\data\customer" Into Table ycurs6
*create a new table
Sele ycurs1
Copy Stru To ycurs.Dbf
Use ycurs Alias ycurs
Sele ycurs
Appe From "ycurs1.dbf"
Appe From "ycurs2.dbf"
Appe From "ycurs3.dbf"
Appe From "ycurs4.dbf"
Appe From "ycurs5.dbf"
Appe From "ycurs6.dbf"
Close Data All
*clean
For i=1 To 6
Dele File ("ycurs"+Trans(i)+".dbf")
Endfor
*populate the grid
Use ycurs Alias ycurs
Sele ycurs
With This
.RecordSource="ycurs"
.RecordSourceType=1
.DeleteMark=.F.
.GridLines=0
.AutoFit()
.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(212,210,208) , RGB(0,255,0))","column")
.Column3.DynamicBackColor = "rgb(255,164,164)"
.column5.DynamicBackColor ="rgb(255,255,0)"
.Column3.FontBold=.T.
.Column3.ForeColor=Rgb(128,0,64)
Locate
.Parent.Caption=Trans(Reccount())+ " records loaded"
.Refresh
Endwith
Endproc
Enddefine
*
*-- EndDefine: asup
Click on code to select [then copy] -click outside to deselect
*13*
*grid search and highlight (with textbox interactiveChange or valid)
Publi oform
oform=Newobject("ygridHL")
oform.Show
Read Events
Retu
*
Define Class ygridHL As Form
Height = 563
Width = 1010
ShowWindow = 2
AutoCenter = .T.
Caption = "Grid search highlighting interactively when typing in textbox.Valid textboix to final result."
BackColor = Rgb(212,210,208)
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 15, ;
Height = 526, ;
Left = 3, ;
Top = 38, ;
Width = 1003, ;
Name = "Grid1"
Add Object text1 As TextBox With ;
FontBold = .T., ;
Anchor = 768, ;
Height = 25, ;
Left = 16, ;
Top = 0, ;
Width = 229, ;
ForeColor = Rgb(128,0,64), ;
Name = "Text1"
Add Object label1 As Label With ;
AutoSize = .T., ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "", ;
Height = 17, ;
Left = 264, ;
Top = 3, ;
Width = 2, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"
Add Object shape1 As Shape With ;
Top = 12, ;
Left = 828, ;
Height = 15, ;
Width = 15, ;
Curvature = 99, ;
MousePointer = 15, ;
ToolTipText = "Change header colors", ;
BackColor = Rgb(128,0,64), ;
Name = "Shape1"
Procedure Load
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
Locate
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure Init
Thisform.ShowTips=.T.
Thisform.text1.SetFocus
Endproc
Procedure Click
Thisform.label1.Caption=""
Endproc
Procedure grid1.Init
With This
.RecordSource="ycurs"
.RecordSourceType=1
.Themes=.F.
.GridLines=0
.DeleteMark=.F.
.HeaderHeight=26
.column1.Width=100
.RecordMark=.T.
For i=1 To .ColumnCount
With .Columns(i).header1
.FontBold=.F.
.FontSize=14
.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
Endwith
Endfor
Endwith
Endproc
Procedure text1.LostFocus
Thisform.label1.Caption=""
Endproc
Procedure text1.InteractiveChange
Local m.tot,m.n
m.n=0
m.tot=0
For Each oCol As Column In Thisform.grid1.Columns FoxObject
If Type(oCol.ControlSource)="C"
Count For Upper(Alltrim(m.thisForm.text1.Value)) $ Eval("UPPER(ALLTRIM("+oCol.ControlSource+"))") To m.n
m.tot=m.tot+m.n
Endi
Next
Thisform.label1.Caption=Trans(m.tot) +" occurences found "
For Each oCol As Column In Thisform.grid1.Columns FoxObject
If Type(oCol.ControlSource)="C"
oCol.DynamicBackColor="IIF(UPPER(ALLTRIM(m.thisForm.text1.Value))$ UPPER(ALLTRIM("+oCol.ControlSource+")),rgb(173,255,47),RGB(255,255,255))"
Else
oCol.DynamicBackColor=""
Endif
Next
Locate
Thisform.grid1.Refresh
Endproc
Procedure text1.Valid
Local m.tot,m.n
m.n=0
m.tot=0
For Each oCol As Column In Thisform.grid1.Columns FoxObject
If Type(oCol.ControlSource)="C"
Count For Upper(Alltrim(m.thisForm.text1.Value)) == Eval("UPPER(ALLTRIM("+oCol.ControlSource+"))") To m.n
m.tot=m.tot+m.n
Endi
Next
Thisform.label1.Caption=Trans(m.tot) +" occurences found "
For Each oCol As Column In Thisform.grid1.Columns FoxObject
If Type(oCol.ControlSource)="C"
oCol.DynamicBackColor="IIF(UPPER(ALLTRIM(m.thisForm.text1.Value))$ UPPER(ALLTRIM("+oCol.ControlSource+")),rgb(173,255,47),RGB(255,255,255))"
Else
oCol.DynamicBackColor=""
Endif
Next
Locate
Thisform.grid1.Refresh
Endproc
Procedure shape1.Click
With Thisform.grid1
For i=1 To .ColumnCount
With .Columns(i).header1
.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
Endwith
Endfor
.Refresh
Endwith
Endproc
Enddefine
*
*-- EndDefine: ygridHL
Click on code to select [then copy] -click outside to deselect
*14* created sunday 21 of january 2018 as answer to a atoutfox user.
*can use "fake" property dynamicFontbold to populate a column grid for a currencontrol here a commandutton.
*the dynamicFontbold must ahve a valid evaluation of the code to work otherwise error is returned.
* the dynamicfontbold links to a shoWcaption() method for each record (itb poulate sthe commandbutton caption+set a commanbutton backcolor)
*click on any button n column3 to return the commandbutton caption.
PUBLIC oform
oform=NEWOBJECT("madagascar")
oform.Show
RETURN
*
DEFINE CLASS madagascar AS form
Top = 17
Left = 130
Height = 459
Width = 808
Caption = "Form1"
Name = "Form1"
ADD OBJECT grid1 AS grid WITH ;
Anchor = 15, ;
Height = 457, ;
Left = 0, ;
Top = 0, ;
Width = 805, ;
Name = "Grid1"
PROCEDURE showcaption
Lparameters toButton, xtext
dodefault() &&important
toButton.Caption =allt(xtext)
toButton.backcolor=iif(mod(recno(),2)=0,rgb(0,255,0),rgb(255,120,140))
retu
ENDPROC
PROCEDURE Load
sele * from home(1)+"samples\data\customer" into cursor ycurs
ENDPROC
PROCEDURE grid1.Init
with this
.recordsource="ycurs"
.recordsourcetype=1
.deletemark=.f.
.rowheight=20
.gridlines=0
.setall("fontbold",.t.,"header")
oCol=.column3
with ocol
try
.addobject("command1","commandbutton")
catch
endtry
.currentcontrol="command1"
.sparse=.f.
with .command1
.caption=""
.backcolor=rgb(0,255,0)
.specialEffect=2
.fontsize=10
.fontname="courier new"
.mousepointer=15
.visible=.t.
endwith
.DynamicFontBold = 'thisform.showCaption(thisform.grid1.column3.command1,ycurs.contact)' &&expression must be valid and evaluated at runtime otherwise error!
endwith
bindevent(ocol.command1,"mousedown",thisform,"my")
.refresh
endwith
ENDPROC
procedure my
LPARAMETERS nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
messagebox("this is:"+loObject.parent.name+"."+loObject.name+".caption= "+loObject.caption,0+32+4096,'',1300)
endproc
ENDDEFINE
*
*-- EndDefine: madagascar
Click on code to select [then copy] -click outside to deselect
*15* created on wednesday 24 of january 2018
*this code makes any header clickable and retrieve a message in a label on bottom of the form and change temporarly the headr color.
*it allows in the first click to order ascending/descending on any column of the grid
*it uses the super function BINDEVENTS() for binding the event mousedown on any grid column header.
set defa to addbs(justpath(sys(16,1)))
*create 2 small gif images for arrows on column.headers (up.gif and down.gif)
local m.myvar
text to m.myvar noshow
R0lGODlhGAAYALMMAAAAABAQEBgYGCEhISkpKVpaWmtra62trbW1tc7OztbW1ufn5wAAAAAAAAAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh+QQFCgAMACwAAAAAGAAYAAAEWpDJSau9OOvNu/9aMggKOCUCAJAmqqqs575wyc10veG5jikp1SCgCgxeMUvhNVgEBYujqoA5CBeMJyOqOmQQBmwWJlkYEB+tSaJet00EFWEtSRgMCbp+z+8zIgA7
endtext
strtofile(strconv(m.myvar,14),"up.gif")
text to m.myvar noshow
R0lGODlhGAAYAMQOAAAAAAgICBAQEBgYGCEhISkpKVpaWmtra62trbW1tc7OztbW1t7e3ufn5wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh+QQFCgAOACwAAAAAGAAYAAAFYqAjjmRpnmiqrmzrOspxKG9ZAEBRkwM+7KMe4Ad0CImtxKEhOooah0QKgSMwnQ0CDoEy4ADWY/ZrQC2EYAFOoPUtUuev/DugqeJzn32Fl9dffUN7Lnh/QGcEg0WLjI2OjCEAADs=
endtext
strtofile(strconv(m.myvar,14),"down.gif")
Public oform
oform=Newobject("ygrid")
oform.Show
Return
*
Define Class yGrid As Form
Height = 400
Width = 924
AutoCenter = .T.
Caption = "Click on any column.header to retrieve a reaction !"
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 15, ;
themes=.f.,;
scrollbars=3,;
Height = 380, ;
Left = 0, ;
Top = 0, ;
Width = 905, ;
highLightStyle=2,;
Name = "Grid1"
Add Object lbl As Label With ;
anchor=768, ;
autosize=.T., ;
caption="", ;
left=10 , ;
top =382+3,;
backstyle=0, ;
fontsize=9, ;
forecolor=255, ;
fontbold=.t.,;
name="lbl"
Procedure mym
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
Local m.xBackcolor
m.xBackcolor=loObject.BackColor
loObject.BackColor=255
Thisform.lbl.Caption="the header ["+loObject.Caption+"] was clicked! ordering column made."
*ordering ascending at first click / descending at second click (see icon on each header)
Local N
N=Int(Val(Substr(loObject.Parent.Name,7))) &&column..
Thisform.grid_reorder(N)
Nodefault
Inke(1.5)
loObject.BackColor=m.xBackcolor
Thisform.lbl.Caption=""
Endproc
Procedure Load
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
Locate
Endproc
Procedure Init
Sele ycurs
If Reccount("ycurs")>0
dx=Dbf("ycurs")
dx=Left(dx, Rat(".",dx))+"cdx"
For i=1 To Fcount()
TEXT to m.myvar textmerge noshow
Inde On <<field(i)>> Tag <<field(i)>> Of (dx)
ENDTEXT
=Execscript(m.myvar) &&inde on all grid columns
Endfor
Set Order To 1 Ascending &&an click on any field for ordering it ascending
Endi
Endproc
Procedure grid_reorder
* grid_reorder
Lparameters ColNo
thisform.grid1.setall("picture","","header")
Local _sele
_sele=Sele()
If Used("ycurs")
Sele ycurs
If Tagno()=ColNo And !"DESCE"$Set("order")
Set Order To ColNo Descending
thisform.grid1.columns(ColNo).header1.picture="up.gif"
Else
Set Order To ColNo Ascending
thisform.grid1.columns(ColNo).header1.picture="down.gif"
Endif
locate
this.grid1.setfocus
This.grid1.Refresh
Endif
Sele (_sele)
Endproc
Procedure grid1.Init
With This
.Themes=.F. && used oonly for header.backColor in method mym (vfp9sp2 cannot colorise the headers if themes=.t.)
.RecordSource="ycurs"
.RecordSourceType=1
.GridLines=0
.headerHeight=40
.DeleteMark=.F.
.SetAll("fontbold",.T.,"header")
.SetAll("fontsize",12,"header")
.SetAll("mousepointer",15,"header")
.setall("alignment",0,"header")
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255), RGB(205,255,220))", "Column")
rand(-1)
for i=1 to .columncount
.columns(i).header1.backcolor=rgb(255*rand(),255*rand(),255*rand())
endfor
.AutoFit()
Locate
.Refresh
For i=1 To .ColumnCount
Bindevent(.Columns(i).header1,"mousedown",Thisform,"mym")
Endfor
Endwith
Endproc
Enddefine
*
*-- EndDefine: ygrid
i already made a similar code to order columns ascending/descending in grid (to search).
Click on code to select [then copy] -click outside to deselect
*16* created on saturday 27 of january 2017
*this is an illustration how to work with a grid and a container class.
*a container can embed all kind of objects, here its used in each row of a grid to embed text on labels ,photos,memo field.
*a cursor gathers informations desserving this grid in particular photos and text of an editbox(can be a great qty of scrollable text in each record).
*click on any photo to zoom it in a modal form with a lightbox vfp effect (i used a shape with drawmode=9 as pointed already in my previous posts).
*setfocus and click on any label to rotate it (1 round).
*the form is resizable vertically only (to hide non used grid areas).can maximize it to have a good look its scrollable by vertical scrollbars or by mouseWhell).
*the column dynamicaOutline property is used here (can be dynamicfontbold,or others dynamic.. in grid).
*the photos used for the demo are in vfp graphics folder
*note that the form ydemo with desktop=.t. skins a windows form (as contrary of native one whose is an >XP theme with blue titlebar+round corners!).
Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
#Define rh 210
Sys(2002)
Publi oform
oform = Createobject("Form1")
oform.Show
Read Event
Retu
Define Class Form1 As Form
AutoCenter= .T.
ShowWindow=2
Height = 600
Width = 800
Caption = 'A rich list with a vfp grid and container class'
Add Object grid1 As Grid With ColumnCount= 1,Anchor=15,;
Top = 0, Left = 0, HeaderHeight= 0, Width = Thisform.Width, Height = Thisform.Height,;
RowHeight= rh, RecordMark= .F.,DeleteMark= .F., ScrollBar = 2,Name="grid1"
Procedure Load
declare integer Sleep in kernel32 integer
Select * From Home(2)+'Northwind\employees' Into Cursor ycurs Readwrite
Inde On firstName Tag firstName
Set Order To firstName
i=1
Scan
Repl employeeId With i
i=i+1
Endscan
Local m.gnbre
m.gnbre=Adir(gabase,Home(1)+"Samples\Data\Graphics\*.gif")
If gnbre=0 &&no images
Return .F.
Endi
Sele ycurs
Repl All photo With Home(1)+"Samples\Data\Graphics\"+gabase(Recno(),1)
* Brow
Locate
Endproc
Procedure Init
Thisform.LockScreen=.T.
With This.grid1 As Grid
.Anchor=15
.RecordSourceType= 1
.RecordSource= 'ycurs'
.AllowHeaderSizing=.F.
.Column1.RemoveObject('Text1')
.Column1.AddObject('yCNT1','yCNT')
.Column1.yCNT1.Visible = .T.
.Column1.Sparse = .F.
.Column1.DynamicFontOutline = 'thisform.showCnt(this.Column1.yCNT1)'
.Column1.Width =Thisform .Width
* .AutoFit
Locate
.SetFocus
.Column1.yCNT1.Resize
.Refresh
Endwith
* Thisform.WindowState=2
Thisform.LockScreen=.F.
local m.myvar
text to m.myvar pretext 7 noshow
this is an illustration how to work with a grid and a container class.
a container can embed all kind of objects, here its used in each row of a grid, to embed text on labels ,photos,memo field and fires some actions.
a cursor gather informations desserving this grid in particular photos and text of an editbox(can be a great qty of scrollable text in each record).
click on any photo to zoom it in a modal form with a lightbox vfp effect (i used a shape with drawmode=9 as pointed already in my previous posts).
click on the demo form to release it and return to the main form.
Set grid focus and click on any label to rotate it (1 round).
the form is resizable vertically only (to hide non used grid areas).can maximize it to have a good look its scrollable by vertical scrollbars or by mouseWhell).
the column dynamicOutline property is used here (can be dynamicfontbold,or others dynamic.. in grid-these evaluate an expression indepently of it signification by itself).
the photos used for the demo are in vfp graphics folder
note that the form ydemo with desktop=.t. skins a windows form (as contrary of native one whose is an >XP theme with blue titlebar+round oorners!).
endtext
local oshell
oshell=newObject("wscript.shell")
oshell.Popup(m.myvar,0, ' Summary help', 0+32+4096)
oshell=null
Endproc
Procedure Resize
This.grid1.Column1.yCNT1.Resize
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure showCNT
Lparameters oContainer
Local lcCountry, lcCity, lcEmployee, lcTitle
* Country label
lcCountry = Alltrim(Country)
oContainer.lblCountry.ForeColor= Iif(m.lcCountry='UK',Rgb(0,128,255),Rgb(255,0,0))
oContainer.lblCountry.Caption= m.lcCountry
oContainer.lblCountry.FontSize= 14
* City label
With oContainer.lblCity As Label
lcCity = Alltrim(City)
.Caption = m.lcCity
.ForeColor = Icase(m.lcCity = 'Seattle',Rgb(128,128,255),m.lcCity = 'Tacoma',Rgb(0,128,0),;
m.lcCity = 'Kirkland',Rgb(255,128,0),m.lcCity = 'Redmond',Rgb(0,128,255),Rgb(255,0,128))
.FontItalic= .T.
Endwith
* Employee label
With oContainer.lblEmployee As Label
lcEmployee = Alltrim(titleofCourtesy)+' '+Alltrim(firstName)+' '+Alltrim(lastname)
.Caption = m.lcEmployee
.FontBold=.T.
.ForeColor= Rgb(0,128,128)
.FontName= 'Calibri'
.FontSize= 20
Endwith
* Title
With oContainer.lblTitle As Label
lcTitle = Alltrim(Title)
.Caption = m.lcTitle
.FontName= 'Calibri'
.FontSize= 12
.ForeColor= Icase(m.lcTitle = 'Sales Representative',Rgb(128,0,64),;
m.lcTitle = 'Vice President, Sales',Rgb(128,128,255),;
m.lcTitle = 'Sales Manager',Rgb(128,128,128),Rgb(128,128,192))
Endwith
* Date of Birth
With oContainer.lblDOB As Label
.Caption = 'Date of Birth: '+Mdy(birthdate)
.FontName= 'Calibri'
Endwith
* Address
With oContainer.lblADR As Label
.Caption = 'Address: '+Allt(address)
.ForeColor=Rgb(255,120,90)
.FontName= 'Calibri'
Endwith
* postal code
With oContainer.lblPC As Label
.Caption = 'Postal code: '+Allt(Postalcode)
.ForeColor=Rgb(0,128,0)
.FontName= 'Calibri'
Endwith
* home phone
With oContainer.lblPh As Label
.Caption = 'Phone: '+Allt(homephone)
.ForeColor=Rgb(255,0,0)
.FontName= 'Calibri'
Endwith
* EmployeeId
With oContainer.lblID As Label
.Caption = Trans(employeeId)
.ForeColor=Rgb(255,0,0)
.FontSize=48
.AutoSize=.T.
.FontName= 'Calibri'
Endwith
* image
With oContainer.img As Image
.Picture= photo
.Visible=Iif(!Empty(.Picture),.T.,.F.)
Endwith
oContainer.edt.Refresh
Endproc
Enddefine
*ERndDefine form1
Define Class yCNT As Container
BorderStyle= 0
BackStyle=0
Height = 70
Width = 590+100+550
BorderWidth= 0
Add Object lblID As ylab With Top = 40, Left = 10
Add Object lblEmployee As ylab With Top = 0, Left = 50
Add Object lblTitle As ylab With Top = 30, Left = 50
Add Object lblDOB As ylab With Top = 50, Left = 50
Add Object lblADR As ylab With Top = 80, Left = 50
Add Object lblPC As ylab With Top = 110, Left = 50
Add Object lblPh As ylab With Top = 140, Left = 50
Add Object lblCountry As ylab With Top = 170, Left =50 ,BorderStyle=1
Add Object lblCity As ylab With Top = 170, Left = 100
Add Object img As img With Top=5,Left=595
Add Object shp1 As shp With Top=0,Left=590
Add Object edt As edt With Top=0,Left=790
Procedure Init
DoDefault()
This.Resize
Endproc
Procedure Resize
Thisform.grid1.Refresh
Thisform.Width=This.Width+40
This.edt.Value=This.edt.Value
This.edt.Refresh
With This.shp1
.Left=.Parent.img.Left-5
.Top=.Parent.img.Top-5
.Width=.Parent.img.Width+2*5
.Height=.Parent.img.Height+2*5
.Curvature=9
.BorderWidth=3
Rand(-1)
.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
.ZOrder(1)
Endwith
Thisform.AutoCenter=.T.
Endproc
Enddefine
*EndDefine ycnt
*
Define Class ylab As Label
BackStyle= 0
AutoSize= .T.
Name="ylab"
procedure click
for i=0 to 35
this.rotation=this.rotation+10
sleep(20)
endfor
this.rotation=0
endproc
Enddefine
*EndDefine ylab
Define Class img As Image
Stretch=0
Picture=""
MousePointer=15
BorderStyle=1
BorderColor=Rgb(72,0,36)
Name="img"
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Local oform
Nodefault
With Thisform
Try
.AddObject("oshp","shape")
Catch
Endtry
With .oshp
.DrawMode=9
.BackColor=Rgb(45,45,45)
.Left=0
.Top=0
.Width=.Parent.Width
.Height=.Parent.Height
.ZOrder(0)
.Visible=.T.
Endwith
Endwith
Sele ycurs
oform=Newobject("ydemo","","",photo,Allt(firstName)+" "+Allt(lastname))
oform.Show(1)
Thisform.RemoveObject("oshp")
Thisform.grid1.SetFocus
Endproc
Enddefine
*EndDefine img
Define Class shp As Shape
BackStyle=1
Width=200
Height=250
BackColor=Rgb(128,0,64)
Name="shp"
Procedure Init
With This
*!* .Left=.Parent.img.Left-5
*!* .Top=.Parent.img.Top-5
*!* .Width=.Parent.img.Width+2*5
*!* .Height=.Parent.img.Height+2*5
.ZOrder(1)
*.parent.resize
.Visible=.T.
Endwith
Endproc
Enddefine
*EndDefine shp
Define Class edt As EditBox
ControlSource="ycurs.notes"
FontName="courier new"
FontSize=9
ForeColor=Rgb(128,0,64)
Margin=5
Width=450
Height=rh
Value=""
ScrollBars=0 &&2
BorderStyle=0
ReadOnly=.T.
Name="edt"
Enddefine
*ydemo
Define Class ydemo As Form
Top = 29
Left = 40
Height = 385
Width = Thisform.Height*16/9
Desktop=.T. &&form style win10 (if not =style XP(blue rounded corners)
ShowWindow=1
Caption = ""
BorderStyle=0
ControlBox = .F.
MaxButton = .F.
MinButton=.F.
AutoCenter=.F.
WindowType = 1
Name = "Form1"
Add Object image1 As Image With ;
anchor=15,;
Stretch = 2, ;
Height = Thisform.Height, ;
Left = 0, ;
MousePointer = 15, ;
Top = 0, ;
Width = Thisform.Width, ;
Name = "Image1"
Procedure Init
Lparameters xpicture,xcap
* DoDefault()
If Empty(xpicture)
Return .F.
Endi
With Thisform
.Caption=Spac(50)+Allt(xcap) +Spac(30)+"[click to exit form]" &&justfstem(xpicture)
.image1.Picture=xpicture
.Refresh
Endwith
Endproc
Procedure image1.Click
Thisform.Release
Endproc
Enddefine
*
*-- EndDefine: ydemo
Click on code to select [then copy] -click outside to deselect
*17* created on sunday 28 of january 2018
*!* this is another illustration how to work with a grid and a container class to show some photos gathered in one directory.
*!* a container can embed all kind of objects, here its used in each row of a grid, to embed text on labels ,photos,memo field and fires some actions.
*!* a cursor gather informations desserving this grid in particular photos and text of an editbox(can be a great qty of scrollable text in each record).
*!* click on any photo to zoom it in a modal fullscreen form .the photos are with strecth=2 (extension to the container defined area.
*!* click on the demo form to release it and return to the main form.
*!* Set grid focus and click on any label to rotate it (1 round).
*!* the form is not resizable to preserve the photo shown. its scrollable by vertical scrollbars or by mouseWheel.
*!* the column dynamicOutline property is used here (can be dynamicfontbold,or others dynamic.. in grid-these evaluate an expression indepently of it signification by itself).
*!* the photos used for the demo can be in great quantity (here 127 photos 800x600)
*!* note that the form ydemo with desktop=.t. skins a windows form (as contrary of native one whose is an >XP theme with blue titlebar+round oorners!).
*!* A timer can cycle all photos with interval =5 sec (can be enabled/disabled in _screen.ytimer public property.
_screen.addproperty("ytimer",.t.) &&timer (5 sec) is enabled here. can disable the timer with a value=.f.
Local m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
Local m.myv
TEXT to m.myv pretext 7 noshow
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra
auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
ENDTEXT
Local m.gnbre,m.yphotos
m.yphotos=Getdir("","","",32) && any folder having photos
m.yphotos=Addbs(m.yphotos)
m.gnbre=Adir(gabase,m.yphotos+"*.jpg")
Create Cursor ycurs(ximg c(150),xedt m)
For i=1 To gnbre
Insert Into ycurs Values(m.yphotos+gabase(i,1),ximg+Chr(13)+Chr(13)+m.myv)
Endfor
*brow
Locate
#Define rh 700 && grid rowHeight
Sys(2002)
Publi oform
oform = Createobject("Form1")
oform.Show
Read Event
Retu
Define Class Form1 As Form
AutoCenter= .T.
ShowWindow=2
Height = 700
Width = 800
MaxButton=.F.
BorderStyle=0
Caption = 'A rich list with a vfp grid and container class'
Add Object grid1 As Grid With ColumnCount= 1,Anchor=15,;
Top = 0, Left = 0, HeaderHeight= 0, Width = Thisform.Width, Height = Thisform.Height,;
RowHeight= rh, RecordMark= .F.,DeleteMark= .F., ScrollBar = 2,Name="grid1"
Add object timer1 as Timer with interval=5000,enabled=_screen.ytimer,name="timer1"
Procedure Load
Declare Integer Sleep In kernel32 Integer
Endproc
Procedure Init
Thisform.LockScreen=.T.
With This.grid1 As Grid
.Anchor=15
.RecordSourceType= 1
.RecordSource= 'ycurs'
.AllowHeaderSizing=.F.
.Column1.RemoveObject('Text1')
.Column1.AddObject('yCNT1','yCNT')
.Column1.yCNT1.Visible = .T.
.Column1.Sparse = .F.
.Column1.BackColor=Rgb(212,210,208)
.Column1.DynamicFontOutline = 'thisform.showCnt(this.Column1.yCNT1)'
.Column1.Width =Thisform .Width
Locate
.SetFocus
.Column1.yCNT1.Resize
.Refresh
Endwith
Thisform.LockScreen=.F.
Local m.myvar
TEXT to m.myvar pretext 7 noshow
this is another illustration how to work with a grid and a container class to show some photos gatherd in one directory.
a container can embed all kind of objects, here its used in each row of a grid, to embed text on labels ,photos,memo field and fires some actions.
a cursor gather informations desserving this grid in particular photos and text of an editbox(can be a great qty of scrollable text in each record).
click on any photo to zoom it in a modal fullscreen form
click on the demo form to release it and return to the main form.the photos are with strecth=2 (extension to the container defined area.
Set grid focus and click on any label to rotate it (1 round).
the form is not resizable to preserve the photo shown. its scrollable by vertical scrollbars or by mouseWheel.
the column dynamicOutline property is used here (can be dynamicfontbold,or others dynamic.. in grid-these evaluate an expression indepently of it signification by itself).
the photos used for the demo can be in great quantity (here 127 photos 800x600)
A timer can cycle all photos with interval =5 sec (can be enabled/disabled in _screen.ytimer public property.
note that the form ydemo with desktop=.t. skins a windows form (as contrary of native one whose is an >XP theme with blue titlebar+round oorners!).
ENDTEXT
Local oshell
oshell=Newobject("wscript.shell")
oshell.Popup(m.myvar,0, ' Summary help', 0+32+4096)
oshell=Null
Endproc
procedure timer1.timer
sele ycurs
try
skip
catch
locate
endtry
if empty(ximg)
locate
endi
thisform.grid1.refresh
endproc
Procedure Resize
This.grid1.Column1.yCNT1.Resize
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure showCNT
Lparameters oContainer
Local lcCountry, lcCity, lcEmployee, lcTitle
With oContainer.lblID As Label
.Caption = Trans(Recno())+"/"+Trans(Reccount())
.ForeColor=Rgb(255,0,0)
.FontSize=48
.AutoSize=.T.
.FontName= 'Calibri'
Endwith
With oContainer.lblFS As Label
.Caption = "click image for fullscreen view"
.ForeColor=Rgb(128,0,64)
.FontSize=12
.AutoSize=.T.
.FontName= 'Calibri'
Endwith
* image
With oContainer.img As Image
.Picture= ximg
.Visible=Iif(!Empty(.Picture),.T.,.F.)
Endwith
oContainer.edt.Refresh
Endproc
Enddefine
*EndDefine form1
Define Class yCNT As Container
BorderStyle= 0
BackStyle=0
Height = 600
Width = 590+100+550
BorderWidth= 0
Add Object lblID As ylab With Top = 605, Left = 100
Add Object lblFS As ylab With Top = 615, Left = 300
Add Object img As img With Top=5,Left=5
Add Object shp1 As shp With Top=0,Left=0
Add Object edt As edt With Top=0,Left=810
Procedure Init
DoDefault()
This.Resize
Endproc
Procedure Resize
Thisform.grid1.Refresh
Thisform.Width=This.Width+40
This.edt.Value=This.edt.Value
This.edt.Refresh
With This.shp1
.Left=.Parent.img.Left-5
.Top=.Parent.img.Top-5
.Width=.Parent.img.Width+2*5
.Height=.Parent.img.Height+2*5
.Curvature=9
.BorderWidth=3
Rand(-1)
.BackColor=Rgb(255*Rand(),255*Rand(),255*Rand())
.ZOrder(1)
Endwith
Thisform.AutoCenter=.T.
Endproc
Enddefine
*EndDefine ycnt
*
Define Class ylab As Label
BackStyle= 0
AutoSize= .T.
MousePointer=15
Name="ylab"
Procedure Click
For i=0 To 35
This.Rotation=This.Rotation+10
Sleep(20)
Endfor
This.Rotation=0
Endproc
Enddefine
*EndDefine ylab
Define Class img As Image
Stretch=2
Picture=""
MousePointer=15
BorderStyle=1
BorderColor=Rgb(72,0,36)
ToolTipText="click for fullscreen"
Name="img"
Procedure Init
With This
.Width=800
.Height=rh-98
Endwith
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Local oform
Nodefault
With Thisform
Try
.AddObject("oshp","shape")
Catch
Endtry
With .oshp
.DrawMode=9
.BackColor=Rgb(45,45,45)
.Left=0
.Top=0
.Width=.Parent.Width
.Height=.Parent.Height
.ZOrder(0)
.Visible=.T.
Endwith
Endwith
Sele ycurs
oform=Newobject("ydemo","","",ximg,Juststem(ximg))
oform.Show(1)
Thisform.RemoveObject("oshp")
Thisform.grid1.SetFocus
Endproc
Enddefine
*EndDefine img
Define Class shp As Shape
BackStyle=1
Width=200
Height=250
BackColor=Rgb(128,0,64)
Name="shp"
Procedure Init
With This
.Left=.Parent.img.Left-5
.Top=.Parent.img.Top-5
.Width=.Parent.img.Width+2*5
.Height=.Parent.img.Height+2*5
.ZOrder(1)
.Visible=.T.
Endwith
Endproc
Enddefine
*EndDefine shp
Define Class edt As EditBox
ControlSource="ycurs.xedt"
FontName="courier new"
FontSize=9
ForeColor=Rgb(128,0,64)
BackColor=Rgb(212,210,208)
Margin=5
Width=450
Height=rh
Value=""
ScrollBars=0 &&2
BorderStyle=0
ReadOnly=.T.
Name="edt"
Enddefine
*ydemo
Define Class ydemo As Form
Top = 29
Left = 40
Height = 385
Width = Thisform.Height*16/9
Desktop=.T. &&form style win10 (if not =style XP(blue rounded corners)
ShowWindow=1
Caption = ximg
BorderStyle=0
ControlBox = .F.
MaxButton = .F.
MinButton=.F.
AutoCenter=.F.
WindowType = 1
WindowState=2
Name = "Form1"
Add Object image1 As Image With ;
anchor=15,;
Stretch = 2, ;
Height = Thisform.Height, ;
Left = 0, ;
MousePointer = 15, ;
Top = 0, ;
Width = Thisform.Width, ;
Name = "Image1"
Procedure Init
Lparameters xpicture,xcap
If Empty(xpicture)
Return .F.
Endi
With Thisform
.Caption=Spac(50)+Allt(xcap) +Spac(30)+"[click to exit form]"
.image1.Picture=xpicture
.Refresh
Endwith
Endproc
Procedure image1.Click
Thisform.Release
Endproc
Enddefine
*
*-- EndDefine: ydemo
grid with container here embeds near 300 images 800x600 without any problem.
Click on code to select [then copy] -click outside to deselect
*18* created on friday 23 of february 2018 answering a user.
*this code shows how to build a grid with a column with embed comboBoxes built with values (here 1-10 added with additem).
Public oform
oform=Newobject("Grid_combo")
oform.Show
Return
*
Define Class Grid_combo As Form
Top = 0
Left = 0
Height = 389
Width = 778
minWidth=600
Caption = "Form1"
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor=15 , ;
Height = 385, ;
Left = 0, ;
Top = 3, ;
Width = 781, ;
Name = "Grid1"
Procedure grid1.Init
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
With This
.RecordSource="ycurs"
.RecordSourceType=1
.GridLines=0
.DeleteMark=.F.
.RowHeight=21
With .column2
.Width=80
.AddObject("combo1","combobox")
.CurrentControl="combo1"
.Sparse=.F.
.ControlSource="" &&important
With .combo1
For i=1 To 10
.AddItem (Trans(i))
Endfor
.ListIndex=1
.Style=2
.Visible=.T.
Endwith
.Refresh
Endwith
.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(167,255,210))", "Column")
.Refresh
Endwith
Endproc
Procedure Resize &&to have always columns shown proportionnaly on grid
With Thisform.grid1
c1=.Width/Fcount()
For i=1 To .ColumnCount
.Columns(i).Width=c1
Endfor
Endwith
Endproc
Enddefine
*
*-- EndDefine:grid_combo
Click on code to select [then copy] -click outside to deselect
*19* created on wednesday 14 of march 2018
*A cursor ys stamps all columns widths in init event (can be also an array).
*Bindevent all grid columns to a custom method yresize that prevent modifying any column width when user try to resize columns.
*you can resize columns proportionally to "preserve grid ratio" by using % column width for each column (this could be another code)
*try to resize the columns in sample below.
Public oform
oform=Newobject("ygrid_preserveW")
oform.Show
Return
Define Class ygrid_preserveW As Form
Height = 500
Width = 700
AutoCenter = .T.
Caption = "Grid preserving initial column widths."
Name = "Form1"
Add Object grid1 As Grid With ;
Anchor = 15, ;
Height = 495, ;
Left = 1, ;
Top = 2, ;
Width = 695, ;
Name = "Grid1"
Procedure yresize
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
Local N
N=Int(Val(Substr(loObject.Name,7) ))
Sele ys
Go N
loObject.Width=xwidth
Endproc
Procedure grid1.Init
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs
Create Cursor ys (xwidth i)
With This
.RecordSource="ycurs"
.RecordSourceType=1
.DeleteMark=.F.
.GridLines=0
.SetAll("fontbold",.T.,"header")
.SetAll("DynamicBackColor","IIF(MOD(RECNO( ), 2)=0, RGB(212,210,208) , RGB(0,200,0))", "Column")
For i=1 To .ColumnCount
Insert Into ys Values ( .Columns(i).Width) &&gather initial comlumn width to resuse them column resize event.
Bindevent(.Columns(i),"resize",Thisform,"yresize")
Endfor
Locate
.Refresh
Endwith
Endproc
Enddefine
*
*-- EndDefine: ygrid_preserveW
Click on code to select [then copy] -click outside to deselect
*20* created on 14 of april 2018
*Grid dynamicforecolor-dynamicBackcolor
PUBLIC oform1
oform1=NEWOBJECT("form1")
oform1.Show
RETURN
*
DEFINE CLASS form1 AS form
Height = 385
Width = 829
AutoCenter = .T.
Caption = "Grid dynamicForecolor(Backcolor)"
Name = "form1"
ADD OBJECT grid1 AS grid WITH ;
FontBold = .T., ;
Anchor = 15, ;
Height = 312, ;
Left = 0, ;
Top = 12, ;
Width = 829, ;
Name = "Grid1"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 350, ;
Left = 301, ;
Height = 27, ;
Width = 84, ;
Anchor = 768, ;
Caption = "Example2", ;
MousePointer = 15, ;
Name = "Command1"
ADD OBJECT command2 AS commandbutton WITH ;
Top = 350, ;
Left = 199, ;
Height = 27, ;
Width = 84, ;
Anchor = 768, ;
Caption = "Example1", ;
MousePointer = 15, ;
Name = "Command2"
ADD OBJECT command3 AS commandbutton WITH ;
Top = 350, ;
Left = 408, ;
Height = 27, ;
Width = 84, ;
Anchor = 768, ;
Caption = "Example3", ;
MousePointer = 15, ;
Name = "Command3"
ADD OBJECT command4 AS commandbutton WITH ;
Top = 350, ;
Left = 511, ;
Height = 27, ;
Width = 84, ;
Anchor = 768, ;
Caption = "Initial grid", ;
MousePointer = 15, ;
Name = "Command4"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
Anchor = 768, ;
Caption = "Can reclick many times for effects", ;
Height = 17, ;
Left = 624, ;
Top = 348, ;
Width = 186, ;
Name = "Label1"
ADD OBJECT optiongroup1 AS optiongroup WITH ;
AutoSize = .T., ;
ButtonCount = 2, ;
Anchor = 768, ;
BackStyle = 0, ;
Value = 1, ;
Height = 27, ;
Left = 12, ;
Top = 348, ;
Width = 156, ;
Name = "Optiongroup1", ;
Option1.BackStyle = 0, ;
Option1.Caption = "Forecolor", ;
Option1.Value = 1, ;
Option1.Height = 17, ;
Option1.Left = 5, ;
Option1.Style = 0, ;
Option1.Top = 5, ;
Option1.Width = 70, ;
Option1.AutoSize = .T., ;
Option1.Name = "Option1", ;
Option2.BackStyle = 0, ;
Option2.Caption = "Backcolor", ;
Option2.Height = 17, ;
Option2.Left = 79, ;
Option2.Style = 0, ;
Option2.Top = 5, ;
Option2.Width = 72, ;
Option2.AutoSize = .T., ;
Option2.Name = "Option2"
PROCEDURE Destroy
clea events
ENDPROC
PROCEDURE grid1.Init
sele * from home(1)+"samples\data\customer" into cursor ycurs
with this
.recordsource="ycurs"
.recordsourcetype=1
.gridlines=0
.deletemark=.f.
locate
.autofit()
.refresh
endwith
ENDPROC
PROCEDURE command1.Click
thisform.command4.click
rand(-1)
with thisform.grid1
local m.x
m.x=INT(.columncount*RAND() + 1)
with .columns(m.x)
if thisform.optiongroup1.value=1
.dynamicforecolor="rgb(255*rand(),255*rand(),255*rand())"
else
.dynamicBackcolor="rgb(255*rand(),255*rand(),255*rand())"
endi
.refresh
endwith
endwith
ENDPROC
PROCEDURE command2.Click
thisform.command4.click
with thisform.grid1.column2
*.dynamicforecolor=255 &&dont work
*.dynamicforecolor="255" &&dont work
*.dynamicforecolor=rgb(255,0,0) && dont work
if thisform.optiongroup1.value=1
.dynamicforecolor="rgb(255,0,0)" && work
else
.dynamicBackcolor="rgb(255,0,0)" && work
endi
*must be mandatory a valid expresion beteen quotes to be evaluated by vfp.Specifies a character expression evaluates at run time to a single color value.
* The color value is reevaluated at run time whenever the Grid control is refreshed
.refresh &&mandatory because a grid column cannot refresh automatically.
endwith
ENDPROC
PROCEDURE command3.Click
thisform.command4.click
rand(-1)
with thisform.grid1
if thisform.optionGroup1.value=1
.setall("dynamicforecolor","iif(mod(recno(),2)=0 ,rgb(255*rand(),255*rand(),255*rand()) ,rgb(255,255,255))","column")
else
.setall("dynamicBackcolor","iif(mod(recno(),2)=0 ,rgb(255*rand(),255*rand(),255*rand()) ,rgb(255,255,255))","column")
endi
.refresh
endwith
ENDPROC
PROCEDURE command4.Click
with thisform.grid1
for i=1 to .columnCount
.columns(i).dynamicForecolor="rgb(0,0,0)"
.columns(i).dynamicBackcolor="rgb(255,255,255)"
.refresh
endfor
endwith
ENDPROC
ENDDEFINE
*
*-- EndDefine: form1
/image%2F1435407%2F20150213%2Fob_a058e9_demo3.jpg)
VFP grid Cosmetics Part I - Visual Foxpro codes
The vfp grid have many PEM to beautify it and make it some ttractive. This code test many methods to do that purpose . this native grid utility can do the follows : -Generates random dynamic lighten
/image%2F1435407%2F20150211%2Fob_20dfbe_demo3.jpg)
Windows listview on vfp forms - Visual Foxpro codes
The listview is the main control used on windows applications as explorer for ex. its not used too on visual foxpro, because the vfp grid is a main component of data visualisation. the grid is more
http://yousfi.over-blog.com/2015/02/windows-listview-on-vfp-forms.html