A special method to search text in complex editbox control.
Maybe its a trivial question nowadays to search text in any support but this code is very special and clever.
all know that editbox is not a richtext control (its mono fontname,mono fontsize and mono forecolor/backcolor at one time).
that why search any string in editbox must highlight the found strings one by one and skip manually, because cannot make selection for all founds strings in the editbox (see hideSelection property).
this code uses a special trick with 2 editboxes,one with black forecolor and the second behind with red forecolor (can customize).
the 2 editboxes are adjusted exactly to look like one editbox ("juxtaposed") .
there is 2 properties making any vfp editbox transparent(borderstyle=0 and backstyle=0) but transparency is lost at any focus(switch to backstyle=1).
if the first editbox is transparent can see the text behind in the second editbox otherwise we see one text (2 editboxes juxtaposed as said).
if change any word in the first editboxes must adjust the text to the second editboxes to preserve the juxtaposed view.
the 2 editboxes are built in a scrollable container as seen in my previous posts(see http://yousfi.over-blog.com/2015/12/testing-a-vfp-scrollbar-container-class-application.html).[same class container and add 2 editboxes edit1 & edit2]
and the complex montage looks like one searchable editbox.
the result of a search is to highlight(red underlined) all strings found in one gesture ( as a web page does for ex.)
text can be any txt file (even big ones).i used the "miserables" of Victor Hugo to test.
*save the 2 codes 1.1 and 1.2 in one searchEditbox.prg
*note original code from the web :http://forum.foxclub.ru/file.php?29,file=11123
*auteur:Chemberzhy
*adapted and written as prg file and added some things (mousewheel in editbox,..).
the code have 2 main classes(the scrollable container and the searcheditbox).translate a vcx class and form to flat code as prg is not so easy.must write another classes,use bindevent,....
*the occurences retrieved in the code are with Occurs() who is sensitive.
[Post 259]
Click on code to select [then copy] -click outside to deselect
*1* created on friday 02 of february 2018
*part 1.1 to add with part1.2 in same ysearchEditbox.prg
*vfpsbcnt.h (include)
#IFNDEF __VFP_SBCONTAINER_H_INCLUDED
#Define __VFP_SBCONTAINER_H_INCLUDED
#Define SBC_HORS 1
#Define SBC_VERT 2
#Define SB_LINEUP 0
#Define SB_LINELEFT 0
#Define SB_LINEDOWN 1
#Define SB_LINERIGHT 1
#Define SB_PAGEUP 2
#Define SB_PAGELEFT 2
#Define SB_PAGEDOWN 3
#Define SB_PAGERIGHT 3
#Define SB_THUMBPOSITION 4
#Define SB_THUMBTRACK 5
#Define SB_TOP 6
#Define SB_LEFT 6
#Define SB_BOTTOM 7
#Define SB_RIGHT 7
#Define COLOR_SCROLLBAR 0
#Define COLOR_BACKGROUND 1
#Define COLOR_ACTIVECAPTION 2
#Define COLOR_INACTIVECAPTION 3
#Define COLOR_MENU 4
#Define COLOR_WINDOW 5
#Define COLOR_WINDOWFRAME 6
#Define COLOR_MENUTEXT 7
#Define COLOR_WINDOWTEXT 8
#Define COLOR_CAPTIONTEXT 9
#Define COLOR_ACTIVEBORDER 10
#Define COLOR_INACTIVEBORDER 11
#Define COLOR_APPWORKSPACE 12
#Define COLOR_HIGHLIGHT 13
#Define COLOR_HIGHLIGHTTEXT 14
#Define COLOR_BTNFACE 15
#Define COLOR_BTNSHADOW 16
#Define COLOR_GRAYTEXT 17
#Define COLOR_BTNTEXT 18
#Define COLOR_INACTIVECAPTIONTEXT 19
#Define COLOR_BTNHIGHLIGHT 20
*-- #if(WINVER >= 0x0400)
#Define COLOR_3DDKSHADOW 21
#Define COLOR_3DLIGHT 22
#Define COLOR_INFOTEXT 23
#Define COLOR_INFOBK 24
*-- #endif /* WINVER >= 0x0400 */
*-- #if(WINVER >= 0x0500)
#Define COLOR_HOTLIGHT 26
#Define COLOR_GRADIENTACTIVECAPTION 27
#Define COLOR_GRADIENTINACTIVECAPTION 28
*-- #endif /* WINVER >= 0x0500 */
*-- #if(WINVER >= 0x0400)
#Define COLOR_DESKTOP COLOR_BACKGROUND
#Define COLOR_3DFACE COLOR_BTNFACE
#Define COLOR_3DSHADOW COLOR_BTNSHADOW
#Define COLOR_3DHIGHLIGHT COLOR_BTNHIGHLIGHT
#Define COLOR_3DHILIGHT COLOR_BTNHIGHLIGHT
#Define COLOR_BTNHILIGHT COLOR_BTNHIGHLIGHT
*-- #endif /* WINVER >= 0x0400 */
#Endif && __VFP_SBCONTAINER_H_INCLUDED
Public oform1
oform1=Newobject("form1")
oform1.Show
Return
*
Define Class form1 As Form
Height = 480
Width = 800
AutoCenter = .T.
ShowWindow=2
MaxButton=.F.
TabStop =.F.
Caption = "Special search method in editbox"
Name = "Form1"
Add Object command1 As CommandButton With ;
Top = 380+30, ;
Left =64, ;
Height = 27, ;
Width = 132, ;
Anchor = 768, ;
Caption = "get TXT file", ;
TabIndex = 1, ;
Name = "Command1"
Add Object yclear As CommandButton With ;
Top =410, ;
Left = 200, ;
Height = 27, ;
Width = 60, ;
Anchor = 768, ;
Caption = "Clear", ;
Name = "yclear"
Add Object command2 As CommandButton With ;
Top = 441, ;
Left = 64, ;
Height = 27, ;
Width = 132, ;
Anchor = 768, ;
Caption = "Search", ;
TabIndex = 2, ;
Name = "Command2"
Add Object check1 As Checkbox With ;
Top = 410, ;
Left = 448+50, ;
Height = 17, ;
Width = 132, ;
Anchor = 768, ;
Alignment = 0, ;
autosize=.T. , ;
Caption = "Insensitive", ;
Value = 1, ;
Name = "Check1"
Add Object yim As CommandButton With ;
Top =410, ;
Left = 610, ;
Height = 27, ;
Width = 50, ;
Anchor = 768, ;
Caption = "Cover", ;
Name = "yim"
Add Object text1 As TextBox With ;
Anchor = 768, ;
Height = 23, ;
Left = 248, ;
TabIndex = 3, ;
Top = 444, ;
Width = 372, ;
Name = "Text1"
Add Object searcheditbox1 As searcheditbox With ;
Anchor = 15, ;
Top = 12, ;
Left = 40, ;
width=720,;
height=370,;
backstyle=1,;
Name = "Searcheditbox1"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontSize = 8, ;
Caption = "", ;
Height = 16, ;
Left = 265, ;
Top = 409, ;
Width = 2, ;
Name = "Label1"
Procedure Init
Thisform.SetAll("mousepointer",15,"commandbutton")
Endproc
Procedure text1.Valid
Thisform.command2.Click
Endproc
Procedure command1.Click
Local m.lcfile
m.lcfile=Getfile('TXT|MPR|H|PRG','') && based txt files
If Empty(m.lcfile)
Return .F.
Endi
Thisform.label1.Caption=""
Thisform.searcheditbox1.addtext(Filetostr(m.lcfile))
Thisform.text1.SetFocus
Endproc
Procedure yclear.Click
With Thisform.searcheditbox1.viewFrame.clientArea
.edit1.Value=""
.edit2.Value=""
Endwith
Thisform.label1.Caption=""
Endproc
Procedure command2.Click
If Empty(Thisform.text1.Value)
Return .F.
Endi
Thisform.label1.Caption=""
Thisform.searcheditbox1.search(Thisform.text1.Value,Thisform.check1.Value)
Thisform.label1.Caption=Trans(Occurs(Allt(Thisform.text1.Value),Thisform.searcheditbox1.viewFrame.clientArea.edit1.Value))+" occurences found."
Thisform.searcheditbox1.img.Visible=.f.
Endproc
Procedure check1.InteractiveChange
This.Caption=Iif(This.Value=1,"insensitive","sensitive")
Endproc
Procedure yim.Click
With Thisform.searcheditbox1
.img.Visible=Iif(.img.Visible=.T.,.F.,.T.)
If .img.Visible=.T.
.img.ZOrder(0)
Endi
Endwith
Endproc
Enddefine
*-- EndDefine: form1
*
Define Class __cntsbbutton As Container
Width = 16
Height = 16
SpecialEffect = 0
BorderColor = Rgb(128,128,128)
Hidden noffset
noffset = 3
Delay = 0.02
Protected m_nbuttonsize
m_nbuttonsize = 16
Name = "__cntsbbutton"
ldown = .F.
Protected ldragging
Add Object imgdirection As Image With ;
Stretch = 2, ;
BackStyle = 0, ;
Enabled = .F., ;
Height = 9, ;
Left = 3, ;
Top = 3, ;
Width = 9, ;
Name = "imgDirection"
Procedure buttondown
With This
If !.ldown
.ldown = .T.
.SpecialEffect = 2 && 1
.imgdirection.Move( .imgdirection.Left + 1, .imgdirection.Top + 1)
.Move( .Left)
Endif
Endwith
Endproc
Procedure buttonup
With This
If .ldown
.ldown = .F.
.SpecialEffect = 0 && 1
.imgdirection.Move( .imgdirection.Left - 1, .imgdirection.Top - 1)
.Move( .Left)
Endif
Endwith
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
With This
.ldragging = .T.
.buttondown()
.Click
Local lnSec, lnDelay
lnDelay = .Delay && / 3
Do While Mdown()
lnSec = Seconds() + m.lnDelay
.Click
*!* If !This.Parent.Parent.ContinuousScroll
*!* Exit
*!* EndIf
Do While Mdown() And m.lnSec > Seconds()
Enddo
loCurObject = Sys( 1270)
If !Mdown() Or Vartype( m.loCurObject) # "O" Or ( m.loCurObject # .imgdirection And m.loCurObject # This)
If ( Vartype( m.loCurObject) = "O" And m.loCurObject # .imgdirection And loCurObject # This)
.buttonup()
Endif
Exit
Endif
Enddo
*!* DoDefault( nButton, nShift, nXCoord, nYCoord)
Endwith
Endif
Endproc
Procedure MouseUp
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
This.ldragging = .F.
This.buttonup()
Nodefault
Endif
Endproc
Procedure MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
Local lnTop, lnLeft
lnTop = Objtoclient( This, 1)
lnLeft = Objtoclient( This, 2)
With This
If .ldragging And Between( m.nXCoord, m.lnLeft, m.lnLeft + .Width) .And. ;
Between( m.nYCoord, m.lnTop, m.lnTop + .Height)
If !.ldown
.buttondown
Endif
Local lnSec, lnDelay
lnDelay = .Delay && / 3
Do While .T.
.Click
lnSec = Seconds() + m.lnDelay
*!* If !This.Parent.Parent.ContinuousScroll
*!* Exit
*!* EndIf
Do While Mdown() And m.lnSec > Seconds()
Enddo
loCurObject = Sys( 1270)
If !Mdown() Or Vartype( m.loCurObject) # "O" Or ( m.loCurObject # .imgdirection And m.loCurObject # This)
If ( Vartype( m.loCurObject) = "O" And m.loCurObject # .imgdirection And loCurObject # This)
.buttonup()
Endif
Exit
Endif
Enddo
Else
If .ldown
.buttonup
Endif
Endif
Endwith
Endif
Endproc
Procedure Init
This.m_nbuttonsize = Sysmetric( 5)
Declare Integer GetSysColor In Win32API Integer
This.BorderColor = GetSysColor( COLOR_BTNSHADOW)
DoDefault()
Endproc
Procedure Resize
With This
If .Width < .m_nbuttonsize Or .Height < .m_nbuttonsize
Local lnOffsetLeft, lnOffsetTop
*!* lnOffsetTop = 3
*!* lnOffsetLeft = 3
*!* If .Width < .m_nButtonSize
lnOffsetLeft = Max( 1, ( .Width - 9) / 2)
* lnOffsetLeft = 1
*!* EndIf
*!* If .Height < .m_nButtonSize
lnOffsetTop = Max( 1, ( .Height - 9) / 2)
* lnOffsetTop = 1
*!* EndIf
.noffset = 3
.imgdirection.Move( m.lnOffsetLeft, m.lnOffsetTop, ;
Min( 9, Max( 0, .Width - m.lnOffsetLeft * 2 - 1)), ;
Min( 9, Max( 0, .Height - m.lnOffsetTop * 2 - 1)))
Else
.noffset = ( .Width - 9) / 2
.imgdirection.Move( .noffset, .noffset, 9, 9)
Endif
Endwith
Endproc
Enddefine
*-- EndDefine: __cntsbbutton
*
Define Class __vscrollbar As Container
Width = 16
Height = 200
BorderWidth = 0
TabStop = .F.
BackColor = Rgb(226,226,226)
*-- Determines how far the scrolling region of the associated control can move.
Range = 1
*-- Specifies the increment a control scrolls when you click on a scroll arrow. Available at design time and run time.
smallchange = 1
*-- Specifies the position of the thumb tab on the scroll bar.
position = 0
kind = 1
m_noffset = 0
controlarea = .Null.
Protected m_npage
m_npage = 0
Protected m_nmax
m_nmax = 0
m_ncalcrange = 0
Delay = 0.02
m_nthumbarea = 0
m_nbuttonsize = 16
*-- Specifies the margin width created in the text portion of the control.
Margin = 0
thumbsize = 0
Name = "__vscrollbar"
Hidden m_bcalcautorange
m_bthumbmove = .F.
m_bthumbmoving = .F.
Add Object shpsplash As Shape With ;
Height = 0, ;
Width = 0, ;
Visible = .F., ;
BackColor = Rgb(0,0,0), ;
Name = "shpSplash"
Add Object scrollthumb As Container With ;
Width = 0, ;
Height = 0, ;
SpecialEffect = 0, ;
Name = "ScrollThumb"
Add Object cntup As __cntsbbutton With ;
Width = 0, ;
Height = 0, ;
Name = "cntUp", ;
imgdirection.Picture = "scrollup.bmp", ;
imgdirection.Height = 9, ;
imgdirection.Width = 9, ;
imgdirection.Name = "imgDirection"
Add Object cntdown As __cntsbbutton With ;
Width = 0, ;
Height = 0, ;
Name = "cntDown", ;
imgdirection.Picture = "scrolldn.bmp", ;
imgdirection.Height = 9, ;
imgdirection.Width = 9, ;
imgdirection.Name = "imgDirection"
Add Object cmdup As CommandButton With ;
Top = 0, ;
Height = 0, ;
Width = 0, ;
Picture = "scrollup.bmp", ;
Caption = "", ;
Enabled = .F., ;
Visible = .F., ;
Name = "cmdUp"
Add Object cmddown As CommandButton With ;
Height = 0, ;
Width = 0, ;
Picture = "scrolldn.bmp", ;
Caption = "", ;
Enabled = .F., ;
Visible = .F., ;
Name = "cmdDown"
Procedure scrollmessage
Lparameters tnMessage, tnPos
Local lnKind, lnOldPos, lnScrollDir
With This
lnScrollDir = -1
lnKind = .kind
lnOldPos = .position
Do Case
Case m.tnMessage = SB_LINEUP
lnScrollDir = Iif( m.lnKind = 1, 0, 4)
.position = ( .position - .smallchange)
Case m.tnMessage = SB_LINEDOWN
lnScrollDir = Iif( m.lnKind = 1, 1, 5)
.position = ( .position + .smallchange)
Case m.tnMessage = SB_PAGEUP
lnScrollDir = Iif( m.lnKind = 1, 2, 6)
.position = ( .position - Int( .ControlSize() / .smallchange) * .smallchange)
Case m.tnMessage = SB_PAGEDOWN
lnScrollDir = Iif( m.lnKind = 1, 3, 7)
.position = ( .position + Int( .ControlSize() / .smallchange) * .smallchange)
Case m.tnMessage = SB_THUMBPOSITION
*!* _Screen.Print( "SB_THUMBPOSITION: " + Transform( m.tnPos) + ", ")
.position = ( m.tnPos)
*!* .SetPosition( IIF( m.tnPos < .Range, Round( m.tnPos / .SmallChange, 0) * .SmallChange, m.tnPos))
*!* .SetPosition( Int( m.tnPos / .SmallChange) * .SmallChange)
lnScrollDir = Iif( m.lnKind = 1, ;
IIF( m.lnOldPos = 0 Or m.lnOldPos > m.tnPos, 0, 1), ;
IIF( m.lnOldPos = 0 Or m.lnOldPos > m.tnPos, 4, 5))
Case m.tnMessage = SB_THUMBTRACK
*!* _Screen.Print( "SB_THUMBTRACK: " + Transform( m.tnPos) + ", ")
If .Parent.ContinuousScroll
*!* .SetPosition( IIF( m.tnPos < .Range, Round( m.tnPos / .SmallChange, 0) * .SmallChange, m.tnPos))
.position = ( m.tnPos)
*!* .SetPosition( Int( m.tnPos / .SmallChange) * .SmallChange)
lnScrollDir = Iif( m.lnKind = 1, ;
IIF( m.lnOldPos = 0 Or m.lnOldPos > m.tnPos, 0, 1), ;
IIF( m.lnOldPos = 0 Or m.lnOldPos > m.tnPos, 4, 5))
Endif
Endcase
*!* If m.lnOldPos != .Position
This.Parent.Scrolled( m.lnScrollDir)
*!* EndIf
Endwith
Endproc
Procedure Update
With This
Local lnControlSize
lnControlSize = .ControlSize()
.m_ncalcrange = Max( 0, .Range - m.lnControlSize)
.m_npage = m.lnControlSize + 1
.m_nmax = Iif( .m_ncalcrange > 0, .Range, 0)
.SetScrollInfo()
.position = .position
Endwith
Endproc
Procedure calcautorange
With This
If !.m_bcalcautorange And !Isnull( .controlarea)
.m_bcalcautorange = .T.
Local lnNewRange, loControl, lnMargin
lnMargin = Val( "0" + Trans( .Margin))
lnNewRange = 0
For Each loControl In .controlarea.Controls
If loControl.Visible
lnNewRange = Max( m.lnNewRange, ;
IIF( .kind = 1, ;
loControl.Top + loControl.Height, ;
loControl.Left + loControl.Width))
Endif
loControl = .Null.
Endfor
loControl = .Null.
.Range = ( m.lnNewRange + m.lnMargin)
.m_bcalcautorange = .F.
Endif
Endwith
Endproc
Protected Procedure SetScrollInfo
With This
If .m_nmax > 0
.cmdup.Visible = .F.
.cmddown.Visible = .F.
Local lnControlSize, lnThumbArea
lnControlSize = .ControlSize()
If .kind = 1 && Vertical
lnThumbArea = .Height - .m_nbuttonsize * 2
lnThumbSize = Max( 8, ;
Min( m.lnThumbArea, ;
( m.lnThumbArea) * m.lnControlSize / .m_nmax))
.scrollthumb.Height = m.lnThumbSize
.m_nthumbarea = .Height - .scrollthumb.Height - .m_nbuttonsize * 2
Else
lnThumbArea = .Width - .m_nbuttonsize * 2
lnThumbSize = Max( 8, Min( m.lnThumbArea, ( m.lnThumbArea) * m.lnControlSize / .m_nmax))
.scrollthumb.Width = m.lnThumbSize
.m_nthumbarea = .Width - .scrollthumb.Width - .m_nbuttonsize * 2
Endif
If m.lnThumbArea >= 8
.scrollthumb.Visible = .T.
Else
.scrollthumb.Visible = .F.
Endif
*!* MessageBox( ".Height = " + AllTrim( Str( .Height)) + Chr(13) + ;
*!* ".m_nPage = " + AllTrim( Str( .m_nPage)) + Chr(13) + ;
*!* ".m_nMax = " + AllTrim( Str( .m_nMax)) + Chr(13) + ;
*!* "-------------------------------" + Chr(13) + ;
*!* ".ScrollThumb.Height = " + AllTrim( Str( .ScrollThumb.Height)))
.cntup.Visible = .T.
.cntdown.Visible = .T.
.Enabled = .T.
Else
If .kind = 1 && Vertical
.scrollthumb.Height = 0
.m_nthumbarea = .Height - .scrollthumb.Height - .m_nbuttonsize * 2
Else
.scrollthumb.Width = 0
.m_nthumbarea = .Width - .scrollthumb.Width - .m_nbuttonsize * 2
Endif
.scrollthumb.Visible = .F.
.cmdup.Visible = .T.
.cmddown.Visible = .T.
.cntup.Visible = .F.
.cntdown.Visible = .F.
.Enabled = .F.
Endif
Endwith
Endproc
Protected Procedure ControlSize
*-- Return IIF( This.Kind = 0, This.Parent.Width, This.Parent.Height)
Return Iif( This.kind = 0, This.Width, This.Height)
*!* Return IIF( Type( "This.ControlArea") = "O" And !IsNull( This.ControlArea), ;
*!* IIF( This.Kind = 0, This.ControlArea.Width, This.ControlArea.Height), ;
*!* 0)
Endproc
Procedure position_assign
Lparameters tnNewPosition
With This
*!* _Screen.Print( "SetPosition: " + Transform( m.tnNewPosition) + ", ")
tnNewPosition = Max( 0, Min( .m_ncalcrange, Int( m.tnNewPosition)))
Local lnOldPos, lnNewThumbPos
lnOldPos = .position
.position = m.tnNewPosition
If .kind = 1 && Vertical
*!* .m_nThumbArea = .Height - .ScrollThumb.Height - .m_nButtonSize * 2
lnNewThumbPos = Min( .m_nthumbarea, Max( 0, Iif( .m_ncalcrange = 0, 0, (.position / .m_ncalcrange) * .m_nthumbarea)))
.scrollthumb.Top = m.lnNewThumbPos + .m_nbuttonsize
.Parent.ScrollBy( 0, m.lnOldPos - m.tnNewPosition)
Else
*!* .m_nThumbArea = .Width - .ScrollThumb.Width - .m_nButtonSize * 2
lnNewThumbPos = Min( .m_nthumbarea, Max( 0, Iif( .m_ncalcrange = 0, 0, (.position / .m_ncalcrange) * .m_nthumbarea)))
.scrollthumb.Left = m.lnNewThumbPos + .m_nbuttonsize
.Parent.ScrollBy( m.lnOldPos - m.tnNewPosition, 0)
Endif
Endwith
Endproc
Protected Procedure range_assign
Lparameters tnNewRange
With This
.Range = Max( 0, m.tnNewRange)
If !Isnull( .controlarea) And .Range != 0
If .kind = 1 &&Vertical
.controlarea.Height = .Range
Else
.controlarea.Width = .Range
Endif
Endif
.Parent.UpdateScrollBars()
Endwith
Endproc
Protected Procedure thumbsize_access
Return Iif( This.kind = 0, This.scrollthumb.Width, This.scrollthumb.Height)
Endproc
Protected Procedure thumbsize_assign
Lparameters vNewVal
Error 1740, "ThumbSize"
Endproc
Procedure needsscrollbarvisible
Lparameters tnSize
If Pcount() = 0 Or Type( "m.tnSize") != "N"
Return This.Range > This.ControlSize()
Endif
Return This.Range > m.tnSize
Endproc
Procedure Init
Lparameters toArea
Declare Integer GetSysColor In Win32API Integer
With This
.m_nbuttonsize = Sysmetric( 5)
Local lnColor1, lnColor2, lnRed1, lnGreen1, lnBlue1, lnRed2, lnGreen2, lnBlue2
lnColor1 = GetSysColor( COLOR_BTNHIGHLIGHT)
lnColor2 = GetSysColor( COLOR_BTNFACE)
lnRed1 = Bitand( m.lnColor1, 0x000000FF)
lnGreen1 = Bitand( m.lnColor1, 0x0000FF00) / 256
lnBlue1 = Bitand( m.lnColor1, 0x00FF0000) / 65536
lnRed2 = Bitand( m.lnColor2, 0x000000FF)
lnGreen2 = Bitand( m.lnColor2, 0x0000FF00) / 256
lnBlue2 = Bitand( m.lnColor2, 0x00FF0000) / 65536
lnRed1 = Bitand( m.lnRed2 + Int( ( m.lnRed1 - m.lnRed2) / 2), 0xFF)
lnGreen1 = Bitand( m.lnGreen2 + Int( ( m.lnGreen1 - m.lnGreen2) / 2), 0xFF)
lnBlue1 = Bitand( m.lnBlue2 + Int( ( m.lnBlue1 - m.lnBlue2) / 2), 0xFF)
.BackColor = Rgb( m.lnRed1, m.lnGreen1, m.lnBlue1)
.m_nmax = 1
.m_npage = 1
If Pcount() > 0 And Vartype( m.toArea) = "O"
.controlarea = m.toArea
Else
.controlarea = .Null.
Endif
.cntup.Move( 0, 0, .m_nbuttonsize, .m_nbuttonsize)
.cmdup.Move( 0, 0, .m_nbuttonsize, .m_nbuttonsize)
If .kind = 1 && Vertical
.cntdown.Move( 0, .Height - .m_nbuttonsize, .m_nbuttonsize, .m_nbuttonsize)
.cmddown.Move( 0, .Height - .m_nbuttonsize, .m_nbuttonsize, .m_nbuttonsize)
.scrollthumb.Move( 0, .m_nbuttonsize, .m_nbuttonsize, .m_nbuttonsize)
.m_nthumbarea = .Height - .scrollthumb.Height - .m_nbuttonsize * 2
Else
.cntdown.Move( .Width - .m_nbuttonsize, 0, .m_nbuttonsize, .m_nbuttonsize)
.cmddown.Move( .Width - .m_nbuttonsize, 0, .m_nbuttonsize, .m_nbuttonsize)
.scrollthumb.Move( .m_nbuttonsize, 0, .m_nbuttonsize, .m_nbuttonsize)
.m_nthumbarea = .Width - .scrollthumb.Width - .m_nbuttonsize * 2
Endif
.cmdup.Visible = .F.
.cmddown.Visible = .F.
*-- .Range = 0
Endwith
Endproc
Procedure Resize
Local lnSize
With This
If .kind = 1 && Vertical
lnSize = .Height
If m.lnSize <= .m_nbuttonsize * 2
lnSize = Int( m.lnSize / 2)
.cmddown.Move( 0, .Height - m.lnSize, .m_nbuttonsize, m.lnSize)
.cntdown.Move( 0, .Height - m.lnSize, .m_nbuttonsize, m.lnSize)
.cmdup.Height = m.lnSize
.cntup.Height = m.lnSize
Else
.cmddown.Move( 0, .Height - .m_nbuttonsize, .m_nbuttonsize, .m_nbuttonsize)
.cntdown.Move( 0, .Height - .m_nbuttonsize, .m_nbuttonsize, .m_nbuttonsize)
.cmdup.Height = .m_nbuttonsize
.cntup.Height = .m_nbuttonsize
Endif
Else
lnSize = .Width
If m.lnSize <= .m_nbuttonsize * 2
lnSize = Int( m.lnSize / 2)
.cmddown.Move( .Width - m.lnSize, 0, m.lnSize, .m_nbuttonsize)
.cntdown.Move( .Width - m.lnSize, 0, m.lnSize, .m_nbuttonsize)
.cmdup.Width = m.lnSize
.cntup.Width = m.lnSize
Else
.cmddown.Move( .Width - .m_nbuttonsize, 0, .m_nbuttonsize, .m_nbuttonsize)
.cntdown.Move( .Width - .m_nbuttonsize, 0, .m_nbuttonsize, .m_nbuttonsize)
.cmdup.Width = .m_nbuttonsize
.cntup.Width = .m_nbuttonsize
Endif
Endif
.Update()
*-- .Range = .Range
Endwith
Endproc
Procedure MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
Local loCurObject
Local lnSec, lnDelay
lnDelay = This.Delay
*!* Do While .T.
*!* DoEvents
*!* Do While lnSec > Seconds()
*!* EndDo
With This
nYCoord = m.nYCoord - Objtoclient( This, 1)
nXCoord = m.nXCoord - Objtoclient( This, 2)
If .Enabled And m.nButton = 1 And .scrollthumb.Visible
If ( .kind = 1 And m.nYCoord < .scrollthumb.Top) Or ( .kind = 0 And m.nXCoord < .scrollthumb.Left)
Nodefault
Do While .T.
lnSec = Seconds() + lnDelay
If .kind = 1 && Vertical
.shpsplash.Move( 0, 0, .m_nbuttonsize, .scrollthumb.Top)
Else
.shpsplash.Move( 0, 0, .scrollthumb.Left, .m_nbuttonsize)
Endif
.shpsplash.Visible = .T.
.scrollmessage( SB_PAGEUP)
Do While Mdown() And m.lnSec > Seconds()
Enddo
loCurObject = Sys( 1270)
If !Mdown() Or Vartype( m.loCurObject) # "O" Or m.loCurObject # .shpsplash
Exit
Endif
Enddo
.shpsplash.Visible = .F.
Else
If ( .kind = 1 And m.nYCoord > .scrollthumb.Top + .scrollthumb.Height) Or ( .kind = 0 And m.nXCoord > .scrollthumb.Left + .scrollthumb.Width)
Nodefault
Do While .T.
lnSec = Seconds() + m.lnDelay
If .kind = 1 && Vertical
.shpsplash.Move( 0, .scrollthumb.Top + .scrollthumb.Height, .m_nbuttonsize, .Height - (.scrollthumb.Top + .scrollthumb.Height) - .m_nbuttonsize)
Else
.shpsplash.Move( .scrollthumb.Left + .scrollthumb.Width, 0, .Width - (.scrollthumb.Left + .scrollthumb.Width) - .m_nbuttonsize, .m_nbuttonsize)
Endif
.shpsplash.Visible = .T.
.scrollmessage( SB_PAGEDOWN)
Do While Mdown() And m.lnSec > Seconds()
Enddo
loCurObject = Sys( 1270)
If !Mdown() Or Vartype( m.loCurObject) # "O" Or m.loCurObject # .shpsplash
Exit
Endif
Enddo
.shpsplash.Visible = .F.
Endif
Endif
Endif
Endwith
Endproc
Procedure Destroy
This.controlarea = .Null.
DoDefault()
Endproc
Procedure scrollthumb.MouseMove
Lparameters nButton, nShift, nXCoord, nYCoord
If Bitand( m.nButton, 1) = 1 And This.Parent.m_bthumbmove And !This.Parent.m_bthumbmoving
With This.Parent
.m_bthumbmoving = .T.
Local lnNewPos
If .kind = 1 && Vertical
lnNewPos = Max( 0, Min( m.nYCoord - .m_noffset, .m_nthumbarea))
* This.Top = m.lnNewPos + .m_nButtonSize
Else
lnNewPos = Max( 0, Min( m.nXCoord - .m_noffset, .m_nthumbarea))
* This.Left = m.lnNewPos + .m_nButtonSize
Endif
.scrollmessage( SB_THUMBTRACK, ( m.lnNewPos / .m_nthumbarea) * .m_ncalcrange)
.m_bthumbmoving = .F.
Endwith
Endif
Endproc
Procedure scrollthumb.MouseDown
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
With This
.Parent.m_noffset = Iif( .Parent.kind = 1, m.nYCoord - .Top, m.nXCoord - .Left) + .Parent.m_nbuttonsize
.Parent.m_bthumbmove = .T.
Endwith
Endif
Endproc
Procedure scrollthumb.MouseUp
Lparameters nButton, nShift, nXCoord, nYCoord
If m.nButton = 1
*!* With This
*!* .Parent.lThumbMove = .F.
*!* Local lnNewPos
*!* If ( .Parent.Kind = 1 and .Top = .m_nButtonSize) or ( .Parent.Kind = 0 and .Left = .m_nButtonSize)
*!* lnNewPos = 0
*!* Else
*!* If .Parent.Kind = 1 && Vertical
*!* lnNewPos = (.Top / .Parent.m_nThumbArea) * .Parent.m_nCalcRange
*!* Else
*!* lnNewPos = (.Left / .Parent.m_nThumbArea) * .Parent.m_nCalcRange
*!* EndIf
*!* EndIf
*!* .Parent.ScrollMessage( SB_THUMBPOSITION, lnNewPos)
*!* EndWith
With This.Parent
.m_bthumbmove = .F.
Local lnNewPos, lnNewPos
If .kind = 1 && Vertical
lnNewPos = Max( 0, Min( m.nYCoord - .m_noffset, .m_nthumbarea))
Else
lnNewPos = Max( 0, Min( m.nXCoord - .m_noffset, .m_nthumbarea))
Endif
.scrollmessage( SB_THUMBPOSITION, ( m.lnNewPos / .m_nthumbarea) * .m_ncalcrange)
Endwith
Endif
Endproc
Procedure cntup.Click
This.Parent.scrollmessage( SB_LINEUP)
Endproc
Procedure cntdown.Click
This.Parent.scrollmessage( SB_LINEDOWN)
Endproc
Enddefine
*-- EndDefine: __vscrollbar
*
Define Class __hscrollbar As __vscrollbar
Width = 252
Height = 16
kind = 0
Name = "__hscrollbar"
shpsplash.Name = "shpSplash"
scrollthumb.Name = "ScrollThumb"
cntup.imgdirection.Picture = "scrolllt.bmp"
cntup.imgdirection.Height = 9
cntup.imgdirection.Width = 9
cntup.imgdirection.Name = "imgDirection"
cntup.Name = "cntUp"
cntdown.imgdirection.Picture = "scrollrt.bmp"
cntdown.imgdirection.Height = 9
cntdown.imgdirection.Width = 9
cntdown.imgdirection.Name = "imgDirection"
cntdown.Name = "cntDown"
cmdup.Picture = "scrolllt.bmp"
cmdup.Name = "cmdUp"
cmddown.Picture = "scrollrt.bmp"
cmddown.Name = "cmdDown"
Enddefine
*-- EndDefine: __hscrollbar
*
Define Class _scrollcontainer As Container
Width = 447
Height = 329
SpecialEffect = 1
*-- Specifies if control scrolling is continuous or the control is only redrawn when the scroll box is released.
ContinuousScroll = .T.
*-- Specifies the type of scroll bars control has. 0 - none, 1 - horizontal, 2 - vertical, 3 - both.
ScrollBars = 3
*-- Specifies the horizontal scrolling increment for a control's horizontal scroll bar.
HscrollSmallChange = 8
*-- Specifies the vertical scrolling increment for a controls vertical scroll bar.
VscrollSmallChange = 8
*-- Specifies the margin width created in the text portion of the control.
Margin = 0
clientArea = .Null.
Name = "_scrollcontainer"
Protected m_bscrollby
Protected m_bupdatingscrollbars
Protected m_bcalcautorange
*-- Indicates whether scroll bars appear automatically on the scrolling windowed control if it is not large enough to display all of its controls.
autoscroll = .F.
Add Object viewFrame As Container With ;
Width = 1024, ;
Height = 1024, ;
Name = "ViewFrame"
Add Object hscrollbar As __hscrollbar With ;
Top = -20, ;
Name = "HScrollBar", ;
shpsplash.Name = "shpSplash", ;
scrollthumb.Name = "ScrollThumb", ;
cntup.imgdirection.Height = 9, ;
cntup.imgdirection.Width = 9, ;
cntup.imgdirection.Name = "imgDirection", ;
cntup.Name = "cntUp", ;
cntdown.imgdirection.Height = 9, ;
cntdown.imgdirection.Width = 9, ;
cntdown.imgdirection.Name = "imgDirection", ;
cntdown.Name = "cntDown", ;
cmdup.Name = "cmdUp", ;
cmddown.Name = "cmdDown"
Add Object vscrollbar As __vscrollbar With ;
Left = -20, ;
Name = "VScrollBar", ;
shpsplash.Name = "shpSplash", ;
scrollthumb.Name = "ScrollThumb", ;
cntup.imgdirection.Height = 9, ;
cntup.imgdirection.Width = 9, ;
cntup.imgdirection.Name = "imgDirection", ;
cntup.Name = "cntUp", ;
cntdown.imgdirection.Height = 9, ;
cntdown.imgdirection.Width = 9, ;
cntdown.imgdirection.Name = "imgDirection", ;
cntdown.Name = "cntDown", ;
cmdup.Name = "cmdUp", ;
cmddown.Name = "cmdDown"
Procedure Init
DoDefault()
With This.viewFrame
Try
.AddObject("clientArea","container")
With .clientArea
.Top = 0
.Left = 0
.Width = 1024
.Height = 1024
.BackStyle = 0
.BorderWidth = 0
.Visible=.T.
.Name = "clientArea"
.AddObject ("edit1","editbox1")
.edit1.Value=""
.edit1.Visible=.T.
.edit1.Name="edit1"
.AddObject("edit2","editbox2")
.edit2.Value=''
.edit2.Visible=.T.
.edit2.Name="edit2"
.Visible=.T.
Endwith
.Visible=.T.
DoDefault()
Catch
Endtry
Endwith
With This
.clientArea = .viewFrame.clientArea
.viewFrame.BorderWidth = 0
.hscrollbar.smallchange = Val( "0" + Trans( .HscrollSmallChange))
.vscrollbar.smallchange = Val( "0" + Trans( .VscrollSmallChange))
.hscrollbar.Margin = Val( "0" + Trans( .Margin))
.vscrollbar.Margin = Val( "0" + Trans( .Margin))
.hscrollbar.controlarea = .clientArea
.vscrollbar.controlarea = .clientArea
.calcautorange()
.Resize()
Endwith
Endproc
Procedure ScrollBy
Lparameters tnDeltaX, tnDeltaY
With This
If !.m_bscrollby
.m_bscrollby = .T.
With .viewFrame.clientArea
.Move( .Left + m.tnDeltaX, .Top + m.tnDeltaY)
Endwith
.m_bscrollby = .F.
Endif
Endwith
Endproc
Procedure UpdateScrollBars
With This
If !.m_bupdatingscrollbars
.m_bupdatingscrollbars = .T.
If Bitand( .ScrollBars, SBC_VERT) != 0
.vscrollbar.Visible = .T.
.vscrollbar.Update()
Else
.vscrollbar.Visible = .F.
Endif
If Bitand( .ScrollBars, SBC_HORS) != 0
.hscrollbar.Visible = .T.
.hscrollbar.Update()
Else
.hscrollbar.Visible = .F.
If Bitand( .ScrollBars, SBC_VERT) != 0
*!* .VScrollBar.Visible = .T.
Endif
Endif
.m_bupdatingscrollbars = .F.
Endif
Endwith
Endproc
*-- Scrolls a control into the visible area of the scrolling windowed control.
Procedure ensureisvisible
Lparameters toControl
If Type( "m.toControl") = "O" And !Isnull( m.toControl)
With This
Local lnLeft, lnTop, lnRight, lnBottom, lnHSPos, lnVSPos, lnVPWidth, lnVPHeight
lnHSPos = .hscrollbar.position
lnVSPos = .vscrollbar.position
lnVPWidth = .viewFrame.Width
lnVPHeight = .viewFrame.Height
lnLeft = m.toControl.Left - m.lnHSPos
lnTop = m.toControl.Top - m.lnVSPos
lnRight = m.lnLeft + m.toControl.Width
lnBottom = m.lnTop + m.toControl.Height
If Bitand( .ScrollBars, SBC_HORS) != 0 And .hscrollbar.Enabled
If m.lnLeft < 0
.hscrollbar.position = ( m.lnHSPos + m.lnLeft)
Else
If m.lnRight > m.lnVPWidth
If m.lnRight - m.lnLeft > m.lnVPWidth
m.lnRight = m.lnLeft + m.lnVPWidth
Endif
.hscrollbar.position = ( m.lnHSPos + m.lnRight - m.lnVPWidth)
Endif
Endif
Endif
If Bitand( .ScrollBars, SBC_VERT) != 0 And .vscrollbar.Enabled
If m.lnTop < 0
.vscrollbar.position = ( m.lnVSPos + m.lnTop)
Else
If m.lnBottom > m.lnVPHeight
If m.lnBottom - m.lnTop > m.lnVPHeight
m.lnBottom = m.lnTop + m.lnVPHeight
Endif
.vscrollbar.position = ( m.lnVSPos + m.lnBottom - m.lnVPHeight)
Endif
Endif
Endif
Endwith
Endif
Endproc
Procedure calcautorange
With This
If !.m_bcalcautorange
.m_bcalcautorange = .T.
.hscrollbar.calcautorange()
.vscrollbar.calcautorange()
.m_bcalcautorange = .F.
Endif
Endwith
Endproc
Protected Procedure autoscroll_assign
Lparameters tbNewVal
With This
If .autoscroll != m.tbNewVal
.autoscroll = m.tbNewVal
If m.tbNewVal
.calcautorange
Else
.hscrollbar.Range = 0
.vscrollbar.Range = 0
Endif
Endif
Endwith
Endproc
*-- Occurs when the horizontal or vertical scroll bars are clicked or dragged
Procedure Scrolled
Lparameters tnDirection
Endproc
Procedure scrollbars_assign
Lparameters tnNewVal
With This
.ScrollBars = m.tnNewVal
.Resize
Endwith
Endproc
Procedure setscrollrange
Lparameters tnRange, tnBar
If tnBar = SBC_HORS
This.hscrollbar.Range = m.tnRange
Else
This.vscrollbar.Range = m.tnRange
Endif
Endproc
Protected Procedure Resize
Thisform.LockScreen = .T.
With This
Local lnMargin, lnBtnSize, lnVPWidth, lnVPHeight, lnTempSize
lnBtnSize = .hscrollbar.m_nbuttonsize
lnMargin = .BorderWidth
If This.SpecialEffect != 2
lnMargin = m.lnMargin + 1
Endif
Store m.lnBtnSize To lnHSBH, lnVSBW
lnVPWidth = Max( 0, .Width - ( m.lnBtnSize + m.lnMargin * 2))
lnVPHeight = Max( 0, .Height - ( m.lnBtnSize + m.lnMargin * 2))
If Bitand( .ScrollBars, SBC_VERT) != 0 And .vscrollbar.Enabled And .vscrollbar.needsscrollbarvisible( m.lnVPHeight)
.vscrollbar.Visible = .T.
Else
.vscrollbar.Visible = .F.
lnVPWidth = m.lnVPWidth + m.lnVSBW
Endif
If Bitand( .ScrollBars, SBC_HORS) != 0 And .hscrollbar.Enabled And .hscrollbar.needsscrollbarvisible( m.lnVPWidth)
.hscrollbar.Visible = .T.
Else
.hscrollbar.Visible = .F.
lnVPHeight = m.lnVPHeight + m.lnHSBH
Endif
.viewFrame.Move( m.lnMargin, m.lnMargin, m.lnVPWidth, m.lnVPHeight)
.hscrollbar.Move( m.lnMargin, lnVPHeight + m.lnMargin, m.lnVPWidth, m.lnBtnSize)
.vscrollbar.Move( m.lnVPWidth + m.lnMargin, m.lnMargin, m.lnBtnSize, m.lnVPHeight)
*!* Local lnMargin, lnBtnWidth, lnVPWidth, lnVPHeight
*!* lnBtnWidth = .HScrollBar.m_nButtonSize
*!* lnMargin = .BorderWidth
*!* If This.SpecialEffect != 2
*!* lnMargin = m.lnMargin + 1
*!* EndIf
*!* lnVPWidth = Max( 0, .Width - ( m.lnBtnWidth + m.lnMargin * 2))
*!* lnVPHeight = Max( 0, .Height - ( m.lnBtnWidth + m.lnMargin * 2))
*!* .ViewFrame.Move( m.lnMargin, m.lnMargin, m.lnVPWidth, m.lnVPHeight)
*!* .HScrollBar.Move( m.lnMargin, lnVPHeight + m.lnMargin, m.lnVPWidth, m.lnBtnWidth)
*!* .VScrollBar.Move( m.lnVPWidth + m.lnMargin, m.lnMargin, m.lnBtnWidth, m.lnVPHeight)
Endwith
Thisform.LockScreen = .F.
Endproc
Procedure Destroy
This.clientArea = .Null.
DoDefault()
Endproc
Enddefine
*-- EndDefine: clientArea
Click on code to select [then copy] -click outside to deselect
*part 1.2 to add with part 1.1 in same ysearchEditbox.prg
Define Class searcheditbox As _scrollcontainer
Width = 447
Height = 329
BackColor = Rgb(255,255,255)
editboxfontsize = 9
ScrollBars = 2
Name = "searcheditbox"
Procedure Init
DoDefault()
With This
Try
.AddObject("img","image")
Catch
Endtry
With .img
.Stretch=2
.Left=0
.Top=0
.Width=.Parent.Width
.Height=.Parent.Height
.PictureVal=yPval("https://images.theconversation.com/files/119126/original/image-20160418-1284-1f6bn9n.jpg?ixlib=rb-1.1.0&q=45&auto=format&w=754&fit=clip") && internet connected - can make a local picture
.Visible=.T.
.ZOrder(0)
Endwith
Endwith
Procedure addtext
Parameters TextAdd
If Empty(TextAdd)
Return
Endif
This.viewFrame.clientArea.edit1.Value=''
This.viewFrame.clientArea.edit2.Value=''
This.viewFrame.clientArea.edit2.Value=Strtran(Strtran(TextAdd,Chr(13)+Chr(10),Chr(13)),Chr(9)," ")
Endproc
Procedure search
Parameters TextFind, RegistrI
If Empty(TextFind)
Return
Endif
If Empty(RegistrI)
RegistrI=0
Endif
Local cObj
cObj=This.viewFrame.clientArea.edit2
nFind=1
cObj.Value=Strtran(cObj.Value,Alltrim(TextFind),Replicate('_',Len(Alltrim(TextFind))),1,Lenc(cObj.Value),RegistrI+2)
Endproc
Enddefine
*-- EndDefine: searcheditbox
*
Define Class editbox1 As EditBox
Anchor=0
FontBold = .F.
FontName = "Courier New"
FontSize = 9
BackStyle = 0
BorderStyle = 0
Height = 217
Left = 0
ReadOnly = .T.
ScrollBars = 0
Top = 0
Width = 360
EnableHyperlinks = .F.
ForeColor = Rgb(255,0,0)
BorderColor = Rgb(0,0,0)
ControlSource = ""
Name = "Editbox1"
Procedure LostFocus
This.ForeColor=Rgb(255,0,0)
Endproc
Procedure GotFocus
This.ForeColor=Rgb(0,0,0)
Endproc
Enddefine
*
Define Class editbox2 As EditBox
Anchor=0
FontName = "Courier New"
FontOutline = .F.
FontSize = 9
FontUnderline = .F.
FontCondense = .F.
FontExtend = .F.
AddLineFeeds = .T.
BackStyle = 0
BorderStyle = 0
Height = 214
Left = 0
ReadOnly = .T.
ScrollBars = 0
Top = 0
Width = 360
ForeColor = Rgb(0,0,0)
ControlSource = ""
IntegralHeight = .F.
Name = "Editbox2"
Increment=5 &&mousewheel
Procedure Init
This.FontSize=This.Parent.Parent.Parent.editboxfontsize
This.Parent.edit1.FontSize=This.Parent.Parent.Parent.editboxfontsize
Public nFind
nFind=0
This.Width=This.Parent.Parent.Parent.Width-20
This.Parent.edit1.Width=This.Parent.Parent.Parent.Width-20
This.Parent.Parent.Parent.Init
Endproc
Procedure ProgrammaticChange
If nFind=0
lenedit=Int((This.Width)/Fontmetric(7,This.FontName, This.FontSize))
kol=1
poz=1
Do While ((poz+lenedit)<Len(This.Value))
a=Substr(This.Value,poz,lenedit)
b=Occurs(Chr(13),a)
If b=0
b=Occurs(' ',a)
If b=0
kol=kol+1
poz=poz+lenedit
Else
kol=kol+1
poz=poz+1+At(' ',a,b)
Endif
Else
kol=kol+1
poz=poz+1+At(Chr(13),a,1)
Endif
Enddo
If ((kol+1)*(Fontmetric(1,This.FontName, This.FontSize)+Fontmetric(4,This.FontName, This.FontSize)))>This.Parent.Parent.Parent.Height
This.Height=(kol+1)*(Fontmetric(1,This.FontName, This.FontSize)+Fontmetric(4,This.FontName, This.FontSize))
This.Parent.edit1.Height=This.Height
Endif
This.Parent.edit1.Value=This.Value
Else
nFind=0
Endif
This.Parent.Parent.Parent.Init
Endproc
Procedure GotFocus
nFind=1
This.Value=This.Parent.edit1.Value
Endproc
Procedure MouseWheel
Lparameters nDirection, nShift, nXCoord, nYCoord
DoDefault()
*scroll vertical only
If nDirection>0
With This
.Top=.Top-This.Increment
.Parent.edit1.Top=.Parent.edit1.Top-This.Increment
Endwith
Else
With This
.Top=.Top+This.Increment
.Parent.edit1.Top=.Parent.edit1.Top+This.Increment
Endwith
Endi
If nDirection>0 &&move scrollbars accordingly
Thisform.searcheditbox1.vscrollbar.cntup.MouseDown(1)
Else
Thisform.searcheditbox1.vscrollbar.cntdown.MouseDown(1)
Endi
Endproc
Enddefine
Function yPval()
Lparameters url
Local loRequest,m.x
m.x=""
Try
m.loRequest = Createobject('MsXml2.XmlHttp')
m.loRequest.Open("GET",url,.F.)
m.loRequest.Send()
m.x=m.loRequest.ResponseBody
m.loRequest=Null
Catch
Endtry
Return m.x
Endfunc
some relative links in this blog
Search for text in editbox with 6 methodsTesting a vfp scrollbar container
scrolling containers with a pure vfp solutions
Scrolling containers with flat scrollbar
the vfp scrollbar container class as a prg code
scrolling texts and images in visual foxpro
A scrollable menu with vfpscrollbar
|
|
Yousfi Benameur |
Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1709(fall creator) & IE11 emulation.