GdiplusX effects & operations on images
these 7 codes makes some effects on images with gdiplusX.
1-halo around images folder
2-shadow around images folder
3. extract a roundRectangle on images folder
4.extract a RoundRectangle with shadow on images folder
5.extract thumbnails with any dimensions from an images folder
6.
and the ymain.prg
Save each code as pointed prg and run the ymain.prg
the code contains 7 prgs.the main prg is a form an can fires any of the 6 others.
any of the 6 last prg's can run as standalone.
must point to system.app and gdiplusX class or better put them in the source folder.
output images are created in thumbnails folder (created in the source if not exists).
You can see some technics to work with imgcanvas class.It can work as standalone (without a form plateform) as object exactly as image with this code with image class
local oImg
oImg=createObject("image")
oImg.picture=getpict()
messagebox("width="+trans(oImg.width)+" Height=" +trans(oImg.height))
oimg=null
release oimg
see some screenshots generated by the application below.
NB:if you have any problem with gdiplmusX object,isuue "clea all" before running code.
This page was last updated on : mardi 17 février 2015; 18:28:47
*-1-ymain.prg
*Begin code
Clea All
Do Locfile("system.app")
Publi m.yrep0
m.yrep0=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep0)
Publi yform
yform=Newobject("yglobal")
yform.Show
Read Events
Retu
*
Define Class yglobal As Form
BorderStyle = 2
Height = 257
Width = 329
ShowWindow = 2
AutoCenter = .T.
BackColor=Rgb(255,255,213)
Caption = ""
MaxButton = .F.
Name = "form1"
Add Object command1 As CommandButton With ;
Top = 37, ;
Left = 24, ;
Height = 27, ;
Width = 288, ;
Caption = "Halo on images", ;
Name = "Command1"
Add Object command2 As CommandButton With ;
Top = 73, ;
Left = 24, ;
Height = 27, ;
Width = 288, ;
Caption = "Shadow on image", ;
Name = "Command2"
Add Object command3 As CommandButton With ;
Top = 109, ;
Left = 24, ;
Height = 27, ;
Width = 288, ;
Caption = "Region XOR RoundRectangle on images", ;
Name = "Command3"
Add Object command4 As CommandButton With ;
Top = 145, ;
Left = 24, ;
Height = 27, ;
Width = 288, ;
Caption = "Region_xor_roundrect_contour on images", ;
Name = "Command4"
Add Object command5 As CommandButton With ;
Top = 181, ;
Left = 24, ;
Height = 27, ;
Width = 288, ;
Caption = "Region_xor_roundrect_shadow.prg on images", ;
Name = "Command5"
Add Object command6 As CommandButton With ;
Top = 217, ;
Left = 24, ;
Height = 26, ;
Width = 288, ;
Caption = "Vignette of images", ;
Name = "Command6"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 24, ;
BackStyle = 0, ;
Caption = " Effects on images", ;
Height = 54, ;
Left = 0, ;
Top = 0, ;
Width = 300, ;
ForeColor = Rgb(68,68,68), ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 24, ;
BackStyle = 0, ;
Caption = " Effects on images", ;
Height = 54, ;
Left = 4, ;
Top = 2, ;
Width = 300, ;
ForeColor = Rgb(255,128,0), ;
Name = "Label2"
Procedure Init
Thisform.SetAll("mousepointer",15,"commandbutton")
Procedure Destroy
Set Defa To (yrep0)
Clea Events
Endproc
Procedure command1.Click
Do yhalo
Endproc
Procedure command2.Click
Do yombreportee
Endproc
Procedure command3.Click
Do yregion_xor_roundrect
Endproc
Procedure command4.Click
Do yregion_xor_roundrect_contour
Endproc
Procedure command5.Click
Do yregion_xor_roundrect_shadow
Endproc
Procedure command6.Click
Do yvignette
Endproc
Enddefine
*
*end code
*-2-yhalo.prg
*Begin Code
If !Vartype(m.yrep0)="C"
clea all
m.yrep0=Addbs(Justpath(Sys(16,1)))
Endi
Declare Integer Sleep In kernel32 Integer
Do Locfile("system.app")
Messagebox("This code makes the jpg images pointed folder with black halo around each image.",0+32,"",1200)
set classlib to
Set Classlib To Locfile["GDIPLUSX.VCX";
,"vcx"] Additive
If Directory(yrep0+"thumbnails")
Set Safe Off
zz=yrep0+"thumbnails\*.*"
Dele File (zz)
Set Safe On
Else
Md (yrep0+"thumbnails")
Endi
Local m.yrep
m.yrep=Addbs(Getdir())
Set Defa To (yrep)
gnbre=Adir(gabase,"*.jpg") &&png,bmp,gif...
If gnbre=0
Messagebox(m.yrep+ " dont contains jpg images !",0+16+4096,"Error",1000)
Return .F.
Endi
with _Screen
.AddObject("ocanvas1","ocanvas")
.AddProperty("ypicture","")
For i=1 To gnbre
.ypicture=gabase(i,1)
.ocanvas1.Draw()
Sleep(10)
Endfor
Endwith
Try
_Screen.ocanvas1=Null
release_screen. ocanvas1
Release Classlib "gdiplusX"
Catch
Set Classlib To
Endtry
aa=(yrep0+"thumbnails\")
Run/N explorer &aa &&show images with effects
Set Defa To (yrep0)
Return
*create the class
Define Class oCanvas As imgcanvas
Anchor = 15
Stretch = 2
Height = 511
Left = 9
Top = 5
Width = 783
smoothingmode = 0
drawWhenInvisible=.T.
Visible=.F.
Name = "ocanvas"
Procedure beforedraw
This.Picture=_Screen.ypicture
This.Stretch=2
This.smoothingmode=0
This.interpolationMode=7
With _Screen.System.Drawing
Local xcolor0,xcolor
xcolor0=.Color.white
xcolor1=.Color.black
Local x1,x2,x3,x4,x5
x1=30
x2=30
x5=15
&&thumbnail dimensions
Local lnWidth,lnHeight
obmp=.Bitmap.new(_Screen.ypicture)
lnWidth=obmp.Width &&here 160 to custom
lnHeight=obmp.Height &&here 120 to custom
Local loFont As xfcFont
This.Clear()
* Create a bitmap in a fixed ratio to the original drawing area.
This.oGfx.Clear(xcolor0 )
Local loBmp As xfcBitmap
Local x
x=x5
loBmp = .Bitmap.new(This.Width / x, This.Height / x)
* Create a GraphicsPath object.
Local loPath As xfcGraphicsPath
loPath = .Drawing2D.GraphicsPath.new()
rec0=.rectangle.new(x1,x2,This.Width-2*x1,This.Height-2*x2)
loPath.addRectangle(rec0)
* Get the graphics object for the image.
Local loGfx As xfcGraphics
loGfx = .Graphics.FromImage(loBmp)
* loGfx.clear(.color.fromRgb(thisform.container1.yback.backcolor) ) &&white
* Create a matrix that shrinks the drawing output by the fixed ratio.
Local loMatrix As xfcMatrix
loMatrix = .Drawing2D.Matrix.new(1/x, 0, 0, 1/x, -1/x, -1/x)
* Choose an appropriate smoothing mode for the halo.
loGfx.smoothingmode = .Drawing2D.smoothingmode.AntiAlias
* Transform the graphics object so that the same half may be used for both halo and text output.
loGfx.Transform = loMatrix
* Using a suitable pen...
Local loPen As xfcPen
loPen = .Pen.new(xcolor1)
* Draw around the outline of the path
loGfx.DrawPath(loPen, loPath)
* and then fill in for good measure.
loGfx.FillPath( .SolidBrush.new(xcolor1), loPath)
* setup the smoothing mode for path drawing
This.oGfx.smoothingmode = .Drawing2D.smoothingmode.AntiAlias
* and the interpolation mode for the expansion of the halo bitmap
This.oGfx.interpolationMode = .Drawing2D.interpolationMode.HighQualityBicubic
* expand the halo making the edges nice and fuzzy.
This.oGfx.DrawImage(loBmp, This.rectangle, 0, 0,loBmp.Width, loBmp.Height, .GraphicsUnit.Pixel)
* Redraw the original
This.oGfx.FillPath(.SolidBrush.new(xcolor1), loPath)
w=rec0.Width
h=rec0.Height
orec=.rectangle.new(x1,x2,This.Width-2*x1,This.Height-2*x1) &&w,h
* Get the graphics object for the image.
This.oGfx.DrawImage(.Bitmap.fromfile(This.Picture),orec)
* Get the resized version of the image
Local loResized As xfcBitmap
loResized = .Bitmap.new(This.obmp, lnWidth, lnHeight)
* Save the resized image as Png
Do Case
Case i<=9
ii="000"+Trans(i)
Case i>9 And i<=99
ii="00"+Trans(i)
Case i>99 And i<=999
ii="0"+Trans(i)
Otherwise
ii=Trans(i)
Endcase
"thumbnails\"+Allt(_Screen.ypicture),.Imaging.ImageFormat.JPEG) loResized.Save(yrep0+ ;
Wait Window("Image: "+Allt(_Screen.ypicture)+"....... "+Trans(i)+"/"+Trans(gnbre)) At Srows()/6,Scols()/6 Nowait
Endwith
Return
Endproc
Enddefine
*
*Endcode
*-3-yregion_xor_roundrect.prg
*Begin code
If !Vartype(m.yrep0)="C"
m.yrep0=Addbs(Justpath(Sys(16,1)))
Endi
Declare Integer Sleep In kernel32 Integer
Do Locfile("system.app")
Messagebox("This code converts an images folder to Round Rectangle jpg images in thumbnail directory ", 0+32+4096,"",1000)
set classlib to
Set Classlib To Locfile["GDIPLUSX.VCX";
,"vcx"] Additive
If Directory(m.yrep0+"thumbnails")
Set Safe Off
zz=m.yrep0+"thumbnails\*.*"
Dele File (zz)
Set Safe On
Else
Md (m.yrep0+"thumbnails")
Endi
Local m.yrep,gnbre
m.yrep=Addbs(Getdir())
Set Defa To (yrep)
gnbre=Adir(gabase,"*.jpg")
If gnbre=0
Messagebox(m.yrep+ " have no images jpg !",0+16+4096,"error",1000)
Return
Endi
Local m.xcolor
m.xcolor=_Screen.System.Drawing.Color.gold contour color
If Messagebox("Change contour color (gold)?",4+32,"")=6
Local m.xcol
m.xcol=Getcolor()
If m.xcol#-1
m.xcolor=_Screen.System.Drawing.Color.fromRGB(m.xcol) && contour color
Endi
Endi
Local m.ypicture
For i=1 To gnbre
m.ypicture=gabase(i,1)
With _Screen.System.Drawing
* Get an image file
Local loBmp As xfcBitmap
loBmp = .Bitmap.FromFile(m.ypicture)
* Create a Gfx object that will allow us to make the transformation
Local loGfx As xfcGraphics
loGfx = .Graphics.FromImage(loBmp)
Local lnWidth, lnHeight
lnWidth = loBmp.Width
lnHeight = loBmp.Height
* Create GraphicsPath object.
Local loClipPath As xfcGraphicsPath
loClipPath = .Drawing2D.GraphicsPath.New()
* LPARAMETERS rc,r
Local x,Y,xwidth,xheight,xpath
x=loBmp.Width/10
Y=loBmp.Height/10
xwidth=loBmp.Width-2*x
xheight=loBmp.Height-2*Y
r=loBmp.Width/5
loGfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
rc = .Rectangle.New(x,Y,xwidth, xheight)
Local g As Graphics
Local p As Pen
x = rc.x
Y = rc.Y
xwidth = rc.Width
xheight = rc.Height
With _Screen.System.Drawing
xpath = .Drawing2D.GraphicsPath.New()
xpath.AddArc(x, Y, r, r, 180, 90) && Upper left corner
xpath.AddArc(x+xwidth - r, Y, r, r, 270, 90) && Upper right corner
xpath.AddArc(x+xwidth - r, Y+xheight - r, r, r, 0, 90) && Lower right corner
xpath.AddArc(x, Y+xheight - r, r, r, 90, 90) &&Lower left corner
xpath.CloseFigure()
Endwith
* An Ellipse shape
loClipPath.AddPath(xpath) &&addEllipse(0, 0, lnWidth, lnHeight)
* Set clipping region to path.
* CombineMode enumeration
* http://msdn.microsoft.com/en-us/library/system.drawing.drawing2d.combinemode.aspx
* CombineMode.Xor - Two clipping regions are combined by taking only the areas
* enclosed by one or the other region, but not both.
loGfx.SetClip(loClipPath,_Screen.System.Drawing.Drawing2D.CombineMode.Xor)
* Fill rectangle to demonstrate clipping region.
loGfx.FillRectangle( .Brushes.white, 0, 0, loBmp.Width, loBmp.Height)
* Save the image to the disk and show
Pen=.Pen.New(xcolor,12)
loGfx.drawPath(Pen,xpath)
Pen.dispose()
* Get the resized version of the image
Local loResized As xfcBitmap
&&thumb dimensions
*local lnWidth,lnHeight
obmp=.Bitmap.New(ypicture)
lnWidth=obmp.Width
lnHeight=obmp.Height
loResized = .Bitmap.New(loBmp, lnWidth, lnHeight)
Wait Window("Image "+m.ypicture+"....... "+Trans(i)+"/"+Trans(gnbre)) At Srows()/6,Scols()/6 Nowait
Endwith
Endfor
aa=(m.yrep0+"thumbnails\")
Run/N explorer &aa
Set Defa To (yrep0)
Return
*End code
*-4-yregion_xor_contour.prg
*Begin code
If !Vartype(m.yrep0)="C"
Clea All
m.yrep0=Addbs(Justpath(Sys(16,1)))
Endi
Declare Integer Sleep In kernel32 Integer
Do Locfile("system.app")
Messagebox("Ce programme transforme les images jpg d'un répertoire en images Round Rectangle avec contour couleur(à Choisir-xcolor).Pour travailler sur les vignettes changer les dimensions ....",0+32,"",1000)
Set Classlib To Locfile("GDIPLUSX.VCX";
,"vcx") Additive &&&
If !Vartype(m.yrep0)="C"
m.yrep0=Addbs(Justpath(Sys(16,1)))
Endi
If Directory(yrep0+"thumbnails")
Set Safe Off
zz=yrep0+"thumbnails\*.*"
Dele File (zz)
Set Safe On
Else
Md (yrep0+"thumbnails")
Endi
Local m.yrep
m.yrep=Addbs(Getdir())
Set Defa To (yrep)
gnbre=Adir(gabase,"*.jpg")
If gnbre=0
Messagebox(m.yrep+ " est vide !",0+16)
Return
Endi
xcolor=_Screen.System.Drawing.Color.blue &&gold &&couleur contour
If Messagebox("Changer la couleur du contour (blue)?",4+32,"")=6
xcol=Getcolor()
If xcol#-1
xcolor=_Screen.System.Drawing.Color.fromRGB(xcol) &&couleur contour
Endi
Endi
Local m.ypicture
For i=1 To gnbre
m.ypicture=gabase(i,1)
With _Screen.System.Drawing
* Get an image file
Local loBmp As xfcBitmap
loBmp = .Bitmap.FromFile(ypicture)
* Create a Gfx object that will allow us to make the transformation
Local loGfx As xfcGraphics
loGfx = .Graphics.FromImage(loBmp)
Local lnWidth, lnHeight
lnWidth = loBmp.Width
lnHeight = loBmp.Height
* Create GraphicsPath object.
Local loClipPath As xfcGraphicsPath
loClipPath = .Drawing2D.GraphicsPath.New()
* LPARAMETERS rc,r
Local x,Y,xwidth,xheight,xpath
x=loBmp.Width/10
Y=loBmp.Height/10
xwidth=loBmp.Width-2*x
xheight=loBmp.Height-2*Y
r=loBmp.Width/5
loGfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
rc = .Rectangle.New(x,Y,xwidth, xheight)
Local g As Graphics
Local p As Pen
x = rc.x
Y = rc.Y
xwidth = rc.Width
xheight = rc.Height
With _Screen.System.Drawing
xpath = .Drawing2D.GraphicsPath.New()
xpath.AddArc(x, Y, r, r, 180, 90) && Upper left corner
xpath.AddArc(x+xwidth - r, Y, r, r, 270, 90) && Upper right corner
xpath.AddArc(x+xwidth - r, Y+xheight - r, r, r, 0, 90) && Lower right corner
xpath.AddArc(x, Y+xheight - r, r, r, 90, 90) &&Lower left corner
xpath.CloseFigure()
Endwith
* An Ellipse shape
loClipPath.AddPath(xpath) &&addEllipse(0, 0, lnWidth, lnHeight)
* Set clipping region to path.
* CombineMode enumeration
* http://msdn.microsoft.com/en-us/library/system.drawing.drawing2d.combinemode.aspx
* CombineMode.Xor - Two clipping regions are combined by taking only the areas
* enclosed by one or the other region, but not both.
loGfx.SetClip(loClipPath,_Screen.System.Drawing.Drawing2D.CombineMode.Xor)
* Fill rectangle to demonstrate clipping region.
loGfx.FillRectangle( .Brushes.white, 0, 0, loBmp.Width, loBmp.Height)
* Save the image to the disk and show
&&contour
Pen=.Pen.New(xcolor,50)
loGfx.drawPath(Pen,xpath)
Pen.dispose()
* Get the resized version of the image
Local loResized As xfcBitmap
*dimensions vignettes
*local lnWidth,lnHeight
obmp=.Bitmap.New(ypicture)
lnWidth=obmp.Width
lnHeight=obmp.Height
loResized = .Bitmap.New(loBmp, lnWidth, lnHeight)
loResized.Save(yrep0+ ;
"thumbnails\"+Allt(m.ypicture), .Imaging.ImageFormat.JPEG)
Wait Window("Image "+m.ypicture+"....... "+Trans(i)+"/"+Trans(gnbre)) At Srows()/6,Scols()/6 Nowait
Endwith
Endfor
aa=(yrep0+"thumbnails\")
Run/N explorer &aa
Set Defa To (yrep0)
Return
*Endcode
*-5-yregion_xor_roundrect_shadow.prg
*Begin code
If !Vartype(m.yrep0)="C"
Clea All
m.yrep0=Addbs(Justpath(Sys(16,1)))
Endi
Declare Integer Sleep In kernel32 Integer
Do Locfile("system.app")
Messagebox("this code convert an images folder to shadowed images roundrectangle ....",0+32,"",1000)
Set Classlib To
Set Classlib To Locfile["GDIPLUSX.VCX";
,"vcx"] Additive
If Directory(m.yrep0+"thumbnails")
Set Safe Off
zz=m.yrep0+"thumbnails\*.*"
Dele File (m.zz)
Set Safe On
Else
Md (m.yrep0+"thumbnails")
Endi
Local m.yrep,gnbre
m.yrep=Addbs(Getdir())
Set Defa To (yrep)
gnbre=Adir(gabase,"*.jpg")
If gnbre=0
Messagebox(m.yrep+ " is empty of images jpg !",0+16+4096,"error",1000)
Return .F.
Endi
Local m.xcolor
m.xcolor=_Screen.System.Drawing.Color.gold &&contour color
If Messagebox("Change color of contour (gold)?",4+32,"")=6
m.xcol=Getcolor()
If m.xcol#-1
m.xcolor=_Screen.System.Drawing.Color.fromRGB(m.xcol) &&contour color
Endi
Endi
Local m.ypicture
For i=1 To gnbre
m.ypicture=gabase(i,1)
With _Screen.System.Drawing
* Get an image file
Local loBmp As xfcBitmap
loBmp = .Bitmap.FromFile(ypicture)
* Create a Gfx object that will allow us to make the transformation
Local loGfx As xfcGraphics
loGfx = .Graphics.FromImage(loBmp)
Local lnWidth, lnHeight
lnWidth = loBmp.Width
lnHeight = loBmp.Height
* Create GraphicsPath object.
Local loClipPath As xfcGraphicsPath
loClipPath = .Drawing2D.GraphicsPath.New()
Local loShpath As xfcGraphicsPath
loShpPath = .Drawing2D.GraphicsPath.New()
* LPARAMETERS rc,r
Local x,Y,xwidth,xheight,xpath
x=loBmp.Width/10
Y=loBmp.Height/10
xwidth=loBmp.Width-2*x
xheight=loBmp.Height-2*Y
r=loBmp.Width/5
loGfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
rc = .Rectangle.New(x,Y,xwidth, xheight)
Local g As Graphics
Local p As Pen
x = rc.x
Y = rc.Y
xwidth = rc.Width
xheight = rc.Height
With _Screen.System.Drawing
xpath = .Drawing2D.GraphicsPath.New()
xpath.AddArc(x, Y, r, r, 180, 90) && Upper left corner
xpath.AddArc(x+xwidth - r, Y, r, r, 270, 90) && Upper right corner
xpath.AddArc(x+xwidth - r, Y+xheight - r, r, r, 0, 90) && Lower right corner
xpath.AddArc(x, Y+xheight - r, r, r, 90, 90) &&Lower left corner
xpath.CloseFigure()
Endwith
* An Ellipse shape
loClipPath.AddPath(xpath) &&addEllipse(0, 0, lnWidth, lnHeight)
* Set clipping region to path.
* CombineMode enumeration
* http://msdn.microsoft.com/en-us/library/system.drawing.drawing2d.combinemode.aspx
* CombineMode.Xor - Two clipping regions are combined by taking only the areas
* enclosed by one or the other region, but not both.
loGfx.SetClip(loClipPath,_Screen.System.Drawing.Drawing2D.CombineMode.Xor)
* Fill rectangle to demonstrate clipping region.
loGfx.FillRectangle( .Brushes.white, 0, 0, loBmp.Width, loBmp.Height)
&&draw contour
Pen=.Pen.New(xcolor,12)
loGfx.drawPath(Pen,xpath)
Pen.dispose()
*roundrectangle shadow
Local g As Graphics
Local p As Pen
Local delta
delta=20
x = rc.x+delta
Y = rc.Y+delta
xwidth = rc.Width
xheight = rc.Height
With _Screen.System.Drawing
ypath = .Drawing2D.GraphicsPath.New()
ypath.AddArc(x, Y, r, r, 180, 90) && Upper left corner
ypath.AddArc(x+xwidth - r, Y, r, r, 270, 90) && Upper right corner
ypath.AddArc(x+xwidth - r, Y+xheight - r, r, r, 0, 90) && Lower right corner
ypath.AddArc(x, Y+xheight - r, r, r, 90, 90) &&Lower left corner
ypath.CloseFigure()
Endwith
br = .SolidBrush.New(.Color.black)
loGfx.fillpath(br,ypath)
br.dispose()
* Get the resized version of the image
Local loResized As xfcBitmap
Local lnWidthv,lnHeightv && thumb dimensions
&&thumb dimensions
*local lnWidth,lnHeight
obmp=.Bitmap.New(ypicture)
lnWidthv=obmp.Width
lnHeightv=obmp.Height
loResized = .Bitmap.New(loBmp, lnWidthv, lnHeightv)
loResized.Save(yrep0+ ;
"thumbnails\"+Allt (m.ypicture),.Imaging.ImageFormat.JPEG)
Wait Window("Image :"+m.ypicture+"....... "+Trans(i)+"/"+Trans(gnbre)) At Srows()/6,Scols()/6 Nowait
Endwith
Endfor
Local m.aa
m.aa=(m.yrep0+"thumbnails\")
Run/N explorer &aa
Set Defa To (yrep0)
Return
*Endcode
*-6-yombreportee.prg
*Begin Code
Declare Integer Sleep In kernel32 Integer
Do Locfile("system.app")
If !Vartype(m.yrep0)="C"
m.yrep0=Addbs(Justpath(Sys(16,1)))
Endi
Messagebox("this code convert an images folder to shadowed .",0+32+4096,"",1000)
set classlib to
Set Classlib To Locfile("gdiplusX") Additive
If Directory(yrep0+"thumbnails")
Set Safe Off
Local m.zz
m.zz=yrep0+"thumbnails\*.*"
Dele File (m.zz)
Set Safe On
Else
Md (m.yrep0+"thumbnails")
Endi
Local m.yrep
m.yrep=Addbs(Getdir())
Set Defa To (yrep)
gnbre=Adir(gabase,"*.jpg") &&png,bmp,gif...
If gnbre=0
Messagebox(m.yrep+ " dont contains jpg images !",0+16+4096,"Error",1000)
Return .F.
Endi
If Vartype(_Screen.ocanvas1)="O"
_Screen.ocanvas1=Null
Release _Screen.ocanvas1
Endi
With _Screen
.AddObject("ocanvas1","ocanvas")
.AddProperty("ypicture","")
For i=1 To gnbre
.ypicture=gabase(i,1)
.ocanvas1.Draw()
Sleep(10)
Endfor
Endwith
Try
_Screen.ocanvas1=Null
Release _Screen. ocanvas1
Release Classlib "gdiplusX"
Catch
Set Classlib To
Endtry
aa=(yrep0+"thumbnails\")
Run/N explorer &aa &&show images with effects
Set Defa To (yrep0)
Return
*create the class
Define Class oCanvas As imgcanvas
Anchor = 15
Stretch = 2
Height = 511
Left = 9
Top = 5
Width = 783
smoothingmode = 0
drawWhenInvisible=.T.
Visible=.F.
Name = "ocanvas"
Procedure beforedraw
This.Picture=_Screen.ypicture
This.Stretch=2
This.smoothingmode=0
This.interpolationMode=7
With _Screen.System.Drawing
Local xcolor0,xcolor
xcolor0=.Color.white
xcolor1=.Color.black
Local x1,x2,x3,x4,x5
x1=15
x2=15
x3=5
x4=5
x5=5
&&thumb dimensions
*local lnWidth,lnHeight
*lnWidth=160
*lnHeight=120
&&dimensions vignettes
*local lnWidth,lnHeight
obmp=.Bitmap.new(_Screen.ypicture)
lnWidth=obmp.Width &&160
lnHeight=obmp.Height &&120
Local loFont As xfcFont
This.Clear()
* Create a bitmap in a fixed ratio to the original drawing area.
This.oGfx.Clear(xcolor0 )
Local loBmp As xfcBitmap
Local x
x=x5
loBmp = .Bitmap.new(This.Width / x, This.Height / x)
* Create a GraphicsPath object.
Local loPath As xfcGraphicsPath
loPath = .Drawing2D.GraphicsPath.new()
rec0=.rectangle.new(x1,x2,This.Width-2*x1,This.Height-2*x2)
loPath.addRectangle(rec0)
* Get the graphics object for the image.
Local loGfx As xfcGraphics
loGfx = .Graphics.FromImage(loBmp)
* Create a matrix that shrinks the drawing output by the fixed ratio.
Local loMatrix As xfcMatrix
loMatrix = .Drawing2D.Matrix.new(1/x, 0, 0, 1/x, -1/x, -1/x)
* Choose an appropriate smoothing mode for the halo.
loGfx.smoothingmode = .Drawing2D.smoothingmode.AntiAlias
* Transform the graphics object so that the same half may be used for both halo and text output.
loGfx.Transform = loMatrix
* Using a suitable pen...
Local loPen As xfcPen
loPen = .Pen.new(xcolor1)
* Draw around the outline of the path
loGfx.DrawPath(loPen, loPath)
* and then fill in for good measure.
loGfx.FillPath( .SolidBrush.new(xcolor1), loPath)
* setup the smoothing mode for path drawing
This.oGfx.smoothingmode = .Drawing2D.smoothingmode.AntiAlias
* and the interpolation mode for the expansion of the halo bitmap
This.oGfx.interpolationMode = .Drawing2D.interpolationMode.HighQualityBicubic
* expand the halo making the edges nice and fuzzy.
This.oGfx.DrawImage(loBmp, This.rectangle, 0, 0,loBmp.Width, loBmp.Height, .GraphicsUnit.Pixel)
* Redraw the original
This.oGfx.FillPath(.SolidBrush.new(xcolor1), loPath)
w=rec0.Width
h=rec0.Height
orec=.rectangle.new(x3,x4,w,h)
* Get the graphics object for the image.
This.oGfx.DrawImage(.Bitmap.fromfile(This.Picture),orec)
* Get the resized version of the image
Local loResized As xfcBitmap
loResized = .Bitmap.new(This.obmp, lnWidth, lnHeight)
loResized.Save(yrep0+ ;
"thumbnails\"+Allt(_Screen.ypicture),.Imaging.ImageFormat.JPEG)
Wait Window("Image "+_Screen.ypicture+"....... "+Trans(i)+"/"+Trans(gnbre)) At Srows()/6,Scols()/6 Nowait
Endwith
Endproc
Enddefine
*
*End code
*-7-yvignette.prg
*Begin Code
If !Vartype(m.yrep0)="C"
clea all
m.yrep0=Addbs(Justpath(Sys(16,1)))
Endi
Declare Integer Sleep In kernel32 Integer
Do Locfile("system.app")
Messagebox("this code convert an images folder to thumbnails 160x120",0+32,"Vignettes simples",1000)
set classlib to
Set Classlib To Locfile["GDIPLUSX.VCX";
,"vcx"] Additive
If Directory(m.yrep0+"thumbnails")
Set Safe Off
Local m.zz
m.zz=m.yrep0+"thumbnails\*.*"
Dele File (m.zz)
Set Safe On
Else
Md (m.yrep0+"thumbnails")
Endi
Publi gnbre
Local m.yrep
m.yrep=Addbs(Getdir())
Set Defa To (yrep)
gnbre=Adir(gabase,"*.jpg") &&png,bmp,gif...
If gnbre=0
Messagebox(m.yrep+ " dont contains jpg images !",0+16+4096,"Error",1000)
Return .F.
Endi
If Vartype(_Screen.ocanvas1)="O"
_Screen.ocanvas1=Null
Release _Screen.ocanvas1
Endi
With _Screen
.AddObject("ocanvas1","ocanvas")
.AddProperty("ypicture","")
For i=1 To gnbre
.ypicture=gabase(i,1)
.ocanvas1.Draw()
Sleep(10)
Endfor
Endwith
Try
_Screen.ocanvas1=Null
Release _Screen. ocanvas1
Release Classlib "gdiplusX"
Catch
Set Classlib To
Endtry
aa=(yrep0+"thumbnails\")
Run/N explorer &aa &&show images with effects
Set Defa To (yrep0)
Return
Define Class oCanvas As imgcanvas
Anchor = 15
Stretch = 2
Height = 511
Left = 9
Top = 5
Width = 783
smoothingmode = 0
interpolationMode=7
drawWhenInvisible=.T.
Visible=.F.
Name = "ocanvas"
Procedure beforedraw
This.Picture=_Screen.ypicture
With _Screen.System.drawing
Local xcolor0,xcolor
xcolor0=.Color.white
&&thumb dimensions
Local lnWidth,lnHeight
lnWidth=160 &&to adapt
lnHeight=120 &&to adapt
This.Clear()
This.oGfx.Clear(xcolor0 )
orec=.rectangle.new(0,0,lnWidth,lnHeight)
* Get the graphics object for the image.
loBMP=.Bitmap.fromfile(_Screen.ypicture)
loResized = .Bitmap.new(loBMP, lnWidth, lnHeight)
loResized.Save(m.yrep0+ ;
"thumbnails\"+Allt(_Screen.ypicture),.Imaging.ImageFormat.JPEG) &&jpeg,png,bmp,gif...
Wait Window("Image "+_Screen.ypicture+"....... "+Trans(i)+"/"+Trans(gnbre)) At Srows()/6,Scols()/6 Nowait
Endwith
Endproc
Enddefine
*End code
Gditexturebrush() :created on 04 of february 2017
gdipusX textureBrush is documented in
http://msdn2.microsoft.com/en-us/library/System.Drawing.TextureBrush.TextureBrush%28vs.80%29.aspx
https://msdn.microsoft.com/en-us/library/windows/desktop/ms534407(v=vs.85).aspx
it have many syntaxes documented in vfp9 gdiplusX system.drawing.prg
its available for gradientbrush and texturebrush and is using with filling area technics.
** Method: xfcTextureBrush.TextureBrush : Initializes a new TextureBrush object that uses the specified image.
** Parameters:
** Image bitmap
** Image image, Rectangle dstRect
** Image image, RectangleF dstRect
** Image image, WrapMode wrapMode
** Image image, Rectangle dstRect, ImageAttributes imageAttr
** Image image, RectangleF dstRect, ImageAttributes imageAttr
** Image image, WrapMode wrapMode, Rectangle dstRect
** Image image, WrapMode wrapMode, RectangleF dstRect
texturebrush want to say filling all background area with image (in respect of wrapmode value :
*!* https://msdn.microsoft.com/en-us/library/system.drawing.drawing2d.wrapmode(v=vs.80).aspx
*!* Clamp The texture or gradient is not tiled.
*!* Tile Tiles the gradient or texture.
*!* TileFlipX Reverses the texture or gradient horizontally and then tiles the texture or gradient.
*!* TileFlipXY Reverses the texture or gradient horizontally and vertically and then tiles the texture or gradient.
*!* TileFlipY Reverses the texture or gradient vertically and then tiles the texture or gradient.
to fill the area with one static image dont use textureBrush.
Click on code to select [then copy] -click outside to deselect
*8* created on 04 of february 2017
Set Classlib To Locfile("gdiplusX","vcx")
Publi yform
yform=Newobject("asup")
Release Classlib gdiplusX
yform.Show
Read Events
Retu
*
Define Class asup As Form
BorderStyle = 3
Height = 419
Width = 604
ShowWindow = 2
AutoCenter = .T.
Caption = ""
BackColor=0
Caption="Texturebrush()"
Name = "Form1"
Add Object imgcanvas1 As imgcanvas With ;
Anchor = 15, ;
Height = 421, ;
Left = -1, ;
Top = -1, ;
Width = 613, ;
Name = "Imgcanvas1"
Add Object combo1 As ComboBox With ;
FontBold = .T., ;
Height = 24, ;
Left = 483, ;
Top = 12, ;
Width = 57, ;
Name = "Combo1"
Add Object command1 As CommandButton With ;
FontBold = .T., ;
Height = 24, ;
Left = 20, ;
Top = 12, ;
Width = 57, ;
backcolor=Rgb(0,255,0), ;
caption="Get pict",;
Name = "Command1"
Procedure command1.Click
Thisform.imgcanvas1.ypict=Getpict()
Thisform.combo1.Value=1
Thisform.combo1.InteractiveChange
Endproc
Procedure imgcanvas1.Setup
This.AddProperty("ypict",Home(1)+"GRAPHICS\ICONS\ELEMENTS\SNOW.ICO")
Endproc
Procedure imgcanvas1.beforedraw
*!*wrapmode enumeration
*!* #DEFINE WrapModeTile 0
*!* #DEFINE WrapModeTileFlipX 1
*!* #DEFINE WrapModeTileFlipy 2
*!* #DEFINE WrapModeTileFlipXY 3
*!* #DEFINE WrapModeClamp 4
With _Screen.System.drawing
This.Clear()
loGfx=This.ogfx
Local lnwidth,lnHeight,x,Y
x=100
Y=50
lnwidth =400
lnHeight=300
Local img As xfcImage
img = .Image.FromFile(This.ypict)
Local tiWrapmode As EnumWrapMode
tiWrapmode=Thisform.combo1.Value
Local Rect As xfcRectangle
Rect=.rectangle.new(x,Y,lnwidth,lnHeight)
*system.drawing.prg syntax**>** Image image, WrapMode wrapMode, Rectangle dstRect
*syntax can be simple **>** Image image
*LPARAMETERS toImage AS xfcImage,tiWrapMode AS EnumWrapMode, toDstRect AS xfcRectangle
br= .TextureBrush.new(img,tiWrapmode,Rect)
loGfx.FillEllipse(br, Rect)
loGfx.drawEllipse(.Pen.new(.Color.red,3),Rect)
Endwith
Endproc
Procedure combo1.InteractiveChange
Thisform.imgcanvas1.Draw
Endproc
Procedure combo1.Init
With This
.AddItem("0")
.AddItem("1")
.AddItem("2")
.AddItem("3")
.AddItem("4")
.ListIndex=1
.Value=1
.Style=2
Endwith
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*
*-- EndDefine: asup
Click on code to select [then copy] -click outside to deselect
*9* created on 04 of february 2017
*clip ellipse or circle on any picture.
*for obtaining a circle use lnWidth=lnheight (or squared image)
DO LOCFILE("System.App")
local m.xpict
m.xpict=getpict()
if empty(m.xpict)
return .f.
endi
WITH _SCREEN.SYSTEM.Drawing
LOCAL loBmp AS xfcBitMap
loBmp = .BITMAP.FromFile(m.xpict)
LOCAL loGfx AS xfcGraphics
loGfx = .Graphics.FromImage(loBmp)
LOCAL lnWidth, lnHeight
lnWidth = loBmp.WIDTH
lnHeight = loBmp.HEIGHT
LOCAL loClipPath AS xfcGraphicsPath
loClipPath = .Drawing2d.GraphicsPath.New()
loClipPath.AddEllipse(0, 0, lnWidth, lnHeight)
loGfx.SetClip(m.loClipPath, .Drawing2d.CombineMode.xor)
loGfx.FillRectangle( .Brushes.White, 0, 0, loBmp.WIDTH, loBmp.HEIGHT)
loBmp.SAVE("result.png", .imaging.imageformat.PNG)
ENDWITH
*show
RUN /N Explorer.EXE result.png
Click on code to select [then copy] -click outside to deselect
*10* apply a default transparency to gdiplusX image object in above code.
*!* can apply the function MakeTransparent() function documented in
*!* http://msdn2.microsoft.com/en-us/library/System.Drawing.Bitmap.MakeTransparent%28vs.80%29.aspx
*!* its a system.drawing.prg function
*!* it apply the default color transparency to image object.
*!* it can be wthout parameter or with xfccolor parameter (color object).
*!* Bitmap.MakeTransparent () Makes the default transparent color transparent for this Bitmap.
*!* Bitmap.MakeTransparent (Color) Makes the specified color transparent for this Bitmap.
*!* below the adapted code with setting the white color as default transparncy color
*!*the result image is rsized(as you want) to make it with wanted dimensions (here squared as circular).
*!* the result is shown on a form...change the form backcolor to see the transparncy effect.
Clea All
Clea Resources && clear the last image retained in vfp cache
Do Locfile("System.App")
Local m.xpict
m.xpict=Getpict()
If Empty(m.xpict)
Return .F.
Endi
Publi m.yrep
m.yrep= Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
With _Screen.System.Drawing
Local loBMP1, loBmp As xfcBitMap
loBmp = .Bitmap.FromFile(m.xpict)
Local loGfx As xfcGraphics
loGfx = .Graphics.FromImage(loBmp)
Local lnWidth, lnHeight
lnWidth = loBmp.Width
lnHeight = loBmp.Height
Local loClipPath As xfcGraphicsPath
loClipPath = .Drawing2d.GraphicsPath.New()
loClipPath.AddEllipse(0, 0, lnWidth, lnHeight)
loGfx.SetClip(m.loClipPath, .Drawing2d.CombineMode.xor)
loGfx.FillRectangle( .Brushes.White, 0, 0, lnWidth, lnHeight)
loBmp.makeTransparent(.Color.White) && set transparency to white color
loBMP1=loBmp.getThumbnailImage(150,150) &&resize (circle)
loBMP1.Save("result.png", .imaging.imageformat.PNG)
Endwith
*show to see transparency on a form
Local oform As Form
oform=Newobject("asup")
oform.Show(1)
m.yrep=Null
Release m.yrep
Retu
Define Class asup As Form
DoCreate = .T.
Caption = "Test image transparency"
BackColor = Rgb(0,0,0)
BorderStyle=0
MaxButton=.F.
AutoCenter=.T.
Name = "Form1"
Add Object command1 As CommandButton With ;
anchor=0,;
Height = 27, ;
Left = 10, ;
Top = 10, ;
Width = 80, ;
mousepointer=15,;
backcolor=Rgb(0,255,0),;
caption="backcolor...",;
Name = "command1"
Add Object image1 As Image With ;
Anchor=0,;
Picture = m.yrep+"result.png", ;
Height = 100, ;
Left = 132, ;
Top = 60, ;
Width = 100, ;
Name = "Image1"
Procedure command1.Click
Thisform.BackColor=Getcolor()
Endproc
Enddefine