Sección de código fuente Visual basic

Código fuente para dibujar usando los métodos gráficos de Visual Basic

Ejemplo que muestra como podemos utilizar los métodos gráficos del visual Basic para dibujar líneas, círculos y rectángulos sobre un control PictureBox

El código es muy fácil y nada complicado, ni siquiera utiliza funciones Api.

El autor del mismo es HiT_MaN

Se pueden dibujar círculos, polígonos, con o sin relleno, líneas continuas, puntos y establecerle el color a las figuras haciendo uso de los Métodos gráficos de visual basic: Line, Circle, PSe

Colocar dentro de un formulario como muestra la imagen, los siguiente controles:

Picture1
Un control Frame1
Dentro del Frame1: 1 Label1 y abajo un Combo1. Al costado del combo1 un Check1
A la derecha del Frame, un Shape1 y al costado 3 HScrollBar (HScroll(0), HScroll(1) y HScroll(2))

Nota: no hace falta poner los valores de los controles ya que se hacen por código:

vista previa

Vista previa del programa de dibujo

Código fuente en el Formulario:

'* Description : Ejemplo de programa para dibujar en un picturebox '*************************************************************************** 'Variables para almacenar las coordenadas _ para los rectángulos y para los círculos Dim X1 As Long Dim Y1 As Long Dim X2 As Long Dim Y2 As Long Private Sub Combo1_Click() Label1.Caption = "Tipo de dibujo: " & Combo1.Text If Combo1.ListIndex = 1 Then Check1.Enabled = True Else Check1.Enabled = False End If End Sub Private Sub Combo1_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub Form_Load() 'Agregamos los valores al combo1 que _ muestra los posibles dibujos a realizar With Combo1 .AddItem "Continuo" .AddItem "Rectangulo" .AddItem "Circulo" .AddItem "Punto" End With HScroll(0).Min = 0: HScroll(1).Min = 0: HScroll(2).Min = 0 HScroll(0).Max = 255: HScroll(1).Max = 255: HScroll(2).Max = 255 Combo1.ListIndex = 0 End Sub Private Sub Form_Resize() 'Redimensionamos los controles On Error Resume Next Frame1.Left = (Me.Width - Frame1.Width) / 2 Frame1.Top = Me.Height - (Frame1.Height + 480) Picture1.Width = Me.Width - 360 Picture1.Height = Frame1.Top - 180 End Sub Private Sub HScroll_Change(Index As Integer) 'Esto le da el color de borde al shape1 _ de acuerdo al valor de los ScrollBar Shape1.BorderColor = RGB(HScroll(0).Value, HScroll(1).Value, HScroll(2).Value) 'Esto le da el color de fondo al shape1 _ de acuerdo al valor de los ScrollBar Shape1.FillColor = RGB(HScroll(0).Value, HScroll(1).Value, HScroll(2).Value) End Sub Private Sub Picture1_MouseDown(Button As Integer, _ Shift As Integer, _ X As Single, Y As Single) 'Almacenamos en estas variables los valores del ratón X1 = X Y1 = Y X2 = X Y2 = Y If Combo1.Text = "Rectangulo" Or Combo1.Text = "Circulo" Then Picture1.PSet (X, Y), Shape1.FillColor End If End Sub Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) If Button = vbLeftButton Then 'Línea continua If Combo1 = "Continuo" Then Picture1.Line (X1, Y1)-(X, Y), Shape1.FillColor X1 = X: Y1 = Y End If 'Para dibujar los puntos If Combo1 = "Punto" Then Picture1.PSet (X, Y), Shape1.FillColor End If End If End Sub Private Sub Picture1_MouseUp(Button As Integer, _ Shift As Integer, _ X As Single, _ Y As Single) On Error Resume Next X1 = 0 Y1 = 0 'Si estamos en modo de rectángulo If Combo1 = "Rectangulo" Then If Check1.Value = 0 Then 'Si no tiene relleno Picture1.Line (X2, Y2)-(X, Y), Shape1.FillColor, B Else 'si tiene relleno Picture1.Line (X2, Y2)-(X, Y), Shape1.FillColor, BF End If End If 'Para los círculos If Combo1 = "Circulo" Then 'sin relleno If X > X2 Then Picture1.Circle (X2, Y2), X - X2, Shape1.FillColor End If 'Con relleno If X2 > X Then Picture1.Circle (X2, Y2), X2 - X, Shape1.FillColor End If End If End Sub

Buscar en Recursos vb