Yet another gradients samples

Published on by Yousfi Benameur

Yet another gradients samples

Click on code to select [then copy] -click outside to deselect


*1*
*i use this sample to build some gradient based images.
*this code draws with vfp native functions 10 random gradients (case choose in the spinner simple gradients or buttons type gradients)
*can capture with the windows10 capture tool (snippingtool.exe) any gradient as picture(png,bmp,jpg,gif..)

If ! _vfp.StartMode=0
    On Shutdown Quit
Endi
_screen.windowstate=1
Publi yform
yform=Newobject("ygrads")
yform.Show
Read Events
Retu
*
Define Class ygrads As Form
	BorderStyle = 3
	Height = 652
	Width = 641
	ShowWindow = 2
	MaxButton=.T.
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "Clcik to Draw 10 brightness random colors like gradient with native vfp"
	Name = "Form1"

	Add Object command3 As CommandButton With ;
		Anchor=768,;
		Top = 613, ;
		Left = 43, ;
		Height = 32, ;
		Width = 84, ;
		FontBold = .T., ;
		WordWrap = .T., ;
		Caption = "10  Random Colors", ;
		MousePointer = 15, ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command3"

	Add Object command4 As CommandButton With ;
		Anchor=768,;
		Top = 613, ;
		Left = 130, ;
		Height = 32, ;
		Width = 84, ;
		FontBold = .T., ;
		Caption = "Capture", ;
		MousePointer = 15, ;
		BackColor = Rgb(255,128,0), ;
		Name = "Command4"

	Add Object spinner1 As Spinner With ;
		Anchor=768,;
		Height = 24, ;
		KeyboardHighValue = 2, ;
		KeyboardLowValue = 1, ;
		Left = 2, ;
		SpinnerHighValue =   2.00, ;
		SpinnerLowValue =   1.00, ;
		ToolTipText = "2:mono dra,1: button", ;
		Top = 613, ;
		Width = 37, ;
		Value = 1, ;
		Name = "Spinner1"

	Procedure Destroy
	Clea Events
	Endproc

	Procedure command3.Click
	With Thisform
		For i=1 To .ControlCount
			Try
				Thisform.RemoveObject(Eval("Thisform.oo"+Trans(i)+".Name"))
			Catch
			Endtry
		Endfor
	Endwith

	Local m.baseRGB
	Rand(-1)
	For j=1 To 10
		Do Case

		Case j=1
			m.baseRGB=Rgb(255*Rand(),255*Rand(),255*Rand())
		Case j=2
			m.baseRGB=Rgb(255*Rand(),255*Rand(),255*Rand())
		Case j=3
			m.baseRGB=Rgb(255*Rand(),255*Rand(),255*Rand())
		Case j=4
			m.baseRGB=Rgb(255*Rand(),255*Rand(),255*Rand())
		Case j=5
			m.baseRGB=Rgb(255*Rand(),255*Rand(),255*Rand())
		Case j=6
			m.baseRGB=Rgb(255*Rand(),255*Rand(),255*Rand())
		Case j=7
			m.baseRGB=Rgb(255*Rand(),255*Rand(),255*Rand())
		Case j=8
			m.baseRGB=Rgb(255*Rand(),255*Rand(),255*Rand())
		Case j=9
			m.baseRGB=Rgb(255*Rand(),255*Rand(),255*Rand())
		Case j=10
			m.baseRGB=Rgb(255*Rand(),255*Rand(),255*Rand())
		Endcase

*Set Proc To yc Additive
		With Thisform
			.AddObject("oo"+Trans(j),"asup")
			ooc=Eval(".oo"+Trans(j))
			With ooc
				.Left=250
				.Top=2+(j-1)*(.Height+2)
				.Width=250
				.Height=60

				If Thisform.spinner1.Value=2
*ooc.Height=60
					ooc.container2.Visible=.F.
					ooc.container1.Height=ooc.Height
				Else
					ooc.container2.Visible=.T.
					ooc.container1.Height=30
				Endi
				.Visible=.T.
			Endwith
		Endwith
*Release Proc yc

		Thisform.Cls
		Thisform.FontSize=10
		i=0
		For lnAlgorithm = 1 To 2
			lnTestcolor=1

* Our amount to increase (percentage)
			For lnPercent = -50 To 50
				i=i+1
* Grab base color's channel components
				rootR =           Bitand(baseRGB, 0x0000ff)
				rootG = Bitrshift(Bitand(baseRGB, 0x00ff00), 8)
				rootB = Bitrshift(Bitand(baseRGB, 0xff0000), 16)

				If lnAlgorithm = 1
* Increase each color channel by a fixed percentage
					newR = Max(Min(255, rootR + (255 * (lnPercent/100))), 0)
					newG = Max(Min(255, rootG + (255 * (lnPercent/100))), 0)
					newB = Max(Min(255, rootB + (255 * (lnPercent/100))), 0)
				Else
* Increase each color channel by its relative percentage
					newR = Max(Min(255, rootR + (rootR * (lnPercent/100))), 0)
					newG = Max(Min(255, rootG + (rootG * (lnPercent/100))), 0)
					newB = Max(Min(255, rootB + (rootB * (lnPercent/100))), 0)
				Endif

* Reassemble the color channel into the RGB value
				newRGB = Rgb(newR,newG,newB)

				Do Case
				Case  lnAlgorithm=1
					With ooc.container1
						.AddObject("shape"+Trans(i),"shape")
						With Eval(".shape"+Trans(i))
							.BorderStyle=0
							.BackColor= m.newRGB

							If i=1
								.Left=0
							Else
								.Left=Eval(".parent.shape"+Trans(i-1)+".left")+Eval(".parent.shape"+Trans(i-1)+".width")
							Endi
							.Width=3
							.Top=0
							.Height=.Parent.Height
							.Visible=.T.
						Endwith

					Endwith

				Case lnAlgorithm=2
					With ooc.container2
						.AddObject("shape"+Trans(i),"shape")
						With Eval(".shape"+Trans(i))
							.BorderStyle=0
							.BackColor= m.newRGB

							If i=1
								.Left=0
							Else
								.Left=Eval(".parent.shape"+Trans(i-1)+".left")+Eval(".parent.shape"+Trans(i-1)+".width")
							Endi
							.Width=3
							.Top=0
							.Height=.Parent.Height
							.Visible=.T.
						Endwith

					Endwith
				Endcase
			Next
			If Thisform.spinner1.Value=2
				Exit
			Endi
			i=0
		Next

	Endfor
	Endproc


	Procedure command4.Click
        try
	Run/N snippingTool.Exe   &&win32bits app
	catch
        Run/N c:\windows\sysnative\snippingtool.exe  &&for win64bits
     Endproc


Enddefine
*
*-- EndDefine: asup


Define Class asup As Container
	Width = 241
	Height = 60
	BorderWidth = 0
	Name = "Container3"

	Add Object container1 As Container With ;
		Top = 0, ;
		Left = 0, ;
		Width = 241, ;
		Height = 30, ;
		BorderWidth = 0, ;
		Name = "Container1"

	Add Object container2 As Container With ;
		Top = 30, ;
		Left = 0, ;
		Width = 241, ;
		Height = 30, ;
		BorderWidth = 0, ;
		Name = "Container2"
	Procedure Init
	This.container1.Width=This.Width
	This.container2.Width=This.Width


Enddefine
*-- EndDefine:asup

 

Yet another gradients samples
Yet another gradients samples
Yet another gradients samples

Click on code to select [then copy] -click outside to deselect


*2*
*the codes asks mandatory  to point to gdiplusX class on disc
*draw 200 shapes with gdiplusX (imgcanvas class) on a form with random gradients, borders and blend effect.
*its a kind of gradients palette.
*its tests also the vfp9 speed to draw with gdiplusX library.
*click on any shape to change its gradients;rightclick on to save the thumbnail.
*click on camera ico to capture all the shappes in one image (format to set otherwise its PNG)
*the code creates a folder 'images' for captures
*click on explorer icon to explore the images folder(captured).

*code asks to gdiplusX class location.system.app must be in prefrence in source folder.

*** Method: xfcLinearGradientBrush.SetBlendTriangularShape: Creates a linear gradient with a center color and
*a linear falloff to a single color on both ends.
***Method:SetSigmaBellShape:Creates a gradient falloff based on a bell-shaped curve.

Do Locfile("system.app")

Publi yform
yform=Newobject("yshapes")
yform.Show
Read Events
Retu
*
Define Class yshapes As Form
    BorderStyle = 0
	Height = 452
	Width = 940
	ShowWindow = 2
	ShowTips=.T.
	AutoCenter = .T.
	Caption = "GdiplusX gradientbrush- a random gradients palette----drawing makes some time to appear"
	MaxButton = .F.
	BackColor = Rgb(0,0,0)
	ext="PNG"
	Name = "Form1"

	Add Object command1 As CommandButton With ;
		Top = 411, ;
		Left = 758+20, ;
		Height = 27, ;
		Width = 84, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Redraw All", ;
		Enabled = .F., ;
		MousePointer = 15, ;
		SpecialEffect = 2, ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command1"


	Add Object check2 As Checkbox With ;
		Top = 411, ;
		Left = 670+47, ;
		Height = 27, ;
		Width = 84, ;
		caption="Borders",;
		backstyle=0,;
		forecolor=Rgb(255,255,25),;
		autosize=.T.,;
		value=1,;
		name="check2"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontName = "Segoe Script", ;
		FontSize = 12, ;
		BackStyle = 0, ;
		Caption = "GdiplusX gradientbrush-click on  any imgcanvas to repaint it-rightclick to save", ;
		Height = 29, ;
		Left = 21, ;
		Top = 412, ;
		Width = 692, ;
		ForeColor = Rgb(255,255,0), ;
		Name = "Label1"


	Add Object label2 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontName = "Segoe Script", ;
		FontSize = 12, ;
		BackStyle = 0, ;
		Caption = "GdiplusX gradientbrush-click on  any imgcanvas to repaint it-rightclick to save", ;
		Height = 29, ;
		Left = 19, ;
		Top = 411, ;
		Width = 692, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label2"


	Add Object image1 As Image With ;
		picture=Home(1)+"graphics\icons\misc\camera.ico" ,;
		BackStyle = 0,;
		Height = 48,;
		Left = 842+25,;
		MousePointer = 15,;
		tooltiptext="capture all palette",;
		Top = 409,;
		Width = 37,;
		Name = "Image1"

	Add Object image2 As Image With ;
		picture=Home(1)+"graphics\icons\win95\explorer.ico" ,;
		BackStyle = 1,;
		Height = 48,;
		Left = 842+25+40,;
		MousePointer = 15,;
		tooltiptext="Explorer images",;
		Top = 409,;
		Width = 37,;
		Name = "Image2"

	Procedure my
	Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
	loObject.Draw()
	Endproc

	Procedure my1
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]

	With _Screen.System.drawing
		Local m.yim
		m.yim=m.yrep+"images\img"+Sys(3)+".jpg"
		loObject.obmp.Save(m.yim,.imaging.imageformat.JPEG)
	Endwith
	Messagebox("Saved as "+m.yim,0+32+4096,"",1000)
	Endproc

	Procedure Init
	Publi m.yrep
	m.yrep=Addbs(Justpath(Sys(16,1)))
	If !Directory(m.yrep+"images")
		Md m.yrep+"images"
	Endi

	m.delta=Int(Val( Inputbox("Grille spacing 0-10","","5")  ))
	If !Between(m.delta,0,10)
		m.delta=5
	Endi

	_Screen.AddProperty("xx",0)
	_Screen.xx=Int(Val(Inputbox(" nothing (0)-SetBlendTriangularShape (1)-:SetSigmaBellShape(2)","","1")))
	If !Between(_Screen.xx,0,2)
		_Screen.xx=0
	Endi

	xwidth=40
	xheight=35
	k=0
	j=0

	Set Classlib To Locfile("gdiplusX.vcx","vcx") AddI
	For  i=1 To 200
		k=k+1
		With Thisform
			.AddObject("imgcanvas"+Trans(i),"imgcanvas")
			With Eval(".imgcanvas"+Trans(i))
				.Anchor = 15
				.Stretch = 2
				.Height = xheight
				.Width=xwidth
				If k>20
					k=1
				Endi

				If k=1
					j=j+1
					.Left=0
					.Top=(j-1)*(xheight+m.delta	)
				Else
					.Left = Eval("thisform.imgcanvas"+Trans(i-1)+".left")+Eval("thisform.imgcanvas"+Trans(i-1)+".width")+m.delta
					.Top  =Eval("thisform.imgcanvas"+Trans(i-1)+".top")
				Endi
				.MousePointer = 15
				.rendermode = 4
				.drawwheninvisible = .T.
				.Name = "Imgcanvas"+Trans(i)
				.Visible=.T.
			Endwith
		Endwith
	Endfor
	Release Classlib gdiplusX

	With This
		.SetAll("anchor",0,"imgcanvas")
		.SetAll("drawWhenInvisible",.T.,"imgcanvas")
		.SetAll("visible",.F.,"imgcanvas")

		For i=1 To .ControlCount
			If Lower(.Controls(i).Class)=="imgcanvas"
				Bindevent(.Controls(i),"beforedraw",Thisform,"ybeforedraw")
				Bindevent(.Controls(i),"mousedown",Thisform ,"my")
				Bindevent(.Controls(i),"rightclick",Thisform,"my1")
			Endi
		Endfor
	Endwith
	Endproc


	Procedure Load
	Do Locfile('system.app')
	Endproc

	Procedure Click
	With Thisform
		For i=1 To .ControlCount
			If Lower(.Controls(i).Class)=="imgcanvas"
				.Controls(i).Click()
			Endi
		Endfor
	Endwith
	Endproc

	Procedure Activate
	Thisform.SetAll("visible",.T.,"imgcanvas")
	Thisform.command1.Enabled=.T.
	Endproc

	Procedure ybeforedraw
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]

	loObject.Clear
	logfx=loObject.ogfx
	With _Screen.System.drawing
		logfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias

		Local color1,color2,color3 As xfccolor
		With _Screen.System.drawing
			Rand(-1)
			color1=.Color.fromRGB(Rgb(255*Rand(),255*Rand(),255*Rand()))
			color2=.Color.fromRGB(Rgb(255*Rand(),255*Rand(),255*Rand()))
			color3=.Color.fromRGB(Rgb(255*Rand(),255*Rand(),255*Rand()))

			nmode=Int(3*Rand())
			br = .Drawing2D.LinearGradientBrush.New(loObject.Rectangle,color1,color2,nmode,.F.)
			Do Case
			Case _Screen.xx=0
			Case _Screen.xx=1
				br.SetBlendTriangularShape(0.5,1.0)
			Case _Screen.xx=2
				br.SetSigmaBellShape(0.2,0.8)
			Endcase

			logfx.FillRectangle(br,loObject.Rectangle)
			If Thisform.check2.Value=1
				Pen = .Pen.New(color3, 2)
				logfx.drawRectangle(Pen,0,0,loObject.Width-2,loObject.Height-2)
				Pen.dispose()
			Endi
			br.dispose()
		Endwith
	Endwith
	Endproc

	Procedure command1.Click
	With Thisform
		For i=1 To .ControlCount
			If Lower(.Controls(i).Class)=="imgcanvas"
				.Controls(i).Draw
			Endi
		Endfor
	Endwith
	Endproc

	Procedure image1.Click
	With _Screen.System.drawing
		Local loCapture As xfcBitmap
*LPARAMETERS tHWnd, tiX, tiY, tiWidth, tiHeight, [tlEnsureVisible]
		Local x0,y0,hh
		x0=0
		y0=Sysmetric(9)+Sysmetric(4)
		hh=This.Height+27+5

		loCapture = .Bitmap.Fromscreen(Thisform.HWnd,x0,y0,Thisform.Width,Thisform.Height-hh) &&capture form  zone (hwnd)
		Inke(1)
		Local m.xx,m.lcdest
		m.xx="capture_"+Ttoc(Datetime())
		m.xx=Strtran(m.xx,"/","_")
		m.xx=Strtran(m.xx,":","_")
		m.xx=Strtran(m.xx,";","_")
		m.lcdest=m.yrep+"images\"+m.xx+"."+Thisform.ext
		Do Case
		Case Upper(Thisform.ext)=="PNG"
			loCapture.Save(m.lcdest,.imaging.imageformat.PNG)
		Case Upper(Thisform.ext)=="JPG"
			loCapture.Save(m.lcdest,.imaging.imageformat.JPEG)
		Case Upper(Thisform.ext)=="BMP"
			loCapture.Save(m.lcdest,.imaging.imageformat.BMP)
		Case Upper(Thisform.ext)=="GIF"
			loCapture.Save(m.lcdest,.imaging.imageformat.GIF)
		Endcase
	Endwith
	Messagebox("Palette PNG Saved as "+m.lcdest,0+32+4096,"",1000)
	Endproc

	Procedure image2.Click
	Local m.oo
	m.oo=m.yrep+"images"
	Run/N explorer &oo
	Endproc

	Procedure Destroy
	Clea Events
	Endproc


Enddefine
*
*-- EndDefine: yshapes



Yet another gradients samples

Click on code to select [then copy] -click outside to deselect


*3*
*this code draws a random background gradient on a temp picture on a form
*this gradient is blend (method SetBlendTriangularShape) if set m.blend=.t.the code asks to the gdiplus class on disc.
*simply click to change the gradient
*A temporarly  image is created to get the blob memo and erased.the blob desserves the pictureVal property of the image.
*Image gradient is better than drawing gradient with line.this dont draw well gradient when there is controls on form.
*its better than drawing line by line the gradient in a loop.

Publi m.blend
m.blend=.F.   &&can change it to .t.
Set Classlib To Locfile("gdiplusX.vcx","vcx") AddI
Publi yform
yform=Newobject("ybackg")
Release Classlib gdiplusX
yform.Show
Read Events
Retu
*
Define Class ybackg As Form
    Height = 466
	Width = 800
	ShowWindow = 2
	AutoCenter = .T.
	Caption = "Click to change random form background"
	WindowState = 0
	Name = "Form1"

	Add Object image1 As Image With ;
		Stretch = 2, ;
		Height = 24, ;
		Left = 0, ;
		MousePointer = 15, ;
		Top = -1, ;
		Width = 36, ;
		Name = "Image1"

	Add Object imgcanvas1 As imgcanvas With ;
		Anchor = 15, ;
		Stretch = 2, ;
		Height = 300, ;
		Left = 126, ;
		MousePointer = 15, ;
		Top = 36, ;
		Visible = .F., ;
		Width = 500, ;
		rendermode = 4, ;
		drawwheninvisible = .T., ;
		Name = "Imgcanvas1"

	Procedure Init
	Thisform.imgcanvas1.Draw()
	Thisform.Resize
	Endproc

	Procedure Resize
	With This.image1
		.Left=-20
		.Top=-20
		.Width=.Parent.Width+40
		.Height=.Parent.Height+40
		.ZOrder(1)
	Endwith
	Endproc

	Procedure Destroy
	Clea Events
	Endproc

	Procedure image1.Click
	Thisform.imgcanvas1.Draw()
	Endproc

	Procedure imgcanvas1.beforedraw
	Local m.lcdest
	m.lcdest=Addbs(Sys(2023))+"ytemp_"+Sys(3)+".jpg"

	This.Clear

	logfx=This.ogfx
	With _Screen.System.Drawing
		logfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
		Rand(-1)
		color1=.Color.fromRGB(Rgb(255*Rand(),255*Rand(),255*Rand()))
		color2=.Color.fromRGB(Rgb(255*Rand(),255*Rand(),255*Rand()))
		nmode=Int(3*Rand())
		br = .Drawing2D.LinearGradientBrush.New(This.Rectangle,color1,color2,nmode,.F.)
		If m.blend=.T.
			br.SetBlendTriangularShape(0.5,1.0)
		Endi
		logfx.FillRectangle(br,This.Rectangle)
		br.Dispose()
		This.obmp.Save(m.lcdest,.imaging.imageformat.JPEG)
	Endwith
	Thisform.image1.PictureVal=Filetostr(m.lcdest)
	Thisform.Resize()
	Erase (m.lcdest)
	Return
	Endproc

Enddefine
*
*-- EndDefine: ybackg


Yet another gradients samples

Click on code to select [then copy] -click outside to deselect


*4*
*this uses the API GradientFill of  Msimg32 library.it draws many gradients on one surface by specifying the vertices.
*can pick the image drawn with thez win10 tool:snippingTool.
*ref:https://msdn.microsoft.com/en-us/library/windows/desktop/dd144957(v=vs.85).aspx

Set Defa To Addbs(Justpath(Sys(16,1)))

yform=Createobject("ygradientfill")
yform.Show
Read Events
Return

*
Define Class ygradientfill As Form
    Top = 8
	Left = 16
	Height = 367
	Width = 730
	ShowWindow = 2
	ShowTips = .T.
	BorderStyle = 3
	Movable=.F.
	Caption = "Test de GradientFill  API "
	MaxButton = .F.
	WindowState = 0
	Name = "Form1"

	Add Object command8 As CommandButton With ;
		Top = 12, ;
		Left = 24, ;
		Height = 27, ;
		Width = 60, ;
		FontBold = .T., ;
		FontSize = 9, ;
		Caption = "Capture", ;
		Name = "Command8"

	Add Object command3 As CommandButton With ;
		Top = 252, ;
		Left = 3, ;
		Height = 48, ;
		Width = 120, ;
		WordWrap = .T., ;
		Caption = "run quadri /3 random colors",;
		Name = "Command3"
	Add Object ycommand As CommandButton With ;
		Top = 24, ;
		Left = 98, ;
		Height = 204, ;
		Width = 624, ;
		Caption = "", ;
		MousePointer = 99, ;
		MouseIcon = "hand-m.cur", ;
		enabled=.F.,;
		Name = "yCommand"


	Add Object shape1 As Shape With ;
		Top = 240, ;
		Left = 240, ;
		Height = 36, ;
		Width = 35, ;
		BackColor = Rgb(255,0,0), ;
		Name = "Shape1"

	Add Object shape2 As Shape With ;
		Top = 240, ;
		Left = 280, ;
		Height = 36, ;
		Width = 35, ;
		BackColor = Rgb(0,255,0), ;
		Name = "Shape2"


	Add Object shape3 As Shape With ;
		Top = 240, ;
		Left = 320, ;
		Height = 36, ;
		Width = 35, ;
		BackColor = Rgb(0,0,255), ;
		Name = "Shape3"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontSize = 8, ;
		BackStyle = 0, ;
		Caption = "Gradient  quadrilatere with  4 random colors ", ;
		Height = 16, ;
		Left = 0, ;
		Top = 229, ;
		Width = 239, ;
		Name = "Label1"

	Add Object shape4 As Shape With ;
		Top = 240, ;
		Left = 358, ;
		Height = 36, ;
		Width = 35, ;
		BackColor = Rgb(255,255,0), ;
		Name = "Shape4"

	Add Object command1 As CommandButton With ;
		Top = 312, ;
		Left = 264, ;
		Height = 47, ;
		Width = 120, ;
		WordWrap = .T., ;
		Caption = "run quadri/3 predefined colors", ;
		Name = "Command1"

	Add Object label2 As Label With ;
		FontSize = 8, ;
		WordWrap = .T., ;
		BackStyle = 0, ;
		Caption = "Gradient  quadrilatère : 4  predefined coulors,Click to select on shapes", ;
		Height = 32, ;
		Left = 216, ;
		Top = 283, ;
		Width = 282, ;
		Name = "Label2"

	Add Object command2 As CommandButton With ;
		Top = 312, ;
		Left = 3, ;
		Height = 48, ;
		Width = 120, ;
		WordWrap = .T., ;
		Caption = "run 3triangles/ 3 random colors", ;
		Name = "Command2"

	Add Object command4 As CommandButton With ;
		Top = 312, ;
		Left = 132, ;
		Height = 48, ;
		Width = 120, ;
		WordWrap = .T., ;
		Caption = "run 4 triangles/3 random colors", ;
		Name = "Command4"

	Add Object command5 As CommandButton With ;
		Top = 312, ;
		Left = 396, ;
		Height = 48, ;
		Width = 120, ;
		WordWrap = .T., ;
		Caption = "run 4 triangles/ 4 random colors", ;
		Name = "Command5"

	Add Object command6 As CommandButton With ;
		Top = 312, ;
		Left = 579, ;
		Height = 48, ;
		Width = 120, ;
		WordWrap = .T., ;
		Caption = "run n triangles/ 4 predefined colors", ;
		Name = "Command6"

	Add Object text1 As TextBox With ;
		ControlSource = "ho", ;
		Height = 24, ;
		InputMask = "999", ;
		Left = 581, ;
		Top = 288, ;
		Width = 49, ;
		Name = "Text1"

	Add Object text2 As TextBox With ;
		ControlSource = "ve", ;
		Height = 24, ;
		InputMask = "999", ;
		Left = 645, ;
		Top = 288, ;
		Width = 49, ;
		Name = "Text2"

	Add Object label3 As Label With ;
		AutoSize = .T., ;
		Caption = "Hor.", ;
		Height = 17, ;
		Left = 591, ;
		Top = 271, ;
		Width = 25, ;
		Name = "Label3"

	Add Object label4 As Label With ;
		AutoSize = .T., ;
		Caption = "Vert.", ;
		Height = 17, ;
		Left = 652, ;
		Top = 271, ;
		Width = 26, ;
		Name = "Label4"

	Add Object combo1 As ComboBox With ;
		RowSourceType = 1, ;
		RowSource = "V,H,T", ;
		Value = "", ;
		Height = 24, ;
		Left = 12, ;
		Style = 2, ;
		Top = 84, ;
		Width = 72, ;
		Name = "Combo1"

	Add Object label5 As Label With ;
		AutoSize = .T., ;
		FontSize = 8, ;
		Caption = "Gradient type", ;
		Height = 16, ;
		Left = 13, ;
		Top = 62, ;
		Width = 67, ;
		Name = "Label5"


	Procedure drawgradient
	Lparameters hDC, x1,y1, x2,y2,x3,y3, ;
		nRed1,nGreen1,nBlue1, nRed2,nGreen2,nBlue2 ,nRed3,nGreen3,nBlue3,xtype
	#Define GRADIENT_FILL_RECT_V 2
	#Define GRADIENT_FILL_RECT_H 0
	#Define GRADIENT_FILL_TRIANGLE 1


	Local lcVertex, lcMesh
	lcMesh = Thisform.num2dword(0) + Thisform.num2dword(1)+ Thisform.num2dword(2)
	lcVertex =Thisform.num2dword(x1) +Thisform.num2dword(y1) +;
		thisform.num2word(nRed1*256) +;
		thisform.num2word(nGreen1*256) +;
		thisform.num2word(nBlue1*256) +;
		thisform.num2word(0) +;
		thisform.num2dword(x2) + Thisform.num2dword(y2)  +;
		thisform.num2word(nRed2*256) +;
		thisform.num2word(nGreen2*256) +;
		thisform.num2word(nBlue2*256) +;
		thisform.num2word(0) +;
		thisform.num2dword(x3) + Thisform.num2dword(y3)  +;
		thisform.num2word(nRed3*256) +;
		thisform.num2word(nGreen3*256) +;
		thisform.num2word(nBlue3*256) +;
		thisform.num2word(0)

	Do Case
	Case  xtype="V"
		= GradientFill(hDC, @lcVertex, 3, @lcMesh, 1, GRADIENT_FILL_RECT_V)
	Case xtype="H"
		= GradientFill(hDC, @lcVertex, 3, @lcMesh, 1, GRADIENT_FILL_RECT_H)
	Case xtype="T"
		= GradientFill(hDC, @lcVertex, 3, @lcMesh, 1, GRADIENT_FILL_TRIANGLE)

	Endcase
	Return
	Endproc

	Procedure num2dword
	Lparameters lnValue
	#Define m0       256
	#Define m1     65536
	#Define m2  16777216
	Local b0, b1, b2, b3
	b3 = Int(lnValue/m2)
	b2 = Int((lnValue - b3*m2)/m1)
	b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
	b0 = Mod(lnValue, m0)
	Return Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
	Endproc


	Procedure num2word
	Parameters lnValue
	Return Chr(Mod(m.lnValue,256)) + Chr(Int(m.lnValue/256))
	Endproc

	Procedure Destroy
	Set Safe Off
	Dele File c:\Windows\temp\ycapture*.*
	Dele File c:\Windows\temp\tmp*.*
	Set Safe On
	Set Curs On
	Clea Events
	Endproc

	Procedure Init
	Set Curs Off
	Publi  xtype,obutton   && ho,ve,
	obutton=.F.
	ho=10
	ve=5
	xtype="V"
	#Define ymaroon  Rgb(0,134,28)
	With This
		.SetAll("backcolor",ymaroon,"commandbutton")
		.SetAll("Mousepointer",15,"commandbutton")
		.SetAll("Mousepointer",15,"shape")
		.SetAll("fontsize",8,"commandbutton")
		.AutoCenter=.T.
	Endwith
	_Screen.WindowState=1

	Endproc

	Procedure command8.Click
	Try
	Run/N snippingTool.Exe  &&32 bits
	Catch
          Run/N c:\windows\sysnative\snippingtool.exe &&64 bit
	Endtry
	Endproc

	Procedure command3.Click
	obutton=.F.
	Thisform.Cls
	Declare Integer GetActiveWindow In user32
	Declare Integer GetWindowDC In user32 Integer HWnd
	Declare Integer ReleaseDC In user32 Integer HWnd, Integer hdc

	Declare Integer GradientFill In Msimg32;
		INTEGER hdc, String @pVertex, Long dwNumVertex,;
		STRING @pMesh, Long dwNumMesh, Long dwMode

	x1=Thisform.ycommand.Left+Sysmetric(3)  +5
	y1=Sysmetric(9)+Sysmetric(3)+Thisform.ycommand.Top+5

	x2=x1+Thisform.ycommand.Width-10
	y2=y1

	x3=x2
	y3=y1+Thisform.ycommand.Height-10

	x4=x1
	y4=y3

	Clear
	gnInférieur = 1
	gnSupérieur = 255
	Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	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)

	nRed3=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nGreen3=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nBlue3 =Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)

	nRed4=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nGreen4=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nBlue4 =Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)


	Thisform.shape1.BackColor=Rgb(nRed1,nGreen1,nBlue1)
	Thisform.shape2.BackColor=Rgb(nRed2,nGreen2,nBlue2)
	Thisform.shape3.BackColor=Rgb(nRed3,nGreen3,nBlue3)
	Thisform.shape4.BackColor=Rgb(nRed4,nGreen4,nBlue4)



	Local hWindow, hDC
	hWindow = GetActiveWindow()
	hDC = GetWindowDC(hWindow)
	If Empty(xtype)
		xtype="V"
	Endi

	=Thisform.drawgradient(hDC, x1,y1, x2,y2,x3,y3,nRed1,nGreen1,nBlue1, nRed2,nGreen2,nBlue2,nRed3,nGreen3,nBlue3,xtype)
	=Thisform.drawgradient(hDC, x1,y1, x3,y3,x4,y4,nRed1,nGreen1,nBlue1, nRed3,nGreen3,nBlue3,nRed4,nGreen4,nBlue4,xtype)

	ReleaseDC(hWindow, hDC)

	Thisform.Refresh
	Endproc
*

	Procedure shape1.Click
	tnColor=Getcolor()
	This.BackColor=tnColor
	Endproc


	Procedure shape2.Click
	tnColor=Getcolor()
	This.BackColor=tnColor
	Endproc


	Procedure shape3.Click
	tnColor=Getcolor()
	This.BackColor=tnColor
	Endproc


	Procedure shape4.Click
	tnColor=Getcolor()
	This.BackColor=tnColor
	Endproc


	Procedure command1.Click
	obutton=.F.
	Thisform.Cls
	Declare Integer GetActiveWindow In user32
	Declare Integer GetWindowDC In user32 Integer HWnd
	Declare Integer ReleaseDC In user32 Integer HWnd, Integer hdc

	Declare Integer GradientFill In Msimg32;
		INTEGER hdc, String @pVertex, Long dwNumVertex,;
		STRING @pMesh, Long dwNumMesh, Long dwMode


	x1=Thisform.ycommand.Left+Sysmetric(3)  +5
	y1=Sysmetric(9)+Sysmetric(3)+Thisform.ycommand.Top+5

	x2=x1+Thisform.ycommand.Width-10
	y2=y1

	x3=x2
	y3=y1+Thisform.ycommand.Height-10

	x4=x1
	y4=y3

	tnColor=Thisform.shape1.BackColor
	nRed1  =Bitand(tnColor, 0x000000FF)
	nGreen1=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue1 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	tnColor=Thisform.shape2.BackColor
	nRed2  =Bitand(tnColor, 0x000000FF)
	nGreen2=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue2 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	tnColor=Thisform.shape3.BackColor
	nRed3  =Bitand(tnColor, 0x000000FF)
	nGreen3=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue3 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	tnColor=Thisform.shape4.BackColor
	nRed4  =Bitand(tnColor, 0x000000FF)
	nGreen4=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue4 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)


	Local hWindow, hDC
	hWindow = GetActiveWindow()
	hDC = GetWindowDC(hWindow)
	If Empty(xtype)
		xtype="V"
	Endi


	=Thisform.drawgradient(hDC, x1,y1, x2,y2,x3,y3,nRed1,nGreen1,nBlue1, nRed2,nGreen2,nBlue2,nRed3,nGreen3,nBlue3,xtype)
	=Thisform.drawgradient(hDC, x1,y1, x3,y3,x4,y4,nRed1,nGreen1,nBlue1, nRed3,nGreen3,nBlue3,nRed4,nGreen4,nBlue4,xtype)

	ReleaseDC(hWindow, hDC)

	Thisform.Refresh
	Endproc


	Procedure command2.Click
	obutton=.F.
	Thisform.Cls
	Declare Integer GetActiveWindow In user32
	Declare Integer GetWindowDC In user32 Integer HWnd
	Declare Integer ReleaseDC In user32 Integer HWnd, Integer hdc

	Declare Integer GradientFill In Msimg32;
		INTEGER hdc, String @pVertex, Long dwNumVertex,;
		STRING @pMesh, Long dwNumMesh, Long dwMode


	x1=Thisform.ycommand.Left+Sysmetric(3)  +5
	y1=Sysmetric(9)+Sysmetric(3)+Thisform.ycommand.Top+5

	x2=x1+Thisform.ycommand.Width-10
	y2=y1

	x3=(x2-x1)/2
	y3=y1+Thisform.ycommand.Height-10


	x4=x2
	y4=y3

	x5=x1
	y5=y3

	Clear
	gnInférieur = 1
	gnSupérieur = 255
	Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)

	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)

	nRed3=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nGreen3=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nBlue3 =Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)

	nRed4=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nGreen4=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nBlue4 =Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)

	nRed5=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nGreen5=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nBlue5 =Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)


	Thisform.shape1.BackColor=Rgb(nRed1,nGreen1,nBlue1)
	Thisform.shape2.BackColor=Rgb(nRed2,nGreen2,nBlue2)
	Thisform.shape3.BackColor=Rgb(nRed3,nGreen3,nBlue3)
	Thisform.shape4.BackColor=Rgb(nRed4,nGreen4,nBlue4)


	Local hWindow, hDC
	hWindow = GetActiveWindow()
	hDC = GetWindowDC(hWindow)
	If Empty(xtype)
		xtype="V"
	Endi

	=Thisform.drawgradient(hDC, x1,y1, x2,y2,x3,y3,nRed1,nGreen1,nBlue1, nRed2,nGreen2,nBlue2,nRed3,nGreen3,nBlue3,xtype)
	=Thisform.drawgradient(hDC, x2,y2, x3,y3,x4,y4,nRed2,nGreen2,nBlue2, nRed3,nGreen3,nBlue3,nRed4,nGreen4,nBlue4,xtype)
	=Thisform.drawgradient(hDC, x1,y1, x3,y3,x5,y5,nRed1,nGreen1,nBlue1, nRed3,nGreen3,nBlue3,nRed5,nGreen5,nBlue5,xtype)


	ReleaseDC(hWindow, hDC)
	Thisform.Refresh
	Endproc


	Procedure command4.Click
	obutton=.F.
	Thisform.Cls
	Declare Integer GetActiveWindow In user32
	Declare Integer GetWindowDC In user32 Integer HWnd
	Declare Integer ReleaseDC In user32 Integer HWnd, Integer hdc

	Declare Integer GradientFill In Msimg32;
		INTEGER hdc, String @pVertex, Long dwNumVertex,;
		STRING @pMesh, Long dwNumMesh, Long dwMode



	x1=Thisform.ycommand.Left+Sysmetric(3)  +5
	y1=Sysmetric(9)+Sysmetric(3)+Thisform.ycommand.Top+5

	x2=x1+Thisform.ycommand.Width-10
	y2=y1

	x3=x1+(x2-x1)/2
	y3=y1+Thisform.ycommand.Height/2  -5


	x4=x2
	y4=y1+Thisform.ycommand.Height   -10

	x5=x1
	y5=y4

	Clear
	gnInférieur = 1
	gnSupérieur = 255
	Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)

	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)

	nRed3=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nGreen3=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nBlue3 =Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)

	nRed4=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nGreen4=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nBlue4 =Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)

	nRed5=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nGreen5=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
	nBlue5 =Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)


	Thisform.shape1.BackColor=Rgb(nRed1,nGreen1,nBlue1)
	Thisform.shape2.BackColor=Rgb(nRed2,nGreen2,nBlue2)
	Thisform.shape3.BackColor=Rgb(nRed3,nGreen3,nBlue3)
	Thisform.shape4.BackColor=Rgb(nRed4,nGreen4,nBlue4)


	Local hWindow, hDC
	hWindow = GetActiveWindow()
	hDC = GetWindowDC(hWindow)
	If Empty(xtype)
		xtype="V"
	Endi

	=Thisform.drawgradient(hDC, x1,y1, x2,y2,x3,y3,nRed1,nGreen1,nBlue1, nRed2,nGreen2,nBlue2,nRed3,nGreen3,nBlue3,xtype)
	=Thisform.drawgradient(hDC, x2,y2, x3,y3,x4,y4,nRed2,nGreen2,nBlue2, nRed3,nGreen3,nBlue3,nRed4,nGreen4,nBlue4,xtype)
	=Thisform.drawgradient(hDC, x4,y4, x3,y3,x5,y5,nRed4,nGreen4,nBlue4, nRed3,nGreen3,nBlue3,nRed5,nGreen5,nBlue5,xtype)
	=Thisform.drawgradient(hDC, x1,y1, x3,y3,x5,y5,nRed1,nGreen1,nBlue1, nRed3,nGreen3,nBlue3,nRed5,nGreen5,nBlue5,xtype)


	ReleaseDC(hWindow, hDC)

	Thisform.Refresh
	Endproc


	Procedure command5.Click
	Thisform.Cls
	obutton=.F.
	Declare Integer GetActiveWindow In user32
	Declare Integer GetWindowDC In user32 Integer HWnd
	Declare Integer ReleaseDC In user32 Integer HWnd, Integer hdc

	Declare Integer GradientFill In Msimg32;
		INTEGER hdc, String @pVertex, Long dwNumVertex,;
		STRING @pMesh, Long dwNumMesh, Long dwMode



	x1=Thisform.ycommand.Left+Sysmetric(3)  +5
	y1=Sysmetric(9)+Sysmetric(3)+Thisform.ycommand.Top+5

	x2=x1+Thisform.ycommand.Width-10
	y2=y1

	x3=x1+(x2-x1)/2
	y3=y1+Thisform.ycommand.Height/2  -5


	x4=x2
	y4=y1+Thisform.ycommand.Height   -10

	x5=x1
	y5=y4

	tnColor=Thisform.shape1.BackColor
	nRed1  =Bitand(tnColor, 0x000000FF)
	nGreen1=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue1 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	tnColor=Thisform.shape2.BackColor
	nRed2  =Bitand(tnColor, 0x000000FF)
	nGreen2=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue2 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	tnColor=Thisform.shape3.BackColor
	nRed3  =Bitand(tnColor, 0x000000FF)
	nGreen3=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue3 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	tnColor=Thisform.shape4.BackColor
	nRed4  =Bitand(tnColor, 0x000000FF)
	nGreen4=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue4 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

&&rajouté
	tnColor=Rgb(255,255,0)
	nRed5  =Bitand(tnColor, 0x000000FF)
	nGreen5=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue5 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)


	Local hWindow, hDC
	hWindow = GetActiveWindow()
	hDC = GetWindowDC(hWindow)
	If Empty(xtype)
		xtype="V"
	Endi


	=Thisform.drawgradient(hDC, x1,y1, x2,y2,x3,y3,nRed1,nGreen1,nBlue1, nRed2,nGreen2,nBlue2,nRed3,nGreen3,nBlue3,xtype)
	=Thisform.drawgradient(hDC, x2,y2, x3,y3,x4,y4,nRed2,nGreen2,nBlue2, nRed3,nGreen3,nBlue3,nRed4,nGreen4,nBlue4,xtype)
	=Thisform.drawgradient(hDC, x4,y4, x3,y3,x5,y5,nRed4,nGreen4,nBlue4, nRed3,nGreen3,nBlue3,nRed5,nGreen5,nBlue5,xtype)
	=Thisform.drawgradient(hDC, x1,y1, x3,y3,x5,y5,nRed1,nGreen1,nBlue1, nRed3,nGreen3,nBlue3,nRed5,nGreen5,nBlue5,xtype)
	ReleaseDC(hWindow, hDC)

	Thisform.Refresh
	Endproc

	Procedure command6.Click
	Thisform.Cls
	obutton=.F.
	Declare Integer GetActiveWindow In user32
	Declare Integer GetWindowDC In user32 Integer HWnd
	Declare Integer ReleaseDC In user32 Integer HWnd, Integer hdc

	Declare Integer GradientFill In Msimg32;
		INTEGER hdc, String @pVertex, Long dwNumVertex,;
		STRING @pMesh, Long dwNumMesh, Long dwMode

	tnColor=Thisform.shape1.BackColor
	nRed1  =Bitand(tnColor, 0x000000FF)
	nGreen1=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue1 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	tnColor=Thisform.shape2.BackColor
	nRed2  =Bitand(tnColor, 0x000000FF)
	nGreen2=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue2 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	tnColor=Thisform.shape3.BackColor
	nRed3  =Bitand(tnColor, 0x000000FF)
	nGreen3=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue3 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	tnColor=Thisform.shape4.BackColor
	nRed4  =Bitand(tnColor, 0x000000FF)
	nGreen4=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue4 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	tnColor=Rgb(255,255,0)
	nRed5  =Bitand(tnColor, 0x000000FF)
	nGreen5=Bitrshift(Bitand(tnColor, 0x0000FF00), 8)
	nBlue5 =Bitrshift(Bitand(tnColor, 0x00FF0000), 16)

	Local hWindow, hDC
	hWindow = GetActiveWindow()
	hDC = GetWindowDC(hWindow)
	xtype=Thisform.combo1.Value

	w=Thisform.ycommand.Width
	h=Thisform.ycommand.Height
	l0=Thisform.ycommand.Left
	t0=Thisform.ycommand.Top

	If Empty(xtype)
		xtype="V"
	Endi

	ve=Thisform.text2.Value
	ho=Thisform.text1.Value

	If ve=0
		ve=4
	Endi
	If ho=0
		ho=8
	Endi
	hh=(h-10)/ve
	ww=w/ho

	For j=1 To ve
		For i=1 To ho

			x1=l0+Sysmetric(3)  +5+(i-1)*ww
			y1=Sysmetric(9)+Sysmetric(3)+t0+5  +(j-1)*hh

			If i=ho
				x2=x1+ww   -10
			Else
				x2=x1+ww
			Endi
			y2=y1

			x3=x1+(x2-x1)/2
			y3=y1+hh   && -5


			x4=x2
			If j=ve
				y4=y1+hh
			Else
				y4=y1+hh
			Endi

			x5=x1
			y5=y4

			=Thisform.drawgradient(hDC, x1,y1, x2,y2,x3,y3,nRed1,nGreen1,nBlue1, nRed2,nGreen2,nBlue2,nRed3,nGreen3,nBlue3,xtype)
			=Thisform.drawgradient(hDC, x2,y2, x3,y3,x4,y4,nRed2,nGreen2,nBlue2, nRed3,nGreen3,nBlue3,nRed4,nGreen4,nBlue4,xtype)
			=Thisform.drawgradient(hDC, x4,y4, x3,y3,x5,y5,nRed4,nGreen4,nBlue4, nRed3,nGreen3,nBlue3,nRed5,nGreen5,nBlue5,xtype)
			=Thisform.drawgradient(hDC, x1,y1, x3,y3,x5,y5,nRed1,nGreen1,nBlue1, nRed3,nGreen3,nBlue3,nRed5,nGreen5,nBlue5,xtype)
		Endfor

	Endfor
	ReleaseDC(hWindow, hDC)

	Thisform.Refresh
	Endproc

	Procedure combo1.Init
	This.Value="V"
	Endproc

	Procedure Destroy
	Erase Addbs(Sys(2023))+"ycap*.bmp"
	Clea Events
	Endproc

Enddefine
*
*-- EndDefine: ygradientfill



 

I set the form.movable=.f. because the API drawing can be cleared when moving the form.this needs to be painted with bindevent & windows winproc...
I set the form.movable=.f. because the API drawing can be cleared when moving the form.this needs to be painted with bindevent & windows winproc...
I set the form.movable=.f. because the API drawing can be cleared when moving the form.this needs to be painted with bindevent & windows winproc...

I set the form.movable=.f. because the API drawing can be cleared when moving the form.this needs to be painted with bindevent & windows winproc...

Click on code to select [then copy] -click outside to deselect

 
 *5* this code uses the html5 canvas to draw some special gradients (linear and radial)
 *updtated on 9 november 2016
Publi yform
yform=Createobject("ygrads")
yform.Show
Read Events
Retu
*
Define Class ygrads As Form
	Height = 409
	Width = 510
	ShowWindow = 2
	AutoCenter = .T.
	Caption = "Html5 canvas  to create special gradients"
	Name = "Form1"

	Add Object olecontrol1 As OleControl With ;
		oleclass="shell.explorer.2",;
		Top = 12, ;
		Left = 152, ;
		Height = 348, ;
		Width = 348, ;
		Anchor = 15, ;
		Name = "Olecontrol1"

	Add Object shape1 As Shape With ;
		Top = 48, ;
		Left = 11, ;
		Height = 36, ;
		Width = 48, ;
		BorderStyle = 0, ;
		MousePointer = 15, ;
		BackColor = Rgb(0,255,0), ;
		Name = "Shape1"

	Add Object shape2 As Shape With ;
		Top = 106, ;
		Left = 10, ;
		Height = 36, ;
		Width = 48, ;
		BorderStyle = 0, ;
		MousePointer = 15, ;
		BackColor = Rgb(255,0,0), ;
		Name = "Shape2"

	Add Object shape3 As Shape With ;
		Top = 169, ;
		Left = 10, ;
		Height = 36, ;
		Width = 48, ;
		BorderStyle = 0, ;
		MousePointer = 15, ;
		BackColor = Rgb(128,0,255), ;
		Name = "Shape3"

	Add Object command1 As CommandButton With ;
		Top = 372, ;
		Left = 228, ;
		Height = 27, ;
		Width = 180, ;
		FontSize = 12, ;
		Caption = "Capture", ;
		MousePointer = 15, ;
		SpecialEffect = 2, ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command1"

	Add Object spinner1 As Spinner With ;
		Height = 24, ;
		Increment =   0.10, ;
		KeyboardHighValue = 1, ;
		KeyboardLowValue = 0, ;
		Left = 72, ;
		SpinnerHighValue =   1.00, ;
		SpinnerLowValue =   0.00, ;
		Top = 51, ;
		Width = 69, ;
		Value = 0.00, ;
		Name = "Spinner1"

	Add Object spinner2 As Spinner With ;
		Height = 24, ;
		Increment =   0.10, ;
		KeyboardHighValue = 1, ;
		KeyboardLowValue = 0, ;
		Left = 72, ;
		SpinnerHighValue =   1.00, ;
		SpinnerLowValue =   0.00, ;
		Top = 111, ;
		Width = 68, ;
		Value = 0.50, ;
		Name = "Spinner2"

	Add Object spinner3 As Spinner With ;
		Height = 24, ;
		Increment =   0.10, ;
		KeyboardHighValue = 1, ;
		KeyboardLowValue = 0, ;
		Left = 72, ;
		SpinnerHighValue =   1.00, ;
		SpinnerLowValue =   0.00, ;
		Top = 170, ;
		Width = 67, ;
		Value = 1.00, ;
		Name = "Spinner3"

	Add Object optiongroup1 As OptionGroup With ;
		ButtonCount = 2, ;
		BackStyle = 0, ;
		Value = 1, ;
		Height = 46, ;
		Left = 12, ;
		Top = 252, ;
		Width = 71, ;
		Name = "Optiongroup1", ;
		Option1.Caption = "Linear", ;
		Option1.Value = 1, ;
		Option1.Height = 17, ;
		Option1.Left = 5, ;
		Option1.Top = 5, ;
		Option1.Width = 61, ;
		Option1.Name = "Option1", ;
		Option2.Caption = "Radial", ;
		Option2.Height = 17, ;
		Option2.Left = 5, ;
		Option2.Top = 24, ;
		Option2.Width = 61, ;
		Option2.Name = "Option2"

	Procedure ybuild
		Local x1,x2,x3
		x1=Thisform.yrgb(Thisform.shape1.BackColor)
		x2=Thisform.yrgb(Thisform.shape2.BackColor)
		x3=Thisform.yrgb(Thisform.shape3.BackColor)

		Local xgrad
		Do Case
			Case Thisform.optiongroup1.Value=1
				m.xgrad=" grd = ctx.createLinearGradient(114.000, 0.000, 186.000, 300.000); "
			Case Thisform.optiongroup1.Value=2
				m.xgrad="  grd = ctx.createRadialGradient(150.000, 150.000, 0.000, 150.000, 150.000, 150.000); "
		Endcase

		Local m.myvar
		TEXT to m.myvar textmerge noshow
		<!doctype html>
		<html>
		  <head>
		    <meta charset="UTF-8">
		    <title>special gradients</title>
		  </head>
		  <body>
		    <canvas id="yCanvas" width="300" height="300"></canvas>
		    <script type="text/javascript">
		      var canvasId = 'yCanvas',
		          canvas = document.getElementById(canvasId),
		          ctx = canvas.getContext('2d'),
		          grd;

		      // Create gradient
		     <<m.xgrad>>

		      // Add colors
		      grd.addColorStop(<<thisform.spinner1.value>>, '<<m.x1>>');
		      grd.addColorStop(<<thisform.spinner2.value>>, '<<m.x2>>');
		      grd.addColorStop(<<thisform.spinner3.value>>, '<<m.x3>>');

		      // Fill with gradient
		      ctx.fillStyle = grd;
		      ctx.fillRect(0, 0, 300.000, 300.000);
		    </script>
		  </body>
		</html>
		ENDTEXT
		Local m.lcdest
		m.lcdest=Addbs(Sys(2023))+"temp.html"
		Set Safe Off
		Strtofile(m.myvar,m.lcdest)
		Thisform.olecontrol1.Navigate(m.lcdest)

		*http://www.w3schools.com/TAgs/canvas_createlineargradient.asp
		*context.createLinearGradient(x0,y0,x1,y1);
		*x0 	The x-coordinate of the start point of the gradient
		*y0 	The y-coordinate of the start point of the gradient
		*x1 	The x-coordinate of the end point of the gradient
		*y1 	The y-coordinate of the end point of the gradient


		*http://www.w3schools.com/tags/canvas_createradialgradient.asp
		*context.createRadialGradient(x0,y0,r0,x1,y1,r1);
		*x0 	The x-coordinate of the starting circle of the gradient
		*y0 	The y-coordinate of the starting circle of the gradient
		*r0 	The radius of the starting circle

		*x1 	The x-coordinate of the ending circle of the gradient
		*y1 	The y-coordinate of the ending circle of the gradient
		*r1 	The radius of the ending circle
	Endproc

	Procedure yrgb
		Lparameters xcol
		Local RGBChr
		m.RGBChr=Left(BinToC(xcol,'R'),3)
		R=Asc(Substr(m.RGBChr,1,1)) && RED
		G=Asc(Substr(m.RGBChr,2,1)) && GREEN
		B=Asc(Substr(m.RGBChr,3,1)) && BLUE
		Return "rgba("+Trans(R,"999")+","+Trans(G,"999")+","+Trans(B,"999")+",1.0)"
	Endproc

	Procedure Init
		_Screen.WindowState=1
		Thisform.ybuild()
	Endproc

	Procedure Destroy
		Clea Events
	Endproc

	Procedure shape1.Click
		Local m.xcolor1
		m.xcolor1=Getcolor()
		If !m.xcolor1=-1
			This.BackColor=m.xcolor1
		Endi
		Thisform.ybuild()
	Endproc

	Procedure shape2.Click
		Local m.xcolor2
		m.xcolor2=Getcolor()
		If !m.xcolor2=-1
			This.BackColor=m.xcolor2
		Endi
		Thisform.ybuild()
	Endproc

	Procedure shape3.Click
		Local m.xcolor3
		m.xcolor3=Getcolor()
		If !m.xcolor3=-1
			This.BackColor=m.xcolor3
		Endi
		Thisform.ybuild()
	Endproc

	Procedure command1.Click
		Try
			Thisform.WindowState=2
			Run/N snippingtool.Exe  &&32 bits 
		Catch
			run/N c:\windows\sysnative\snippingtool.exe  &&64 bits
		Endtry
	Endproc

	Procedure spinner1.InteractiveChange
		Thisform.ybuild()
	Endproc

	Procedure spinner2.InteractiveChange
		Thisform.ybuild()
	Endproc

	Procedure spinner3.InteractiveChange
		Thisform.ybuild()
	Endproc

	Procedure optiongroup1.InteractiveChange
		Thisform.ybuild()
	Endproc

Enddefine
*
*-- EndDefine: ygrads



Yet another gradients samples
Yet another gradients samples
Yet another gradients samples

Important:All Codes above are tested on VFP9SP2 & windows 10 pro.

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