A form picture tiled with resizing

Published on by Yousfi Benameur

The Native Form background Image Is Not tiled And If its
dimension are small its reproduced As duplication (cloned) on the form area.(See the first image attached below).this produces a bad view.
This Code makes this Image bakground tiled When resizing the Form.

the  tiled Image is created in temp folder.
When the Form Is resized the Image Is also resized simultaneously and
almost instantaneously by Code and it occupes all the Form area.( same effect with an image control+stretch=2)

The code uses the native vfp9 gdiplus library (who is directly accessible in vfp IDE).

*Begin code

Publi yform
yform=Newobject("yform_picture_tile")
yform.Show
Read Events
Return

Define Class yform_picture_tile As Form
Height = 458
Width = 817
ShowWindow = 2
AutoCenter = .T.
Caption = "Form1"
Name = "form1"

Add Object edit1 As EditBox With ;
FontBold = .T., ;
Anchor = 768, ;
Alignment = 2, ;
BackStyle = 0, ;
BorderStyle = 0, ;
Height = 96, ;
Left = 0, ;
ReadOnly = .T., ;
Top = 12, ;
Width = 264, ;
ForeColor = Rgb(128,0,64), ;
Name = "Edit1"

Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 16, ;
Caption = "A tiled background picture on form", ;
Height = 27, ;
Left = 276, ;
Top = 12, ;
Width = 360, ;
ForeColor = Rgb(255,128,0), ;
BackColor = Rgb(255,255,0), ;
Name = "Label1"

Add Object grid1 As Grid With ;
Anchor = 768, ;
Height = 120, ;
Left = 408, ;
Top = 336, ;
Width = 396, ;
Name = "Grid1"

Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 20, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "?", ;
Height = 35, ;
Left = 720, ;
MousePointer = 15, ;
Top = 12, ;
Width = 19, ;
ForeColor = Rgb(0,255,0), ;
BackColor = Rgb(255,0,0), ;
Name = "Label2"

Procedure resizeimg
Lparameters img
Local lcDest,todel
This.LockScreen=.T.
todel=Addbs(Sys(2023))+"_yb*.jpg"
Erase (todel)
&&with native _gdiplus vfp9 class
oImage= Newobject('GpBitmap',Home()+'ffc/_gdiplus.vcx') && Create and instance of an image
oImage.CreateFromFile(m.xpict) && load the initial image
oImg=oImage.GetThumbnailImage(This.Width,This.Height) && resize image
lcDest=Addbs(Sys(2023))+"_yb"+Sys(2015)+".jpg" &&create an unique image to avoid vfp cache problems
oImg.SaveToFile(m.lcDest,"image/jpeg",'quality=100') &&jpg image with max quality
This.Picture=m.lcDest
This.LockScreen=.F.
Endproc

Procedure Load
Close Data All
Sele * From (Home(1)+"samples\data\customer") Into Cursor ycurs
Sele ycurs
*brow
Endproc

Procedure Resize
If !Empty(This.Picture)
Thisform.resizeimg(m.xpict)
Endi
Endproc

Procedure Destroy
todel=Addbs(Sys(2023))+"_yb*.jpg"
Erase (todel)
Clea Events
Endproc

Procedure Init
Thisform.Caption = "yImage background tiled picture 06/2011"
Sele ycurs
Locate
With Thisform.grid1
.RecordSource="ycurs"
.RecordSourceType=1
.Themes=.F.
.DeleteMark=.F.
.GridLines=0
.HeaderHeight=25
.RowHeight=18
.FontBold=.T.
.Anchor=15
.HighlightStyle=1
.SetAll('DynamicBackColor','IIF(mod(recno(),2)=0,RGB(128,255,0),RGB(220,228,211))','Column')
.Refresh
Endwith
Publi m.xpict
m.xpict=Getpict()
Thisform.Picture=m.xpict &&original image you choiced
If !Empty(This.Picture)
Thisform.resizeimg(m.xpict)
Endi
Endproc

Procedure edit1.Init
TEXT to this.value 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
Endproc

Procedure label2.Click
Local m.myvar
TEXT to m.myvar noshow
the native form background image is not tiled and if its
dimension are small its reproduced as duplication (cloned).
this code makes this image bakground tiled when resizing the
form.the image tiled is created on temp folder.
when the form is resized the image is also resized by code and it
occupes all the form area.
ENDTEXT
Messagebox(m.myvar,0+32+4096)
Endproc

Enddefine
*

*end code

*remark : can use a control image anchored to 15 and stretched to 2 for this goal but must be always with  zorder(1).

Can download the fennec (algerian fox) image to see the effect.
Can download the fennec (algerian fox) image to see the effect.
Can download the fennec (algerian fox) image to see the effect.

Can download the fennec (algerian fox) image to see the effect.

Published on Visual Foxpro, Form, gdiplus

To be informed of the latest articles, subscribe:
Comment on this post