Advanced drawings with vfp gdiplusX
*I)
*this code makes many drawings ans fillings with gdiplusX using imgcanvas control class.
*-creates the main prg code and a prg class derived from Bo Durban code and a menu (mpr)
*-use the system.app functions
*-Drawing2D.GraphicsPath,Drawing2D.Matrix,Drawing2D.SmoothingMode,Drawing.PointF,Drawing2D.LinearGradientBrush
*-Drawing2D.PathGradientBrush,Drawing2D.Blend
*-Drawing.RectangleF,polygons,paths,random colors,makes animation with timer
*-draws texts along curves (paths)
*-saves drawings to show in MSPAINT (save as wanted) or to save directly as png unique file in source folder.
*Make sure you have the gdiplusX proj stable version (download in vfpx codeplex)
*the code ask you to point to gdiplusX.vcx and to run system.app before.
*Begin code
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Classlib To Locfile("gdiplusX") AddI
Publi yform
yform=Newobject("ydraw09")
Release Classlib "gdiplusX"
yform.Show
Read Events
Return
*
Define Class ydraw09 As Form
BorderStyle = 2
Top = 2
Left = -8
Height = 767
Width = 1024
ShowWindow = 2
ShowTips = .T.
Caption = "GdiPlusX drawings and fillings Yousfi Benameur November 26,2008"
KeyPreview = .T.
WindowState = 2
BackColor = Rgb(0,0,0)
ycolor1 = ""
ycolor2 = ""
nmode = 1
nbr = "15"
AutoR = 0
ycl = 0
Name = "FORM1"
Add Object imgcanvas1 As imgcanvas With ;
Anchor = 15, ;
Stretch = 2, ;
Height = 721, ;
Left = -24, ;
Top = 0, ;
Width = 1044, ;
Name = "Imgcanvas1"
Add Object command1 As CommandButton With ;
Top = 732, ;
Left = 352, ;
Height = 27, ;
Width = 84, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Switch colors", ;
BackColor = Rgb(0,255,0), ;
Name = "Command1"
Add Object timer1 As Timer With ;
Top = 720, ;
Left = 396, ;
Height = 23, ;
Width = 23, ;
Enabled = .F., ;
Interval = 500, ;
Name = "Timer1"
Add Object command2 As CommandButton With ;
Top = 732, ;
Left = 162, ;
Height = 27, ;
Width = 84, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "7 Effects", ;
ToolTipText = "ESC to stop", ;
BackColor = Rgb(0,0,255), ;
Name = "Command2"
Add Object command3 As CommandButton With ;
Top = 732, ;
Left = 440, ;
Height = 27, ;
Width = 113, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Swicth colors BW", ;
BackColor = Rgb(0,255,0), ;
Name = "Command3"
Add Object command4 As CommandButton With ;
Top = 731, ;
Left = 572, ;
Height = 27, ;
Width = 84, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Wrapped text", ;
ToolTipText = "6 cases wrapped text", ;
BackColor = Rgb(255,0,0), ;
Name = "Command4"
Add Object yb8 As CommandButton With ;
Top = 725, ;
Left = 683, ;
Height = 35, ;
Width = 36, ;
Anchor = 768, ;
Picture = Home(4)+"icons\misc\camera.ico", ;
Caption = "", ;
ToolTipText = "Capture image+View", ;
Name = "yb8"
Add Object command5 As CommandButton With ;
Top = 732, ;
Left = 744, ;
Height = 25, ;
Width = 73, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Save", ;
BackColor = Rgb(0,255,0), ;
Name = "Command5"
Procedure getpath
Lparameters rc,r
Local x,Y,xwidth,xheight,xpath
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
Return xpath
Endproc
Procedure ypolygon
Lparameters nb,r,pr
Create Cursor ycoord (nx N(4,0),ny N(4,0))
Set Safe On
xc=0.8*Thisform.Width
yc=1.1*Thisform.Height/2
For i=0 To 2*Pi() Step 2*Pi()/nb
x=xc+r*Cos(i-Pi()/2)
Y=yc+r*Sin(i-Pi()/2)
Sele ycoord
Appe Blan
Repl nx With x,ny With Y
x1=xc+pr*Cos(i-Pi()/2+Pi()/nb)
y1=yc+pr*Sin(i-Pi()/2+Pi()/nb)
Sele ycoord
Appe Blan
Repl nx With x1,ny With y1
Endfor
&&montage fichier polygon
Sele ycoord
Count To xx For Not Deleted()
Go Top
Dimension Mat0(xx,2)
i=1
v=""
Do While Not Eof()
If Not Deleted()
Mat0(i,1)=nx
Mat0(i,2)=ny
v=v+"Mat0("+Allt(Str(i))+",1)="+Allt(Str(nx))+Chr(13)+"Mat0("+Allt(Str(i))+",2)="+Allt(Str(ny))+Chr(13)
i=i+1
Endi
Skip
Enddo
vv="dimension Mat0("+Allt(Str(i-1))+",2)"+Chr(13) +v
TEXT to myvar noshow
<<vv>>
ENDTEXT
Endproc
Procedure ypoly
Lparameters nb,r,pr
Create Cursor ycoord1 (nx N(4,0),ny N(4,0))
Set Safe On
xc=0.2*Thisform.Width
yc=200
For i=0 To 2*Pi() Step 2*Pi()/nb
x=xc+r*Cos(i-Pi()/2)
Y=yc+r*Sin(i-Pi()/2)
x1=xc+1.5*pr*Cos(i-Pi()/2+Pi()/nb)
y1=yc+1.5*pr*Sin(i-Pi()/2+Pi()/nb)
Sele ycoord1
Appe Blan
Repl nx With x1,ny With y1
Endfor
&&montage fichier polygon
Sele ycoord1
Count To xx For Not Deleted()
Go Top
Dimension mat1(xx,2)
i=1
v=""
Do While Not Eof()
If Not Deleted()
mat1(i,1)=nx
mat1(i,2)=ny
v=v+"mat1("+Allt(Str(i))+",1)="+Allt(Str(nx))+Chr(13)+"mat1("+Allt(Str(i))+",2)="+Allt(Str(ny))+Chr(13)
i=i+1
Endi
Skip
Enddo
vv="dimension mat1("+Allt(Str(i-1))+",2)"+Chr(13) +v
TEXT to myvar1 noshow
<<vv>>
ENDTEXT
Endproc
Procedure yrandom
Clear
gnInférieur = 1
gnSupérieur = 255
nRed1=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
nGreen1=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
nBlue1=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
nRed2=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
nGreen2=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
nBlue2 =Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
Thisform.ycolor1=Rgb(nRed1,nGreen1,nBlue1)
Thisform.ycolor2=Rgb(nRed2,nGreen2,nBlue2)
Endproc
Procedure drawrappedtext
Lparameters nn
*original source from Bo Durban adapted in this form (thanks to Bo).
Set Proc To wrappedText.prg
Local wt As wrappedText && WrappedText engine for rendering flowing text
Local gp As xfcGraphicsPath && GraphicsPath to use as the guide
Local tp As xfcGraphicsPath && GraphicsPath that contains the wrapped text
Local gfx As xfcGraphics && Graphics object, used to draw to screen
Local bmp As xfcBitmap
Local mx As xfcMatrix
With _Screen.System.Drawing
** Guide path for the text to flow around
gp = .Drawing2D.GraphicsPath.New(1)
**************************
Do Case
Case nn = 1 && Ellipse
gp.AddArc(0,0,100,100,-180,360)
Case nn= 2 && Curve
gp.AddBezier(0,0,100,0,0,100,100,100)
Case nn = 3 && Rectangle
gp.AddRectangle(0,0,100,100)
Case nn = 4 && Line
gp.AddLine(0,0,100,100)
Case nn = 5 && Wave
gp.AddBezier(0,50,0,-25,33,-25,33,50)
gp.AddBezier(33,50,33,125,67,125,67,50)
gp.AddBezier(67,50,67,-25,100,-25,100,50)
Case nn = 6 && Letter "Y"
gp.AddString("Y",.FontFamily.New("Arial"),1,110,.Rectangle.New(-10,-10,100,100))
Endcase
*************************
mx = .Drawing2D.Matrix.New()
mx.Translate(50,50)
mx.Scale((Thisform.imgcanvas1.Width-100)/100,(Thisform.imgcanvas1.Height-100)/100)
gp.Transform(mx)
** Create a path to hold flowed text
tp = .Drawing2D.GraphicsPath.New(1)
** Create the WrappedText engine
wt = Createobject("WrappedText", gp)
wt.Font = .Font.New("Arial black,48,BI")
wt.Skew = 0
** Render the text to the GraphicsPath
nOffset = 0
xtext="Visual Foxpro can handle more and is always wonderful.GdiPlusX is cool!"
wt.GetPathText(tp, xtext, 0, 2)
If Vartype(Thisform.bmp) <> "O" ;
OR Thisform.bmp.Height <> Thisform.imgcanvas1.Height ;
OR Thisform.bmp.Width <> Thisform.imgcanvas1.Width
AddProperty(Thisform, "bmp", .Bitmap.New(Thisform.imgcanvas1.Width, Thisform.imgcanvas1.Height))
Endif
gfx = .Graphics.FromImage(Thisform.bmp)
gfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
gfx.Clear(.Color.black)
** Draw the base path for reference
gfx.DrawPath(.Pens.black,gp)
** Draw the text with random colors
gnInférieur = 1
gnSupérieur = 10
num=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
Do Case
Case num=1
yloBrush=".Brushes.gold"
Case num=2
yloBrush=".Brushes.blue"
Case num=3
yloBrush=".Brushes.green"
Case num=4
yloBrush=".Brushes.cyan"
Case num=5
yloBrush=".Brushes.red"
Case num=6
yloBrush=".Brushes.pink"
Case num=7
yloBrush=".Brushes.yellow"
Case num=8
yloBrush=".Brushes.white"
Case num=9
yloBrush=".Brushes.gray"
Case num=10
yloBrush=".Brushes.black"
Endcase
gfx.FillPath(&yloBrush,tp)
gfx.DrawPath(.Pens.red,tp)
**************
Thisform.bmp.Save(Thisform.imgcanvas1)
********
*image on imgcanvas is shown but is not in oBMP and not shown in mspaint or save !!!!!
*this code below avoids this pb
*********
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"temp.png"
Thisform.bmp.Save(m.lcdest,.imaging.imageformat.png)
logfx=Thisform.imgcanvas1.oGfx
loBMP=.Image.fromfile(m.lcdest)
m.w=loBMP.Width
m.h=loBMP.Height
logfx.drawImage(loBMP,0,0,m.w,m.h)
Endwith
Set Proc To
Endproc
Procedure Load
Do Locfile("system.app","app")
Endproc
Procedure KeyPress
Lparameters nKeyCode, nShiftAltCtrl
If nKeyCode=27
This.timer1.Enabled=.F.
Endi
Endproc
Procedure Init
Set Safe Off
Publi myvar,myVar1,Mat0,mat1
Thisform.SetAll("mousepointer",15,"commandbutton")
This.ycolor1=Rgb(255,0,0)
This.ycolor2=Rgb(0,255,0)
This.imgcanvas1.Left=0
This.imgcanvas1.Top=0
This.imgcanvas1.Width=This.Width
This.imgcanvas1.Height=This.Height-This.command1.Top
Thisform.nbr=15
******build wmenu.mpr*****
Local m.myvar
TEXT to m.myvar noshow
DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR 1 OF raccourci PROMPT "Ellipse"
DEFINE BAR 2 OF raccourci PROMPT "Curve"
DEFINE BAR 3 OF raccourci PROMPT "Rectangle"
DEFINE BAR 4 OF raccourci PROMPT "Line"
DEFINE BAR 5 OF raccourci PROMPT "Wave"
DEFINE BAR 6 OF raccourci PROMPT "Letter Y"
ON SELECTION BAR 1 OF raccourci ;
DO _2iz10zxt4 ;
IN LOCFILE("\ZZZYGDIPLUS\WMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is WMENU?")
ON SELECTION BAR 2 OF raccourci ;
DO _2iz10zxt5 ;
IN LOCFILE("\ZZZYGDIPLUS\WMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is WMENU?")
ON SELECTION BAR 3 OF raccourci ;
DO _2iz10zxt6 ;
IN LOCFILE("\ZZZYGDIPLUS\WMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is WMENU?")
ON SELECTION BAR 4 OF raccourci ;
DO _2iz10zxt7 ;
IN LOCFILE("\ZZZYGDIPLUS\WMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is WMENU?")
ON SELECTION BAR 5 OF raccourci ;
DO _2iz10zxt8 ;
IN LOCFILE("\ZZZYGDIPLUS\WMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is WMENU?")
ON SELECTION BAR 6 OF raccourci ;
DO _2iz10zxt9 ;
IN LOCFILE("\ZZZYGDIPLUS\WMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is WMENU?")
ACTIVATE POPUP raccourci
PROCEDURE _2iz10zxt4
wait window ("Wait a moment please!") nowait
_screen.activeform.autor=2
_screen.activeform.drawrappedtext(1)
*
PROCEDURE _2iz10zxt5
wait window ("Wait a moment please!") nowait
_screen.activeform.autor=2
_screen.activeform.drawrappedtext(2)
*
PROCEDURE _2iz10zxt6
wait window ("Wait a moment please!") nowait
_screen.activeform.autor=2
_screen.activeform.drawrappedtext(3)
*
PROCEDURE _2iz10zxt7
wait window ("Wait a moment please!") nowait
_screen.activeform.autor=2
_screen.activeform.drawrappedtext(4)
*
PROCEDURE _2iz10zxt8
wait window ("Wait a moment please!") nowait
_screen.activeform.autor=2
_screen.activeform.drawrappedtext(5)
*
PROCEDURE _2iz10zxt9
wait window ("Wait a moment please!") nowait
_screen.activeform.autor=2
_screen.activeform.drawrappedtext(6)
ENDTEXT
Strtofile(m.myvar,m.yrep+"wmenu.mpr")
*****************************************************
*create the prg class of wrapped text(adapted from Bo Durban class)
TEXT to m.myvar noshow
**************************************************************
** Sample
**************************************************************
IF VARTYPE(_SCREEN.System) <> "O"
DO LOCFILE("system.app")
ENDIF
LOCAL wt AS WrappedText && WrappedText engine for rendering flowing text
LOCAL gp AS xfcGraphicsPath && GraphicsPath to use as the guide
LOCAL tp AS xfcGraphicsPath && GraphicsPath that contains the wrapped text
LOCAL gfx AS xfcGraphics && Graphics object, used to draw to screen
WITH _SCREEN.System.Drawing
** Guide path for the text to flow around
gp = .Drawing2D.GraphicsPath.New(1)
gp.AddArc(200,80,500,500,-180+42,98)
*gp.AddBezier(20,40,800,20,20,300,800,300)
** Create a path to hold flowed text
tp = .Drawing2D.GraphicsPath.New(1)
** Create the WrappedText engine
wt = CREATEOBJECT("WrappedText", gp)
wt.Font = .Font.New("Bookman Old Style",80,1)
wt.Skew = 1.0
** Render the text to the GraphicsPath
nOffset = 0
wt.GetPathText(tp, "GDIPlusX", 0, 1, 7)
wt.GetPathText(tp, "is cool!!", 0, 3, 17)
gfx = .Graphics.FromHwnd(_SCREEN.HWnd)
gfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
gfx.Clear(.Color.White)
** Draw the base path for reference
gfx.DrawPath(.Pens.Gray,gp)
** Draw the text
gfx.FillPath(.Brushes.Orange,tp)
gfx.DrawPath(.Pens.Blue,tp)
ENDWITH
**************************************************************
DEFINE CLASS WrappedText AS Custom
****************************************************************
** Public Members
****************************************************************
Skew = 1.0 && Determines skew of the text
&& 0.0 = relative to path (no skew)
&& 1.0 = relative to top (characters lean to the top)
Font = NULL && Font used for text render
****************************************************************
FUNCTION Init(toGuidePath AS xfcGraphicsPath)
****************************************************************
** Parameters
** toGuidePath - The GraphicsPath to use as a guide for the wrapped text
IF VARTYPE(_SCREEN.System)<>"O"
DO LOCFILE("system.app")
ENDIF
IF VARTYPE(_SCREEN.System)<>"O"
ERROR "The GDIPlusX library is required for this class. Download from www.codeplex.com/VFPX"
ENDIF
This._oGuidePath = m.toGuidePath.Clone()
This._oGuidePath.Flatten(_SCREEN.System.Drawing.Drawing2D.Matrix.New(),1.5)
This._oGuidePathData = This._oGuidePath.PathData
ENDFUNC
****************************************************************
FUNCTION GetPathText(toPath AS xfcGraphicsPath, tcTextValue, tnIndent, tnTPos, tnCharSpacing)
****************************************************************
** Parameters
** toPath - The GraphicsPath to append the wrapped text to
** tcTextValue - The text to wrap
** tnIndent - The indent position on the guide path to start the wrapped text
** NOTE: If this parameter is passed by reference it will be updated with
** the indent position at the end of the rendered text. You can use this
** for subsequent calls, similar to VFP's _MLINE system variable.
** tnTPos - The baseline for the text relative to the guide path
** 1 - Above the guide path
** 2 - Center of guide path
** 3 - Below the guide path
** tnCharSpacing - (Optional) Spacing to use between characters.
** If -1, the default spacing is used
**
** Return Value
** Integer - Returns the number of characters rendered
****************************************************************
LOCAL lnPos, lnNewPos, lnCharIndex
This._nCharSpacing = IIF(PCOUNT() < 5, -1, m.tnCharSpacing)
m.toPath.FillMode = 1 && FillMode.Winding
m.lnPos = This.GetPathPosition(m.tnIndent)
FOR m.lnCharIndex = 1 TO LEN(m.tcTextValue)
m.lnNewPos = This.AddCharacter(SUBSTR(m.tcTextValue,m.lnCharIndex,1), m.toPath, m.lnPos, m.tnTPos)
IF m.lnNewPos < 0
EXIT
ENDIF
m.lnPos = m.lnNewPos
ENDFOR
m.tnIndent = This.GetPathIndent(m.lnPos)
RETURN m.lnCharIndex-1
ENDFUNC
****************************************************************
** Protected Members
****************************************************************
PROTECTED _oGuidePath
PROTECTED _oGuidePathData
_oGuidePath = NULL
_oGuidePathData = NULL
_nCharSpacing = -1
****************************************************************
FUNCTION Destroy()
This._oGuidePathData = NULL
This._oGuidePath = NULL
This.Font = NULL
ENDFUNC
****************************************************************
PROTECTED FUNCTION AddGlyph(tc, toLocation AS xfcPointF, toPath AS xfcGraphicsPath, tnTPos)
****************************************************************
LOCAL loGlyph AS xfcGraphicsPath
LOCAL loMX AS xfcMatrix
LOCAL loRect AS xfcRectangle
m.loGlyph = This.Glyph(m.tc, m.tnTPos)
m.loMX = _SCREEN.System.Drawing.Drawing2D.Matrix.New()
m.loMX.Translate(m.toLocation.X, m.toLocation.Y)
m.loGlyph.Transform(m.loMX)
IF m.tc != " "
m.toPath.AddPath(m.loGlyph,.F.)
ENDIF
m.loRect = m.loGlyph.GetBounds()
m.toLocation.X = m.toLocation.X + (m.loRect.Width/1)
m.toLocation.Y = m.toLocation.Y + (m.loRect.Height/1)
m.loGlyph.Dispose()
ENDFUNC
****************************************************************
PROTECTED FUNCTION Glyph(tc, tnTPos)
****************************************************************
LOCAL loPath AS xfcGraphicsPath
LOCAL loSF AS xfcStringFormat
LOCAL loPoint AS xfcPointF
LOCAL lnDrawPos
LOCAL loMat AS xfcMatrix
m.loPath = _SCREEN.System.Drawing.Drawing2D.GraphicsPath.New(1) && FillMode.Winding
m.loSF = _SCREEN.System.Drawing.StringFormat.New()
m.loSF = m.loSF.GenericTypographic
m.lnDrawPos = 0.0
DO CASE
CASE tnTPos = 2 && Center
m.lnDrawPos = -((This.Font.SizeInPoints*2)/3.0)
CASE tnTPos = 1 && Above
m.lnDrawPos = -This.Font.SizeInPoints
ENDCASE
m.loPoint = _SCREEN.System.Drawing.PointF.New(0.0,m.lnDrawPos)
IF m.tc = " "
m.tc = "-"
ENDIF
m.loPath.AddString(m.tc, This.Font.FontFamily, This.Font.Style, This.Font.SizeInPoints, m.loPoint, m.loSF)
IF m.tc = " "
m.loPath = _SCREEN.System.Drawing.Drawing2D.GraphicsPath.New()
ENDIF
RETURN m.loPath
ENDFUNC
****************************************************************
PROTECTED FUNCTION LineSegmentCircle(topntA AS xfcPointF, topntB AS xfcPointF, tocenter AS xfcPointF, tnr2)
****************************************************************
LOCAL lna, lnb, lnc, lnD, lnt, lnsqrtD, lnt1, lnt2
LOCAL lnrA2, lnrB2, lnDiffX, lnDiffY
m.topntA.X = m.topntA.X - m.tocenter.X
m.topntA.Y = m.topntA.Y - m.tocenter.Y
m.topntB.X = m.topntB.X - m.tocenter.X
m.topntB.Y = m.topntB.Y - m.tocenter.Y
m.lnrA2 = (m.topntA.X * m.topntA.X) + (m.topntA.Y * m.topntA.Y)
m.lnrB2 = (m.topntB.X * m.topntB.X) + (m.topntB.Y * m.topntB.Y)
IF((m.lnrA2 > m.tnr2 AND m.lnrB2 > m.tnr2) OR (m.lnrA2 < m.tnr2 AND m.lnrB2 < m.tnr2))
RETURN -1
ENDIF
m.lnDiffX = m.topntB.X - topntA.X
m.lnDiffY = m.topntB.Y - topntA.Y
m.lna = (m.lnDiffX * m.lnDiffX)+(m.lnDiffY * m.lnDiffY)
m.lnb = 2 * ((m.topntA.X * m.lnDiffX) + (m.topntA.Y * m.lnDiffY))
m.lnc = m.lnrA2 - m.tnr2
m.lnD = (m.lnb * m.lnb) - (4 * m.lna * m.lnc)
m.lnt = -1
IF (m.lnD == 0)
m.lnt = -m.lnb /(2 * m.lna)
ELSE
IF (m.lnD > 0)
m.lnsqrtD = SQRT(m.lnD)
m.lnt1 = (-m.lnb + m.lnsqrtD)/(2 * m.lna)
m.lnt2 = (-m.lnb - m.lnsqrtD)/(2 * m.lna)
IF (m.lnt1>= 0 AND m.lnt1 <= 1)
IF (m.lnt2 >= 0 AND m.lnt2 < m.lnt1)
m.lnt = m.lnt2
ELSE
m.lnt = m.lnt1
ENDIF
ELSE
IF (m.lnt2 >= 0 AND m.lnt2 <= 1)
m.lnt = m.lnt2
ENDIF
ENDIF
ENDIF
ENDIF
RETURN m.lnt
ENDFUNC
****************************************************************
PROTECTED FUNCTION AddCharacter(tcChar, toPath AS xfcGraphicsPath, tnPosition, tnTPos)
****************************************************************
LOCAL lnWCell, lnPosRight, lncosPhi, lnsinPhi, lnM21, lnM22
LOCAL lopntOrigin AS xfcPointF
LOCAL loPathGlyph AS xfcGraphicsPath
LOCAL loPntLeft AS xfcPointF
LOCAL loPntRight aS xfcPointF
LOCAL lomx AS xfcMatrix
m.loPntOrigin = _SCREEN.System.Drawing.PointF.New(0.0, 0.0)
m.loPathGlyph = _SCREEN.System.Drawing.Drawing2D.GraphicsPath.New()
This.AddGlyph(m.tcChar, @m.loPntOrigin, m.loPathGlyph, m.tnTPos)
IF This._nCharSpacing = -1
m.lnWCell = m.loPntOrigin.X+(This.Font.Size/8)
ELSE
m.lnWCell = m.loPntOrigin.X+This._nCharSpacing
ENDIF
IF (m.lnWCell == 0)
RETURN -1.0
ENDIF
m.lnPosRight = This.FindNextPosition(m.tnPosition, m.lnWCell)
IF (m.tcChar != " ")
IF (m.lnPosRight < 0)
RETURN m.lnPosRight
ENDIF
m.loPntLeft = This.GetPathPoint(m.tnPosition)
m.loPntRight = This.GetPathPoint(m.lnPosRight)
m.lncosPhi = (m.loPntRight.X - loPntLeft.X)/m.lnWCell
m.lnsinPhi = (m.loPntRight.Y - loPntLeft.Y)/m.lnWCell
m.lnm21 = -(1-This.Skew) * m.lnsinPhi
m.lnm22 = 1 + (1-This.Skew) * (m.lncosPhi-1)
m.lomx = _SCREEN.System.Drawing.Drawing2D.Matrix.New( ;
m.lncosPhi,m.lnsinPhi, ;
m.lnm21,m.lnm22, ;
m.loPntLeft.X,m.loPntLeft.Y)
m.loPathGlyph.Transform(m.lomx)
m.toPath.AddPath(m.loPathGlyph,.F.)
ENDIF
RETURN m.lnPosRight
ENDFUNC
****************************************************************
PROTECTED FUNCTION GetPathPoint(tnPosition)
****************************************************************
LOCAL lor AS xfcPointF
LOCAL lor2 AS xfcPointF
LOCAL lopd AS xfcPathData
LOCAL liSegment, lnt
m.lor = _SCREEN.System.Drawing.PointF.New(0.0,0.0)
IF m.tnPosition < 0
RETURN m.lor
ENDIF
m.liSegment = FLOOR(m.tnPosition)
IF (m.liSegment < This._oGuidePath.PointCount)
m.lopd = This._oGuidePathData
m.lor = m.lopd.Points[m.liSegment]
m.lor2 = m.lopd.Points[m.liSegment+1]
m.lnt = m.tnposition - m.liSegment
m.lor.X = m.lor.X + m.lnt * (m.lor2.X - m.lor.X)
m.lor.Y = m.lor.Y + m.lnt * (m.lor2.Y - m.lor.Y)
ENDIF
RETURN m.lor
ENDFUNC
****************************************************************
PROTECTED FUNCTION GetPathPosition(tnIndent)
****************************************************************
LOCAL lopd AS xfcPathData
LOCAL lnDiffX, lnDiffY, lnLength, lni
m.lopd = This._oGuidePathData
FOR lni = 1 TO This._oGuidePath.PointCount -1
m.lnDiffX = m.lopd.Points[lni].X - m.lopd.Points[lni+1].X
m.lnDiffY = m.lopd.Points[lni].Y - m.lopd.Points[lni+1].Y
m.lnlength = SQRT((m.lnDiffX*m.lnDiffX)+(m.lnDiffY*m.lnDiffY))
IF m.tnIndent < m.lnLength
RETURN m.lni+m.tnIndent/m.lnLength
ENDIF
m.tnIndent = m.tnIndent - m.lnLength
ENDFOR
RETURN -1
ENDFUNC
****************************************************************
PROTECTED FUNCTION GetPathIndent(tnPosition)
****************************************************************
LOCAL lopd AS xfcPathData
LOCAL lnDiffX, lnDiffY, lnLength, lni, liSegment, lnLengthTot
m.lopd = This._oGuidePathData
m.liSegment = FLOOR(m.tnPosition)
m.lnLengthTot = 0
FOR m.lni = 1 TO m.liSegment
m.lnDiffX = m.lopd.Points[lni].X - m.lopd.Points[lni+1].X
m.lnDiffY = m.lopd.Points[lni].Y - m.lopd.Points[lni+1].Y
m.lnLength = SQRT((m.lnDiffX*m.lnDiffX)+(m.lnDiffY*m.lnDiffY))
IF m.lni = m.liSegment
m.lnLengthTot = m.lnLengthTot + ((m.tnPosition-m.liSegment)*m.lnLength)
EXIT
ENDIF
m.lnLengthTot = m.lnLengthTot + m.lnLength
ENDFOR
RETURN m.lnLengthTot
ENDFUNC
****************************************************************
PROTECTED FUNCTION FindNextPosition(tnPos, tnRadius)
****************************************************************
LOCAL liStartSegment
LOCAL lopd AS xfcPathData
LOCAL lopntStart AS xfcPointF
LOCAL lnr2, lnr2Right, lnrRight, lnr2LEft, lnrLeft, lnt
LOCAL lnDiffX, lnDiffY
IF m.tnPos < 0
RETURN -1
ENDIF
m.liStartSegment = FLOOR(m.tnPos)
IF (m.liStartSegment >= This._oGuidePath.PointCount)
RETURN -1
ENDIF
m.lopd = This._oGuidePathData
m.lopntStart = This.GetPathPoint(m.tnPos)
m.lnr2 = m.tnRadius*m.tnRadius
m.lnDiffX = m.lopntStart.X - m.lopd.Points[m.liStartSegment+1].X
m.lnDiffY = m.lopntStart.Y - m.lopd.Points[m.liStartSegment+1].Y
m.lnr2Right = (m.lnDiffX*m.lnDiffX)+(m.lnDiffY*m.lnDiffY)
IF (m.lnr2 < m.lnr2Right)
m.lnDiffX = m.lopntStart.X - m.lopd.Points[m.liStartSegment].X
m.lnDiffY = m.lopntStart.Y - m.lopd.Points[m.liStartSegment].Y
m.lnr2Left = (m.lnDiffX*m.lnDiffX) + (m.lnDiffY*m.lnDiffY)
m.lnrLeft = SQRT(m.lnr2Left)
m.lnrRight = SQRT(m.lnr2Right)
RETURN m.liStartSegment + 1.0 - (m.lnrRight - m.tnRadius)/(m.lnrRight+m.lnrLeft)
ENDIF
FOR m.lni = m.liStartSegment+1 TO This._oGuidePath.PointCount-1
m.lnt = This.LineSegmentCircle(m.lopd.Points[m.lni],m.lopd.Points[m.lni+1],m.lopntStart,m.lnr2)
IF (m.lnt >= 0)
RETURN m.lni+m.lnt
ENDIF
ENDFOR
RETURN -1
ENDFUNC
ENDDEFINE
ENDTEXT
Strtofile(m.myvar,m.yrep+"wrappedText.prg")
************************************
Endproc
Procedure imgcanvas1.beforedraw
Do Case
Case Thisform.AutoR=2
Thisform.drawwrappedText()
Otherwise
Local nbr,x,Y,xwidth,xheight,r,ra
Local br
Local rc
Local logfx
Local path1
logfx=This.oGfx
nbr=Thisform.nbr
Thisform.ypoly(nbr,180,120)
Thisform.ypolygon(nbr,180,95)
****************************
x=5
Y=5
xwidth=300
xheight=200
r=40
This.Clear()
logfx=This.oGfx
With _Screen.System.Drawing
logfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
rc = .Rectangle.New(x,Y,xwidth, xheight)
path1 = Thisform.getpath(rc, r)
*draw star
gnInférieur = 1
gnSupérieur = 10
num=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
Do Case
Case num=1
yloBrush=".Brushes.gold"
Case num=2
yloBrush=".Brushes.blue"
Case num=3
yloBrush=".Brushes.green"
Case num=4
yloBrush=".Brushes.cyan"
Case num=5
yloBrush=".Brushes.red"
Case num=6
yloBrush=".Brushes.pink"
Case num=7
yloBrush=".Brushes.yellow"
Case num=8
yloBrush=".Brushes.white"
Case num=9
yloBrush=".Brushes.gray"
Case num=10
yloBrush=".Brushes.black"
Endcase
***********
If Thisform.AutoR=1
color1=.Color.fromRGB(Thisform.ycolor1)
color2=.Color.fromRGB(Thisform.ycolor2)
br = .Drawing2D.LinearGradientBrush.New(This.Rectangle,color1,color2,Thisform.nmode,.F.)
* br.SetBlendTriangularShape(0.5,1.0)
logfx.FillRectangle(br,This.Rectangle)
br.Dispose()
Else
This.Clear(.Color.black)
Endi
This.oGfx.FillPolygon(&yloBrush, @Mat0)
Pen = .Pen.New(.Color.red, 4)
logfx.DrawPolygon(Pen, @Mat0)
Pen.Dispose()
Pen = .Pen.New(.Color.red, 4)
logfx.DrawPolygon(Pen, @mat1)
Pen.Dispose()
pth = .Drawing2D.GraphicsPath.New()
Dimension points(Alen(mat1)-2)
For i=1 To Alen(mat1)-2 Step 4
pth.AddLine(.Point.New( mat1(i),mat1(i+1)) ,.Point.New(mat1(i+2),mat1(i+3)))
Endfor
pth.CloseFigure
pgb=.Drawing2D.PathGradientBrush.New(pth)
pgb.CenterColor=.Color.fromRGB(Thisform.ycolor1)
pgb.SurroundColors=.Color.fromRGB(Thisform.ycolor2)
bl=.Drawing2D.Blend.New()
bl.Factors=_Screen.System.Single.newArray(1,0,1,0,1)
bl.Positions= _Screen.System.Single.newArray(0,0.25,0.5,0.75,1)
pgb.Blend=bl
logfx.FillPath(pgb,pth)
pgb.Dispose
*texte
Local lcStyle
lcStyle = "BI"
xtext="GdiPlusX under Visual Foxpro 9"
xfont="Arial Black"
xsize=32
epaisseur=4
Local loFont As xfcFont
Local lostyle
lostyle = .FontStyle.BoldItalic
* Create a GraphicsPath object.
Local loPath As xfcGraphicsPath
loPath = .Drawing2D.GraphicsPath.New()
* Add the string in the chosen style.
loPath.AddString(xtext,.FontFamily.New(xfont),lostyle,xsize,.Point.New(50,620))
tncolor1=.Color.fromRGB(Thisform.ycolor1)
tncolor2=.Color.fromRGB(Thisform.ycolor2)
* Using a suitable pen...
Local loPen As xfcPen
loPen = .Pen.New(tncolor1,epaisseur)
* Choose an appropriate smoothing mode for the border.
This.oGfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
* Draw around the outline of the path
This.oGfx.DrawPath(loPen, loPath)
* Redraw the original text
This.oGfx.FillPath(.SolidBrush.New(tncolor2), loPath)
ystring="Yousfi Benameur November,2008"
loFont = .Font.New("tahoma", 9, .FontStyle.BoldItalic)
loSizeF = logfx.MeasureString(ystring, loFont)
loRectangleF =_Screen.System.Drawing.RectangleF.New(This.Width-loSizeF.Width-10,This.Height-loSizeF.Height-5,loSizeF.Width, loSizeF.Height)
loBrush = .Drawing2D.LinearGradientBrush.New(loRectangleF,.Color.red,.Color.green,3)
logfx.DrawString(ystring, loFont,loBrush, loRectangleF)
Endwith
Endcase
Return
Endproc
Procedure command1.Click
&&random color
Thisform.AutoR=0
Thisform.yrandom()
Thisform.nmode=Thisform.nmode+1
If Thisform.nmode>3
Thisform.nmode=1
Endi
gnInférieur = 5
gnSupérieur = 50
Thisform.nbr=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
Thisform.imgcanvas1.Draw()
Thisform.Refresh
Endproc
Procedure timer1.Timer
With Thisform
.ycl=.ycl+1
If .ycl>7
.ycl=0
This.Enabled=.F.
Else
Thisform.command1.Click()
Endi
Endwith
Endproc
Procedure command2.Click
Thisform.timer1.Enabled=.T.
Thisform.Refresh
Endproc
Procedure command3.Click
&&random color
Thisform.AutoR=1
Thisform.ycolor1=0
Thisform.ycolor2=Rgb(255,255,255)
Thisform.nmode=Thisform.nmode+1
If Thisform.nmode>3
Thisform.nmode=1
Endi
gnInférieur = 5
gnSupérieur = 50
Thisform.nbr=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
Thisform.imgcanvas1.Draw()
Thisform.Refresh
Endproc
Procedure command4.Click
Do wmenu.mpr
Thisform.Refresh
Endproc
Procedure yb8.Click
Thisform.imgcanvas1.obmp.toclipboard()
Run/n3 mspaint
Inkey(2)
loShell=Createobject("wscript.shell")
loShell.sendKeys("^{v}")
Endproc
Procedure command5.Click
*save contents as PNG in source folder
Thisform.Refresh
Local m.lcdest
m.lcdest=m.yrep+"ycap"+Sys(2015)+".png"
With _Screen.System.Drawing
Thisform.imgcanvas1.obmp.Save(m.lcdest,.imaging.imageformat.png)
Messagebox(m.lcdest,0+32+4096,"saved",500)
Endwith
Endproc
Procedure Destroy
Clea Events
Endproc
Enddefine
*
*End code
*II)This code draws random multi linear gradients on a triangle.
*it uses the imgcanvas contol class of gsiplusX
*it uses random colors
*can view the drawing surfca eon Mspaint or save directly to an unique png picture in source folder
*subjects used in this code
*-Drawing.rectangleF,Drawing2D.linearGradientbrush,
*-fonts,fontstyle, mesureString,drawString
*-Color.fromRG,interpolati on
*-path,drawPath,fillPath,points array,addline,closefigure,Drawing2D.ColorBlend
*Begin code
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
Set Classlib To Locfile("gdiplusX.vcx") AddI
Publi yform
yform=Newobject("ytest06")
Release Classlib "gdiplusX"
yform.Show
Read Events
Return
*
Define Class ytest06 As Form
Height = 573
Width = 816
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Caption = "multiLinearGradient sample for a triangle "
BackColor = Rgb(0,0,0)
ycolor1 = 255
ycolor2 = 4521
nmode = 1
Name = "Form1"
Add Object imgcanvas1 As imgcanvas With ;
Anchor = 15, ;
Stretch = 2, ;
Height = 527, ;
Left = 0, ;
Top = 0, ;
Width = 816, ;
Name = "Imgcanvas1"
Add Object command1 As CommandButton With ;
Top = 540, ;
Left = 84, ;
Height = 27, ;
Width = 108, ;
Anchor = 768, ;
Caption = "Swith 10 colors", ;
BackColor = Rgb(255,128,0), ;
Name = "Command1"
Add Object yb8 As CommandButton With ;
Top = 532, ;
Left = 324, ;
Height = 35, ;
Width = 36, ;
Anchor = 768, ;
Picture = (Home(4)+"icons\misc\camera.ico"), ;
Caption = "", ;
ToolTipText = "Capture image+View", ;
Name = "yb8"
Add Object command5 As CommandButton With ;
Top = 540, ;
Left = 384, ;
Height = 25, ;
Width = 73, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Save", ;
BackColor = Rgb(0,255,0), ;
Name = "Command5"
Procedure yrandom
nRed1 = Int(255*Rand())
nGreen1=Int(255*Rand())
nBlue1=Int(255*Rand())
nRed2 =Int(255*Rand())
nGreen2=Int(255*Rand())
nBlue2 =Int(255*Rand())
Thisform.ycolor1=Rgb(nRed1,nGreen1,nBlue1)
Thisform.ycolor2=Rgb(nRed2,nGreen2,nBlue2)
Endproc
Procedure Init
With Thisform
.SetAll("mousepointer",15,"commandbutton")
.yrandom()
Endwith
Endproc
Procedure imgcanvas1.beforedraw
This.Clear
logfx=This.ogfx
With _Screen.System.Drawing
This.ogfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
This.Clear(.Color.black)
Local br As xfcLinearGradientBrush
Local rc As xfcRectangleF
Local color1,color2,color3,color4,color5,color6,color7,color8,color9 ,color10 As xfcColors
ypath = .Drawing2D.GraphicsPath.New()
Y=This.Height-25
x=10
Dimension points(3)
points(1)=.Point.New(x,Y)
points(2)=.Point.New(x+This.Width-20,Y)
points(3)=.Point.New(This.Width/2,10)
ypath.addlines(@points)
ypath.CloseFigure()
*****
*draw
Pen = .Pen.New(.Color.gold, 6)
logfx.DrawPath(Pen,ypath)
&&10 couleurs
rc = .Rectangle.New(0,0,This.Width,This.Height)
br = .Drawing2D.LinearGradientBrush.New(rc,.Color.black,.Color.black,0,.F.)
cb = .Drawing2D.ColorBlend.New(10)
Thisform.yrandom()
color1=.Color.fromRGB(Thisform.ycolor1)
Thisform.yrandom()
color2=.Color.fromRGB(Thisform.ycolor1)
Thisform.yrandom()
color3=.Color.fromRGB(Thisform.ycolor1)
Thisform.yrandom()
color4=.Color.fromRGB(Thisform.ycolor1)
Thisform.yrandom()
color5=.Color.fromRGB(Thisform.ycolor1)
Thisform.yrandom()
color6=.Color.fromRGB(Thisform.ycolor1)
Thisform.yrandom()
color7=.Color.fromRGB(Thisform.ycolor1)
Thisform.yrandom()
color8=.Color.fromRGB(Thisform.ycolor1)
Thisform.yrandom()
color9=.Color.fromRGB(Thisform.ycolor1)
Thisform.yrandom()
color10 =.Color.fromRGB(Thisform.ycolor1)
For i = 1 To 10
cb.Positions[i] = (i - 1)/9
cb.ColorS=.Color.NewArray(color1,color2,color3,color4,color5,color6,color7,color8,color9,color10)
br.InterpolationColors = cb
logfx.FillPath(br,ypath)
Endfor
*texte
Local loFont,loFont1 As xfcFont
Local loBrush,loBrush1 As xfcLinearGradientBrush
Local loRectangleF,loRectangleF1 As xfcRectangleF
Local loSizeF,loSizeF1 As xfcSizeF
ystring="GdiPlusX under Visual Foxpro 9 "
ystring1="That's all folks !"
loFont = .Font.New("Arialk",14 ,.FontStyle.BoldItalic)
loFont1 = .Font.New("Batavia",24 ,.FontStyle.Bold) && **************///////////////
loSizeF = logfx.MeasureString(ystring, loFont)
loSizeF1 = logfx.MeasureString(ystring1, loFont1)
loRectangleF =_Screen.System.Drawing.RectangleF.New(0,0,loSizeF.Width, loSizeF.Height)
loRectangleF1=_Screen.System.Drawing.RectangleF.New(10,This.Height/10,loSizeF1.Width, loSizeF1.Height)
loBrush = .Drawing2D.LinearGradientBrush.New(loRectangleF,;
.Color.fromRGB(Thisform.ycolor1), ;
.Color.fromRGB(Thisform.ycolor2),;
thisform.nmode)
loBrush1 = .Drawing2D.LinearGradientBrush.New(loRectangleF1,;
.Color.fromRGB(Thisform.ycolor1), ;
.Color.fromRGB(Thisform.ycolor2),;
thisform.nmode)
logfx.DrawString(ystring, loFont,loBrush, loRectangleF)
logfx.DrawString(ystring1, loFont1,loBrush1, loRectangleF1)
ystring="Yousfi Benameur November,2008"
loFont = .Font.New("tahoma", .FontStyle.BoldItalic)
loSizeF = logfx.MeasureString(ystring, loFont)
loRectangleF =_Screen.System.Drawing.RectangleF.New(This.Width-loSizeF.Width-10,This.Height-loSizeF.Height-5,loSizeF.Width, loSizeF.Height)
loBrush = .Drawing2D.LinearGradientBrush.New(loRectangleF,.Color.red,.Color.green,3)
logfx.DrawString(ystring, loFont,loBrush, loRectangleF)
Endwith
Return
Endproc
Procedure command1.Click
&&random color
Thisform.yrandom()
Thisform.imgcanvas1.Draw()
Endproc
Procedure yb8.Click
Thisform.imgcanvas1.obmp.toclipboard()
Run/n3 mspaint
Inkey(2)
loShell=Createobject("wscript.shell")
loShell.sendKeys("^{v}")
Endproc
Procedure command5.Click
*save contents as PNG in source folder
Local m.lcdest
m.lcdest=m.yrep+"ycap"+Sys(2015)+".png" &&unique file picture in source folder
With _Screen.System.Drawing
Thisform.imgcanvas1.obmp.Save(m.lcdest,.imaging.imageformat.PNG)
Messagebox(m.lcdest,0+32+4096,"saved",500)
Endwith
Endproc
Procedure destroy
clea events
endproc
Enddefine
*
*End code
