Creando Formas irregulares con el Objeto Shape en VFP 9

A partir de VFP 9 podemos crear Shapes basandonos en poligonos, el cual se basa en un arreglo de cualquier dimension conteniendo las coordenadas X y Y en el orden en que debera ser dibujado.

La propiedad que se debe establecer hacia el arreglo que contenga las coordenadas es PolyPoints.

A continuación un Ejemplo de como usar esta nueva propiedad:

Public oFrm_Shape
oFrm_Shape=Newobject("frm_shape")
oFrm_Shape.Show
Return
Define Class frm_shape As Form
 DataSession = 2
 Top = 0
 Left = 0
 Height = 354
 Width = 592
 DoCreate = .T.
 Caption = "Creando Shapes Complejos"
 Name = "frm_shape"
 Dimension apuntos[1]
 Add Object shape1 As Shape With ;
  Top = 19, ;
  Left = 260, ;
  Height = 314, ;
  Width = 319, ;
  BackStyle = 1, ;
  BorderWidth = 3, ;
  BackColor = Rgb(0,128,255), ;
  BorderColor = Rgb(255,255,255), ;
  Name = "Shape1"
 Add Object spinner1 As Spinner With ;
  Height = 24, ;
  KeyboardHighValue = 50, ;
  KeyboardLowValue = 1, ;
  Left = 137, ;
  SpinnerHighValue =  50.00, ;
  SpinnerLowValue =   1.00, ;
  Top = 24, ;
  Width = 117, ;
  Value = 1, ;
  NullDisplay = "0", ;
  Name = "Spinner1"
 Add Object grid1 As Grid With ;
  ColumnCount = 3, ;
  FontSize = 8, ;
  DeleteMark = .F., ;
  Height = 284, ;
  Left = 3, ;
  Panel = 1, ;
  RecordSource = "cPuntos", ;
  RowHeight = 17, ;
  ScrollBars = 2, ;
  Top = 51, ;
  Width = 252, ;
  Name = "Grid1", ;
  Column1.FontSize = 8, ;
  Column1.ControlSource = "Recno()", ;
  Column1.Width = 94, ;
  Column1.Name = "Column1", ;
  Column2.FontSize = 8, ;
  Column2.ControlSource = "cPuntos.nPosX", ;
  Column2.Width = 53, ;
  Column2.Name = "Column2", ;
  Column3.FontSize = 8, ;
  Column3.ControlSource = "cPuntos.NPosY", ;
  Column3.Width = 55, ;
  Column3.Name = "Column3"
 Procedure odibujar
  Local nValor, nReg
  nReg=Recno("cPuntos")
  Select Count(nPosx) As Conteo From cPuntos Where !Deleted() Into Cursor cC
  nValor = cC.Conteo
  Use In Select('cC')
  Select cPuntos
  Copy To Array apuntos For !Deleted('cPuntos')
  Acopy(apuntos,Thisform.apuntos)
  Thisform.shape1.Polypoints=[thisform.apuntos]
  Go (nReg) In cPuntos
 Endproc
 Procedure Load
  Create Cursor cPuntos (nPosx N(3,0),nPosY N(3,0))
  Set Deleted On
 Endproc
 Procedure Init
  With This.grid1
   .Column1.header1.Caption = [Posición]
   .Column2.header1.Caption = [X]
   .Column3.header1.Caption = [Y]
   .SetAll([alignment],2,[Header])
  Endwith
  This.spinner1.Value = 19
  Local apuntos
  Dimension apuntos[19,2]
  Select cPuntos
  apuntos[1,1] = 5 
  apuntos[1,2] = 4
  apuntos[2,1] = 24
  apuntos[2,2] = 4
  apuntos[3,1] = 24
  apuntos[3,2] = 23
  apuntos[4,1] = 11
  apuntos[4,2] = 23
  apuntos[5,1] = 11
  apuntos[5,2] = 46
  apuntos[6,1] = 5
  apuntos[6,2] = 46
  apuntos[7,1] = 5
  apuntos[7,2] = 4
  apuntos[8,1] = 37
  apuntos[8,2] = 4
  apuntos[9,1] = 37
  apuntos[9,2] = 13
  apuntos[10,1] = 29
  apuntos[10,2] = 13
  apuntos[11,1] = 29
  apuntos[11,2] = 26
  apuntos[12,1] = 37
  apuntos[12,2] = 26
  apuntos[13,1] = 37
  apuntos[13,2] = 35
  apuntos[14,1] = 30
  apuntos[14,2] = 35
  apuntos[15,1] = 30
  apuntos[15,2] = 46
  apuntos[16,1] = 20
  apuntos[16,2] = 46
  apuntos[17,1] = 20
  apuntos[17,2] = 23
  apuntos[18,1] = 24
  apuntos[18,2] = 23
  apuntos[19,1] = 24
  apuntos[19,2] = 4
  Append From Array apuntos
  Thisform.odibujar()
 Endproc

 Procedure spinner1.InteractiveChange
  Thisform.LockScreen = .T.
  Local nReg, nValor,nDel
  Set Deleted Off
  Select Count(nPosx) As Conteo From cPuntos Where Deleted() Into Cursor cC
  nDel = cC.Conteo
  Use In Select('cC')
  Select cPuntos
  nReg=Reccount('cPuntos')-nDel
  nValor = This.Value
  If nReg >nValor
   Delete From cPuntos Where Recno()>nValor
  Else
   For nCiclo =  1 To Abs(nReg-nValor)
    Locate For Deleted('cPuntos')
    If Found()
     Recall
    Else
     Insert Into cPuntos (nPosx,nPosY) Values (1,20)
    Endif
   Endfor
  Endif
  Set Deleted On
  Copy To Array apuntos For !Deleted('cPuntos')
  Dimension Thisform.apuntos[Alen(apuntos,1),2]
  Acopy(apuntos,Thisform.apuntos)
  Thisform.Refresh
  Thisform.LockScreen = .F.
 Endproc

 Procedure grid1.AfterRowColChange
  Lparameters nColIndex
  DoDefault(nColIndex)
  Thisform.odibujar()
 Endproc
Enddefine

Saludos

Jorge Mota, Guatemala