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
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
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
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...
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
Important:All Codes above are tested on VFP9SP2 & windows 10 pro.