Page 1 of 1

Dibujar Polígonos.

Posted: Mon May 10, 2010 4:44 pm
by antolin
Hola foreros.

Aqui os dejo una función para dibujar polígonos. Espero que os sirva.

Ejemplo:
Image

La función:
-----------

Code: Select all

PolyForms( <nRow>, <nCol>, <nWidth>, <nHeight>, <nLados>, <nGiro>, <nPorCent> )

   Función que crea un ARRAY con las coordenadas de los vertices de un polígono
regular para dibujarlo con PolyPolygon(). El polígono puede ser normal
o en estrella.

<nRow>, <nCol>      Coordenadas de la esquina superior izquierda de la zona
                    cuadrángular en la que se va a inscribir el polígono.

<nWidth>, <nHeight> Dimesiones de la zona cuadrángular. Puede definirse como
                    un cuadrado o como un rectángulo, en cuyo caso el
                    polígono se deforma para adaptarse a la superficie.

<nLados>            Número de lados del polígono regular.

<nGiro>             Cantidad de grados que deseamos girar el polígono con
                    respecto a la horizontal (en sentido horario).
                    Por defecto '0'.

<nPorCent>          Para dibujarlos en forma de estrella. Si vale 100 el
                    polígono se dibuja normal. Por defecto vale 100. Con otro 
                    valor se dibuja en forma de estrella. Este valor indica
                    el porcentaje del radio interior con respecto al radio
                    exterior. Cuanto menor sea ese valor, mayor será el efecto
                    estrella, las puntas saldrán más estrechas y profundas.
El ejemplo / Sample:

Code: Select all

FUNCTION Poligonos()
   LOCAL oDlg
   LOCAL hBrush := { CreateSolidBrush( CLR_HRED ), CreateSolidBrush( CLR_GREEN ) }

   #Define PI   3.141592653589
   *
   DEFINE DIALOG oDlg  SIZE 860,360 COLOR 0,CLR_WHITE TITLE " Polígonos"
      oDlg:bPainted := { |hDc| PaintPrb(hDc,hBrush) }
   ACTIVATE DIALOG oDlg CENTER
   *
   DeleteObject( hBrush )
RETURN NIL
*
FUNCTION PaintPrb(hDc,hBrs)
   LOCAL hOldPen  := SelectObject( hDc, GetStockObject( 7 ) )
   LOCAL hOldBush := SelectObject( hDc, hBrs[1] )
   *
   Rectangle( hDc,18,18,224,224 )
   SelectObject( hDc, hBrs[2] )
   PolyPolygon( hDc, PolyForms( 20,20,200,200,10,18,46 ), PolyForms( 20,20,200,200,5 ) )
   PolyPolygon( hDc, PolyForms( 20,260,200,200,5,-18,31 ) )
   SelectObject( hDc, hBrs[1] )
   PolyPolygon( hDc, PolyForms( 20,500,200,200,6,0,80 ) )
   *
   SelectObject( hDc, hOldBush )
   SelectObject( hDc, hOldPen )
RETURN NIL
*
FUNCTION PolyForms(nX,nY,nWidth,nHeight,nLados,nGiro,nPorC)
   LOCAL aVert
   LOCAL nRadV := nHeight/2
   LOCAL nRadH := nWidth/2
   LOCAL nAngl := (2*PI)/nLados
   LOCAL nAngu,nOAng
   LOCAL nCount,nStep

   DEFAULT nGiro := 0 , ;
           nPorC := 100
   *
   nPorc := Max(0,Min(100,nPorC))   // SOLO ENTRE 0 Y 100 (ONLY FROM 0 TO 100)
   nAngu := (nGiro*PI)/180
   IF nPorC = 100
      aVert := Array(nLados+1,2)
      nStep := 1
   ELSE
      aVert := Array((nLados*2)+1,2)
      nStep := 2
      nOAng := nAngl/2
      nLados:= nLados*2
      nPorC := 9.9+(nPorC*0.9)    // LIMITADO 0.9 A 99 (LIMITED FROM 9.9 TO 99)
   ENDIF
   *
   FOR nCount = 1 TO nLados STEP nStep
       aVert[nCount] := { nY+nRadH+(nRadH*Cos(nAngu)), nX+nRadV+(nRadV*Sin(nAngu)) }
       IF nPorC < 100
      aVert[nCount+1] := { nY+nRadH+(nRadH*(nPorC/100)*Cos(nAngu+nOAng)), ;
                           nX+nRadV+(nRadV*(nPorC/100)*Sin(nAngu+nOAng))  }
       ENDIF
       nAngu += nAngl
   NEXT
   aVert[nLados+1] := aVert[1]
RETURN aVert

 

Re: Dibujar Polígonos.

Posted: Mon May 10, 2010 4:47 pm
by antolin
I'll try to explain it in english

Code: Select all

PolyForms( <nRow>, <nCol>, <nWidth>, <nHeight>, <nLados>, <nGiro>, <nPorCent> )

   This function build an array with the vertex coordinates of a polygon to 
paint it with PolyPolygon(). Polygons can be normal or stared (see sample).

<nRow>, <nCol>      Coordinates for the upper left corner of the quadrangular
                    zone where the polygon will be fitted.

<nWidth>, <nHeight> Dimensions of the quadrangular zone. It can be a square 
            or a rectangle, in which case the polygon will be 
                    deformed to fit the zone.

<nLados>            Number of sides.

<nGiro>             Amount of degrees to turn the polygon (in hourly sens) in
                    relation to the horizontal line. Default '0'.

<nPorCent>          To paint stared polygon. 100 mean normal (default). Other
                    value indicate the pecentage of the small radius in
                    relation tothe normal radius. Smaller values indicate 
                    greater and tighter arms than higher values.
(excuse my english) Regards.

Re: Dibujar Polígonos.

Posted: Tue May 18, 2010 9:09 am
by mmercado
Hola Antolín:
antolin wrote:Aqui os dejo una función para dibujar polígonos. Espero que os sirva.
Muy útil, muchísimas gracias/Very usefull thanks a lot.

Un abrazo.

Manuel Mercado Gómez.

Re: Dibujar Polígonos.

Posted: Sat May 22, 2010 5:45 pm
by Antonio Linares
Antolín,

Gracias! :-)