Old foxdraw resurrected in one prg

This reproduces in one prg the old sample vfp drawing shipped since vfp5.(samples\solution)
it builds a toolbar with some drawing tools and a drawing area.the toolbar can be dockable in 4 form side or free
Can draw manually with native functions and save the entire form to mspaint...
the constants file foxdraw.h is reproduced in starting folder as it.

*1*

*begin code
Set Defa To Justpath(Sys(16,1))
Set Safe Off
Local m.myvar
* create foxdraw.h IN STARTING FOLDER
TEXT to m.myvar textmerge noshow
* Toolbar Object captions and tooltips
#DEFINE WLOAD_LOC "Loading FoxDraw..."
#DEFINE WUNLOAD_LOC "Unloading FoxDraw..."
#DEFINE LBL1CAP_LOC "Form Drawing Is:"
#DEFINE CMDDRAWCAP1_LOC "Inactive"
#DEFINE CMDDRAWCAP2_LOC "Active"
#DEFINE CMDDRAWTIP_LOC "Click to toggle Form Drawing on/off.."
#DEFINE LBL2CAP_LOC "Mode Is:"
#DEFINE CMDDRAWMODECAP1_LOC "Lines"
#DEFINE CMDDRAWMODECAP2_LOC "Rays"
#DEFINE CMDDRAWMODETIP_LOC "Click to toggle between Rays and Lines.."
#DEFINE LBL3CAP_LOC "Pen Width:"
#DEFINE SPNPENWIDTHTIP_LOC "Set Pen Width to <n> pixels"
#DEFINE LBL4CAP_LOC "Pen Draw Mode:"
#DEFINE CBOPENMODETIP_LOC "Set Pen Draw Mode to < 1 - 16>"
#DEFINE CMDREDCAP_LOC "Red"
#DEFINE CMDREDTIP_LOC "Change Pen Color to Red"
#DEFINE CMDGREENCAP_LOC "Green"
#DEFINE CMDGREENTIP_LOC "Change Pen Color to Green"
#DEFINE CMDBLUECAP_LOC "Blue"
#DEFINE CMDBLUETIP_LOC "Change Pen Color to Blue"
#DEFINE CMDCUSTOMCAP_LOC "Custom"
#DEFINE CMDCUSTOMTIP_LOC "Select Custom Pen Color"
#DEFINE CMDERASECAP_LOC "Erase"
#DEFINE CMDERASETIP_LOC "Erase at Current Pen Width"
#DEFINE CMDCLEARCAP_LOC "Clear"
#DEFINE CMDCLEARTIP_LOC "Clear Form drawing surface.."
#DEFINE LBL5CAP_LOC "Method Samples:"
#DEFINE CBOGDEMOTIP_LOC "Examples of Graphics Methods"
#DEFINE CMDDONECAP_LOC "Done"
#DEFINE CMDDONETIP_LOC "Exit FoxDraw Ctrl+D"
#DEFINE TBRCAP_LOC "Draw Control"
#DEFINE CBOGDEMOITEM1_LOC "Line:Draw Styles"
#DEFINE CBOGDEMOITEM2_LOC "Line:Triangle"
#DEFINE CBOGDEMOITEM3_LOC "Circles:Open"
#DEFINE CBOGDEMOITEM4_LOC "Circles:Filled"
#DEFINE CBOGDEMOITEM5_LOC "Ellipses:Open"
#DEFINE CBOGDEMOITEM6_LOC "Ellipses:Filled"
#DEFINE CBOGDEMOITEM7_LOC "Boxes:Open"
#DEFINE CBOGDEMOITEM8_LOC "Boxes:Filled"
#DEFINE CMDWIDTH1_LOC 110
#DEFINE CMDWIDTH2_LOC 120
#DEFINE CMDHT_LOC 23
#DEFINE CMDFONTNAME "MS San Serif"
#DEFINE CMDFONTSIZE 8
#DEFINE CBOPENMODE1_LOC "1-Blackness"
#DEFINE CBOPENMODE2_LOC "2-Not Merge Pen"
#DEFINE CBOPENMODE3_LOC "3-Mask Not Pen"
#DEFINE CBOPENMODE4_LOC "4-Not Copy Pen"
#DEFINE CBOPENMODE5_LOC "5-Mask Pen Not"
#DEFINE CBOPENMODE6_LOC "6-Invert"
#DEFINE CBOPENMODE7_LOC "7-Xor Pen"
#DEFINE CBOPENMODE8_LOC "8-Not Mask Pen"
#DEFINE CBOPENMODE9_LOC "9-Mask Pen"
#DEFINE CBOPENMODE10_LOC "10-Not Xor Pen"
#DEFINE CBOPENMODE11_LOC "11-Nop"
#DEFINE CBOPENMODE12_LOC "12-Merge Not Pen"
#DEFINE CBOPENMODE13_LOC "13-Copy Pen(Def)"
#DEFINE CBOPENMODE14_LOC "14-Merge Pen Not"
#DEFINE CBOPENMODE15_LOC "15-Merge Pen"
#DEFINE CBOPENMODE16_LOC "16-Whiteness"
ENDTEXT
Strtofile(m.myvar,"foxdraw.h")

#INCLUDE "foxdraw.h"

yform =Newobject("ydraw")
yform.Show
Read Events
Return

Define Class ydraw As Form
Top = 10
Left = 27
Height = 557
Width = 913
ShowWindow = 2
BorderStyle = 2
Caption = "yFoxdraw"
MaxButton = .F.
tbrfd1 = ""
cformname = ""
cpencolor = ""
ndrawmode = 1
cformmode = ""
otoolbar = .F.
Name = "Form1"

Add Object timer1 As Timer With ;
Top = 24, ;
Left = 60, ;
Height = 23, ;
Width = 23, ;
Interval = 500, ;
Name = "Timer1"

Procedure drawaction
*-- Method: What drawing action to take
Parameters nMPointer
#Define INACTIVE_LOC " - (Inactive - "
#Define ACTIVE_LOC " - (Active - "
* Change mouse pointer and form caption as needed
If nMPointer = 1
Thisform.MousePointer = 2
Else
Thisform.MousePointer = 1
Endif
Thisform.cformmode = Iif(nMPointer = 2, ;
INACTIVE_LOC,ACTIVE_LOC)
Thisform.SetCaption
Thisform.Refresh
Endproc

Procedure drawcolor
*-- Method: Sets drawing color.
Parameters nColor, cColorName
* Set colors, add to caption
Thisform.ForeColor = nColor
Thisform.cpencolor = cColorName
Thisform.SetCaption
Endproc

Procedure SetCaption
*-- Method: Sets caption to current state
*- Set form caption to current mode, color
Local lcColorName
#Define PEN_LOC "Pen"
lcColorName = Thisform.cpencolor + PEN_LOC + ;
"/" + Ltrim(Str(Thisform.DrawWidth,3,0)) +")"
Thisform.Caption = ;
THIS.cformname + This.cformmode + lcColorName
Endproc

Procedure chgdrawmode
*-- Method: Switches drawing mode
*- Switch draw modes
Thisform.ndrawmode = Iif(Thisform.ndrawmode = 1, 0, 1)
Endproc

Procedure setpenwidth
*-- Method: Set PenWidth property
Parameters nValue
* Set pen width
Thisform.DrawWidth = nValue
Endproc

Procedure setdrawmode
*-- Method: Sets DrawMode property
Parameters nValue
* Set Draw mode
Thisform.DrawMode = nValue
Endproc

Procedure setdrawstyle
*-- Method: Sets DrawStyle property
Parameters nValue
* Set draw style
Thisform.DrawStyle = nValue
Endproc

Procedure clearform
*-- Method: Clears the form surface
* Clear the form surface
Thisform.Cls
Endproc

Procedure graphdemo
*-- Method: Main module to demo graphic methods.
Parameters nChoice
* Show various graph methods - line, circle, box

#Define DRAWSTYLE_LOC "Draw Style: "

Local I, lnXaxis,lnYaxis,lnXPos,lnYPos,lnRadius,;
lnFillStyle,lnAspect,lnBoxX,lnBoxY,lnOldDrawWidth

lnXaxis = Thisform.Width
lnYaxis = Thisform.Height
lnRadius = 90
lnAspect = 3

* Select Graphics method - Line, Circle, or Box
Do Case
Case nChoice = 1
* Draw a line in each DrawStyle
I = 1
lnOldDrawWidth = Thisform.DrawWidth
Thisform.DrawWidth = 1
Thisform.PSet(10,10)
For I = 1 To 4
Thisform.PSet(10,I*50)
Thisform.Print ( DRAWSTYLE_LOC + Str((I-1)) )
Thisform.DrawStyle = I - 1
Thisform.Line(10,I*50, lnXaxis-50,I*50)
Endfor
Thisform.DrawStyle = 0 && Reset DrawStyle to normal
Thisform.DrawWidth = lnOldDrawWidth
Case nChoice = 2
* Draw a triangle
Thisform.Line(150,50,300,200)
Thisform.Line(300,200,150,200)
Thisform.Line(150,200,150,50)
Case Str(nChoice,1,0) $ "345678"
* Circles - Open = 3, Filled = 4
* Ellipses - Open = 5, Filled = 6
* Square - Open = 7, Filled = 8
If Str(nChoice,1,0) $ "468"
* Select random fill style - 0/7
Thisform.FillStyle = Thisform.uRand(1,7)-1
Endif

* Calculate X,Y position for circle randomly in quadrant 1-4
Do Case
Case Thisform.uRand(1,4) = 1
lnXPos = lnXaxis*.25
lnYPos = lnYaxis*.25
Case Thisform.uRand(1,4) = 2
lnXPos = lnXaxis*.75
lnYPos = lnYaxis*.25
Case Thisform.uRand(1,4) = 3
lnXPos = lnXaxis*.25
lnYPos = lnYaxis*.75
Otherwise && uRand = 4
lnXPos = lnXaxis*.75
lnYPos = lnYaxis*.75
Endcase
* test draw from last position
lnXPos = Iif(Thisform.CurrentX < 2, Thisform.Width /2, Thisform.CurrentX)
lnYPos = Iif(Thisform.CurrentY < 2, Thisform.Height /2, Thisform.CurrentY)
Do Case
Case nChoice = 3 Or nChoice = 4
* Circle - plain or filled
Thisform.Circle(;
lnRadius * Rand(),lnXPos * Rand(),lnYPos * Rand() )
Case nChoice = 5 Or nChoice = 6
Thisform.Circle(;
lnRadius, lnXPos*Rand(),lnYPos*Rand(),lnAspect*Rand())
Case nChoice = 7 Or nChoice = 8
lnBoxX = 50 + Rand()*100
lnBoxY = 30 + Rand()*100
Thisform.Box( lnBoxX,lnBoxY, lnBoxX+170,lnBoxY+150 )
Endcase
Thisform.FillStyle = 1
Endcase
Thisform.Refresh
Endproc

Procedure uRand
*-- Method: Generates random number for use by graphdemo method.
Parameters nLower, nUpper
* Return uniform series of integers between nLower, nUpper
Return Int((nUpper-nLower+1)*Rand()+1)
Endproc

Procedure Init
With This
.MousePointer = 1
.BackColor = Rgb(255,255,255)
Endwith
*- Form Specific Init
#Define MODE_LOC " - (Active - "
#Define PENCOLOR_LOC "Black"
*- Set form properties
This.ScaleMode = 3
This.cformname = This.Caption
This.cformmode = MODE_LOC
This.cpencolor = PENCOLOR_LOC
This.MousePointer = 2
This.SetCaption
Thisform.timer1.Enabled=.T.
Endproc

Procedure MouseMove
Parameters nButton, nShift, nXCoord, nYCoord
*- Type of lines to draw - regular or 'anchored' (rays)
If nButton = 1 And This.MousePointer = 2
If Thisform.ndrawmode = 1 && Lines
*- Draw from MouseDown point
Thisform.Line(nXCoord, nYCoord)
Else && Rays
*- Draw to CurrentX, CurrentY
Thisform.Line(nXCoord, nYCoord, Thisform.CurrentX, Thisform.CurrentY)
Endif
Endif
Endproc

Procedure MouseDown
Parameters nButton, nShift, nXCoord, nYCoord
*- Set Start point if nDrawMode = 1 (Lines)
If Thisform.MousePointer = 2
Thisform.PSet(nXCoord, nYCoord)
Endif
Endproc

Procedure Activate
Wait Clear
Endproc

Procedure Destroy
Set Safe On
Clea Events
Endproc

Procedure timer1.Timer
If Type("thisform.oToolbar")="O" And !Isnull(Thisform.otoolbar)
Return .F.
Endif
Thisform.otoolbar=Create("fdtoolbar",Thisform)
Thisform.otoolbar.Show
Endproc

Enddefine

*-- EndDefine: ydraw

*fdtoolbar class
Define Class fdToolBar As Toolbar
oformref=.F.
ShowWindow=1
BackColor=Rgb(240,240,240) &&180,255,210)
iLastDockWidth = 0

Add Object lbl1 As Label With ;
Caption = LBL1CAP_LOC, ;
AutoSize = .T., ;
BackStyle = 0, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

* Following object Caption changes when clicked
Add Object cmdDraw As CommandButton With ;
HEIGHT = CMDHT_LOC,;
WIDTH = CMDWIDTH1_LOC, ;
Caption = CMDDRAWCAP2_LOC, ;
ToolTipText = CMDDRAWTIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object sepL2 As Separator

Add Object lbl2 As Label With ;
Caption = LBL2CAP_LOC, ;
AutoSize = .T., ;
BackStyle = 0, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

* Following object Caption changes when clicked
Add Object cmdDrawMode As CommandButton With ;
HEIGHT = CMDHT_LOC,;
WIDTH = CMDWIDTH1_LOC, ;
Caption = CMDDRAWMODECAP1_LOC, ;
ToolTipText = CMDDRAWMODETIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object sepD2 As Separator

Add Object lbl3 As Label With ;
Caption = LBL3CAP_LOC, ;
AutoSize = .T.,;
BackStyle = 0, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object spnPenWidth As Spinner With ;
VALUE = 1, ;
SpinnerLowValue = 1, ;
SpinnerHighValue = 99, ;
InputMask = "99", ;
WIDTH = CMDWIDTH1_LOC, ;
HEIGHT = CMDHT_LOC,;
ToolTipText = SPNPENWIDTHTIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object sepS As Separator

Add Object lbl4 As Label With ;
Caption = LBL4CAP_LOC,;
AutoSize = .T., ;
BackStyle = 0, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object cboPenMode As ComboBox With ;
VALUE = 13, ;
STYLE = 2, ;
WIDTH = CMDWIDTH2_LOC, ;
ToolTipText = CBOPENMODETIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object sepC1 As Separator

Add Object cmdRed As CommandButton With ;
HEIGHT = CMDHT_LOC, ;
WIDTH = CMDWIDTH2_LOC, ;
Caption = CMDREDCAP_LOC, ;
ForeColor = Rgb(255,0,0), ;
ToolTipText = CMDREDTIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object cmdGreen As CommandButton With ;
HEIGHT = CMDHT_LOC, ;
WIDTH = CMDWIDTH2_LOC, ;
Caption = CMDGREENCAP_LOC, ;
ForeColor = Rgb(0,255,0), ;
ToolTipText = CMDGREENTIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object cmdBlue As CommandButton With ;
HEIGHT = CMDHT_LOC,;
WIDTH = CMDWIDTH2_LOC,;
Caption = CMDBLUECAP_LOC, ;
ForeColor = Rgb(0,0,255),;
ToolTipText = CMDBLUETIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object cmdCustom As CommandButton With;
HEIGHT = CMDHT_LOC, ;
WIDTH = CMDWIDTH2_LOC, ;
Caption = CMDCUSTOMCAP_LOC, ;
ForeColor =16711935, ;
ToolTipText = CMDCUSTOMTIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object cmdErase As CommandButton With ;
HEIGHT = CMDHT_LOC, ;
WIDTH = CMDWIDTH2_LOC, ;
Caption = CMDERASECAP_LOC, ;
ForeColor = Rgb(255,255,255), ;
ToolTipText = CMDERASETIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object cmdClear As CommandButton With ;
HEIGHT = CMDHT_LOC,;
WIDTH = CMDWIDTH2_LOC, ;
Caption = CMDCLEARCAP_LOC, ;
ToolTipText = CMDCLEARTIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object sepClr1 As Separator

Add Object lbl5 As Label With ;
Caption = LBL5CAP_LOC, ;
AutoSize = .T., ;
BackStyle = 0, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object cboGDemo As ComboBox With ;
VALUE = 1, ;
STYLE = 2, ;
WIDTH = CMDWIDTH2_LOC, ;
ToolTipText = CBOGDEMOTIP_LOC, ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object sepCG1 As Separator

Add Object cmdCapture As CommandButton With ;
HEIGHT = CMDHT_LOC, ;
WIDTH = CMDWIDTH2_LOC, ;
Caption = "Capture FORM+drawing", ;
ToolTipText = "Capture the drawing to photo", ;
FontName = CMDFONTNAME, ;
FontSize = CMDFONTSIZE

Add Object sepCG2    As Separator       
        Add Object shape1 as shape with;
        width=CMDWIDTH2_LOC,;
        height=25,;
        curvature=15,;
        backcolor=rgb(240,240,240),;
        mousepointer=15,;
        tooltiptext="Toolbar backcolor",;
        name="shape1"   
        
    Procedure shape1.click
    local m.xcolor
    m.xcolor=getcolor()
    if ! m.xcolor=-1
    this.parent.backcolor=m.xcolor
    this.backcolor=m.xcolor
    endi
    endproc   

Procedure Init
#Define ERR_NOFORMPARM_LOC "You must pass a form reference to create this toolbar."
Parameter oForm
If Type("m.oForm")#"O" Or Isnull(m.oForm) Or Upper(oForm.BaseClass) # "FORM"
Messagebox(ERR_NOFORMPARM_LOC)
Return .F.
Endif
This.oformref = oForm
*- Setup and Dock ToolBar
This.Dock(1)
This.ScaleMode = 3
This.Caption = TBRCAP_LOC
This.ControlBox = .T.
This.SetAll('FontSize',8)
This.Visible = .T.
Push Key
On Key Label CTRL+D _Screen.ActiveForm.Parent.Release
Endproc

Procedure BeforeDock
Parameters iLocation
If This.DockPosition = -1
This.Width = This.iLastDockWidth
Endif
Endproc

Procedure AfterDock
Parameters iIndex
If This.DockPosition = 3 Or This.DockPosition = 0
??Chr(7)
This.Dock(-1)
Endif
Endproc

Procedure UnDock
Parameters iIndex
This.Width = 130
Endproc

Procedure Destroy
This.Release
Endproc

Procedure cmdDraw.Click
_Screen.ActiveForm.drawaction (_Screen.ActiveForm.MousePointer)
If _Screen.ActiveForm.MousePointer = 1
This.Caption = CMDDRAWCAP1_LOC
Else
This.Caption = CMDDRAWCAP2_LOC
Endif
Endproc

Procedure cmdDrawMode.Click
_Screen.ActiveForm.chgdrawmode
If _Screen.ActiveForm.ndrawmode = 1
This.Caption = CMDDRAWMODECAP1_LOC
Else
This.Caption = CMDDRAWMODECAP2_LOC
Endif
Endproc

Procedure spnPenWidth.InteractiveChange
_Screen.ActiveForm.setpenwidth ( This.Value )
_Screen.ActiveForm.SetCaption
Endproc

Procedure cboPenMode.InteractiveChange
_Screen.ActiveForm.setdrawmode ( This.Value )
Endproc

Procedure cboGDemo.Click
_Screen.ActiveForm.graphdemo ( This.Value )
Endproc

Procedure cmdRed.Click
_Screen.ActiveForm.drawcolor ( Rgb(255,0,0), This.Caption )
Endproc

Procedure cmdGreen.Click
_Screen.ActiveForm.drawcolor ( Rgb(0,255,0), This.Caption )
Endproc

Procedure cmdBlue.Click
_Screen.ActiveForm.drawcolor ( Rgb(0,0,255),This.Caption )
Endproc

Procedure cmdCustom.Click
Local lnColor
lnColor = Getcolor()
_Screen.ActiveForm.drawcolor ( lnColor, This.Caption )
This.ForeColor = lnColor
Endproc

Procedure cmdErase.Click
_Screen.ActiveForm.drawcolor ( Rgb(255,255,255), This.Caption )
Endproc

Procedure cmdClear.Click
_Screen.ActiveForm.clearform
Endproc

Procedure cmdCapture.Click
This.Parent.Visible=.F.
&&capture window
Declare Integer keybd_event In Win32API ;
INTEGER, Integer, Integer, Integer
VK_SNAPSHOT = 44 && from the winuser.h
VK_LMENU = 164
KEYEVENTF_KEYUP = 2
KEYEVENTF_EXTENDEDKEY = 1

*The following commands copy the active application window to the
*clipboard (the equivalent of ALT+PrintScrn):
DoEvents
keybd_event( VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0 ) && key down
keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0 )
keybd_event( VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 )
keybd_event( VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0 )
DoEvents
This.Parent.Visible=.T.
Inkey(0.5)
Run/n3 "mspaint"
Inkey(2)
oshell=Createobject("wscript.shell")
oshell.sendkeys("^{v}")
Endproc

Procedure cboPenMode.Init
This.AddItem ( CBOPENMODE1_LOC,1)
This.AddItem ( CBOPENMODE2_LOC,2 )
This.AddItem ( CBOPENMODE3_LOC,3 )
This.AddItem ( CBOPENMODE4_LOC,4 )
This.AddItem ( CBOPENMODE5_LOC,5 )
This.AddItem ( CBOPENMODE6_LOC,6 )
This.AddItem ( CBOPENMODE7_LOC,7 )
This.AddItem ( CBOPENMODE8_LOC,8 )
This.AddItem ( CBOPENMODE9_LOC,9 )
This.AddItem ( CBOPENMODE10_LOC,10 )
This.AddItem ( CBOPENMODE11_LOC,11 )
This.AddItem ( CBOPENMODE12_LOC,12 )
This.AddItem ( CBOPENMODE13_LOC,13 )
This.AddItem ( CBOPENMODE14_LOC,14 )
This.AddItem ( CBOPENMODE15_LOC,15 )
This.AddItem ( CBOPENMODE16_LOC,16 )
Endproc

Procedure cboGDemo.Init
This.AddItem ( CBOGDEMOITEM1_LOC,1 )
This.AddItem ( CBOGDEMOITEM2_LOC,2 )
This.AddItem ( CBOGDEMOITEM3_LOC,3 )
This.AddItem ( CBOGDEMOITEM4_LOC,4 )
This.AddItem ( CBOGDEMOITEM5_LOC,5 )
This.AddItem ( CBOGDEMOITEM6_LOC,6 )
This.AddItem ( CBOGDEMOITEM7_LOC,7 )
This.AddItem ( CBOGDEMOITEM8_LOC,8 )
Endproc
Enddefine
**-- EndDefine: fdtoolbar

*end code

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

*2 *
*created on  15 of february 2017.
*this code draws a background grid with lines on a form.
*the graphic grid is always on bottom.can change the spacing(1-80), the color,and the possibility to
* erase the previous drawing (or superpose it).
*infortunatly the editbox dont allow to be always transparent (the backstye property turns always to
*1 when gotfocus on it even if set backstyle=0)
*can capture the form as graphic paper...

Publi yform
yform=Newobject("ygridL")
yform.Show
Read Events
Retu
*
Define Class yGridL As Form
	Height = 540
	Width = 878
	ShowWindow = 2
	AutoCenter = .T.
	Caption = "Background graphic grid"
	MaxButton = .F.
	Name = "Form1"

	Add Object ycont As ycont0 With ;
		Anchor = 768, ;
		Top = 496, ;
		Left = 305, ;
		Width = 228, ;
		Height = 37, ;
		Name = "ycont"

	Add Object grid1 As Grid With ;
		Height = 385, ;
		Left = 79, ;
		Top = 37, ;
		Width = 672, ;
		Name = "Grid1"

	Procedure yGridL
		Local w,h,nstep,x,Y
		With Thisform
			For i=1 To .ControlCount
				Try
					If !.Controls(i).Name=="ycont"
						.Controls(i).Visible=.F.
					Endi
				Catch
				Endtry
			Endfor

			w=.Width
			h=.Height
			.ForeColor=Thisform.ycont.shape1.BackColor
			.DrawWidth=1
			If Thisform.ycont.check1.Value=1
				.Cls
			Endi
			nstep=Thisform.ycont.spinner1.Value
			For Y=0 To h Step nstep
				.Line(0,Y,w,Y)
			Endfor
			For x=0 To w Step nstep
				.Line(x,0,x,h)
			Endfor

			For i=1 To .ControlCount
				Try
					If !.Controls(i).Name=="ycont"
						.Controls(i).Visible=.T.
					Endi
				Catch
				Endtry
			Endfor
		Endwith
	Endproc

	Procedure Resize
		Thisform.yGridL()
	Endproc

	Procedure Init
		Thisform.yGridL()
	Endproc

	Procedure Destroy
		Clea Events
	Endproc

	Procedure grid1.Init
		_Screen.WindowState=1
		Close Data All
		Sele * From Home(1)+"samples\data\customer" Into  Table ycurs
		Sele ycurs
		With This
			.RecordSource="ycurs"
			.RecordSourceType=1
			.themes=.f.
			.headerHeight=26
			.setall("fontbold",.t.,"header")
			.setall("Fontsize",12,"header")
			.setall("forecolor",rgb(128,0,64),"header")
			.setall("Backcolor",rgb(0,255,255),"header")
			.DeleteMark=.F.
			.GridLines=0
			.AutoFit()
			.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0, RGB(212,210,208) , RGB(0,255,0))","column")
			.Column3.DynamicBackColor = "rgb(255,164,164)"
			.column5.DynamicBackColor ="rgb(255,255,0)"
			.Column3.FontBold=.T.
			.Column3.ForeColor=Rgb(128,0,64)
			Locate
			.Refresh
		Endwith
	Endproc

Enddefine
*
*-- EndDefine: ygridl

*
Define Class ycont0 As Container
	Anchor = 768
	Top = 496
	Left = 305
	Width = 228
	Height = 37
	Name = "ycont"

	Add Object spinner1 As Spinner With ;
		Anchor = 768, ;
		Height = 24, ;
		KeyboardHighValue = 80, ;
		KeyboardLowValue = 1, ;
		Left = 7, ;
		MousePointer = 15, ;
		SpinnerHighValue =  80.00, ;
		SpinnerLowValue =   1.00, ;
		Top = 6, ;
		Width = 84, ;
		Value = 10, ;
		Name = "Spinner1"

	Add Object check1 As Checkbox With ;
		Top = 6, ;
		Left = 115, ;
		Height = 17, ;
		Width = 42, ;
		Anchor = 768, ;
		AutoSize = .T., ;
		Alignment = 0, ;
		BackStyle = 0, ;
		Caption = "CLS", ;
		MousePointer = 15, ;
		Name = "Check1"

	Add Object shape1 As Shape With ;
		Top = 6, ;
		Left = 168, ;
		Height = 25, ;
		Width = 37, ;
		BorderStyle = 0, ;
		Curvature = 15, ;
		MousePointer = 15, ;
		BackColor = Rgb(192,192,192), ;
		Name = "Shape1"

	Procedure spinner1.InteractiveChange
		Thisform.yGridL()
	Endproc

	Procedure check1.InteractiveChange
		Thisform.yGridL()
	Endproc

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

Enddefine
*
*-- EndDefine: ycont

can capture graphic grid with code or manually with snippingtool.exe