Sección de códigos, trucos y ejemplos para visual basic

Clic para descargar Velneo Open source Software - Plataforma para el desarrollo de aplicaciones sobre base de datos

472 - Dibujar estrellas

Ejemplo que dibuja estrellas sobre un formulario mediante los métodos gráficos de vb

Hola. Os envío un ejemplo con el código fuente para poder dibujar estrellas de 5 puntas sin utilizar para el relleno interior la Api FloodFill, ya que consume muchos recursos y por lo tanto va muy lento

Descargar

La función se llama Estrella y los parametros a pasar son:

X1: punto X central de la circunferencia
Y1: punto Y central de la circunferencia
Radio: radio de la circunferencia
Color_Borde: Color del borde exterior de la estrella
Color_Fondo: Color de relleno de la estrella

Para poder utilizar esta función en otro programa debes copiar las funciones estrella, triángulo y punto_medio; y modificar la palabra picture1 que está en estrella y en el triángulo por el dispositivo picturebox, form o usercontrol donde vayas a dibujar.

El dispositivo donde vayas a dibujar debe tener las propiedades:

Scalemode = Pixels
Autoredraw =true

Saludos

Agustín Dávila

código fuente

Private Const pi = 3.14159265358979 Private Sub Estrella( _ X1 As Single, _ Y1 As Single, _ Radio As Single, _ Color_Borde As Long, _ Color_Fondo As Long) Dim i As Single, Inicio As Single, Final As Single, m As Single Dim Aux As Single, PY As Single, PX As Single, a As Single Dim CX(10) As Single, CY(10) As Single m = pi / 2 PY = Radio * Sin(pi / 10) PX = PY / Tan(13 * (pi / 45)) PX = PX * PX PY = PY * PY a = Sqr(PX + PY) For i = 1 To 10 If i Mod 2 = 0 Then CX(i) = Punto_Medio(X1 + (a * Cos(m))) CY(i) = Punto_Medio(Y1 - (a * Sin(m))) Else CX(i) = Punto_Medio(X1 + (Radio * Cos(m))) CY(i) = Punto_Medio(Y1 - (Radio * Sin(m))) End If m = m + pi / 5 Next i Triángulo CX(1), CY(1), CX(5), CY(5), CX(6), CY(6) + 1, Color_Fondo Triángulo CX(1), CY(1), CX(7), CY(7), CX(6), CY(6), Color_Fondo Triángulo CX(2) + 3, CY(2), CX(3), CY(3), CX(4), CY(4), Color_Fondo Triángulo CX(10) - 3, CY(10), CX(9), CY(9), CX(8), CY(8), Color_Fondo Picture1.Line (CX(1), CY(1))-(CX(2), CY(2)), Color_Borde For i = 3 To 10 Picture1.Line -(CX(i), CY(i)), Color_Borde Next i Picture1.Line -(CX(1), CY(1)), Color_Borde End Sub Private Function Punto_Medio(v As Single) As Single Dim n As Integer, n1 As Single n = Fix(v) n1 = v - n If n1 = 0 Then Punto_Medio = v ElseIf n1 >= 0.5 Then Punto_Medio = n + 1 Else Punto_Medio = v End If End Function Private Sub Triángulo( _ X1 As Single, _ Y1 As Single, _ X2 As Single, _ Y2 As Single, _ X3 As Single, _ Y3 As Single, _ CColor As Long) Dim VX(3) As Single Dim VY(3) As Single Dim i As Single Dim CY1 As Single Dim CY2 As Single Dim m As Single Dim n As Single If X1 <= X2 And X1 <= X3 Then VX(1) = X1 VY(1) = Y1 If X2 <= X3 Then VX(2) = X2 VY(2) = Y2 VX(3) = X3 VY(3) = Y3 Else VX(2) = X3 VY(2) = Y3 VX(3) = X2 VY(3) = Y2 End If ElseIf X2 <= X1 And X2 <= X3 Then VX(1) = X2 VY(1) = Y2 If X1 <= X3 Then VX(2) = X1 VY(2) = Y1 VX(3) = X3 VY(3) = Y3 Else VX(2) = X3 VY(2) = Y3 VX(3) = X1 VY(3) = Y1 End If ElseIf X3 <= X1 And X3 <= X2 Then VX(1) = X3 VY(1) = Y3 If X1 <= X2 Then VX(2) = X1 VY(2) = Y1 VX(3) = X2 VY(3) = Y2 Else VX(2) = X2 VY(2) = Y2 VX(3) = X1 VY(3) = Y1 End If End If n1 = VX(3) - VX(1) For i = VX(1) To VX(2) Step 1 If (VX(2) - VX(1)) = 0 Then m = 0 Else m = (VY(1) - VY(2)) / (VX(2) - VX(1)) End If CY1 = Punto_Medio(VY(1) + m * (i - VX(1))) CY1 = 2 * VY(1) - CY1 If (VX(3) - VX(1)) = 0 Then m = 0 Else m = (VY(1) - VY(3)) / (VX(3) - VX(1)) End If CY2 = Punto_Medio(VY(1) + m * (i - VX(1))) CY2 = 2 * VY(1) - CY2 Picture1.Line (i, CY1)-(i, CY2), CColor Next i For i = VX(2) To VX(3) Step 1 If (VX(3) - VX(2)) = 0 Then m = 0 Else m = (VY(2) - VY(3)) / (VX(3) - VX(2)) End If CY1 = Punto_Medio(VY(2) + m * (i - VX(2))) CY1 = 2 * VY(2) - CY1 If (VX(3) - VX(1)) = 0 Then m = 0 Else m = (VY(1) - VY(3)) / (VX(3) - VX(1)) End If CY2 = Punto_Medio(VY(1) + m * (i - VX(1))) CY2 = 2 * VY(1) - CY2 Picture1.Line (i, CY1)-(i, CY2), CColor Next i End Sub Private Sub Command1_Click() Picture1.Cls End Sub Private Sub Command2_Click() Trapecio 100, 100, 500, 400 End Sub Private Sub Form_Load() Randomize Timer End Sub Private Sub Form_Resize() On Error Resume Next Picture1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight On Error GoTo 0 End Sub Private Sub Timer1_Timer() Dim PX As Single, PY As Single, r As Single, CFondo As Long PX = CInt(Rnd * Picture1.ScaleWidth) PY = CInt(Rnd * Picture1.ScaleHeight) r = CInt(Rnd * 40) + 1 CFondo = CLng(Rnd * 16700000) Estrella PX, PY, r, 0, CFondo End Sub

Recursos visual basic 6.0

Métodos gráficos

Recursos vb.net

Dibujar líneas en un form

Buscar en Recursos vb