VFP Shapes and maps drawings

Published on by Yousfi Benameur


Native vfp shapes are controls having some properties.Can be rectangular, roundrectangular or circular (set with their  property curvature 0-99).
natively they cannot embed any drawing until vfp9 adds the property Polypoint who support to make drawings as polygons.
Specifies an array of coordinates for creating polygon shapes using the Shape control and polygon lines using the Line control. Read/write at design time and run time.There is native vfp drawing (pset,box,circle...) but its only a drawing .Shape is an object an can be manipulated programmatly.
the line control can in vfp9 draw a Bezier curve  (using the LineSlant property and array).

from Foxhelp:
PolyPoints creates a polygon shape. For Line controls, PolyPoints creates a polygon line (polylines) or shape.
syntax:
Control.PolyPoints [= cArrayName]

where cArrayName Specifies the name of an array containing pairs of coordinates for drawing a polygon shape or line. Coordinates use the format (X, Y).can be also in %.
The array must be in scope in order for the object to properly display the polygon or polyline.
The array can have any dimension; however, having two columns makes it easier for you to program mainly when converting a simple cursor as i made in code.
Store the X-coordinate point in first column and store the Y-coordinate point in the second column.
The array must be filled entirely with numeric values; otherwise, trailing elements containing False (.F.) will prevent the line or shape from being drawn.

PolyPoints requires at least two pairs of coordinates to draw a line, three pairs of coordinates to draw a polygon line, three pairs of coordinates to draw a polygon shape with the Shape control, and four pairs of  coordinates to draw an enclosed polygon line, or shape, with the Line control.
 To create a polygon shape with the Line control, the fifth pair of coordinates in the array must have the  same coordinates as the first pair to draw the last line segment and complete the polygon shape.
When setting the LineSlant property to draw Bezier curves, you must specify a total of (3n + 1) coordinates
 with n representing the number of curves you want to draw. For more information, see LineSlant Property.

the codes below :
-creates a collection of points choosen manually and gathered into a cursor.(code *1*)
-the cursor is converted as array (2 columns) and populates a shape polypoint.
-that what i used to draw a map , accepting any quantity of points coordinates (x,y). code *3*
 -in code 2 i used an image and populate it with native rectangular semi transparent  shapes.this is done by the shape drawmode property.this builds a clickable map with some events as demo only.
-the gdiuplusX can also draw beautiful maps as in code *4*
-The code *5* is an example of what the web (powered with angular.js) can bring.


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


*1* gather manually data from a map into a cursor or a table
*populate the cursor at each click on region/center click on num region
*use the same form mandatory because same form coordinates (x,y) on each click
*this draw a small fill red rectangle to specify each region is gathered in cursor
*preferably click on regions 1,2,3...n to have same order in shapes created.
*this code assumes have downloaded the map (its added in code)
*the cursor (table) built is used in next code for the same map.


Set Defa To Addbs(Justpath(Sys(16,1)))
Publi yform0
yform0=Newobject("asup")
yform0.Show
Read Events
Retu
*
Define Class asup As Form
    Top = 0
	Left = 0
	Height = 480
	Width = 764
	Caption = "Gathering  map data in table.Click on the num region (center) to gather coordonnees in cursor"
	Name = "Form1"

	Add Object image1 As Image With ;
		Picture = "frdep.gif", ;
		Height = 400, ;
		Left = 12, ;
		MousePointer = 1, ;
		Top = 12, ;
		Width = 404, ;
		Name = "Image1"

	Add Object image2 As Image With ;
		Stretch = 2, ;
		Height = 217, ;
		Left = 456, ;
		Top = 24, ;
		Width = 288, ;
		Name = "Image2"

	Add Object edit1 As EditBox With ;
		Height = 229, ;
		Left = 456, ;
		Top = 248, ;
		Width = 289, ;
		Name = "Edit1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 10, ;
		Caption = "", ;
		Height = 18, ;
		Left = 518, ;
		Top = 4, ;
		Width = 2, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(255,255,128), ;
		Name = "Label1"
   
   Procedure init
   set curs off
    lcDownloadURL = "http://www.crwflags.com/fotw/misc/fr%28dep.gif"
	lcDownloadLoc ="frdep.gif"
	lnResult = DeleteUrlCacheEntry(lcDownloadURL)
	lnResult = URLDownloadToFile(0, lcDownloadURL, lcDownloadLoc , 0,0)
	If lnResult = 0
		Wait Window "Download "+lcDownloadLoc +"  Complete" Nowait
*Else
*!*        Messagebox("Download fails")
	Endi
	Thisform.image1.Picture=m.lcDownloadLoc
	endproc	
    
    
    Procedure Load
	Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
	Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName
	Create Cursor ycurs (x i,Y i,img c(100),Info m)
	Endproc

	Procedure Unload
*when close the form, the cursor yet exists.can copy it in a ycoord.dbf table (or when unload this form)
	If Messagebox("Save the cursor gatherd to ycoord.dbf?",4+64)=6
		Sele ycurs
		Copy To ycoord.Dbf
	Endi
	Endproc

	Procedure Load
	Create Cursor ycurs (x i,Y i,img c(100),Info m)
	Endproc

	Procedure image1.MouseDown
	Lparameters nButton, nShift, nXCoord, nYCoord
	With Thisform
		.ForeColor=255
		.DrawWidth=12
		.FillStyle=0
		.FillColor=255
		.PSet(nXCoord,nYCoord)
	Endwith
	Insert Into ycurs Values(nXCoord,nYCoord,"","")
	Endproc

	Procedure Destroy
	Clea Events
	Endproc

Enddefine
*
*-- EndDefine: asup


VFP Shapes and maps drawings

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


*2*the cursor calculated previously is made to work in this code to build a clickable map on a picture.

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

Publi yform
yform=Newobject("ymap")
yform.Show
Read Events
Retu
*
Define Class ymap As Form
    Top = 0
	Left = 0
	Height = 602
	Width = 921
	ShowWindow = 2
	Caption = "Fake Demo form-Click on any region"
	BackColor = Rgb(212,208,200)
	Name = "Form1"

	Add Object image1 As Image With ;
		Anchor = 15, ;
		Picture = "frdep.gif", ;
		Height = 400, ;
		Left = 12, ;
		MousePointer = 1, ;
		Top = 12, ;
		Width = 404, ;
		Name = "Image1"

	Add Object image2 As Image With ;
		Anchor = 15, ;
		Stretch = 1, ;
		BackStyle = 0, ;
		BorderStyle = 1, ;
		Height = 180, ;
		Left = 516, ;
		Top = 24-10, ;
		Visible = .F., ;
		Width = 288, ;
		Name = "Image2"

	Add Object edit1 As EditBox With ;
		FontBold = .T., ;
		FontSize = 12, ;
		Anchor = 15, ;
		BackStyle = 0, ;
		BorderStyle = 0, ;
		Height = 229, ;
		Left = 456, ;
		Top = 348, ;
		scrollbars=0,;
		Visible = .F., ;
		Width = 444, ;
		ForeColor = Rgb(0,0,255), ;
		Name = "Edit1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 24, ;
		Anchor = 768, ;
		Caption = "", ;
		Height = 25, ;
		Left = 144, ;
		Top = 444, ;
		Visible = .F., ;
		Width = 2, ;
		ForeColor = Rgb(255,0,0), ;
		BackColor = Rgb(255,255,128), ;
		Name = "Label1"

	Add Object command1 As CommandButton With ;
		Top = 504,;
		Left = 180,;
		Height = 25,;
		Width = 85,;
		FontBold = .T.,;
		FontSize = 10,;
		Anchor = 768,;
		Caption = "Circuit",;
		MousePointer = 15,;
		ForeColor = Rgb(0,0,255),;
		BackColor = Rgb(128,255,0),;
		Name = "Command1"

	Add Object yhelp As CommandButton With ;
		Top = 504,;
		Left = 180+100,;
		width=32,;
		height=25,;
		FontBold = .T.,;
		FontSize = 16,;
		Forecolor=Rgb(0,255,0),;
		Anchor = 768,;
		Caption = "?",;
		MousePointer = 15,;
		ForeColor = Rgb(0,0,255),;
		BackColor = Rgb(128,255,0),;
		Name = "yHelp"

	Add Object combo1 As ComboBox With ;
		Anchor=768, ;
		Height = 25,;
		Left = 48,;
		Top = 504,;
		Width = 50,;
		Name = "Combo1"

	Add Object yimg  As Image With ;
		Picture = "frdep.gif",;
		Stretch = 2,;
		Height = 1,;
		Left = 444,;
		Top = 252,;
		Visible = .F.,;
		Width = 1,;
		Name = "yimg"


	Add Object check1 As Checkbox With ;
		Top = 504,;
		Left = 276+40,;
		Height = 17,;
		Width = 60,;
		Anchor = 768,;
		Alignment = 0,;
		BackStyle = 0,;
		Caption = "Zoom",;
		Name = "Check1"


	Procedure yimg.Click
	With This
		.Width=1
		.Height=1
		.Visible=.F.
		.Parent.check1.Value=0
	Endwith
	Endproc

	Procedure check1.InteractiveChange
	Thisform.Cls
	If This.Value=1
		With Thisform.yimg
			.Left=0+.Parent.image1.Left
			.Top=0+.Parent.image1.Top
			.Width =.Parent.Width
			.Height=.Parent.Height
			DoEvents
*kx=(.width/thisform.image1.width)
*ky=(.height/thisform.image1.height)
			.Visible=.T.
			.ZOrder(0)
		Endwith

*with thisform
*.forecolor=255
*.drawWidth=6

*sele ycurs
*scan
*.forecolor=255
*if recno()=1
*.pset(x*kx,y*ky)
*endi
*.Line(x*kx,y*ky)
*.forecolor=rgb(0,255,0)
*.circle(10,x*kx,y*ky)
*endscan
*endwith
	Endi
	Endproc


	Procedure command1.Click
	With Thisform
		.ForeColor=255
		.DrawWidth=6
		For i=1 To 99
			x=Eval(".sh"+Trans(i))
			.ForeColor=255
			If i=1
				.PSet(x.Left+10,x.Top+10)
			Endi
			.Line(x.Left+10,x.Top+10)
			.ForeColor=Rgb(0,255,0)
			.Circle(10,x.Left+10,x.Top+10)
		Endfor
	Endwith
	Endproc

	Procedure combo1.Click
	Local xshape
	xshape=Eval("thisform.sh"+This.Value)
	With xshape
		.MouseDown(1)
	Endwith
	Endproc

	Procedure combo1.Init
	With This
		For i=1 To 99
			.AddItem( Trans(i))
		Endfor
		.ListIndex=1
		.Style=2
	Endwith
	Endproc

	Procedure my
	Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
	Local m.u  ,m.x0
	m.u=Int(Val(Substr(loObject.Name,3)))
	Sele ycurs
	Go m.u
	m.x0=loObject.BackColor
	loObject.BackColor=Rgb(0,255,0)
	With Thisform
		.DrawWidth=10
		.Circle(20,x,Y)
	Endwith
	sleep(700)
	loObject.BackColor=m.x0
	Thisform.Cls

	With Thisform
		.image2.Picture=img
		.image2.Visible=.T.
		.edit1.Value=Info
		.edit1.ForeColor=Rgb(255*Rand(),255*Rand(),255*Rand())
		.edit1.Visible=.T.
		.label1.Caption="zone"+Substr(loObject.Name,3)
		.label1.Visible=.T.
	Endwith
	Endproc

	Procedure Load
	Set Curs Off
	Declare Integer Sleep In kernel32 Integer
	Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
	Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName

*sele * from ycoord into cursor ycurs readwrite  &&if table ycoord prepared before
	Create Cursor ycurs(num i,x i,Y i,img c(100),Info m)
	Insert Into ycurs Values(0,44,130,"","")
	Insert Into ycurs Values(0,74,130,"","")
	Insert Into ycurs Values(0,113,140,"","")
	Insert Into ycurs Values(0,76,152,"","")
	Insert Into ycurs Values(0,107,171,"","")
	Insert Into ycurs Values(0,143,175,"","")
	Insert Into ycurs Values(0,139,146,"","")
	Insert Into ycurs Values(0,129,102,"","")
	Insert Into ycurs Values(0,155,102,"","")
	Insert Into ycurs Values(0,166,121,"","")
	Insert Into ycurs Values(0,165,150,"","")
	Insert Into ycurs Values(0,202,132,"","")
	Insert Into ycurs Values(0,227,129,"","")
	Insert Into ycurs Values(0,218,114,"","")
	Insert Into ycurs Values(0, 195,102,"","")
	Insert Into ycurs Values(0, 194, 80,"","")
	Insert Into ycurs Values(0, 230, 44,"","")
	Insert Into ycurs Values(0, 264, 48,"","")
	Insert Into ycurs Values(0, 230, 68,"","")
	Insert Into ycurs Values(0, 230, 88,"","")
	Insert Into ycurs Values(0, 264, 82,"","")
	Insert Into ycurs Values(0, 302, 78,"","")
	Insert Into ycurs Values(0, 322,107,"","")
	Insert Into ycurs Values(0, 288,107,"","")
	Insert Into ycurs Values(0, 248,123,"","")
	Insert Into ycurs Values(0, 119,204,"","")
	Insert Into ycurs Values(0, 155,213,"","")
	Insert Into ycurs Values(0, 178,212,"","")
	Insert Into ycurs Values(0, 179,184,"","")
	Insert Into ycurs Values(0, 200,165,"","")
	Insert Into ycurs Values(0, 228,153,"","")
	Insert Into ycurs Values(0,206,202,"","")
	Insert Into ycurs Values(0,238,192,"","")
	Insert Into ycurs Values(0,266,192,"","")
	Insert Into ycurs Values(0,264,160,"","")
	Insert Into ycurs Values(0,284,133,"","")
	Insert Into ycurs Values(0,316,148,"","")
	Insert Into ycurs Values(0,344,123,"","")
	Insert Into ycurs Values(0,354,102,"","")
	Insert Into ycurs Values(0,385,115,"","")
	Insert Into ycurs Values(0,351,138,"","")
	Insert Into ycurs Values(0,375,152,"","")
	Insert Into ycurs Values(0,343,162,"","")
	Insert Into ycurs Values(0,301,172,"","")
	Insert Into ycurs Values(0,301,209,"","")
	Insert Into ycurs Values(0,333,205,"","")
	Insert Into ycurs Values(0,342,185,"","")
	Insert Into ycurs Values(0,368,165,"","")
	Insert Into ycurs Values(0,258,222,"","")
	Insert Into ycurs Values(0,228,234,"","")
	Insert Into ycurs Values(0,200,245,"","")
	Insert Into ycurs Values(0,168,253,"","")
	Insert Into ycurs Values(0,143,249,"","")
	Insert Into ycurs Values(0,145,293,"","")
	Insert Into ycurs Values(0,184,280,"","")
	Insert Into ycurs Values(0,217,271,"","")
	Insert Into ycurs Values(0,254,251,"","")
	Insert Into ycurs Values(0,284,252,"","")
	Insert Into ycurs Values(0,299,246,"","")
	Insert Into ycurs Values(0,316,238,"","")
	Insert Into ycurs Values(0,355,236,"","")
	Insert Into ycurs Values(0,357,255,"","")
	Insert Into ycurs Values(0,336,265,"","")
	Insert Into ycurs Values(0,281,277,"","")
	Insert Into ycurs Values(0,248,277,"","")
	Insert Into ycurs Values(0,213,299,"","")
	Insert Into ycurs Values(0,175,311,"","")
	Insert Into ycurs Values(0,136,327,"","")
	Insert Into ycurs Values(0,131,359,"","")
	Insert Into ycurs Values(0,162,368,"","")
	Insert Into ycurs Values(0,173,342,"","")
	Insert Into ycurs Values(0,192,329,"","")
	Insert Into ycurs Values(0,241,313,"","")
	Insert Into ycurs Values(0,267,306,"","")
	Insert Into ycurs Values(0,299,296,"","")
	Insert Into ycurs Values(0,321,296,"","")
	Insert Into ycurs Values(0,353,297,"","")
	Insert Into ycurs Values(0,351,319,"","")
	Insert Into ycurs Values(0,379,327,"","")
	Insert Into ycurs Values(0,356,346,"","")
	Insert Into ycurs Values(0,323,327,"","")
	Insert Into ycurs Values(0,322,346,"","")
	Insert Into ycurs Values(0,298,329,"","")
	Insert Into ycurs Values(0,264,346,"","")
	Insert Into ycurs Values(0,228,337,"","")
	Insert Into ycurs Values(0,233,366,"","")
	Insert Into ycurs Values(0,238,393,"","")
	Insert Into ycurs Values(0,210,378,"","")
	Insert Into ycurs Values(0,202,355,"","")
	Insert Into ycurs Values(0, 28,271,"","")
	Insert Into ycurs Values(0, 20,281,"","")
	Insert Into ycurs Values(0, 44,270,"","")
	Insert Into ycurs Values(0, 55,259,"","")
	Insert Into ycurs Values(0, 42,244,"","")
	Insert Into ycurs Values(0, 74,265,"","")
	Insert Into ycurs Values(0, 58,281,"","")
	Insert Into ycurs Values(0, 42,293,"","")
	Insert Into ycurs Values(0, 56,357,"","")
	Insert Into ycurs Values(0, 52,382,"","")

	Local m.myvar,gnbre,i
	TEXT to m.myvar noshow
		Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
		fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
		nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
		Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra
		auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
	ENDTEXT
	Local gnbre
	gnbre=Adir(gabase, Home(1)+"graphics\icons\misc\*.ico")  &&some pictures as icons here (88)
	Repl All num With Recno()
	Locate
	i=1
	Scan
		If i<=gnbre
			Repl img With Home(1)+"graphics\icons\misc\"+Allt(gabase(i,1))
		Else
			Repl img With Home(1)+"graphics\icons\misc\"+Allt(gabase(Recno()-gnbre,1))
		Endi
		i=i+1
		Repl Info With Trans(Recno())+". "+m.myvar
	Endscan
*brow
	Endproc

	Procedure Init
	lcDownloadURL = "http://www.crwflags.com/fotw/misc/fr%28dep.gif"
	lcDownloadLoc ="frdep.gif"
	lnResult = DeleteUrlCacheEntry(lcDownloadURL)
	lnResult = URLDownloadToFile(0, lcDownloadURL, lcDownloadLoc , 0,0)
	If lnResult = 0
		Wait Window "Download "+lcDownloadLoc +"  Complete" Nowait
*Else
*!*        Messagebox("Download fails")
	Endi
	Thisform.image1.Picture=m.lcDownloadLoc
	Thisform.yimg.Picture=m.lcDownloadLoc
	Sele ycurs
	Locate
	Scan
		i=Recno()
		With Thisform
			.AddObject("sh"+Trans(i),"shape")

			With Eval(".sh"+Trans(i))
				.Left=x-10
				.Top=Y-10
				.Width=20
				.Height=20
				.BackStyle=1   &&0
				.BorderStyle=0
				.MousePointer=15
				.Visible=.T.
			Endwith
			Bindevent(Eval("thisform.sh"+Trans(i)),"mousedown",Thisform,"my")
		Endwith
	Endscan
	Thisform.SetAll("drawmode",9,"shape")
	Endproc

	Procedure yhelp.Click
	Local m.myvar
	TEXT to m.myvar noshow
   This is a country Fr* map (can be any porepared map) with subdivisions in zones as 99 regions.
-in first step must gather all pointswith tjeir coordinates x,y in a cursor or physical table.
in this cursor add other fields can desserve the project(images,information...)
that is done by executing the first form yform_shapes0.cx

-in second step run the form yform_shape.scx
its exactly the same form as the first (dont change dimensions because the points are with their coordinates x,y).
this builds a clickable map.
any ckicl on any region  fires an image+relative informations (can add other things...)
Any click on combo does same thing+draw temporarly circle n region cibled
Clicking the button circuit draw all regions centers (invisible shapes) and lines.
here a region is defined with a simpe rectangular shape.for more complexity can define a region entierely
with a curve as polypoint(many points x,y attached to a region....as an SVG does.)

Yousfi Benameur  10 march 2016
	ENDTEXT
	Messagebox(m.myvar,0+32+4096,"Summary help")

	Procedure Destroy
	Clea Events
	Endproc

Enddefine
*
*-- EndDefine: ymap



VFP Shapes and maps drawings

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


*3*recquires vfp9 (polypoint array)
*the map is built point by point by the first code *1* and Algeria source map picture.

publi yform
yform=newObject("ymap_algeria")
yform.show
read events
retu
*
DEFINE CLASS ymap_algeria AS form
    Top = 4
	Left = 1
	Height = 620
	Width = 950
	ShowWindow = 2
	ScrollBars = 3
    picture=""      &&can populate picture  and make shape transparent
	Caption = "Shapes & map on a form  -  Drag the map by mouseDown"
	BackColor = RGB(212,208,200)
	xoffset = .F.
	yoffset = .F.
	Name = "Form1"
	
	ADD OBJECT ymap AS shape WITH ;
		Top = 27, ;
		Left = 120, ;
		Height = 588, ;
		Width = 828, ;
		Anchor = 0, ;
		BackStyle = 0, ;
		BorderWidth = 3, ;
		FillStyle = 7, ;
		MousePointer = 15, ;
		SpecialEffect = 0, ;
		FillColor = RGB(0,0,255), ;
		BorderColor = RGB(128,0,255), ;
		ZOrderSet = 21, ;
		PolyPoints = "THIS.aPoly", ;
		Name = "ymap"

	ADD OBJECT container1 AS ycont WITH ;
		Top = 0, ;
		Left = 0, ;
		Width = 130, ;
		Height = 336, ;
		BackStyle = 0, ;
		BorderWidth = 0, ;
		BorderColor = RGB(0,0,255), ;
		Name = "Container1"

	PROCEDURE DragDrop
		LPARAMETERS oSource, nXCoord, nYCoord
		oSource.Left = nXCoord - THISFORM.XOffset
		oSource.Top = nYCoord - THISFORM.YOffset
	ENDPROC

	PROCEDURE Load
		 Create Cursor ycurs (x i,Y i)
		       insert into ycurs values(532,37  )
		insert into ycurs values(523,35   )
		insert into ycurs values(513,40   )
		insert into ycurs values(503,33   )
		insert into ycurs values(493,37   )
		insert into ycurs values(480,36   )
		insert into ycurs values(469,41   )
		insert into ycurs values(460,41   )
		insert into ycurs values(453,46   )
		insert into ycurs values(445,41   )
		insert into ycurs values(431,39   )
		insert into ycurs values(419,41   )
		insert into ycurs values(412,42   )
		insert into ycurs values(402,43   )
		insert into ycurs values(393,46   )
		insert into ycurs values(381,46   )
		insert into ycurs values(366,51  )
		insert into ycurs values(358,50  )
		insert into ycurs values(347,56  )
		insert into ycurs values(335,59  )
		insert into ycurs values(328,64  )
		insert into ycurs values(322,71  )
		insert into ycurs values(313,69  )
		insert into ycurs values(305,74 )
		insert into ycurs values(296,79  )
		insert into ycurs values(290,84  )
		insert into ycurs values(280,90  )
		insert into ycurs values(273,91 )
		insert into ycurs values(280,98 )
		insert into ycurs values(284,107 )
		insert into ycurs values(282,117 )
		insert into ycurs values(282,125)
		insert into ycurs values(283,134 )
		insert into ycurs values(284,143 )
		insert into ycurs values(288,155 )
		insert into ycurs values(294,164 )
		insert into ycurs values(295,174 )
		insert into ycurs values(286,180 )
		insert into ycurs values(277,177 )
		insert into ycurs values(267,177  )
		insert into ycurs values(258,176  )
		insert into ycurs values(248,179  )
		insert into ycurs values(244,185 )
		insert into ycurs values(235,188 )
		insert into ycurs values(228,190  )
		insert into ycurs values(226,199  )
		insert into ycurs values(227,205 )
		insert into ycurs values(220,213  )
		insert into ycurs values(206,220  )
		insert into ycurs values(197,220 )
		insert into ycurs values(190,233  )
		insert into ycurs values(181,239  )
		insert into ycurs values(171,239 )
		insert into ycurs values(159,238 )
		insert into ycurs values(153,244)
		insert into ycurs values(145,241 )
		insert into ycurs values(133,244 )
		insert into ycurs values(128,250 )
		insert into ycurs values(114,256 )
		insert into ycurs values(106,262 )
		insert into ycurs values( 99,268 )
		insert into ycurs values( 97,278 )
		 insert into ycurs values(97,289  )
		 insert into ycurs values(95,301 )
		insert into ycurs values(100,309 )
		insert into ycurs values(110,320  )
		insert into ycurs values(122,331  )
		insert into ycurs values(130,339 )
		insert into ycurs values(138,346 )
		insert into ycurs values(150,351 )
		insert into ycurs values(163,360 )
		insert into ycurs values(172,371 )
		insert into ycurs values(177,376)
		insert into ycurs values(188,382 )
		insert into ycurs values(199,393 )
		insert into ycurs values(210,398 )
		insert into ycurs values(222,406 )
		insert into ycurs values(230,415 )
		insert into ycurs values(234,417 )
		insert into ycurs values(245,426 )
		insert into ycurs values(253,433 )
		insert into ycurs values(259,442 )
		insert into ycurs values(272,448 )
		insert into ycurs values(280,454 )
		insert into ycurs values(288,463 )
		insert into ycurs values(295,466 )
		insert into ycurs values(306,473 )
		insert into ycurs values(313,479 )
		insert into ycurs values(317,481 )
		insert into ycurs values(325,485 )
		insert into ycurs values(331,489)
		insert into ycurs values(337,494 )
		insert into ycurs values(342,499 )
		insert into ycurs values(348,508 )
		insert into ycurs values(352,517 )
		insert into ycurs values(362,521)
		insert into ycurs values(365,528 )
		insert into ycurs values(374,529 )
		insert into ycurs values(380,532 )
		insert into ycurs values(389,536 )
		insert into ycurs values(398,536 )
		insert into ycurs values(402,548 )
		insert into ycurs values(403,551 )
		insert into ycurs values(403,557 )
		insert into ycurs values(405,563 )
		insert into ycurs values(417,565 )
		insert into ycurs values(426,563)
		insert into ycurs values(436,562 )
		insert into ycurs values(444,558)
		insert into ycurs values(459,555 )
		insert into ycurs values(465,553 )
		insert into ycurs values(473,550 )
		insert into ycurs values(485,543 )
		insert into ycurs values(497,531 )
		insert into ycurs values(507,523 )
		insert into ycurs values(515,514 )
		insert into ycurs values(530,504)
		insert into ycurs values(543,492 )
		insert into ycurs values(556,484 )
		insert into ycurs values(573,476 )
		insert into ycurs values(583,467)
		insert into ycurs values(596,460 )
		insert into ycurs values(607,448)
		insert into ycurs values(620,437 )
		insert into ycurs values(636,426)
		insert into ycurs values(633,412 )
		insert into ycurs values(623,403)
		insert into ycurs values(613,396 )
		insert into ycurs values(602,396)
		insert into ycurs values(592,397 )
		insert into ycurs values(586,387 )
		insert into ycurs values(581,373 )
		insert into ycurs values(574,359 )
		insert into ycurs values(565,353 )
		insert into ycurs values(571,344 )
		insert into ycurs values(578,336 )
		insert into ycurs values(573,327 )
		insert into ycurs values(573,318 )
		insert into ycurs values(576,310)
		insert into ycurs values(578,304 )
		insert into ycurs values(574,290 )
		insert into ycurs values(575,274 )
		insert into ycurs values(575,262 )
		insert into ycurs values(566,248 )
		insert into ycurs values(559,232 )
		insert into ycurs values(564,218 )
		insert into ycurs values(557,203 )
		insert into ycurs values(551,184 )
		insert into ycurs values(543,175)
		insert into ycurs values(534,166 )
		insert into ycurs values(529,155 )
		insert into ycurs values(521,148 )
		insert into ycurs values(515,142 )
		insert into ycurs values(511,137 )
		insert into ycurs values(510,125 )
		insert into ycurs values(514,117 )
		insert into ycurs values(521,110 )
		insert into ycurs values(526,105 )
		insert into ycurs values(526,99)
		insert into ycurs values(529,88 )
		insert into ycurs values(529,82 )
		insert into ycurs values(527,71 )
		insert into ycurs values(523,68 )
		insert into ycurs values(523,62 )
		insert into ycurs values(526,58 )
		insert into ycurs values(528,49 )
		insert into ycurs values(533,43 )
		sele ycurs
	ENDPROC

	PROCEDURE Init
		with this
		.width=sysmetric(1)-5
		.height=sysmetric(2)-34
		.left=-5
		.top=0
		.setall("mousepointer",15,"commandbutton")
		.setall("backcolor",rgb(0,255,0),"commandbutton")
		.setall("anchor",768,"commandbutton")
		endwith
	ENDPROC

	PROCEDURE Destroy
		close data all
		clea events
	ENDPROC

	PROCEDURE ymap.Click
		local m.myvar
		text to m.myvar noshow
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat
fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum
nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra
auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non
sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie
sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit
velit vel ex aliquam, eget convallis ante mollis.
*end*
		endtext
		messagebox(m.myvar,0+32+4096,"Algeria map")
	ENDPROC

	PROCEDURE ymap.MouseMove
		LPARAMETERS nButton, nShift, nXCoord, nYCoord
		IF nButton = 1 && Left button
			THISFORM.XOffset = nXCoord - THIS.Left
			THISFORM.YOffset = nYCoord - THIS.Top
			THIS.Drag
		ENDIF
	ENDPROC

	PROCEDURE ymap.DragDrop
		LPARAMETERS oSource, nXCoord, nYCoord
		THIS.Parent.DragDrop(oSource, nXCoord, nYCoord)
		thisform.container1.zorder(0)
	ENDPROC

	PROCEDURE ymap.Init
		this.addproperty("w0",this.width)
		this.addproperty("h0",this.height)
		this.w0=this.width
		this.h0=this.height
		THIS.AddProperty("aPoly[1,1]")
		sele ycurs
		DIMENSION THISform.ymap.aPoly[reccount(),2]
		scan
		x=x+100
		y=y+100
		thisform.ymap.aPoly[recno(),1]=100*x/thisform.ymap.width
		thisform.ymap.aPoly[recno(),2]=100*y/thisform.ymap.height
		endscan
		this.zorder(0)
	ENDPROC

ENDDEFINE
*
*-- EndDefine: ymap_Algeria
DEFINE CLASS ycont AS container
	Top = 0
	Left = 0
	Width = 115
	Height = 336
	BackStyle = 0
	BorderWidth = 0
	BorderColor = RGB(0,0,255)
	Name = "ycont"

	ADD OBJECT check2 AS checkbox WITH ;
		Top = 38, ;
		Left = 7, ;
		Height = 29, ;
		Width = 101, ;
		FontBold = .T., ;
		FontSize = 10, ;
		Anchor = 768, ;
		AutoSize = .F., ;
		Alignment = 0, ;
		Caption = "Backstyle", ;
		Style = 1, ;
		ForeColor = RGB(255,0,0), ;
		BackColor = RGB(128,255,0), ;
		Name = "Check2"

	ADD OBJECT check1 AS checkbox WITH ;
		Top = 68, ;
		Left = 7, ;
		Height = 27, ;
		Width = 95, ;
		Anchor = 768, ;
		AutoSize = .T., ;
		Alignment = 0, ;
		Caption = "Draw the map", ;
		MousePointer = 15, ;
		Style = 1, ;
		BackColor = RGB(128,255,0), ;
		Name = "Check1"

	ADD OBJECT command7 AS commandbutton WITH ;
		Top = 96, ;
		Left = 7, ;
		Height = 25, ;
		Width = 73, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "FillColor", ;
		BackColor = RGB(128,255,0), ;
		Name = "Command7"

	ADD OBJECT command3 AS commandbutton WITH ;
		Top = 126, ;
		Left = 7, ;
		Height = 25, ;
		Width = 73, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Fillstyle 0-7", ;
		BackColor = RGB(128,255,0), ;
		Name = "Command3"

	ADD OBJECT check3 AS checkbox WITH ;
		Top = 158, ;
		Left = 7, ;
		Height = 29, ;
		Width = 87, ;
		FontBold = .T., ;
		FontSize = 10, ;
		Anchor = 768, ;
		AutoSize = .T., ;
		Alignment = 0, ;
		Caption = "Rotation+-", ;
		Style = 1, ;
		ForeColor = RGB(255,0,0), ;
		BackColor = RGB(128,255,0), ;
		Name = "Check3"

	ADD OBJECT command4 AS commandbutton WITH ;
		Top = 195, ;
		Left = 7, ;
		Height = 25, ;
		Width = 97, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Center shape", ;
		BackColor = RGB(128,255,0), ;
		Name = "Command4"

	ADD OBJECT command6 AS commandbutton WITH ;
		Top = 228, ;
		Left = 7, ;
		Height = 25, ;
		Width = 97, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Zoom 2x", ;
		BackColor = RGB(128,255,0), ;
		Name = "Command6"

	ADD OBJECT olecontrol1 AS olecontrol WITH ;
	    oleClass="MSComctlLib.Slider.2",;
		Top = 260, ;
		Left = 7, ;
		Height = 24, ;
		Width = 100, ;
		Anchor = 768, ;
		Name = "Olecontrol1"

	ADD OBJECT command8 AS commandbutton WITH ;
		Top = 297, ;
		Left = 7, ;
		Height = 25, ;
		Width = 140, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Drawmodes(1-16)", ;
		BackColor = RGB(128,255,0), ;
		Name = "Command8"

	ADD OBJECT line1 AS line WITH ;
		BorderWidth = 6, ;
		Height = 0, ;
		Left = 37, ;
		MousePointer = 15, ;
		Top = 8, ;
		Width = 36, ;
		Name = "Line1"

	ADD OBJECT line2 AS line WITH ;
		BorderWidth = 6, ;
		Height = 0, ;
		Left = 37, ;
		MousePointer = 15, ;
		Top = 14, ;
		Width = 36, ;
		Name = "Line2"

	ADD OBJECT line3 AS line WITH ;
		BorderWidth = 6, ;
		Height = 0, ;
		Left = 37, ;
		MousePointer = 15, ;
		Top = 21, ;
		Width = 36, ;
		Name = "Line3"

	ADD OBJECT shape1 AS shape WITH ;
		Top = 1, ;
		Left = 25, ;
		Height = 25, ;
		Width = 61, ;
		BackStyle = 0, ;
		BorderStyle = 0, ;
		BorderWidth = 0, ;
		MousePointer = 15, ;
		Name = "Shape1"

	PROCEDURE Init
		with this
		for i=1 to .controlcount
		.controls(i).visible=.f.
		endfor
		.backstyle=0
		.borderwidth=0
		.height=30
		.line1.visible=.t.
		.line2.visible=.t.
		.line3.visible=.t.
		.shape1.visible=.t.
		endwith
	ENDPROC

	PROCEDURE check2.InteractiveChange
		if this.value=1
		thisform.ymap.backStyle=1
		else
		thisform.ymap.backStyle=0
		endi
	ENDPROC


	PROCEDURE check1.InteractiveChange
		if this.value=1
		this.caption="Clear map"
		sele ycurs
		locate
		with thisform
		.drawWidth=12
		.forecolor=255
		.fillstyle=0
		.fillcolor=rgb(0,255,0)
		.pset(x+thisform.ymap.left,y+thisform.ymap.top)
		endwith

		scan
		thisform.line(x+thisform.ymap.left,y+thisform.ymap.top)
		endscan
		else
		this.caption="Draw the map"
		thisform.cls
		endi
	ENDPROC

	PROCEDURE command7.Click
		local m.xcolor
		m.xcolor=getcolor()
		if m.xcolor=-1
		retu .f.
		endi
		thisform.ymap.fillcolor=m.xcolor
	ENDPROC

	PROCEDURE command3.Click
		for i=0 to 7
		thisform.ymap.fillStyle=i
		thisform.ymap.fillcolor=rgb(255*rand(),255*rand(),255*rand())
		wait window "FillStyle="+trans(i) nowait
		inke(1)
		endfor
	ENDPROC

	PROCEDURE check3.InteractiveChange
		if this.value=0
		this.caption="Rotation -"
		thisform.ymap.rotation=360
		WITH THISform
			FOR i = 1 TO 35
				INKEY(.1,"H")
		 		.ymap.Rotation = .ymap.Rotation - 10
		 	ENDFOR
		ENDWITH
		THISFORM.SetAll("Rotation",0,"Shape")
		else
		this.caption="Rotation+"
		WITH THISform
			FOR i = 1 TO 35
				INKEY(.1,"H")
		 		.ymap.Rotation = .ymap.Rotation + 10
		 	ENDFOR
		ENDWITH
		THISFORM.SetAll("Rotation",0,"Shape")
    	endi
	ENDPROC

	PROCEDURE command4.Click
		with thisform.ymap
		.left=(thisform.width-.width)/2
		.top=(thisform.height-.height)/2
		endwith
	ENDPROC

	PROCEDURE command6.Click
		with thisform.ymap
		.width=2*.w0
		.height=2*.h0
		endwith
		thisform.refresh
	ENDPROC

	PROCEDURE olecontrol1.Change
		*** Événement de contrôle ActiveX  ***
		with thisform.ymap
		.width=.w0*(1+this.value/100)
		.height=int(.h0*(1+this.value/100))
		endwith
		thisform.refresh
	ENDPROC

	PROCEDURE command8.Click
		for i=1 to 16
		thisform.ymap.drawmode=i
		inke(1)
		endfor
		thisform.ymap.drawmode=13
	ENDPROC

	PROCEDURE shape1.Click
		if this.parent.height>30
		this.parent.height=30
		with this.parent
		for i=1 to .controlcount
		.controls(i).visible=.f.
		endfor
		.backstyle=0
		.borderwidth=0
		.height=30
		.line1.visible=.t.
		.line2.visible=.t.
		.line3.visible=.t.
		.shape1.visible=.t.
		endwith
		else
		this.parent.height=336
		with this.parent
		for i=1 to .controlcount
		.controls(i).visible=.t.
		endfor
		.backstyle=0
		.borderwidth=0  &&1
		.height=336
		endwith
		endi
		this.parent.zorder(0)
	ENDPROC

ENDDEFINE
*
*-- EndDefine: ycont


VFP Shapes and maps drawings

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


*4*
*the code asks for  the gdiplusX location (or copy it (vcx/vct) in the source folder)+system.app location.

*draw a gdiplusX map with data gathered in a cursor(see first code)
*can change colors,view/save in msPaint or save directly as a PNG

Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
set defa to (yrep)
*download a photo for background

Declare Integer Sleep In kernel32 Integer
    Declare Integer URLDownloadToFile In urlmon.Dll Integer pCaller, String szURL, String szFileName, Integer dwReserved, Integer lpfnCB
	Declare Integer DeleteUrlCacheEntry In wininet String lpszUrlName

lcDownloadURL = "http://img.over-blog-kiwi.com/1/43/54/07/20160313/ob_1f4998_sam-2260-resized.JPG"
	lcDownloadLoc ="kantara.jpg"
	lnResult = DeleteUrlCacheEntry(lcDownloadURL)
	lnResult = URLDownloadToFile(0, lcDownloadURL, lcDownloadLoc , 0,0)
	If lnResult = 0
		Wait Window "Download "+lcDownloadLoc +"  Complete" Nowait
*Else
*!*        Messagebox("Download fails")
	Endi
	

Do Locfile("system.app")  &&point to system.app
Set Classlib To  locfile("gdiplusX") AddI  && hardcode  it in the code definitively

Publi yform
yform=Newobject("ymap_algeria")
yform.Show
Release Classlib "gdiplusX"
Read Events
Return

Define Class ymap_algeria As Form
    Height = 714
	Width = 995
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "GdiPlusX Algeria MAP - Drawing polygons"
	KeyPreview = .T.
	WindowState = 2
	BackColor = Rgb(0,0,0)
	ycolor1 = 255
	ycolor2 = 1254
	nmode = 3
	nbr = 5
	ycolor0 = 0
	ycli = 0
    ypict=.f.
	Name = "Form1"

	Add Object imgcanvas As imgcanvas With ;
		Anchor = 15, ;
		Stretch = 2, ;
		Height = 672, ;
		Left = 0, ;
		Top = 0, ;
		Width = 997, ;
		drawWhenInvisible=.T.,;
		Name = "imgcanvas"

	Add Object command2 As CommandButton With ;
		Top = 686-5, ;
		Left = 110, ;
		Height = 27, ;
		Width = 200 ,;
		Anchor = 768, ;
		Caption = "Re click to Switch  multi colors", ;
		ToolTipText = "acolor(5)=.color.brown", ;
		BackColor = Rgb(0,255,0), ;
		Name = "Command2"
      
     Add Object ycom As CommandButton With ;
    	Top = 686-5, ;
		Left = 320, ;
		Height = 25, ;
		Width = 73, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Bgd Picture", ;
		BackColor = Rgb(0,255,0), ;
		Name = "ycom"	 

	Add Object command5 As CommandButton With ;
		Top = 681-10, ;
		Left = 608, ;
		Height = 35, ;
		Width = 36, ;
		Anchor = 768, ;
		Picture = Home(1)+"graphics\icons\misc\camera.ico", ;
		Caption = "", ;
		ToolTipText = "Capture  image+View", ;
		Name = "Command5"

	Add Object command6 As CommandButton With ;
		Top = 686-5, ;
		Left = 685-30, ;
		Height = 25, ;
		Width = 73, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Save", ;
		BackColor = Rgb(0,255,0), ;
		Name = "Command6"
  Procedure ycom.click
    thisform.ypict=.t.	
	thisform.imgcanvas.draw	
  endproc	


	Procedure ypolygon
	Lparameters nb
* build polygon array
	Sele  ycurs
	Count To xx    &&For Not Deleted()
	locate
	Dimension  Mat0(xx,2)
	i=1
	v=""
	*Do While Not Eof()
	scan
		If Not Deleted()
			Mat0(i,1)=nx
			Mat0(i,2)=ny
			v=v+"Mat0("+Allt(Str(i))+",1)="+Allt(Str(nx))+Chr(13)+"Mat0("+Allt(Str(i))+",2)="+Allt(Str(ny))+Chr(13)
			i=i+1
		Endi
		*Skip
	*Enddo
	endscan
	
	vv="dimension Mat0("+Allt(Str(i-1))+",2)"+Chr(13) +v
	TEXT to myvar noshow
        <<vv>>
	ENDTEXT
	Endproc

	Procedure ypat
	With _Screen.System.Drawing
		pth = .Drawing2D.GraphicsPath.New()
		nn=Alen(Mat0)
		aa=""
		For i=1 To Alen(Mat0)-1  Step 2
			pth.AddLine(.Point.New(Mat0(i),Mat0(i+1)),.Point.New(Mat0(i+2),Mat0(i+3)) )
			aa=aa+Trans(".point.new("+Trans(Mat0(i))+ "," +Trans(Mat0(i+1))+ "),"  +".point.new("+Trans(Mat0(i))+ "," +Trans(Mat0(i+1))+")")+Chr(13)
			If i>nn-4
				Exit
			Endi
		Endfor
		pth.closeFigure()
	Endwith
	Return pth
	Endproc

	Procedure Init
	Set Esca Off
	Thisform.SetAll("mousepointer",15,"commandbutton")
	Publi ii,pth,Mat0
	ii=0
	This.imgcanvas.Visible=.T.
	This.imgcanvas.Left=This.Left
	This.imgcanvas.Top=This.Top
	This.imgcanvas.Width=This.Width
	This.imgcanvas.Height=This.Height
	Thisform.ycolor0=0  &&black
   This.ycolor1=255
	This.ycolor2=Rgb(0,255,0)

	Sele ycurs
	Thisform.nbr=Reccount()
	thisform.caption="GdiPlusX Algeria MAP - Drawing polygons"
	Endproc
	
	Procedure activate
	with this  &&to make form.caption appears !
	.width=.width+1
	.width=.width-1
	endwith
	endproc
	
	Procedure Destroy
	Clea Events
	Endproc

	Procedure imgcanvas.beforedraw
	Local yPath As xfcGraphicsPath
	Local pgb As xfcPathGradientBrush
	Local logfx
	Local w,h
	Thisform.nmode=Thisform.nmode+1
	If Thisform.nmode>3
		Thisform.nmode=1
	Endi
	logfx=This.ogfx
	With _Screen.System.Drawing
		logfx.SmoothingMode = .Drawing2D.SmoothingMode.AntiAlias
		This.Clear(.Color.black)      &&fromRGB(thisform.ycolor0))
		Thisform.ypolygon(Thisform.nbr)

		gnInférieur = 1
		gnSupérieur = 10
		num=Int((gnSupérieur - gnInférieur + 1) * Rand( ) + gnInférieur)
		Do Case
		Case num=1
			yloBrush=".Brushes.gold"
		Case num=2
			yloBrush=".Brushes.blue"
		Case num=3
			yloBrush=".Brushes.green"
		Case num=4
			yloBrush=".Brushes.cyan"
		Case num=5
			yloBrush=".Brushes.red"
		Case num=6
			yloBrush=".Brushes.pink"
		Case num=7
			yloBrush=".Brushes.yellow"
		Case num=8
			yloBrush=".Brushes.white"
		Case num=9
			yloBrush=".Brushes.gray"
		Case num=10
			yloBrush=".Brushes.black"
		Endcase

		This.ogfx.FillPolygon(&yloBrush, @Mat0)
		Pen = .Pen.New(.Color.fromrgb(255*Rand(),255*Rand(),255*Rand()), 4)
		This.ogfx.DrawPolygon(Pen, @Mat0)
		Pen.Dispose()

		Thisform.ypat()
		pgb=.Drawing2D.PathGradientBrush.New(pth)
		pgb.CenterColor=.Color.White

		pgb.SurroundColors=.Color.fromARGB(80,255*Rand(),255*Rand(),255*Rand())

if thisform.ypict=.f.
    	logfx.FillPath(pgb,pth)
		pgb.Dispose()
else

if file("Kantara.jpg")
img = .IMAGE.FromFile("KANTARA.JPG")
pgb = .TextureBrush.New(img)
logfx.FillPath(pgb,pth)
		pgb.Dispose()
endi        
endi

*texte
		Local loFont As xfcFont
		Local loBrush As xfcLinearGradientBrush
		Local loRectangleF As xfcRectangleF
		Local loSizeF As xfcSizeF
		ystring="Yousfi.overBlog.com/"
		ystring1="ALGERIA MAP"
		loFont  = .Font.New("Arial Black",14,  .FontStyle.Bold)
		loFont1 = .Font.New("Batavia",36,  .FontStyle.Bold)

		loSizeF = logfx.MeasureString(ystring, loFont)
		loSizeF1 = logfx.MeasureString(ystring1, loFont1)

		loRectangleF =_Screen.System.Drawing.RectangleF.New(0,5,loSizeF.Width, loSizeF.Height)
		loRectangleF1=_Screen.System.Drawing.RectangleF.New(10,This.Height/10-20,loSizeF1.Width, loSizeF1.Height)
		Thisform.ycolor1=.Color.red
		Thisform.ycolor2=.Color.cyan
		loBrush = .Drawing2D.LinearGradientBrush.New(loRectangleF,;
			Thisform.ycolor1, ;
			Thisform.ycolor2,;
			thisform.nmode)
		loBrush1 = .Drawing2D.LinearGradientBrush.New(loRectangleF1,;
			Thisform.ycolor2, ;
			Thisform.ycolor1,;
			thisform.nmode)
		logfx.DrawString(ystring, loFont,loBrush, loRectangleF)
		logfx.DrawString(ystring1, loFont1,loBrush1, loRectangleF1)

	Endwith
	Endproc

	Procedure command2.Click
    thisform.ypict=.f.
	Thisform.ycolor0=".color.black"
	Thisform.BackColor=0
	ii=ii+1
	If ii>10
		ii=1
	Endi

	Do Case
	Case ii=1
		Thisform.ycolor1=".color.red"
	Case ii=2
		Thisform.ycolor1=".color.green"
	Case ii=3
		Thisform.ycolor1=".color.blue"
	Case ii=4
		Thisform.ycolor1=".color.cyan"
	Case ii=5
		Thisform.ycolor1=".color.yellow"
	Case ii=6
		Thisform.ycolor1=".color.magenta"
	Case ii=7
		Thisform.ycolor1=".color.gold"
	Case ii=8
		Thisform.ycolor1=".color.gray"
	Case ii=9
		Thisform.ycolor1=".color.black"
	Case ii=10
		Thisform.ycolor1=".color.purple"
	Endcase

	Thisform.imgcanvas.Visible=.T.

	Thisform.imgcanvas.Draw()
	Endproc


	Procedure command5.Click
	Thisform.imgcanvas.obmp.toclipboard()

	Run/n3 mspaint
	Inkey(2)
	loShell=Createobject("wscript.shell")
	loShell.sendKeys("^{v}")

	Endproc

	Procedure command6.Click
*save contents as PNG in source folder
	Thisform.Refresh
	Local m.lcdest
	m.lcdest=m.yrep+"ycap"+Sys(2015)+".png"
	With _Screen.System.Drawing
		Thisform.imgcanvas.obmp.Save(m.lcdest,.imaging.imageformat.PNG)
		Messagebox("Saved as :"+m.lcdest,0+32+4096,"saved",1000)
	Endwith
	Endproc


	Procedure Load
	Create Cursor ycurs (nx i,ny i)
	Insert Into ycurs Values(532,37  )
	Insert Into ycurs Values(523,35   )
	Insert Into ycurs Values(513,40   )
	Insert Into ycurs Values(503,33   )
	Insert Into ycurs Values(493,37   )
	Insert Into ycurs Values(480,36   )
	Insert Into ycurs Values(469,41   )
	Insert Into ycurs Values(460,41   )
	Insert Into ycurs Values(453,46   )
	Insert Into ycurs Values(445,41   )
	Insert Into ycurs Values(431,39   )
	Insert Into ycurs Values(419,41   )
	Insert Into ycurs Values(412,42   )
	Insert Into ycurs Values(402,43   )
	Insert Into ycurs Values(393,46   )
	Insert Into ycurs Values(381,46   )
	Insert Into ycurs Values(366,51  )
	Insert Into ycurs Values(358,50  )
	Insert Into ycurs Values(347,56  )
	Insert Into ycurs Values(335,59  )
	Insert Into ycurs Values(328,64  )
	Insert Into ycurs Values(322,71  )
	Insert Into ycurs Values(313,69  )
	Insert Into ycurs Values(305,74 )
	Insert Into ycurs Values(296,79  )
	Insert Into ycurs Values(290,84  )
	Insert Into ycurs Values(280,90  )
	Insert Into ycurs Values(273,91 )
	Insert Into ycurs Values(280,98 )
	Insert Into ycurs Values(284,107 )
	Insert Into ycurs Values(282,117 )
	Insert Into ycurs Values(282,125)
	Insert Into ycurs Values(283,134 )
	Insert Into ycurs Values(284,143 )
	Insert Into ycurs Values(288,155 )
	Insert Into ycurs Values(294,164 )
	Insert Into ycurs Values(295,174 )
	Insert Into ycurs Values(286,180 )
	Insert Into ycurs Values(277,177 )
	Insert Into ycurs Values(267,177  )
	Insert Into ycurs Values(258,176  )
	Insert Into ycurs Values(248,179  )
	Insert Into ycurs Values(244,185 )
	Insert Into ycurs Values(235,188 )
	Insert Into ycurs Values(228,190  )
	Insert Into ycurs Values(226,199  )
	Insert Into ycurs Values(227,205 )
	Insert Into ycurs Values(220,213  )
	Insert Into ycurs Values(206,220  )
	Insert Into ycurs Values(197,220 )
	Insert Into ycurs Values(190,233  )
	Insert Into ycurs Values(181,239  )
	Insert Into ycurs Values(171,239 )
	Insert Into ycurs Values(159,238 )
	Insert Into ycurs Values(153,244)
	Insert Into ycurs Values(145,241 )
	Insert Into ycurs Values(133,244 )
	Insert Into ycurs Values(128,250 )
	Insert Into ycurs Values(114,256 )
	Insert Into ycurs Values(106,262 )
	Insert Into ycurs Values( 99,268 )
	Insert Into ycurs Values( 97,278 )
	Insert Into ycurs Values(97,289  )
	Insert Into ycurs Values(95,301 )
	Insert Into ycurs Values(100,309 )
	Insert Into ycurs Values(110,320  )
	Insert Into ycurs Values(122,331  )
	Insert Into ycurs Values(130,339 )
	Insert Into ycurs Values(138,346 )
	Insert Into ycurs Values(150,351 )
	Insert Into ycurs Values(163,360 )
	Insert Into ycurs Values(172,371 )
	Insert Into ycurs Values(177,376)
	Insert Into ycurs Values(188,382 )
	Insert Into ycurs Values(199,393 )
	Insert Into ycurs Values(210,398 )
	Insert Into ycurs Values(222,406 )
	Insert Into ycurs Values(230,415 )
	Insert Into ycurs Values(234,417 )
	Insert Into ycurs Values(245,426 )
	Insert Into ycurs Values(253,433 )
	Insert Into ycurs Values(259,442 )
	Insert Into ycurs Values(272,448 )
	Insert Into ycurs Values(280,454 )
	Insert Into ycurs Values(288,463 )
	Insert Into ycurs Values(295,466 )
	Insert Into ycurs Values(306,473 )
	Insert Into ycurs Values(313,479 )
	Insert Into ycurs Values(317,481 )
	Insert Into ycurs Values(325,485 )
	Insert Into ycurs Values(331,489)
	Insert Into ycurs Values(337,494 )
	Insert Into ycurs Values(342,499 )
	Insert Into ycurs Values(348,508 )
	Insert Into ycurs Values(352,517 )
	Insert Into ycurs Values(362,521)
	Insert Into ycurs Values(365,528 )
	Insert Into ycurs Values(374,529 )
	Insert Into ycurs Values(380,532 )
	Insert Into ycurs Values(389,536 )
	Insert Into ycurs Values(398,536 )
	Insert Into ycurs Values(402,548 )
	Insert Into ycurs Values(403,551 )
	Insert Into ycurs Values(403,557 )
	Insert Into ycurs Values(405,563 )
	Insert Into ycurs Values(417,565 )
	Insert Into ycurs Values(426,563)
	Insert Into ycurs Values(436,562 )
	Insert Into ycurs Values(444,558)
	Insert Into ycurs Values(459,555 )
	Insert Into ycurs Values(465,553 )
	Insert Into ycurs Values(473,550 )
	Insert Into ycurs Values(485,543 )
	Insert Into ycurs Values(497,531 )
	Insert Into ycurs Values(507,523 )
	Insert Into ycurs Values(515,514 )
	Insert Into ycurs Values(530,504)
	Insert Into ycurs Values(543,492 )
	Insert Into ycurs Values(556,484 )
	Insert Into ycurs Values(573,476 )
	Insert Into ycurs Values(583,467)
	Insert Into ycurs Values(596,460 )
	Insert Into ycurs Values(607,448)
	Insert Into ycurs Values(620,437 )
	Insert Into ycurs Values(636,426)
	Insert Into ycurs Values(633,412 )
	Insert Into ycurs Values(623,403)
	Insert Into ycurs Values(613,396 )
	Insert Into ycurs Values(602,396)
	Insert Into ycurs Values(592,397 )
	Insert Into ycurs Values(586,387 )
	Insert Into ycurs Values(581,373 )
	Insert Into ycurs Values(574,359 )
	Insert Into ycurs Values(565,353 )
	Insert Into ycurs Values(571,344 )
	Insert Into ycurs Values(578,336 )
	Insert Into ycurs Values(573,327 )
	Insert Into ycurs Values(573,318 )
	Insert Into ycurs Values(576,310)
	Insert Into ycurs Values(578,304 )
	Insert Into ycurs Values(574,290 )
	Insert Into ycurs Values(575,274 )
	Insert Into ycurs Values(575,262 )
	Insert Into ycurs Values(566,248 )
	Insert Into ycurs Values(559,232 )
	Insert Into ycurs Values(564,218 )
	Insert Into ycurs Values(557,203 )
	Insert Into ycurs Values(551,184 )
	Insert Into ycurs Values(543,175)
	Insert Into ycurs Values(534,166 )
	Insert Into ycurs Values(529,155 )
	Insert Into ycurs Values(521,148 )
	Insert Into ycurs Values(515,142 )
	Insert Into ycurs Values(511,137 )
	Insert Into ycurs Values(510,125 )
	Insert Into ycurs Values(514,117 )
	Insert Into ycurs Values(521,110 )
	Insert Into ycurs Values(526,105 )
	Insert Into ycurs Values(526,99)
	Insert Into ycurs Values(529,88 )
	Insert Into ycurs Values(529,82 )
	Insert Into ycurs Values(527,71 )
	Insert Into ycurs Values(523,68 )
	Insert Into ycurs Values(523,62 )
	Insert Into ycurs Values(526,58 )
	Insert Into ycurs Values(528,49 )
	Insert Into ycurs Values(533,43 )
	Sele ycurs
	Repl All nx With nx+100
	Repl All ny With ny+100
	Endproc

Enddefine
*
*End code

 

 code  with a background map picture (choose large as the imgcanvas dimensions or a small texture  image as gif...). to fill the map area correctly.
 code  with a background map picture (choose large as the imgcanvas dimensions or a small texture  image as gif...). to fill the map area correctly.
 code  with a background map picture (choose large as the imgcanvas dimensions or a small texture  image as gif...). to fill the map area correctly.
 code  with a background map picture (choose large as the imgcanvas dimensions or a small texture  image as gif...). to fill the map area correctly.
 code  with a background map picture (choose large as the imgcanvas dimensions or a small texture  image as gif...). to fill the map area correctly.
 code  with a background map picture (choose large as the imgcanvas dimensions or a small texture  image as gif...). to fill the map area correctly.
 code  with a background map picture (choose large as the imgcanvas dimensions or a small texture  image as gif...). to fill the map area correctly.

code with a background map picture (choose large as the imgcanvas dimensions or a small texture image as gif...). to fill the map area correctly.

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


*5* a web sample (open source)-works with  JQuery (loaded in code from web site).
*A sample from http://jsfiddle.net/neveldo/TUYHN/
*ie nowadays  must be run with administrator privelege (run vfp9.exe as administrator).

Clea All
Set Safe Off
Declare Integer BringWindowToTop In user32 Integer

Local m.myvar
TEXT to m.myvar noshow
<!DOCTYPE html>
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
<meta name="robots" content="noindex, nofollow">
<meta name="googlebot" content="noindex, nofollow">
<meta charset="UTF-8">
<script type="text/javascript" src="http://code.jquery.com/jquery-2.1.3.js"></script>
<link rel="stylesheet" type="text/css" href="http:/css/result-light.css">
<script type="text/javascript" src="https://cdn.rawgit.com/DmitryBaranovskiy/raphael/v2.1.4/raphael-min.js"></script>
<script type="text/javascript" src="https://cdn.rawgit.com/neveldo/jQuery-Mapael/1.1.0/js/jquery.mapael.js"></script>
<script type="text/javascript" src="https://cdn.rawgit.com/neveldo/jQuery-Mapael/1.1.0/js/maps/france_departments.js"></script>

<style type="text/css">
    .mapTooltip {
	position : fixed;
	background-color : #fff;
	moz-opacity:0.70;
	opacity: 0.70;
	filter:alpha(opacity=70);
	border-radius:10px;
	padding : 10px;
	z-index: 1000;
	max-width: 200px;
	display:none;
	color:#343434;
}

.container {
	max-width: 800px;
	margin:auto;
}

body {
	font-family:Helvetica,Arial,sans-serif;
}

h1 {
	color:#5d5d5d;
	font-size:30px;
}
</style>

<title> by neveldo</title>

<script type='text/javascript'>//<![CDATA[
$(window).load(function(){
$(function(){
$(".mapcontainer").mapael({
map : {
	name : "france_departments",
	defaultArea: {
		attrs : {
			stroke : "#fff",
			"stroke-width" : 1
		},
		attrsHover : {
			"stroke-width" : 2
		}
	}
},
legend : {
	area : {
		title :"Population of France by department",
		slices : [
			{
				max :300000,
				attrs : {
					fill : "#97e766"
				},
				label :"Less than de 300 000 inhabitants"
			},
			{
				min :300000,
				max :500000,
				attrs : {
					fill : "#7fd34d"
				},
				label :"Between 100 000 and 500 000 inhabitants"
			},
			{
				min :500000,
				max :1000000,
				attrs : {
					fill : "#5faa32"
				},
				label :"Between 500 000 and 1 000 000 inhabitants"
			},
			{
				min :1000000,
				attrs : {
					fill : "#3f7d1a"
				},
				label :"More than 1 million inhabitants"
			}
		]
	}
},
areas: {
	"department-59": {
		value: "2617939",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Nord (59)</span><br />Population : 2617939"}
	},
	"department-75": {
		value: "2268265",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Paris (75)</span><br />Population : 2268265"}
	},
	"department-13": {
		value: "2000550",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Bouches-du-Rhône (13)</span><br />Population : 2000550"}
	},
	"department-69": {
		value: "1756069",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Rhône (69)</span><br />Population : 1756069"}
	},
	"department-92": {
		value: "1590749",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Hauts-de-Seine (92)</span><br />Population : 1590749"}
	},
	"department-93": {
		value: "1534895",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Seine-Saint-Denis (93)</span><br />Population : 1534895"}
	},
	"department-62": {
		value: "1489209",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Pas-de-Calais (62)</span><br />Population : 1489209"}
	},
	"department-33": {
		value: "1479277",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Gironde (33)</span><br />Population : 1479277"}
	},
	"department-78": {
		value: "1435448",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Yvelines (78)</span><br />Population : 1435448"}
	},
	"department-77": {
		value: "1347008",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Seine-et-Marne (77)</span><br />Population : 1347008"}
	},
	"department-94": {
		value: "1340868",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Val-de-Marne (94)</span><br />Population : 1340868"}
	},
	"department-44": {
		value: "1317685",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Loire-Atlantique (44)</span><br />Population : 1317685"}
	},
	"department-76": {
		value: "1275952",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Seine-Maritime (76)</span><br />Population : 1275952"}
	},
	"department-31": {
		value: "1268370",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Haute-Garonne (31)</span><br />Population : 1268370"}
	},
	"department-38": {
		value: "1233759",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Isère (38)</span><br />Population : 1233759"}
	},
	"department-91": {
		value: "1233645",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Essonne (91)</span><br />Population : 1233645"}
	},
	"department-95": {
		value: "1187836",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Val-d'Oise (95)</span><br />Population : 1187836"}
	},
	"department-67": {
		value: "1115226",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Bas-Rhin (67)</span><br />Population : 1115226"}
	},
	"department-06": {
		value: "1094579",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Alpes-Maritimes (06)</span><br />Population : 1094579"}
	},
	"department-57": {
		value: "1066667",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Moselle (57)</span><br />Population : 1066667"}
	},
	"department-34": {
		value: "1062617",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Hérault (34)</span><br />Population : 1062617"}
	},
	"department-83": {
		value: "1026222",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Var (83)</span><br />Population : 1026222"}
	},
	"department-35": {
		value: "1015470",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Ille-et-Vilaine (35)</span><br />Population : 1015470"}
	},
	"department-29": {
		value: "929286",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Finistère (29)</span><br />Population : 929286"}
	},
	"department-974": {
		value: "829903",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">La Réunion (974)</span><br />Population : 829903"}
	},
	"department-60": {
		value: "823668",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Oise (60)</span><br />Population : 823668"}
	},
	"department-49": {
		value: "808298",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Maine-et-Loire (49)</span><br />Population : 808298"}
	},
	"department-42": {
		value: "766729",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Loire (42)</span><br />Population : 766729"}
	},
	"department-68": {
		value: "765634",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Haut-Rhin (68)</span><br />Population : 765634"}
	},
	"department-74": {
		value: "760979",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Haute-Savoie (74)</span><br />Population : 760979"}
	},
	"department-54": {
		value: "746502",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Meurthe-et-Moselle (54)</span><br />Population : 746502"}
	},
	"department-56": {
		value: "744663",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Morbihan (56)</span><br />Population : 744663"}
	},
	"department-30": {
		value: "726285",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Gard (30)</span><br />Population : 726285"}
	},
	"department-14": {
		value: "699561",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Calvados (14)</span><br />Population : 699561"}
	},
	"department-45": {
		value: "674913",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Loiret (45)</span><br />Population : 674913"}
	},
	"department-64": {
		value: "674908",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Pyrénées-Atlantiques (64)</span><br />Population : 674908"}
	},
	"department-85": {
		value: "654096",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Vendée (85)</span><br />Population : 654096"}
	},
	"department-63": {
		value: "649643",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Puy-de-Dôme (63)</span><br />Population : 649643"}
	},
	"department-17": {
		value: "640803",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Charente-Maritime (17)</span><br />Population : 640803"}
	},
	"department-01": {
		value: "614331",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Ain (01)</span><br />Population : 614331"}
	},
	"department-22": {
		value: "612383",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Côtes-d'Armor (22)</span><br />Population : 612383"}
	},
	"department-37": {
		value: "605819",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Indre-et-Loire (37)</span><br />Population : 605819"}
	},
	"department-27": {
		value: "603194",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Eure (27)</span><br />Population : 603194"}
	},
	"department-80": {
		value: "583388",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Somme (80)</span><br />Population : 583388"}
	},
	"department-51": {
		value: "579533",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Marne (51)</span><br />Population : 579533"}
	},
	"department-72": {
		value: "579497",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Sarthe (72)</span><br />Population : 579497"}
	},
	"department-71": {
		value: "574874",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Saône-et-Loire (71)</span><br />Population : 574874"}
	},
	"department-84": {
		value: "555240",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Vaucluse (84)</span><br />Population : 555240"}
	},
	"department-02": {
		value: "555094",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Aisne (02)</span><br />Population : 555094"}
	},
	"department-25": {
		value: "542509",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Doubs (25)</span><br />Population : 542509"}
	},
	"department-21": {
		value: "538505",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Côte-d'Or (21)</span><br />Population : 538505"}
	},
	"department-50": {
		value: "517121",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Manche (50)</span><br />Population : 517121"}
	},
	"department-26": {
		value: "499313",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Drôme (26)</span><br />Population : 499313"}
	},
	"department-66": {
		value: "457238",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Pyrénées-Orientales (66)</span><br />Population : 457238"}
	},
	"department-28": {
		value: "440291",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Eure-et-Loir (28)</span><br />Population : 440291"}
	},
	"department-86": {
		value: "438566",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Vienne (86)</span><br />Population : 438566"}
	},
	"department-73": {
		value: "428751",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Savoie (73)</span><br />Population : 428751"}
	},
	"department-24": {
		value: "426607",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Dordogne (24)</span><br />Population : 426607"}
	},
	"department-971": {
		value: "409905",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Guadeloupe (971)</span><br />Population : 409905"}
	},
	"department-972": {
		value: "400535",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Martinique (972)</span><br />Population : 400535"}
	},
	"department-40": {
		value: "397766",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Landes (40)</span><br />Population : 397766"}
	},
	"department-88": {
		value: "392846",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Vosges (88)</span><br />Population : 392846"}
	},
	"department-81": {
		value: "387099",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Tarn (81)</span><br />Population : 387099"}
	},
	"department-87": {
		value: "384781",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Haute-Vienne (87)</span><br />Population : 384781"}
	},
	"department-79": {
		value: "380569",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Deux-Sèvres (79)</span><br />Population : 380569"}
	},
	"department-11": {
		value: "365854",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Aude (11)</span><br />Population : 365854"}
	},
	"department-16": {
		value: "364429",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Charente (16)</span><br />Population : 364429"}
	},
	"department-89": {
		value: "353366",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Yonne (89)</span><br />Population : 353366"}
	},
	"department-03": {
		value: "353124",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Allier (03)</span><br />Population : 353124"}
	},
	"department-47": {
		value: "342500",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Lot-et-Garonne (47)</span><br />Population : 342500"}
	},
	"department-41": {
		value: "340729",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Loir-et-Cher (41)</span><br />Population : 340729"}
	},
	"department-07": {
		value: "324885",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Ardèche (07)</span><br />Population : 324885"}
	},
	"department-18": {
		value: "319600",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Cher (18)</span><br />Population : 319600"}
	},
	"department-53": {
		value: "317006",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Mayenne (53)</span><br />Population : 317006"}
	},
	"department-10": {
		value: "311720",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Aube (10)</span><br />Population : 311720"}
	},
	"department-61": {
		value: "301421",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Orne (61)</span><br />Population : 301421"}
	},
	"department-08": {
		value: "291678",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Ardennes (08)</span><br />Population : 291678"}
	},
	"department-12": {
		value: "288364",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Aveyron (12)</span><br />Population : 288364"}
	},
	"department-39": {
		value: "271973",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Jura (39)</span><br />Population : 271973"}
	},
	"department-19": {
		value: "252235",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Corrèze (19)</span><br />Population : 252235"}
	},
	"department-82": {
		value: "248227",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Tarn-et-Garonne (82)</span><br />Population : 248227"}
	},
	"department-70": {
		value: "247311",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Haute-Saône (70)</span><br />Population : 247311"}
	},
	"department-36": {
		value: "238261",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Indre (36)</span><br />Population : 238261"}
	},
	"department-65": {
		value: "237945",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Hautes-Pyrénées (65)</span><br />Population : 237945"}
	},
	"department-43": {
		value: "231877",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Haute-Loire (43)</span><br />Population : 231877"}
	},
	"department-973": {
		value: "231167",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Guyane (973)</span><br />Population : 231167"}
	},
	"department-58": {
		value: "226997",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Nièvre (58)</span><br />Population : 226997"}
	},
	"department-55": {
		value: "200509",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Meuse (55)</span><br />Population : 200509"}
	},
	"department-32": {
		value: "195489",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Gers (32)</span><br />Population : 195489"}
	},
	"department-52": {
		value: "191004",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Haute-Marne (52)</span><br />Population : 191004"}
	},
	"department-46": {
		value: "181232",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Lot (46)</span><br />Population : 181232"}
	},
	"department-2B": {
		value: "168869",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Haute-Corse (2B)</span><br />Population : 168869"}
	},
	"department-04": {
		value: "165155",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Alpes-de-Haute-Provence (04)</span><br />Population : 165155"}
	},
	"department-09": {
		value: "157582",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Ariège (09)</span><br />Population : 157582"}
	},
	"department-15": {
		value: "154135",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Cantal (15)</span><br />Population : 154135"}
	},
	"department-90": {
		value: "146475",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Territoire de Belfort (90)</span><br />Population : 146475"}
	},
	"department-2A": {
		value: "145998",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Corse-du-Sud (2A)</span><br />Population : 145998"}
	},
	"department-05": {
		value: "142312",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Hautes-Alpes (05)</span><br />Population : 142312"}
	},
	"department-23": {
		value: "127919",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Creuse (23)</span><br />Population : 127919"}
	},
	"department-48": {
		value: "81281",
		href : "#",
		tooltip: {content : "<span style=\"font-weight:bold;\">Lozère (48)</span><br />Population : 81281"}
	}
}
});
});
});//]]>

</script>


</head>

<body>
<input type="Button" value="X" style="float:right;background-color:lime; color:red;cursor:pointer;" onclick="window.open('','_self');window.close();">
<div class="container">
<h1>Map with a legend for areas</h1>
<div class="mapcontainer">
	<div class="map">
		<span>Alternative content for the map</span>
	</div>
	<div class="areaLegend">
		<span>Alternative content for the legend</span>
	</div>
</div>
</div>
</body>
</html>
ENDTEXT

Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"ymap_fr.html"
Strtofile(m.myvar,m.lcdest)
Publi apie
apie=Newobject('internetexplorer.application')
With apie
.Navigate(m.lcdest)
.menubar=0
.Toolbar=0
.StatusBar=0
.fullscreen=1
BringWindowToTop(.HWnd)
.Visible=.T.
Endwith


VFP Shapes and maps drawings

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

                       

*6* created on 11 of january 2017
*can custom your map+the points circuit(x,y captured manually-read the commentedimage mousedown)
*map is grabbed directly from the web (internet connected).

Publi yform
yform=Newobject("ycircuit")
yform.Show
Read Events
Retu
*
DEFINE CLASS ycircuit AS form
	Height = 573
	Width = 863
	ShowWindow = 2
	DoCreate = .T.
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "Drawing circuits on a map"
	WindowState = 2
	Name = "Form1"

	ADD OBJECT image1 AS image WITH ;
		Anchor = 15, ;
		Height = 576, ;
		Left = 0, ;
		Top = 0, ;
		Width = 864, ;
		Name = "Image1"

	PROCEDURE ydraw
		local m.myvar
		text to m.myvar noshow
		             589         38
		        601         57
		        553         76
		        482         73
		        477         61
		        447         80
		        406         89
		        385        103
		        406        119
		        480        108
		        474        135
		        397        131
		        404        181
		        486        179
		        563        181
		        586        241
		        359        268
		        402        406
		        696        572
		        832        447
		        721        252
		        744        175
		        748        135
		        760        113
		        806        111
		        794         88
		        818         84
		        818         68
		        816         47
		        789         55
		        762         38
		        794         35
		        750         69
		        710         53
		        661         61
		        707         80
		        704         98
		        653        103
		        645         83
		        616         70
		        612         53
		        589         42
		        592         39
		        597         52
		        587         54
		        573         55
		        563         55
		        548         56
		        529         56
		        520         57
		        504         62
		        490         64
		        477         69
		        464         75
		        453         78
		        441         86
		        429         91
		        412         91
		        403         89
		        400         93
		        398        110
		        392        123
		        389        132
		        390        144
		        395        165
		        397        174
		        397        180
		        410        184
		        423        184
		        433        184
		        443        184
		        454        184
		        467        183
		        487        182
		        500        182
		        496        189
		        477        204
		        467        210
		        446        222
		        434        229
		        420        236
		        400        244
		        389        252
		        374        256
		        354        264
		        336        267
		        330        273
		        314        282
		        302        292
		        271        304
		        256        309
		        248        326
		        244        329
		        237        346
		        231        360
		        229        364
		        219        361
		        209        361
		        197        364
		        182        367
		        160        374
		        156        377
		        143        382
		        128        386
		        119        390
		         93        398
		         96        396
		        136        403
		        149        415
		        180        437
		        200        452
		        236        472
		        251        478
		        272        478
		        291        476
		        307        465
		        322        454
		        334        445
		        346        435
		        357        427
		        369        422
		        395        410
		        407        406
		        412        408
		        431        420
		        445        430
		        462        443
		        475        454
		        501        475
		        513        484
		        549        506
		        563        518
		        594        534
		        610        544
		        633        554
		        666        568
		        691        574
		        691        574
		        708        570
		        725        557
		        731        548
		        742        539
		        770        517
		        783        509
		        810        486
		        824        468
		        830        460
		        842        447
		        840        443
		        820        442
		        795        441
		        765        438
		        737        438
		        708        433
		        683        429
		        683        429
		        680        427
		        645        405
		        633        401
		        616        380
		        600        345
		        593        312
		        593        300
		        593        286
		        594        270
		        597        261
		        599        247
		        601        241
		        621        242
		        643        243
		        650        244
		        668        244
		        686        245
		        727        245
		        734        249
		        733        238
		        739        215
		        742        194
		        744        165
		        744        164
		        717        164
		        697        165
		        660        170
		        627        172
		        608        176
		        589        178
		        588        178
		        601        155
		        605        146
		        605        146
		        615        145
		        643        145
		        678        140
		        716        132
		        737        132
		        744        123
		        760        114
		        781        114
		        795        114
		        819        114
		        821        113
		        821         96
		        816         88
		        814         79
		        813         75
		        815         57
		        817         50
		        821         37
		        800         43
		        796         44
		        764         38
		        760         36
		        757         36
		        743         39
		        731         47
		        720         53
		        709         54
		        677         61
		        676         61
		        664         52
		        647         48
		        640         48
		        627         49
		        604         59
		        594         43
		endtext

		try
		zap in slect("ycurs")
		catch
		endtry
		local m.x,m.y
		for i=1 to memlines(m.myvar)
		m.x=int(val(getwordnum(allt(mline(m.myvar,i)),1)))
		m.y=int(val(getwordnum(allt(mline(m.myvar,i)),2)))
		insert into ycurs values(m.x,m.y)
		endfor
		*brow
		locate
	
		with thisform
		.cls
		.forecolor=255

		sele ycurs
		locate
		x0=x
		y0=y
		scan
		m.shp="shape"+trans(recno())
		.addobject(m.shp,"shape")
		with eval("."+m.shp)
		 .width=20
		 .height=20
		 .left=x-.width/2
		 .top=y-.height/2
		 .backcolor=rgb(255*rand(),255*rand(),255*rand())
		 .bordercolor=0
		 .borderstyle=1
		 .borderwidth=3
		 .drawmode=9
		 .curvature=99
		 .visible=.t.
		 endwith
		 bindevent(eval("."+m.shp),"mouseMove",thisform,"my")
		 endscan
	
		 inke(2)  &&sleep gives bad result
		 .setall("drawmode",15,"shape")
		
		 inke(2)
		 .setall("backcolor",rgb(0,255,255),"shape")
		 .setall("bordercolor",255,"shape")
		 .setall("drawmode",9,"shape")
		 endwith
		 messagebox("Mousemove on any shape to read the coordinates",0+32+4096,"",1200)
	ENDPROC

	PROCEDURE my
		LPARAMETERS nButton, nShift, nXCoord, nYCoord
		*--- aevent create an array laEvents
		   Aevents( myArray, 0)
		 *--- reference the calling object
		    loObject = myArray[1]
		    loObject.mousepointer=15
		    sele ycurs
		    go int(val(substr(loObject.name,6)))
		    loObject.tooltiptext=trans(x)+","+trans(y)
	ENDPROC

	PROCEDURE Activate
		inke(2)
		with thisform
		.drawWidth=4
		.forecolor=255
		.backcolor=rgb(0,0,255)
		.fillstyle=0
		sele ycurs
		x0=x
		y0=y
		scan
		if recno()=1
		.line(x0,y0,x,y)
		else
		.line(x,y)
		endi

		.circle(12,x,y)
		endscan
		endwith

		inke(3)

		with thisform
		.cls
		.forecolor=255

		sele ycurs
		x0=x
		y0=y
		scan
		m.shp="shape"+trans(recno())
		.addobject(m.shp,"shape")
		with eval("."+m.shp)
		 .width=30
		 .height=30
		 .left=x-.width/2
		 .top=y-.height/2
		 .backcolor=rgb(0,255,0)
		 .bordercolor=0
		 .borderstyle=1
		 .borderwidth=3
		 .drawmode=9
		 .curvature=99
		 .visible=.t.
		 endwith
		 endscan
		
		inke(2)

		 sele ycurs
		 locate
		 x0=x
		 y0=y
		scan
		 if recno()=1
		.line(x0,y0,x,y)
		else
		.line(x,y)
		endi
		endscan
		
		 inke(2)  &&sleep gives bad result
		 .setall("drawmode",15,"shape")
		
		 inke(2)
		 .setall("backcolor",rgb(255,255,0),"shape")
		 .setall("drawmode",9,"shape")
		
		 inke(2)

		for i=1 to .controlcount
		try
		thisform.removeObject(eval(".shape"+trans(i)+".name"))
		catch
		endtry
		endfor


		*inke(2)
		.ydraw
		  endwith
	ENDPROC

	PROCEDURE Load
		close data all
		*the  captured path  is here (x,y)

		create cursor ycurs (x i ,y i)
		local m.myvar
		text to m.myvar pretext 7 noshow
		        589         38
		        601         57
		        553         76
		        482         73
		        477         61
		        447         80
		        406         89
		        385        103
		        406        119
		        480        108
		        474        135
		        397        131
		        404        181
		        486        179
		        563        181
		        586        241
		        359        268
		        402        406
		        696        572
		        832        447
		        721        252
		        744        175
		        748        135
		        760        113
		        806        111
		        794         88
		        818         84
		        818         68
		        816         47
		        789         55
		        762         38
		        794         35
		        750         69
		        710         53
		        661         61
		        707         80
		        704         98
		        653        103
		        645         83
		        616         70
		        612         53
		        589         42
		endtext
		local m.x,m.y
		for i=1 to memlines(m.myvar)
		m.x=int(val(getwordnum(allt(mline(m.myvar,i)),1)))
		m.y=int(val(getwordnum(allt(mline(m.myvar,i)),2)))
		insert into ycurs values(m.x,m.y)
		endfor
		*brow
		locate
	ENDPROC

	PROCEDURE Destroy
		clea events
	ENDPROC

	PROCEDURE image1.MouseDown
		LPARAMETERS nButton, nShift, nXCoord, nYCoord

		*!*	*can captures points x,y (form.load) with this method.uncomment,comment form.activate,and run ...click the way to capture point by point
		*!*	*close the form, the ycurs cursor saty in memor...brow...copy to ycircuit.txt sdf.....open txt selecta all and copy...

		*!*insert into ycurs values( nxcoord,nycoord)  &&capture one point (x,y)
	ENDPROC

	PROCEDURE image1.Init
		*internet must be connected....capture the image blob as pictureval on the form
		this.stretch=2
		Local loRequest,lcUrl
			try
			m.lcUrl="http://www.mapsopensource.com/images/algeria-map.gif"
			m.loRequest = Createobject('MsXml2.XmlHttp')
			m.loRequest.Open("GET",lcUrl,.F.)
			m.loRequest.Send()
			This.PictureVal=m.loRequest.ResponseBody
			m.loRequest=Null
			catch
			messagebox("An error was occured!",16+4096,"error")
			endtry
	ENDPROC

ENDDEFINE
*
*-- EndDefine: ycircuit


VFP Shapes and maps drawings

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

                        


*7*created on Monday 16 of january 2017-updated on 20 of january 2017
*!*-this code draws any star form 3 branches to 200.
*!*it uses also the floodfill API to paint each star branch with a random
*!*color(can use the palette colors to mousedown any color on the star).
*!*if there is no radius painted , it paint all the star shape.
*!*can capture the star painted with snippingtool utility.
*!* can make the second radius r0 varibale to have other kinds of stars(0.6*r,0.7*r,0.8*r,0.9*r...)
*this is added with spinner2 control on form.
*!*see also same objects in gdiplusX drawings (previous posts)

_Screen.WindowState=1
Publi yform
yform=Newobject("ystars")
yform.Show
Read Events
Retu
*
Define Class ystars As Form
	BorderStyle = 0
	Height = 590
	Width = 794
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "Draw stars from 3 to 200 branches. and fill with any color."
	MaxButton = .F.
	Themes = .T.
	ycolor = 255
	yhwnd = .F.
	Name = "Form1"

	Add Object shape1 As Shape With ;
		Top = 24, ;
		Left = 24, ;
		Height = 480, ;
		Width = 744, ;
		Anchor = 15, ;
		BackColor = Rgb(0,255,255), ;
		Name = "Shape1"

	Add Object spinner1 As Spinner With ;
		Anchor = 768, ;
		Height = 24, ;
		KeyboardHighValue = 200, ;
		KeyboardLowValue = 3, ;
		Left = 541, ;
		SpinnerHighValue = 200.00, ;
		SpinnerLowValue =   3.00, ;
		ToolTipText = "Shape branches", ;
		Top = 534, ;
		Width = 72, ;
		Value = 5, ;
		Name = "Spinner1"

	Add Object timer1 As Timer With ;
		Top = 540, ;
		Left = 504, ;
		Height = 23, ;
		Width = 23, ;
		Enabled = .F., ;
		Interval = 1000, ;
		Name = "Timer1"

	Add Object check1 As Checkbox With ;
		Top = 540, ;
		Left = 432, ;
		Height = 17, ;
		Width = 60, ;
		Anchor = 768, ;
		Alignment = 0, ;
		Caption = "Radius", ;
		Value = 1, ;
		Name = "Check1"

	Add Object container1 As ycnt With ;
		Anchor = 768, ;
		Top = 540, ;
		Left = 12, ;
		Width = 396, ;
		Height = 32, ;
		BackStyle = 0, ;
		BorderWidth = 1, ;
		ToolTipText = "Pick a color and paint the star", ;
		Name = "Container1"

	Add Object command1 As CommandButton With ;
		Top = 540, ;
		Left = 648, ;
		Height = 25, ;
		Width = 48, ;
		FontBold = .T., ;
		Anchor = 768, ;
		Caption = "Clear", ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 32, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "?", ;
		Height = 54, ;
		Left = 744, ;
		MousePointer = 15, ;
		Top = 516, ;
		Width = 28, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label1"

	Add Object command2 As CommandButton With ;
		Top = 540,;
		Left = 700,;
		Height = 25,;
		Width = 44,;
		FontSize = 11,;
		Caption = "Cap",;
		MousePointer = 15,;
		BackColor = Rgb(255,128,64),;
		Name = "Command2"
		
	ADD Object spinner2  AS spinner with ;
	Anchor = 768,;
	Height = 24,;
	Increment =   0.020,;
	InputMask = "99.999",;
	KeyboardHighValue = 1.000,;
	KeyboardLowValue = 0.000,;
	Left = 541,;
	SpinnerHighValue =   0.980,;
	SpinnerLowValue =   0.100,;
	ToolTipText = "radius --- R0/R",;
	Top = 559,;
	Width = 72,;
	Value = 0.500,;
	Name = "Spinner2"

	PROCEDURE Spinner2.InteractiveChange
	    this.refresh
		if  between(this.value,this.spinnerLowValue,this.SpinnerHighValue)
		inke(0.2,'H')
		thisform.ydraw(thisform.spinner1.value)
		endi
	ENDPROC
		

	Procedure command2.Click
		Try
			Run/N snippingtool
		Catch
			Messagebox("snippingtool.exe dont exists!",16+4096,"error")
		Endtry
	Endproc


	Procedure ydraw
		Lparameters N
		Thisform.Cls
		teta=2*Pi()/N
		Local r,r0,xc,yc,x0,y0,x,Y
		r=0.30*(Thisform.shape1.Width-20)
		r0=r*thisform.spinner2.value
		Thisform.ForeColor=255
		xc=Thisform.shape1.Left+Thisform.shape1.Width/2
		yc=Thisform.shape1.Top+Thisform.shape1.Height/2

		For i=0 To N
			x0=xc+r0*Cos(i*teta-teta/2)
			y0=yc+r0*Sin(i*teta-teta/2)

			x=xc+r*Cos(i*teta)
			Y=yc+r*Sin(i*teta)

			If i=0
				xb=x
				yb=Y
			Endi
			Thisform.DrawWidth=3
			Thisform.ForeColor=255
			Thisform.Line(xb,yb,x0,y0)
			Thisform.Line(x0,y0,x,Y)

			*rayons
			If Thisform.check1.Value=1
				Thisform.ForeColor=Rgb(0,0,0)
				Thisform.DrawWidth=1
				Thisform.Line(xc,yc,x,Y)
			Endi

			xb=x
			yb=Y
		Endfor

		*fill random color
		For i=1 To N+1
			x0=xc+0.5*r0*Cos(i*teta-teta/2)
			y0=yc+0.5*r0*Sin(i*teta-teta/2)
			Thisform.ycolor=Rgb(255*Rand(),255*Rand(),255*Rand())
			Thisform.shape1.MouseDown(1,"",x0,y0)
			Inke(0.1)
		Endfor
		*thisform.spinner1.setfocus
	Endproc

	Procedure my
		Lparameters nButton, nShift, nXCoord, nYCoord

		*--- aevent create an array laEvents
		Aevents( myArray, 0)
		*--- reference the calling object
		loObject = myArray[1]
		Thisform.ycolor= loObject.BackColor
	Endproc

	Procedure Destroy
		Clea Events
	Endproc

	Procedure Init
		#Define GW_CHILD 5
		If Thisform.ShowWindow= 2
			Thisform.yhwnd = GetWindow(Thisform.HWnd, GW_CHILD)
		Else
			Thisform.yhwnd= Thisform.HWnd   && _vfp.hwnd
		Endif

		Thisform.timer1.Enabled=.T.
	Endproc

	Procedure Load
		Declare Integer SelectObject     In WIN32API Integer hdc, Integer hgdiobj
		Declare Integer GetPixel         In win32API Integer hdc, Integer nXPos, Integer nYPos
		Declare SHORT   GetCursorPos     In win32api String @ lpPoint
		Declare Integer GetWindowDC      In Win32API Integer HWnd
		Declare Integer CreateSolidBrush In WIN32API Long crColor
		Declare Long    DeleteObject     In WIN32API Long hObject
		Declare Integer GetDC In user32 Integer HWnd
		Declare Long ExtFloodFill In gdi32 Long hdc, Long x, Long Y, Long crColor, Long wFillType
		Declare Long SetPixel     In gdi32 Long hdc, Long x, Long Y, Long crColor
		Declare Integer GetWindow In user32 Integer HWnd,Integer wFlag
	Endproc


	Procedure shape1.MouseDown
		Lparameters nButton, nShift, nXCoord, nYCoord
		#Define FLOODFILLBORDER  0  && Fill until crColor& color encountered.
		#Define FLOODFILLSURFACE 1  && Fill surface until crColor& color not encountered.

		Local lpPoint, lnPosX, lnPosY
		lpPoint = Space(8)
		If GetCursorPos(@lpPoint) = 0
			Return
		Endif
		lnPosX = Asc(Substr(lpPoint,1))*256^0+;
			ASC(Substr(lpPoint,2))*256^1+;
			ASC(Substr(lpPoint,3))*256^2+;
			ASC(Substr(lpPoint,4))*256^3
		lnPosY = Asc(Substr(lpPoint,5))*256^0+;
			ASC(Substr(lpPoint,6))*256^1+;
			ASC(Substr(lpPoint,7))*256^2+;
			ASC(Substr(lpPoint,8))*256^3

		Local lnNewColor, lnHDC, lhBrush,xxx,yyy,zzz
		lnHDC=GetWindowDC(Thisform.yhwnd)

		* Create a solid brush
		lhBrush = CreateSolidBrush(Thisform.ycolor)

		* Select the brush into the PictureBox' device context
		xxx=SelectObject(lnHDC, lhBrush)

		* Fill the object
		yyy=ExtFloodFill(lnHDC, nXCoord, nYCoord,GetPixel(lnHDC, nXCoord, nYCoord) , FLOODFILLSURFACE)
		* Release the brush
		zzz=DeleteObject(lhBrush)
		Thisform.MousePointer=0
		Thisform.ycolor=Rgb(255*Rand(),255*Rand(),255*Rand())  &&fill the property with random color ready to fillflood any area of star

	Endproc

	Procedure spinner1.InteractiveChange
		If  Between(This.Value,This.SpinnerLowValue,This.SpinnerHighValue)
			Inke(0.2,'H')
			Thisform.ydraw(This.Value)
		Endi
	Endproc

	Procedure timer1.Timer
		Thisform.spinner1.InteractiveChange()
		This.Enabled=.F.
	Endproc

	Procedure check1.InteractiveChange
		*thisform.ydraw(this.parent.spinner1.value)
	Endproc

	Procedure container1.Init
		With This
			.SetAll("mousepointer",15,"shape")
			For i=1 To .ControlCount
				Bindevent(.Controls(i),"mousedown",Thisform,"my")
			Endfor
		Endwith
		Thisform.ycolor=Thisform.BackColor
	Endproc

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

	Procedure command1.Click
		Thisform.Cls
	Endproc

	Procedure label1.Click
		Local m.myvar
		TEXT to m.myvar pretext 7 noshow
		-this code draw any star form 3 branches to 200.
		it uses also the floodfill API to paint each star branch with a random
		color(can use the palette colors to mousedown any color on the star).
		if there is no radius painted , it paint all the star shape.
		can capture the star painted with snippingtool utility.
    can make the second radius r0 varibale to have other kinds of stars(0.6*r,0.7*r,0.8*r,0.9*r...)
    *That is updated on code  with spinner2 (0-1 values with 0.02 as increment).
		ENDTEXT
		Messagebox(m.myvar,0+32+4096,"Summary help")
	Endproc

Enddefine
*
*-- EndDefine: ystars

*
Define Class ycnt As Container
	Anchor = 768
	Top = 540
	Left = 12
	Width = 396
	Height = 32
	BackStyle = 0
	BorderWidth = 1
	ToolTipText = "Pick a color and paint the star"
	Name = "Container1"

	Add Object shape2 As Shape With ;
		Top = 4, ;
		Left = 46, ;
		Height = 25, ;
		Width = 37, ;
		BackColor = Rgb(255,0,0), ;
		Name = "Shape2"

	Add Object shape3 As Shape With ;
		Top = 4, ;
		Left = 87, ;
		Height = 25, ;
		Width = 37, ;
		BackColor = Rgb(0,0,255), ;
		Name = "Shape3"

	Add Object shape4 As Shape With ;
		Top = 4, ;
		Left = 129, ;
		Height = 25, ;
		Width = 37, ;
		BackColor = Rgb(0,255,255), ;
		Name = "Shape4"

	Add Object shape5 As Shape With ;
		Top = 4, ;
		Left = 172, ;
		Height = 25, ;
		Width = 37, ;
		BackColor = Rgb(128,0,255), ;
		Name = "Shape5"

	Add Object shape6 As Shape With ;
		Top = 4, ;
		Left = 214, ;
		Height = 25, ;
		Width = 37, ;
		BackColor = Rgb(128,0,64), ;
		Name = "Shape6"

	Add Object shape7 As Shape With ;
		Top = 4, ;
		Left = 256, ;
		Height = 25, ;
		Width = 37, ;
		BackColor = Rgb(255,128,0), ;
		Name = "Shape7"

	Add Object shape8 As Shape With ;
		Top = 4, ;
		Left = 4, ;
		Height = 25, ;
		Width = 37, ;
		BackColor = Rgb(128,255,0), ;
		Name = "Shape8"

	Add Object shape9 As Shape With ;
		Top = 4, ;
		Left = 301, ;
		Height = 25, ;
		Width = 37, ;
		BackColor = Rgb(255,255,0), ;
		Name = "Shape9"


	Add Object command1 As CommandButton With ;
		Top = 4, ;
		Left = 348, ;
		Height = 25, ;
		Width = 37, ;
		FontBold = .T., ;
		Caption = "...", ;
		MousePointer = 15, ;
		Name = "Command1"

	Procedure Init
		With This
			.SetAll("mousepointer",15,"shape")
			For i=1 To .ControlCount
				Bindevent(.Controls(i),"mousedown",Thisform,"my")
			Endfor
		Endwith
		Thisform.ycolor=Thisform.BackColor
	Endproc

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

Enddefine
*
*-- EndDefine: ycnt




can modify with ths spinner2 control the radius r0 (0.6*r,0.7*r,0.8*r,0.98*r...) to have another lkinds of stars.
can modify with ths spinner2 control the radius r0 (0.6*r,0.7*r,0.8*r,0.98*r...) to have another lkinds of stars.
can modify with ths spinner2 control the radius r0 (0.6*r,0.7*r,0.8*r,0.98*r...) to have another lkinds of stars.
can modify with ths spinner2 control the radius r0 (0.6*r,0.7*r,0.8*r,0.98*r...) to have another lkinds of stars.
can modify with ths spinner2 control the radius r0 (0.6*r,0.7*r,0.8*r,0.98*r...) to have another lkinds of stars.

can modify with ths spinner2 control the radius r0 (0.6*r,0.7*r,0.8*r,0.98*r...) to have another lkinds of stars.

Important:All Codes above are tested on VFP9SP2 & windows 10 pro & IE11 emulation. To avoid some problems with priveleges level, run vfp9.exe as administrator.

Please come back with any bug.correct code is usefull to all readers. With the pleasure to share.

Comment on this post

customer service number uk 05/04/2017 12:18

These blogs and articles are fully good enough for me.