Scrolling containers with pure and simple vfp solutions
scroll container dont implemented at all in vfp litterature.
in my knowledge vfp IDE have not a scrollbar class!
i presented in previous post 3 some big methods to scroll any vfp container embedding objects.
the codes below implement 2 simple solutions to do that job.
Infortunatly vfp controls (as container) have not handle and that why cannot use APIs to scrollH/V or mouseWheel.
but vfp have always many solutions to any problem.
*the code *7* is suffisent for me to scroll any container (only with mouseWheel event) (if mouse built with wheel !).
[post 245]
Click on code to select [then copy] -click outside to deselect
*1* created on 24 of november 2017
*this code can scroll any vfp container with a simple (spinner+textbox) vertically or/and horizontally
*can fill the container with objects as wanted
*2 classes yscrollV and yscrollH make the job with increment typed in textbox class (can be small or big)
*adjust the spinnerhightvalue function of scroll aera.
*it's a bit of a craft solution.
*cannot use APIs to scroll a vfp container because vfp objects have not handles (only form have it).
Publi yform
yform=Newobject("yscrolls")
yform.Show
Read Events
Retu
*
Define Class yscrolls As Form
Top = 0
Left = 0
Height = 495
Width = 678
ShowWindow = 2
ShowTips = .T.
Caption = "Form1"
Name = "form1"
Add Object container1 As ycnt With ;
Top = 24, ;
Left = 36, ;
Width = 589, ;
Height = 409, ;
BorderWidth = 2, ;
BackColor = Rgb(213,255,255), ;
Name = "Container1"
Add Object yscrollV As yscrollV With ;
name="yscrollV"
Add Object yscrollH As yscrollH With ;
name="yscrollH"
Add Object check1 As Checkbox With ;
autosize=.T. ,;
style=1,;
caption="MouseWheel ScrollV",;
backcolor=Rgb(0,255,0),;
fontbold=.T.,;
value=1,;
visible=.T.,;
name="check1"
Procedure Destroy
Clea Events
Endproc
Procedure Init
With This.check1
.Left=(Thisform.container1.Width-.Width)/2
.Top=Thisform.container1.Top+Thisform.container1.Height+20
Endwith
Procedure check1.InteractiveChange
This.Caption=Iif(This.Value=1,"MouseWheel ScrollV","MouseWheel ScrollH")
Endproc
Enddefine
*
*-- EndDefine: yscrolls
Define Class ycnt As Container
Top = 24
Left = 36
Width = 589
Height = 409
BorderWidth = 2
BackColor = Rgb(213,255,255)
Name = "Container1"
Add Object image1 As Image With ;
Picture = home(1)+"SAMPLES\TASTRADE\BITMAPS\TTRADESM.BMP", ;
Height = 900, ;
Left = 7, ;
Top = 6, ;
Width = 900*9/16, ;
backstyle=0,;
stretch=2,;
Name = "Image1"
Add Object edit1 As EditBox With ;
Height = 289, ;
Left = 611, ;
Top = 12, ;
Width = 373, ;
Name = "Edit1"
Add Object grid1 As Grid With ;
Height = 193, ;
Left = 72, ;
Top = 419, ;
Width = 445, ;
Name = "Grid1"
Procedure edit1.Init
With This
TEXT to .value 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.
Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non
pellentesque metus scelerisque ac. Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat
lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut
sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie
sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit
velit vel ex aliquam, eget convallis ante mollis.
ENDTEXT
.Top=10
.Left=.Parent.image1.Left+.Parent.image1.Width+20
.BackStyle=0
.BorderStyle=0
.ForeColor=Rgb(128,0,64)
.ScrollBars=0
.FontBold=.T.
Endwith
Endproc
Procedure grid1.Init
Sele * From Home(1)+"samples\data\customer" Into Cursor ygridCurs
With This
.RecordSource=""
.RecordSource="ygridCurs"
.RecordSourceType=1
.GridLines=0
.DeleteMark=.F.
.Height=400
.Left=90
.Top=.Parent.image1.Top+.Parent.image1.Height+40
.FontBold=.T.
.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(190,235,200))", "Column")
Locate
.Refresh
Endwith
Endproc
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
DoDefault()
Do Case
Case Thisform.check1.Value=1 &&scroll vertical
If nDirection>0
Thisform.yscrollV.yscroller.DownClick
Else
Thisform.yscrollV.yscroller.UpClick
Endi
Case Thisform.check1.Value=0
If nDirection>0
Thisform.yscrollH.yscroller.DownClick
Else
Thisform.yscrollH.yscroller.UpClick
Endi
Endcase
Endproc
Procedure image1.MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel(nDirection)
Endproc
Enddefine
*
*-- EndDefine: ycnt
*yScrollV class
Define Class yscrollV As Container
Top = 24
Left = 629
Width = 40
Height = 156
BackStyle = 1
BorderWidth = 0
BackColor = Rgb(128,128,128)
ToolTipText = "scrollV"
Name = "yscrollerV"
Add Object Spinner1 As Spinner With ;
Height = 24, ;
Increment = 10.00, ;
KeyboardHighValue = 1000, ;
KeyboardLowValue = 0, ;
Left = 9, ;
MousePointer = 15, ;
SpinnerHighValue = 1000.00, ;
SpinnerLowValue = 0.00, ;
Top = 4, ;
Width = 20, ;
Name = "Spinner1"
Add Object Text1 As TextBox With ;
FontBold = .T., ;
FontSize = 8, ;
Alignment = 3, ;
Value = 50, ;
Height = 24, ;
Left = 4, ;
ToolTipText = "Increment", ;
Top = 29, ;
Width = 32, ;
VALUE=50,;
Name = "Text1"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 8, ;
WordWrap = .T., ;
BackStyle = 0, ;
Caption = ("S"+Chr(13)+"c"+Chr(13)+"r"+Chr(13)+"o"+Chr(13)+"l"+Chr(13)+"l"+Chr(13)+"V"), ;
Height = 100, ;
Left = 15, ;
Top = 54, ;
Width = 10, ;
ForeColor = Rgb(255,255,0), ;
Name = "Label1"
Procedure Init
With This
.Top=Thisform.container1.Top
.Left=Thisform.container1.Left+Thisform.container1.Width+2
Endwith
Endproc
Procedure Spinner1.UpClick
This.Increment=This.Parent.Text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Top=obj.Top-This.Increment
Next
Endwith
Endproc
Procedure Spinner1.DownClick
This.Increment=This.Parent.Text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Top=obj.Top+This.Increment
Next
Endwith
Endproc
Procedure Spinner1.Init
With This
.Increment = 50.00
.KeyboardHighValue = 2000
.KeyboardLowValue = 0
.SpinnerHighValue = 2000.00
.SpinnerLowValue = 0.00
.MousePointer=15
.Name = "yscroller"
.Value=0
Endwith
Endproc
Enddefine
*
*-- EndDefine: yScrollV
*yScrollH class
*
Define Class yscrollH As Container
Top = 440
Left = 472
Width = 156
Height = 30
BackStyle = 1
BorderWidth = 0
BackColor = Rgb(128,128,128)
ToolTipText = "scrollH"
Name = "yscrollerH"
Add Object Spinner1 As Spinner With ;
Height = 24, ;
Increment = 10.00, ;
KeyboardHighValue = 1000, ;
KeyboardLowValue = 0, ;
Left = 2, ;
MousePointer = 15, ;
SpinnerHighValue = 1000.00, ;
SpinnerLowValue = 0.00, ;
Top = 3, ;
Width = 20, ;
Name = "Spinner1"
Add Object Text1 As TextBox With ;
FontBold = .T., ;
FontSize = 8, ;
Alignment = 3, ;
Value = 20, ;
Height = 24, ;
Left = 23, ;
ToolTipText = "Increment", ;
Top = 3, ;
Width = 37, ;
VALUE=50,;
Name = "Text1"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 8, ;
BackStyle = 0, ;
Caption = "Scroll H", ;
Height = 16, ;
Left = 61, ;
Top = 6, ;
Width = 43, ;
ForeColor = Rgb(255,255,0), ;
Name = "Label1"
Procedure Init
With This
.Top=Thisform.container1.Top+Thisform.container1.Height+2
.Left=Thisform.container1.Width-.Width
Endwith
Endproc
Procedure Spinner1.UpClick
This.Increment=This.Parent.Text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Left=obj.Left-This.Increment
Next
Endwith
Endproc
Procedure Spinner1.DownClick
This.Increment=This.Parent.Text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Left=obj.Left+This.Increment
Next
Endwith
Endproc
Procedure Spinner1.Init
With This
.Increment = 50.00
.KeyboardHighValue = 2000
.KeyboardLowValue = 0
.SpinnerHighValue = 2000.00
.SpinnerLowValue = 0.00
.MousePointer=15
.Name = "yscroller"
.Value=0
Endwith
Endproc
Enddefine
Click on code to select [then copy] -click outside to deselect
*2* created on 24 of november 2017
*this is a simple scrollable form with showWindow=1(in the master form).master form can be as ShowWindow=0 (screen form) or 2 (top level)
*the good add is that scrollable container can be resized with the mouse (see the gripper at bottom right, and from window sides).
*note that form.scrollbars (0,1,2,3) is Read/write at design time; read-only at run time.that why this code needs a form class scroller (bottom class).
*modal forms are not concerned here.
*the scroll form embeds an editbox,a container and an image as demo.
Publi oform
oform=Newobject("ymain")
oform.Show
Read Events
Retu
*
Define Class ymain As Form
Top = 10
Left = 83
Height = 520
Width = 750
ShowWindow =2 &&0
autocenter=.t.
ScrollBars = 3 &&both H and V scrolls
Caption = "Form embedding a form as scrollable container"
Name = "form1"
add object command1 as commandbutton with ;
left=620,;
top=20,;
caption="this is my button",;
autosize=.t.,;
backcolor=rgb(128,0,64),;
name="command1"
add object text1 as textbox with ;
left=620,;
top=60,;
value="this is test texbox",;
width=120,;
name="text1"
Procedure Destroy
Clea Events
Endproc
Procedure Init
Publi o
o=Newobject("ychild")
With o
.TitleBar=0
.ScrollBars=3
.Width=500
.Height=450
.Name="child"
.AddObject("edit1","editbox")
.AddObject("container1","container")
.AddObject ("image1","image")
With .edit1
.Height=500
.Width=200
.Value=Repli("***",400)
.Visible=.T.
Endwith
With .container1
.Left=.Parent.edit1.Left+.Parent.edit1.Width+2
.Width=200
.Height=200
.BackColor=Rgb(0,255,0)
.SpecialEffect=2
.borderwidth=3
.Visible=.T.
Endwith
With .image1
.Stretch=2
.Width=400
.Height=.Width*9/16
.backstyle=0
.Left=.Parent.container1.Left+.Parent.container1.Width+10
.Top=10
.Picture=Home(1)+"SAMPLES\TASTRADE\BITMAPS\TTRADESM.BMP"
.Visible=.T.
Endwith
Endwith
Activate Window Child In Window (Thisform.Name)
Endproc
Enddefine
*
*-- EndDefine: ymain
Define Class ychild As Form
TitleBar=0
Width=500
Height=300
ShowWindow=1
ScrollBars=3
Name="child"
Enddefine
Click on code to select [then copy] -click outside to deselect
*3* created on saturday 25 of november 2017
*a scrollable container as custom listbox
*see help in form yhelp button
Close Data All
Local m.myvar
TEXT to m.myvar textmerge noshow
zazezezez ezezezeze http://www.yousfi.over-blog.com zezeze yhyuyuiuiuoioiopppopopouiuio uii
vbxhdduu http://www.lebuteur.com/
ENDTEXT
if len(m.myvar)>128 &&limit the text to 128 chars
m.myvar=substr(m.myvar,1,128)
endi
Create Cursor ycurs(xtext m)
For i=1 To 20
Insert Into ycurs Values (Trans(i)+" ."+Chr(13)+m.myvar)
Endfor
*brow
with _Screen
.AddProperty("opt",_vfp.EditorOptions) &&save initial editorOptions to restore it late
endwith
_vfp.EditorOptions="k" &&Enable Hyperlinks (Click to follow the link) [K:Enable Hyperlinks (Click to follow the link)]
Publi yform
yform=Newobject("ylistbox")
yform.Show
Read Events
Retu
Define Class ylistbox As Form
showWindow=2
Top = 0
Left = 0
Height = 500
Width = 550
AutoCenter=.T.
Caption = "can use mouseWheel to scrollV"
ShowTips=.T.
MaxButton=.F.
BorderStyle=0
Name = "form1"
ncount=1
Add Object container1 As Container With ;
Left = 12, ;
Width = 349, ;
Height = 469, ;
borderwidth=2,;
bordercolor=Rgb(0,0,255),;
Name = "Container1"
Add Object yscroller As yscroller With;
toscroll="thisform.container1",;
name="yscroller"
Add Object check1 As Checkbox With;
autosize=.T.,;
caption="Visibility",;
value=1,;
name="check1"
Add Object yhelp As Label With;
autosize=.T.,;
mousepointer=15,;
backstyle=0,;
caption="?",;
fontsize=18,;
fontbold=.T.,;
forecolor=255,;
tooltiptext="Summary help",;
name="yhelp"
Add Object check2 As Checkbox With;
autosize=.T.,;
caption="EnableHyperlinks",;
value=0,;
name="check2"
Add Object check3 As Checkbox With;
autosize=.T.,;
caption="borders",;
value=0,;
name="check3"
Procedure container1.MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
* mousewheel scroll vertical here
If nDirection>0
Thisform.yscroller.spinner1.DownClick
Else
Thisform.yscroller.spinner1.UpClick
Endi
Endproc
Procedure Init
DoDefault()
Sele ycurs
Thisform.ncount=Reccount()
With Thisform.container1
For i=1 To Thisform.ncount
.AddObject ("yitem"+Trans(i),"yitem")
With Eval(".yitem"+Trans(i))
.Top=(i-1)*.Height+1
.Left=2
.Width=.Parent.Width -4
.Name="yitem"+Trans(i)
Sele ycurs
Go i
.Value=xtext
.Visible=.T.
Endwith
Endfor
.Refresh
Endwith
With This.yscroller
.Left=.Parent.container1.Left+.Parent.container1.Width+5
.Top=10
.Parent.check1.Top=15
.Parent.check1.Left=.Parent.yscroller.Left+.Parent.yscroller.Width+10
.Parent.yhelp.Left=.Parent.check1.Left+.Parent.check1.Width-30
.Parent.yhelp.Top=.Parent.check1.Top-10
.Parent.check2.Left=.Left
.Parent.check2.Top=.Top+.Height+10
.Parent.check3.Left=.Left
.Parent.check3.Top=.Top+3*.Height
Endwith
Endproc
Procedure check1.InteractiveChange()
Thisform.yscroller.Visible=!Thisform.yscroller.Visible
Endproc
Procedure check2.InteractiveChange()
With Thisform.container1
DoDefault()
For i=1 To .ControlCount
If Lower(.Controls(i).Class)=="edit1"
.Controls(i).EnableHyperlinks=!.Controls(i).EnableHyperlinks
.Refresh
Endi
Endfor
Endwith
Endproc
Procedure check3.InteractiveChange()
With Thisform.container1
DoDefault()
For i=1 To .ControlCount
If Lower(.Controls(i).Class)=="edit1"
.Controls(i).BorderStyle=Iif(.Controls(i).BorderStyle=0,1,0)
.Refresh
Endi
Endfor
Endwith
Endproc
Procedure yhelp.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
this is a demo for a scrollable container with containers editbox items.
can set the scrollV increment in textbox, or mouseUp,mouseDown the spinner to scroll V.
can make visible or invisible the yscroller container (a spînner+incremental textbox).
can enabled/disable the hyperlinks (a click open the relative web page directly in default navigator).
As within the editor, the activation of a hyperlink depends on the _VFP.EditorOptions setting (whether click or CTRL+Click goes to the link).
can enable/disable borders)
set 'toscroll' yscroller property class to the container to scroll.
can MouseWheel to scroll vertically the container elements.At least if hide yscroller ,mousewheel can scrolls the container .
note: property enablehyperlnks makes all color disappear ? (bug)
ENDTEXT
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(m.myvar,0, 'Summary help ', 0+32+4096) &&4,16,48,64...
oshell=Null
Endproc
Procedure Destroy
_vfp.EditorOptions=_Screen.opt
Clea Events
Endproc
Enddefine
*Enddefine ylistbox
Define Class yitem As EditBox
BackStyle = 0
BorderStyle =0 &&1
Margin=10
Height = 110
Left = 7
MousePointer = 15
ReadOnly = .T.
FontSize=11
ScrollBars = 0
Top = 1
Width = 337
SpecialEffect=2
EnableHyperlinks = .F.
ForeColor=255
DisabledForeColor=255
Name = "Edit1"
Procedure Init
This.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
This.DisabledForeColor=This.ForeColor
Endproc
Procedure MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
Set Curs Off
With This
.BackStyle=1
.DisabledBackColor=Rgb(175,175,175)
Endwith
Endproc
Procedure MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.BackStyle=0
.DisabledBackColor=Rgb(240,240,240)
Endwith
Set Curs On
Endproc
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel(nDirection)
Endproc
Enddefine
*-- EndDefine:yitem
Define Class yscroller As Container
Top = 84
Left = 390
Width = 68
Height = 27
BorderWidth = 0
Name = "yscroller"
toscroll=""
Add Object spinner1 As Spinner With ;
Height = 24, ;
Increment = 10.00, ;
KeyboardHighValue = 2000, ;
KeyboardLowValue = 0, ;
Left = 5, ;
SpinnerHighValue = 2000.00, ;
SpinnerLowValue = 0.00, ;
Top = 2, ;
Width = 20, ;
Name = "Spinner1"
Add Object text1 As TextBox With ;
Height = 25, ;
Left = 29, ;
Top = 1, ;
Width = 37, ;
value=20,;
fontbold=.T.,;
Name = "Text1"
Procedure Init
If !Vartype(Eval(This.toscroll))="O"
Messagebox("toscroll container must exist",16+4096,"error")
Return .F.
Endi
With This.text1
.Parent.spinner1.Increment=.Value
Endwith
Endproc
Procedure spinner1.DownClick
This.Increment=This.Parent.text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Top=obj.Top-This.Increment
Next
Endwith
Endproc
Procedure spinner1.UpClick
This.Increment=This.Parent.text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Top=obj.Top+This.Increment
Next
Endwith
Endproc
Enddefine
*
*-- EndDefine: ycom
can put textbox or labels instead editbox ...with hyperlinks..
Click on code to select [then copy] -click outside to deselect
*4* created on sunday 26 of november 2017
*same as above code but with images decoration.
*a scrollable container as custom listbox with images and editbox
*see help in form yhelp button
Close Data All
Local m.myvar
TEXT to m.myvar textmerge noshow
zazezezez ezezezeze http://www.yousfi.over-blog.com zezeze yhyuyuiuiuoioiopppopopouiuio uii
vbxhdduu http://www.lebuteur.com/
ENDTEXT
If Len(m.myvar)>128 &&limit the text to 128 chars
m.myvar=Substr(m.myvar,1,128)
Endi
Local gnbre
gnbre=Adir(gabase,Home(1)+"GRAPHICS\ICONS\MISC\*.ico")
Create Cursor ycurs(xtext m,ximg c(150))
For i=1 To 20
Insert Into ycurs Values (Trans(i)+" ."+Chr(13)+m.myvar,Home(1)+"GRAPHICS\ICONS\MISC\"+Allt(gabase(i,1)))
Endfor
*brow
With _Screen
.AddProperty("opt",_vfp.EditorOptions) &&save initial editorOptions to restore it late
Endwith
_vfp.EditorOptions="k" &&Enable Hyperlinks (Click to follow the link) [K:Enable Hyperlinks (Click to follow the link)]
Publi yform
yform=Newobject("ylistbox")
yform.Show
Read Events
Retu
Define Class ylistbox As Form
ShowWindow=2
Top = 0
Left = 0
Height = 500
Width = 550
ShowWindow=2
AutoCenter=.T.
Caption = "can use mouseWheel to scrollV"
ShowTips=.F.
MaxButton=.F.
BorderStyle=0
Name = "form1"
ncount=1
Add Object container1 As Container With ;
Left = 12, ;
Width = 349, ;
Height = 469, ;
borderwidth=2,;
bordercolor=Rgb(0,0,255),;
Name = "Container1"
Add Object yscroller As yscroller With;
toscroll="thisform.container1",;
name="yscroller"
Add Object check1 As Checkbox With;
autosize=.T.,;
caption="Visibility",;
value=1,;
name="check1"
Add Object yhelp As Label With;
autosize=.T.,;
mousepointer=15,;
backstyle=0,;
caption="?",;
fontsize=18,;
fontbold=.T.,;
forecolor=255,;
tooltiptext="Summary help",;
name="yhelp"
Add Object check2 As Checkbox With;
autosize=.T.,;
caption="EnableHyperlinks",;
value=0,;
name="check2"
Add Object check3 As Checkbox With;
autosize=.T.,;
caption="borders",;
value=0,;
name="check3"
Procedure container1.MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
* mousewheel scroll vertical here
If nDirection>0
Thisform.yscroller.spinner1.DownClick
Else
Thisform.yscroller.spinner1.UpClick
Endi
Endproc
Procedure Init
DoDefault()
Sele ycurs
Thisform.ncount=Reccount()
With Thisform.container1
For i=1 To Thisform.ncount
Sele ycurs
Go i
.AddObject ("yitem"+Trans(i),"yitem")
With Eval(".yitem"+Trans(i))
.Top=(i-1)*.Height+1
.Left=2+64+4
.Width=.Parent.Width -4-64-10
.Name="yitem"+Trans(i)
.Value=xtext
.Visible=.T.
Endwith
.AddObject ("yimg"+Trans(i),"yimg")
With Eval(".yimg"+Trans(i))
.Left=4
.Width=64
.Height=64
.Top=(i-1)*Eval(".parent.yitem"+Trans(i)+".height")+1+20
.Stretch=2
.Picture=Nvl(ximg,"")
.Name="yimg"+Trans(i)
.Visible=.T.
Endwith
Endfor
.Refresh
Endwith
With This.yscroller
.Left=.Parent.container1.Left+.Parent.container1.Width+5
.Top=10
.Parent.check1.Top=15
.Parent.check1.Left=.Parent.yscroller.Left+.Parent.yscroller.Width+10
.Parent.yhelp.Left=.Parent.check1.Left+.Parent.check1.Width-30
.Parent.yhelp.Top=.Parent.check1.Top-10
.Parent.check2.Left=.Left
.Parent.check2.Top=.Top+.Height+10
.Parent.check3.Left=.Left
.Parent.check3.Top=.Top+3*.Height
Endwith
Endproc
Procedure check1.InteractiveChange()
Thisform.yscroller.Visible=!Thisform.yscroller.Visible
Endproc
Procedure check2.InteractiveChange()
With Thisform.container1
DoDefault()
For i=1 To .ControlCount
If Lower(.Controls(i).Class)=="edit1"
.Controls(i).EnableHyperlinks=!.Controls(i).EnableHyperlinks
.Refresh
Endi
Endfor
Endwith
Endproc
Procedure check3.InteractiveChange()
With Thisform.container1
DoDefault()
For i=1 To .ControlCount
If Lower(.Controls(i).Class)=="edit1"
.Controls(i).BorderStyle=Iif(.Controls(i).BorderStyle=0,1,0)
.Refresh
Endi
Endfor
Endwith
Endproc
Procedure yhelp.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
this is a demo for a scrollable container with containers editbox items.
can set the scrollV increment in textbox, or mouseUp,mouseDown the spinner to scroll V.
can make visible or invisible the yscroller container (a spînner+incremental textbox).
can enabled/disable the hyperlinks (a click open the relative web page directly in default navigator).
As within the editor, the activation of a hyperlink depends on the _VFP.EditorOptions setting (whether click or CTRL+Click goes to the link).
can enable/disable borders)
set 'toscroll' yscroller property class to the container to scroll.
can MouseWheel to scroll vertically the container elements.At least if hide yscroller ,mousewheel can scrolls the container .
note: property enablehyperlnks makes all color disappear ? (bug)
i decorated with rand forecolor,can set any user forecolors.
ENDTEXT
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(m.myvar,0, 'Summary help ', 0+32+4096) &&4,16,48,64...
oshell=Null
Endproc
Procedure Destroy
_vfp.EditorOptions=_Screen.opt
Clea Events
Endproc
Enddefine
*Enddefine ylistbox
Define Class yitem As EditBox
BackStyle = 0
BorderStyle =0 &&1
Margin=10
Height = 110
Left = 7
MousePointer = 15
ReadOnly = .T.
FontSize=10
ScrollBars = 0
Top = 1
Width = 337
SpecialEffect=2
EnableHyperlinks = .F.
ForeColor=255
DisabledForeColor=255
Name = "Edit1"
Procedure Init
This.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
This.DisabledForeColor=This.ForeColor
Endproc
Procedure MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
Set Curs Off
With This
.BackStyle=1
.DisabledBackColor=Rgb(175,175,175)
Endwith
Endproc
Procedure MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.BackStyle=0
.DisabledBackColor=Rgb(240,240,240)
Endwith
Set Curs On
Endproc
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel(nDirection)
Endproc
Enddefine
*-- EndDefine:yitem
Define Class yimg As Image
Left=2
Width=64
Height=64
Stretch=2
Picture=""
MousePointer=15
BackStyle=0
Name="yimg"
Procedure MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.Left=.Left-2
.Top=.Top-2
.BorderStyle=1
Local m.x
x=Eval(".parent.yitem"+Substr(.Name,5) )
x.MouseEnter(1)
Endwith
Endproc
Procedure MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.Left=.Left+2
.Top=.Top+2
.BorderStyle=0
Local m.x
x=Eval(".parent.yitem"+Substr(.Name,5) )
x.MouseLeave(1)
Endwith
Endproc
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel(nDirection)
Endproc
Enddefine
Define Class yscroller As Container
Top = 84
Left = 390
Width = 68
Height = 27
BorderWidth = 0
Name = "yscroller"
toscroll=""
Add Object spinner1 As Spinner With ;
Height = 24, ;
Increment = 10.00, ;
KeyboardHighValue = 2000, ;
KeyboardLowValue = 0, ;
Left = 5, ;
SpinnerHighValue = 2000.00, ;
SpinnerLowValue = 0.00, ;
Top = 2, ;
Width = 20, ;
Name = "Spinner1"
Add Object text1 As TextBox With ;
Height = 25, ;
Left = 29, ;
Top = 1, ;
Width = 37, ;
value=20,;
fontbold=.T.,;
Name = "Text1"
Procedure Init
If !Vartype(Eval(This.toscroll))="O"
Messagebox("toscroll container must exist",16+4096,"error")
Return .F.
Endi
With This.text1
.Parent.spinner1.Increment=.Value
Endwith
Endproc
Procedure spinner1.DownClick
This.Increment=This.Parent.text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Top=obj.Top-This.Increment
Next
Endwith
Endproc
Procedure spinner1.UpClick
This.Increment=This.Parent.text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Top=obj.Top+This.Increment
Next
Endwith
Endproc
Enddefine
*
*-- EndDefine: ycom
Click on code to select [then copy] -click outside to deselect
*5* created on saturday 25 of november 2017
*custom listbox with container/textbox with enabledHyperlinks property on/off
*see help in form yhelp button
Close Data All
Local m.myvar
TEXT to m.myvar noshow
https://www.foxite.com/forum/
https://www.levelextreme.com/Default.aspx?LevelExtremeRedirect=1
http://www.elkhabar.com/
http://www.huffpostmaghreb.com/algerie/
http://www.lebuteur.com/
http://www.atoutfox.org/
http://weblogs.foxite.com/vfpimaging/author/vfpimaging/
http://www.news2news.com/vfp/index.php
http://www.sweetpotatosoftware.com/spsblog/
https://west-wind.com/wconnect/weblog/ShowEntry.blog?id=669
http://stackoverflow.com/questions/tagged/foxpro
http://www.foxpert.com/knowlbits.htm
https://vfpx.github.io/
http://www.berezniker.com/blogs/sergey
http://doughennig.blogspot.com/
http://sandstorm36.blogspot.com/
http://www.tomorrowssolutionsllc.com/
https://blogs.msdn.microsoft.com/calvin_hsia/tag/visual-foxpro/
http://fox.wikis.com/
http://doughennig.com/papers/
https://translate.google.dz/?hl=fr&tab=wT#fr/en/
http://www.lequipe.fr/
http://www.sport.fr/
http://praisachion.blogspot.ro/2015/02/api-messagebox.html
http://www.jasinskionline.com/windowsapi/ref/funca.html
http://www.west-wind.com/articles.aspx
http://www.arg.kirov.ru/
ENDTEXT
set memowidth to 8192
Create Cursor ycurs(xtext c(50))
For i=1 To memlines(m.myvar)
Insert Into ycurs Values (Trans(i)+" . "+mline(m.myvar,i))
Endfor
*brow
with _Screen
.AddProperty("hyp",.F.)
.AddProperty("opt",_vfp.EditorOptions) &&save initial editorOptions to restore it late
*messagebox(.opt)
endwith
_vfp.EditorOptions="k" &&Enable Hyperlinks (Click to follow the link) [K:Enable Hyperlinks (Click to follow the link)]
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
Define Class asup As Form
Top = 0
Left = 0
Height = 500
Width = 550
showWindow=2
AutoCenter=.T.
Caption = "can use mouseWheel to scrollV"
ShowTips=.f.
MaxButton=.F.
BorderStyle=0
Name = "form1"
ncount=1
Add Object container1 As Container With ;
Left = 12, ;
Width = 349, ;
Height = 469, ;
borderwidth=2,;
bordercolor=Rgb(0,0,255),;
Name = "Container1"
Add Object yscroller As yscroller With;
toscroll="thisform.container1",;
name="yscroller"
Add Object check1 As Checkbox With;
autosize=.T.,;
caption="Visibility",;
value=1,;
name="check1"
Add Object yhelp As Label With;
autosize=.T.,;
mousepointer=15,;
backstyle=0,;
caption="?",;
fontsize=18,;
fontbold=.T.,;
forecolor=255,;
tooltiptext="Summary help",;
name="yhelp"
Add Object check2 As Checkbox With;
autosize=.T.,;
caption="EnableHyperlinks",;
value=0,;
name="check2"
Add Object check3 As Checkbox With;
autosize=.T.,;
caption="borders",;
value=0,;
name="check3"
Procedure container1.MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
* mousewheel scroll vertical here
If nDirection>0
Thisform.yscroller.spinner1.DownClick
Else
Thisform.yscroller.spinner1.UpClick
Endi
Endproc
Procedure Init
DoDefault()
Sele ycurs
Thisform.ncount=Reccount()
With Thisform.container1
For i=1 To Thisform.ncount
.AddObject ("yitem"+Trans(i),"yitem")
With Eval(".yitem"+Trans(i))
.Top=(i-1)*.Height+1
.Left=2
.Width=.Parent.Width -4
.Name="yitem"+Trans(i)
Sele ycurs
Go i
.Value=xtext
.Visible=.T.
Endwith
Endfor
.Refresh
Endwith
With This.yscroller
.Left=.Parent.container1.Left+.Parent.container1.Width+5
.Top=10
.Parent.check1.Top=15
.Parent.check1.Left=.Parent.yscroller.Left+.Parent.yscroller.Width+10
.Parent.yhelp.Left=.Parent.check1.Left+.Parent.check1.Width-30
.Parent.yhelp.Top=.Parent.check1.Top-10
.Parent.check2.Left=.Left
.Parent.check2.Top=.Top+.Height+10
.Parent.check3.Left=.Left
.Parent.check3.Top=.Top+3*.Height
Endwith
Endproc
Procedure check1.InteractiveChange()
Thisform.yscroller.Visible=!Thisform.yscroller.Visible
Endproc
Procedure check2.InteractiveChange()
With Thisform.container1
DoDefault()
For i=1 To .ControlCount
If Lower(.Controls(i).Class)=="text1"
.Controls(i).EnableHyperlinks=!.Controls(i).EnableHyperlinks
.Refresh
Endi
Endfor
Endwith
Endproc
Procedure check3.InteractiveChange()
With Thisform.container1
DoDefault()
For i=1 To .ControlCount
If Lower(.Controls(i).Class)=="text1"
.Controls(i).BorderStyle=Iif(.Controls(i).BorderStyle=0,1,0)
.Refresh
Endi
Endfor
Endwith
Endproc
Procedure yhelp.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
this is a demo for a scrollable container with containers textbox items.
can set the scrollV increment in textbox, or mouseUp,mouseDown the spinner to scroll V.
can make visible or invisible the yscroller container (a spînner+incremental textbox).
can enabled/disable the hyperlinks (a click open the relative web page directly in default navigator).
As within the editor, the activation of a hyperlink depends on the _VFP.EditorOptions
setting (whether click or CTRL+Click goes to the link).
can enable/disable borders)
set 'toscroll' yscroller property class to the container to scroll.
can MouseWheel to scroll vertically the container elements.At least if hide yscroller ,mousewheel can scrolls the container .
note: property enablehyperlnks makes all color disappear ? (bug)
ENDTEXT
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(m.myvar,0, 'Summary help ', 0+32+4096) &&4,16,48,64...
oshell=Null
Endproc
Procedure Destroy
_vfp.EditorOptions=_Screen.opt
Clea Events
Endproc
Enddefine
Define Class yitem As Textbox
BackStyle = 0
BorderStyle =0 &&1
Margin=10
Height = 40
Left = 7
MousePointer = 15
ReadOnly = .T.
FontSize=11
Top = 1
Width = 337
SpecialEffect=2
EnableHyperlinks = .F.
ForeColor=255
DisabledForeColor=255
Name = "Text1"
Procedure Init
This.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
This.DisabledForeColor=This.ForeColor
Endproc
Procedure MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
Set Curs Off
With This
.BackStyle=1
.DisabledBackColor=Rgb(175,175,175)
Endwith
Endproc
Procedure MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.BackStyle=0
.DisabledBackColor=Rgb(240,240,240)
Endwith
Set Curs On
Endproc
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel(nDirection)
Endproc
Enddefine
*-- EndDefine:yitem
Define Class yscroller As Container
Top = 84
Left = 390
Width = 68
Height = 27
BorderWidth = 0
Name = "yscroller"
toscroll=""
Add Object spinner1 As Spinner With ;
Height = 24, ;
Increment = 10.00, ;
KeyboardHighValue = 2000, ;
KeyboardLowValue = 0, ;
Left = 5, ;
SpinnerHighValue = 2000.00, ;
SpinnerLowValue = 0.00, ;
Top = 2, ;
Width = 20, ;
Name = "Spinner1"
Add Object text1 As TextBox With ;
Height = 25, ;
Left = 29, ;
Top = 1, ;
Width = 37, ;
value=20,;
fontbold=.T.,;
Name = "Text1"
Procedure Init
If !Vartype(Eval(This.toscroll))="O"
Messagebox("toscroll container must exist",16+4096,"error")
Return .F.
Endi
With This.text1
.Parent.spinner1.Increment=.Value
Endwith
Endproc
Procedure spinner1.DownClick
This.Increment=This.Parent.text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Top=obj.Top-This.Increment
Next
Endwith
Endproc
Procedure spinner1.UpClick
This.Increment=This.Parent.text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Top=obj.Top+This.Increment
Next
Endwith
Endproc
Enddefine
*
*-- EndDefine: ycom
Click on code to select [then copy] -click outside to deselect
*6* created on sunday 26 of november 2017
*same as above but updated with images and a similar status event.
*custom listbox with container/textbox and images (icons) with enabledHyperlinks property on/off
*see help in form yhelp button
Close Data All
Local m.myvar
TEXT to m.myvar noshow
https://www.foxite.com/forum/
https://www.levelextreme.com/Default.aspx?LevelExtremeRedirect=1
http://www.elkhabar.com/
http://www.huffpostmaghreb.com/algerie/
http://www.lebuteur.com/
http://www.atoutfox.org/
http://weblogs.foxite.com/vfpimaging/author/vfpimaging/
http://www.news2news.com/vfp/index.php
http://www.sweetpotatosoftware.com/spsblog/
https://west-wind.com/wconnect/weblog/ShowEntry.blog?id=669
http://stackoverflow.com/questions/tagged/foxpro
http://www.foxpert.com/knowlbits.htm
https://vfpx.github.io/
http://www.berezniker.com/blogs/sergey
http://doughennig.blogspot.com/
http://sandstorm36.blogspot.com/
http://www.tomorrowssolutionsllc.com/
https://blogs.msdn.microsoft.com/calvin_hsia/tag/visual-foxpro/
http://fox.wikis.com/
http://doughennig.com/papers/
https://translate.google.dz/?hl=fr&tab=wT#fr/en/
http://www.lequipe.fr/
http://www.sport.fr/
http://praisachion.blogspot.ro/2015/02/api-messagebox.html
http://www.jasinskionline.com/windowsapi/ref/funca.html
http://www.west-wind.com/articles.aspx
http://www.arg.kirov.ru/
ENDTEXT
Set Memowidth To 8192
Local gnbre
gnbre=Adir(gabase,Home(1)+"GRAPHICS\ICONS\MISC\*.ico")
Create Cursor ycurs(xtext c(60),ximg c(150))
For i=1 To 20
Insert Into ycurs Values (Trans(i)+" . "+Mline(m.myvar,i),Home(1)+"GRAPHICS\ICONS\MISC\"+Allt(gabase(i,1)))
Endfor
*brow
With _Screen
.AddProperty("hyp",.F.)
.AddProperty("opt",_vfp.EditorOptions) &&save initial editorOptions to restore it late
*messagebox(.opt)
Endwith
_vfp.EditorOptions="k" &&Enable Hyperlinks (Click to follow the link) [K:Enable Hyperlinks (Click to follow the link)]
Publi yform
yform=Newobject("asup")
yform.Show
Read Events
Retu
Define Class asup As Form
Top = 0
Left = 0
Height = 500
Width = 550
ShowWindow=2
AutoCenter=.T.
Caption = "can use mouseWheel to scrollV"
ShowTips=.F.
MaxButton=.F.
BorderStyle=0
Name = "form1"
ncount=1
Add Object container1 As Container With ;
Left = 12, ;
Width = 349, ;
Height = 469, ;
borderwidth=2,;
bordercolor=Rgb(0,0,255),;
Name = "Container1"
Add Object ystat As Label With ;
autosize=.T.,;
left=12,;
fontsize=8,;
top=475,;
caption="",;
name="ystat"
Add Object yscroller As yscroller With;
toscroll="thisform.container1",;
name="yscroller"
Add Object check1 As Checkbox With;
autosize=.T.,;
caption="Visibility",;
value=1,;
name="check1"
Add Object yhelp As Label With;
autosize=.T.,;
mousepointer=15,;
backstyle=0,;
caption="?",;
fontsize=18,;
fontbold=.T.,;
forecolor=255,;
tooltiptext="Summary help",;
name="yhelp"
Add Object check2 As Checkbox With;
autosize=.T.,;
caption="EnableHyperlinks",;
value=0,;
name="check2"
Add Object check3 As Checkbox With;
autosize=.T.,;
caption="borders",;
value=0,;
name="check3"
Procedure container1.MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
* mousewheel scroll vertical here
If nDirection>0
Thisform.yscroller.spinner1.DownClick
Else
Thisform.yscroller.spinner1.UpClick
Endi
Endproc
Procedure Init
DoDefault()
Sele ycurs
Thisform.ncount=Reccount()
With Thisform.container1
For i=1 To Thisform.ncount
.AddObject ("yitem"+Trans(i),"yitem")
With Eval(".yitem"+Trans(i))
.Top=(i-1)*.Height+1
.Left=32+2
.Width=.Parent.Width -32-4
.Name="yitem"+Trans(i)
Sele ycurs
Go i
.Value=xtext
.Visible=.T.
Endwith
.AddObject ("yimg"+Trans(i),"yimg")
With Eval(".yimg"+Trans(i))
.Left=4
.Width=20
.Height=20
.Top=(i-1)*Eval(".parent.yitem"+Trans(i)+".height")+1+5
.Stretch=2
.Picture=Nvl(ximg,"")
.Name="yimg"+Trans(i)
.Visible=.T.
Endwith
Endfor
.Refresh
Endwith
With This.yscroller
.Left=.Parent.container1.Left+.Parent.container1.Width+5
.Top=10
.Parent.check1.Top=15
.Parent.check1.Left=.Parent.yscroller.Left+.Parent.yscroller.Width+10
.Parent.yhelp.Left=.Parent.check1.Left+.Parent.check1.Width-30
.Parent.yhelp.Top=.Parent.check1.Top-10
.Parent.check2.Left=.Left
.Parent.check2.Top=.Top+.Height+10
.Parent.check3.Left=.Left
.Parent.check3.Top=.Top+3*.Height
Endwith
Endproc
Procedure check1.InteractiveChange()
Thisform.yscroller.Visible=!Thisform.yscroller.Visible
Endproc
Procedure check2.InteractiveChange()
With Thisform.container1
DoDefault()
For i=1 To .ControlCount
If Lower(.Controls(i).Class)=="text1"
.Controls(i).EnableHyperlinks=!.Controls(i).EnableHyperlinks
.Refresh
Endi
Endfor
Endwith
Endproc
Procedure check3.InteractiveChange()
With Thisform.container1
DoDefault()
For i=1 To .ControlCount
If Lower(.Controls(i).Class)=="text1"
.Controls(i).BorderStyle=Iif(.Controls(i).BorderStyle=0,1,0)
.Refresh
Endi
Endfor
Endwith
Endproc
Procedure yhelp.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
this is a demo for a scrollable container with containers textbox items.
can set the scrollV increment in textbox, or mouseUp,mouseDown the spinner to scroll V.
can make visible or invisible the yscroller container (a spînner+incremental textbox).
can enabled/disable the hyperlinks (a click open the relative web page directly in default navigator).
As within the editor, the activation of a hyperlink depends on the _VFP.EditorOptions
setting (whether click or CTRL+Click goes to the link).
can enable/disable borders)
set 'toscroll' yscroller property class to the container to scroll.
can MouseWheel to scroll vertically the container elements.At least if hide yscroller ,mousewheel can scrolls the container .
note: property enablehyperlnks makes all color disappear ? (bug)
ENDTEXT
Local oshell
oshell = Createobject('WScript.Shell')
oshell.Popup(m.myvar,0, 'Summary help ', 0+32+4096) &&4,16,48,64...
oshell=Null
Endproc
Procedure Destroy
_vfp.EditorOptions=_Screen.opt &&restore settings
Clea Events
Endproc
Enddefine
*
Define Class yitem As TextBox
BackStyle = 0
BorderStyle =0 &&1
Margin=10
Height = 40
Left = 7
MousePointer = 15
ReadOnly = .T.
FontSize=11
Top = 1
Width = 337
SpecialEffect=2
EnableHyperlinks = .F.
ForeColor=255
DisabledForeColor=255
Name = "Text1"
Procedure Init
This.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
This.DisabledForeColor=This.ForeColor
Endproc
Procedure MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
Set Curs Off
With This
.BackStyle=1
.DisabledBackColor=Rgb(175,175,175)
Thisform.ystat.Caption=Substr(.Value,4)
Endwith
Endproc
Procedure MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.BackStyle=0
.DisabledBackColor=Rgb(240,240,240)
Thisform.ystat.Caption=""
Endwith
Set Curs On
Endproc
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel(nDirection)
Endproc
Enddefine
*-- EndDefine:yitem
*
Define Class yimg As Image
Left=2
Width=32
Height=32
Stretch=2
Picture=""
MousePointer=15
BackStyle=0
Name="yimg"
Procedure MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.Left=.Left-2
.Top=.Top-2
.BorderStyle=1
Local m.x
x=Eval(".parent.yitem"+Substr(.Name,5) )
x.MouseEnter(1)
Endwith
Endproc
Procedure MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.Left=.Left+2
.Top=.Top+2
.BorderStyle=0
Local m.x
x=Eval(".parent.yitem"+Substr(.Name,5) )
x.MouseLeave(1)
Endwith
Endproc
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel(nDirection)
Endproc
Enddefine
*
Define Class yscroller As Container
Top = 84
Left = 390
Width = 68
Height = 27
BorderWidth = 0
Name = "yscroller"
toscroll=""
Add Object spinner1 As Spinner With ;
Height = 24, ;
Increment = 10.00, ;
KeyboardHighValue = 2000, ;
KeyboardLowValue = 0, ;
Left = 5, ;
SpinnerHighValue = 2000.00, ;
SpinnerLowValue = 0.00, ;
Top = 2, ;
Width = 20, ;
Name = "Spinner1"
Add Object text1 As TextBox With ;
Height = 25, ;
Left = 29, ;
Top = 1, ;
Width = 37, ;
value=20,;
fontbold=.T.,;
Name = "Text1"
Procedure Init
If !Vartype(Eval(This.toscroll))="O"
Messagebox("toscroll container must exist",16+4096,"error")
Return .F.
Endi
With This.text1
.Parent.spinner1.Increment=.Value
Endwith
Endproc
Procedure spinner1.DownClick
This.Increment=This.Parent.text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Top=obj.Top-This.Increment
Next
Endwith
Endproc
Procedure spinner1.UpClick
This.Increment=This.Parent.text1.Value
With Thisform.container1
For Each obj In .Controls
obj.Top=obj.Top+This.Increment
Next
Endwith
Endproc
Enddefine
*
*-- EndDefine: ycom
Click on code to select [then copy] -click outside to deselect
*7* created on sunday 26 of november 2017
*this code can scroll any vfp container with a simple mousewheel event vertically or horizontally (to switch in checkBox)
*can fill the container with objects as wanted.
*cannot use APIs to scroll a vfp container because vfp objects have not handles (only form have it).
*change the increment of mouseWheel in the ycnt class container on need.
**of course can limit the scrolling area after testing the mousewhell parameters (nXcoord and nYcoord)!add test: if between(nxcoord,..,..) or between(nycoord,..,..)
*nowadays all PC mouses are built with a mousewheel and that is suffisent to scroll any vfp container (no need to build a scrollbar).
Close Data All
Create Cursor ycurs (ximg c(150))
Local gnbre
gnbre=Adir(gabase,Home(1)+"graphics\icons\misc\*.ico")
For i=1 To gnbre
Insert Into ycurs Values(Home(1)+"graphics\icons\misc\"+gabase(i,1))
Endfor
*brow
Publi yform
yform=Newobject("yscrolls")
yform.Show
Read Events
Retu
*
Define Class yscrolls As Form
Top = 0
Left = 0
Height = 540
Width = 450
ShowWindow = 2
ShowTips = .T.
Caption = "scroll V or H only with ths mousewheel"
Name = "form1"
Add Object container1 As ycnt With ;
Top = 24, ;
Left = 36, ;
BorderWidth = 2, ;
BackColor = Rgb(213,255,255), ;
Name = "Container1"
Add Object check1 As Checkbox With ;
autosize=.T. ,;
style=1,;
caption="MouseWheel ScrollV",;
backcolor=Rgb(0,255,0),;
fontbold=.T.,;
value=1,;
visible=.T.,;
name="check1"
Add Object label1 As Label With;
autosize=.T.,;
backstyle=0,;
fontsize=11,;
caption="Click on any icon",;
name="label1"
Add Object yhelp As Label With;
autosize=.T.,;
backstyle=0,;
fontsize=22,;
caption="?",;
mousepointer=15,;
forecolor=255,;
fontbold=.T.,;
name="yhelp"
Procedure yhelp.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
Scroll any vfp container fill with objects vertically or horizontally with the mouseWheel only.
can sweetch V or H with the checkbox (click or key a return it have the focus).
in the objects embed must code the mouseWheel to redirect it to the main container (see in yimg class this procedure).
of course the container mouyseWheel must be coded (see in ycnt container).
change the increment of mouseWheel in the ycnt class container on need.
*of course can limit the scrolling area after testing the mousewhell parameters (nXcoord and nYcoord)!add test: if between(nxcoord,..,..) or between(nycoord,..,..).
here all misc icons of home(1).can code any of them to fire any code (as menu).
ENDTEXT
Messagebox(m.myvar,0+32+4096,"Summary help")
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure Init
With This.check1
.Left=(Thisform.container1.Width-.Width)/2
.Top=Thisform.container1.Top+Thisform.container1.Height+20
.Parent.label1.Left=.Left+.Width +50
.Parent.label1.Top=.Top
.Parent.yhelp.Left=10
.Parent.yhelp.Top=.Top
Endwith
Procedure check1.InteractiveChange
This.Caption=Iif(This.Value=1,"MouseWheel ScrollV","MouseWheel ScrollH")
Endproc
Enddefine
*
*-- EndDefine: yscrolls
Define Class ycnt As Container
Top = 24
Left = 36
Width = 400
Height =450
BorderWidth = 2
BackColor = Rgb(213,255,255)
Name = "Container1"
Increment=30 &&variable property to implement value of scroll V or H.
Procedure Init
Local m.delta
m.delta=20
m.perRow=6
With This
.Top=10
.Left=10
.BackStyle=0
Sele ycurs
Locate
k=1
u=0
Scan
j=Recno()
.AddObject("yimg"+Trans(j),"yimg")
With Eval (".yimg"+Trans(j))
.Picture=ximg
.Width=64
.Height=64
If u>m.perRow-1
u=1
k=k+1
Else
u=u+1
Endi
If u=1
Left=10
Else
.Left=Eval(".parent.yimg"+Trans(j-1)+".left")+Eval(".parent.yimg"+Trans(j-1)+".width")+m.delta
Endi
If k=1
.Top=10
Else
.Top=10+(k-1)*.Height+m.delta
Endi
.Visible=.T.
Endwith
Endscan
Endwith
Endproc
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
DoDefault()
Do Case
Case Thisform.check1.Value=1 &&scroll vertical
If nDirection>0
With This
For Each obj In .Controls
Try &&in case object have not top property (a timer for ex)
obj.Top=obj.Top-This.Increment
catch
endtry
Next
Endwith
Else
With This
For Each obj In .Controls
try
obj.Top=obj.Top+This.Increment
catch
endtry
Next
Endwith
Endi
Case Thisform.check1.Value=0
If nDirection>0
With This
For Each obj In .Controls
try
obj.Left=obj.Left-This.Increment
catch
endtry
Next
Endwith
Else
With This
For Each obj In .Controls
Try &&in case object have not left property (a timer for ex)
obj.Left=obj.Left+This.Increment
catch
endtry
Next
Endwith
Endi
Endcase
Endproc
Enddefine
*
*-- EndDefine: ycnt
Define Class yimg As Image
Stretch=2
Width=96
Height=96
Picture=""
BackStyle=0
MousePointer=15
Name="yimg"
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
This.Parent.MouseWheel(nDirection)
Endproc
Procedure MouseEnter
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.Left=.Left-2
.Top=.Top-2
.BorderStyle=1
Endwith
Endproc
Procedure MouseLeave
Lparameters nButton, nShift, nXCoord, nYCoord
With This
.Left=.Left+2
.Top=.Top+2
.BorderStyle=0
Endwith
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Messagebox(" picture:"+Chr(13)+ +This.Picture+Chr(13)+Chr(13)+" can fire any code from here!",0+32+4096,'',1200)
Endproc
Enddefine
Click on code to select [then copy] -click outside to deselect
*8*
*created on 27 of december 2017
*mouseWeel on comboBox control
*by default the combo shows a scrollbar if its items count are >1
*you can set combo.displaycount to set the visible items on combo (by defaut its 0 corresponding to max 7 items)
*here can mouseWheel on the area of combo (not on items)or optionly on form to dropdown the combo and scroll its items
*can set the increment to scroll (here xincrement=1)
*can scroll the same combo by mouseWheel out on the form if theoptional property ms=.t. (as below)
Public oform
oform=Newobject("ycombo_mouse")
oform.Show
Return
*
Define Class ycombo_mouse As Form
Top = 0
Left = 0
Height = 399
Width = 450
Caption = "MouseWheel a combo area or optionly on form(to set in ms"
Name = "Form1"
ms=.t. &&make it to .f. if dont want mouseWheel the combo from form.
Add Object combo1 As ComboBox With ;
Height = 37, ;
Left = 60, ;
Top = 24, ;
Width = 181, ;
Name = "Combo1"
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
if thisform.ms=.t.
Thisform.combo1.MouseWheel(nDirection) &&can interact with combo from form.mousewheel
endi
Endproc
Procedure combo1.MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
Local m.xincrement
m.xincrement=1
If nDirection<0
This.Value=This.Value+m.xincrement
Keyboard "{f4}" &&drop down the combo
Endi
If nDirection>0
This.Value=This.Value-m.xincrement
Keyboard "{f4}" &&drop down the combo
Endi
Endproc
Procedure combo1.Init
With This
For i=1 To 100
.AddItem(Trans(i)+" blablabla")
Endfor
.ListIndex=1
.Style=2
.Value=1
Endwith
Endproc
Enddefine
*
*-- EndDefine: ycombo_mouse
Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1703 ( creator update) .