Curso Entrega 6:

En esta entrega vamos a trabajar con un Editor de gráficos al estilo Paint. Que nos permita dibujar, líneas, rectángulos, círculos y líneas punteadas. Darle color y grabar la imagen como .bmp. La aplicación se verá así:

El Menú Archivo contiene los siguientes SubMenús: Nueva Imagen, Abrir Imagen, Grabar Imagen, y Salir. Esto lo confeccionamos con el Editor de menú como en el ejercicio anterior. También vamos a usar un CommonDialog para abrir un nuevo Archivo y para grabar el que dibujemos como .bmp. Las Listas desplegables son ComboList y usamos tres Barras de Scroll Horizontal para combinar los colores con la Función RGB. Todo esto dentro de un Frame o Cuadro.Para ubicarlo mejor en la pantalla y diferenciarlo del Área de dibujo que es un Control Picture con su propiedad AutoRedraw a True, para que se redibuje, o sea se actualice al aplicarle distintos métodos gráficos.

El código es el siguiente:

Option Explicit
Dim X1 As Long 'esta es la Posición x de la última línea dibujada.
Dim Y1 As Long 'esta es la posición y de la ultima linea dibujada.
Dim X2 As Long 'este es el comienzo del rectangulo o círculo.
Dim Y2 As Long 'este es el comienzo del rectangulo o círculo.

Private Sub Combo1_Click()
Label2.Caption = Combo1.Text
If Combo1.ListIndex = 1 Then Check1.Enabled = True Else Check1.Enabled = False
End Sub

'Aquí controlamos si la elección del combo corresponde al item 1 o sea rectángulo, 'entonces habilitamos la opción rellenar del CheckBox, si es línea contínua, círculo o 'línea discontínua, lo deshabilitamos.

Private Sub Form_Load() 'al cargar el Form iniciamos los valores de los Combo en el 'primer item o sea 0
Combo1.ListIndex = 0
Combo2.ListIndex = 0
End Sub

Private Sub HScroll1_Change(Index As Integer)
Shape1.BorderColor = RGB(HScroll1(0).Value, HScroll1(1).Value, HScroll1(2).Value)
Shape1.FillColor = RGB(HScroll1(0).Value, HScroll1(1).Value, HScroll1(2).Value)
End Sub

'La figura (Shape) se rellena con el color elegido según la propiedad Value de los 'Scrolls, combinados en la Función RGB.

Private Sub mnuAbrir_Click()
On Error Resume Next
CommonDialog1.DialogTitle = "Abrir..."
CommonDialog1.Filter = "Todos los Archivos de Imagenes (*.gif,*.jpg,*.bmp)|*.gif;*.jpg;*.bmp| BMP Solamente(*.bmp)|*.bmp"
CommonDialog1.ShowOpen
If CommonDialog1.filename = "" Then Exit Sub
Picture1.Picture = LoadPicture(CommonDialog1.filename)
End Sub

'El submenú Abrir muestra la ventana Abrir de Windows determinada por el método 'ShowOpen. Si el archivo seleccionado es cadena vacía o sea ninguno, luego sale del 'procedimiento para evitar un mensaje de error. Si en cambio hay seleccionado un 'archivo .bmp o de otro tipo de imagen (Esto lo pongo como ejemplo, para otro tipo 'de programa que permita abrir jpg, o gif o dib). Con LoadPicture lo despliega. Y la 'selección se hace a través de la propiedad Filter.

'La sintáxis Resume next, hace que en caso de encontrar un error, salte a la próxima 'línea de código.

Private Sub mnuGrabar_Click()
On Error Resume Next
CommonDialog1.DialogTitle = "Grabar ..."
CommonDialog1.Filter = "Archivos de imagenes (*.bmp)|*.bmp"
CommonDialog1.ShowSave
If CommonDialog1.filename = "" Then Exit Sub
SavePicture Picture1.Image, CommonDialog1.filename
End Sub

'ShowSave es el método que muestra la ventana de Grabar un archivo, y la sintáxis 'SavePicture lo graba como un archivo.

Private Sub mnuNuevo_Click()
'Vacia la imagen para volver a dibujar
Picture1.Picture = LoadPicture("")
Picture1.Cls ' Cls limpia y redibuja la Picture donde dibujamos.
End Sub

Private Sub mnuSalir_Click()
Unload Me
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
X1 = X
Y1 = Y
X2 = X
Y2 = Y

'si usamos un rectángulo o circulo marcamos el comienzo de estos con el metodo 'Pset
If Label2.Caption = "Rectángulo" Or Label2.Caption = "Circulo" Then Picture1.PSet (X, Y), Shape1.FillColor ' con el color determinado por la selección de los Scroll Bar
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
'si la línea es continua la dibuja continua, sino en puntos
If Label2.Caption = "Continua" Then
Picture1.Line (X1, Y1)-(X, Y), Shape1.FillColor
X1 = X: Y1 = Y
End If

If Label2.Caption = "Punteada" Then Picture1.PSet (X, Y), Shape1.FillColor
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

'dibuja un rectangulo
If Label2.Caption = "Rectangulo" Then
If Check1.Value = 0 Then
Picture1.Line (X2, Y2)-(X, Y), Shape1.FillColor, B
Else
Picture1.Line (X2, Y2)-(X, Y), Shape1.FillColor, BF
End If
End If

'dibuja un circulo
If Label2.Caption = "Circulo" Then
If X > X2 Then Picture1.Circle (X2, Y2), X - X2, Shape1.FillColor
If X2 > X Then Picture1.Circle (X2, Y2), X2 - X, Shape1.FillColor
End If

End Sub

Los métodos Line, toma como referente las dos primeras coordenadas y las dos ultimas. El método Circle toma como referentes las dos corrdenadas iniciales y luego determina el radio del círculo. Y en el caso del rectángulo toma el inicio y fin de la diagonal y las vuelca como dos líeas que se cortan, y copia estas medidas en forma de espejo sobre el lado opuesto.

Para mayor claridad pueden consultar en la Ayuda de VB estos métodos gráficos.

Les envío un módulo con un algoritmo que me facilitó un colega y que permite hacer controles en 3D, o sea darles efectos de profundidad, en el ejemplo lo vemos con botones, frames, labels y pictures.

El código debe grabarse en un módulo y luego con Agregar módulo ya existente lo pueden agregar a cualquier proyecto y dándole los valores correspondientes a cada control, verán aplicados los efectos. El código del módulo es:

Option Explicit

Public PixX%
Public PixY%
Public CTop%
Public CLft%
Public Crgt%
Public CBtm%
Public i%
Public AddX%
Public AddY%
Public Sub MakeIt3D(Ctrl As Control, nBevel%, nSpace%, bInset%)
'Hace que el control aparezca en formato 3D.
'Parámetros:
' Ctrl = aplica el efecto 3D a un control
' nBevel% = el ancho del borde o bizelado (pixels)
' nSpace% = distancia entre el borde y el control (pixels)
' bInset% = True si tiene borde 3D. False si no lo tiene.

PixX% = Screen.TwipsPerPixelX
PixY% = Screen.TwipsPerPixelY
CTop% = Ctrl.Top - PixX%
CLft% = Ctrl.Left - PixY%
Crgt% = Ctrl.Left + Ctrl.Width
CBtm% = Ctrl.Top + Ctrl.Height
If bInset% Then 'hunde el borde
For i% = nSpace% To (nBevel% + nSpace% - 1)
AddX% = i% * PixX%
AddY% = i% * PixY%
Ctrl.Parent.Line (CLft% - AddX%, CTop% - AddY%)-(Crgt% + AddX%, CTop% - AddY%), &HFFFF&
Ctrl.Parent.Line (CLft% - AddX%, CTop% - AddY%)-(CLft% - AddX%, CBtm% + AddY%), &HFFFF&
Ctrl.Parent.Line (CLft% - AddX%, CBtm% + AddY%)-(Crgt% + AddX% + PixX%, CBtm% + AddY%), &H8080&
Ctrl.Parent.Line (Crgt% + AddX%, CTop% - AddY%)-(Crgt% + AddX%, CBtm% + AddY%), &H8080&
Next
Else 'aumenta o eleva el borde
For i% = nSpace% To (nBevel% + nSpace% - 5)
AddX% = i% * PixX%
AddY% = i% * PixY%
Ctrl.Parent.Line (Crgt% + AddX%, CBtm% + AddY%)-(Crgt% + AddX%, CTop% - AddY%), &HFFFF&
Ctrl.Parent.Line (Crgt% + AddX%, CBtm% + AddY%)-(CLft% - AddX%, CBtm% + AddY%), &HFFFF&
Ctrl.Parent.Line (Crgt% + AddX%, CTop% - AddY%)-(CLft% - AddX% - PixX%, CTop% - AddY%), &H8080&
Ctrl.Parent.Line (CLft% - AddX%, CBtm% + AddY%)-(CLft% - AddX%, CTop% - AddY%), &H8080&
Next
End If
End Sub

Luego en el formulario donde dibujamos los controles, debemos convocarlos y asignarles los valores que deseamos a cada argumento. El código del Form que mostramos en la Imagen es:

Private Sub Form_Paint()'en el procedimiento Dibujar del Formulario
'Llamamos al procedimiento MakeIt3D y le asignamos un valor para el borde 3D y 'un valor para el borde interno entre el control y el borde externo. Y luego lo determinamos a True, o sea verdadero.

MakeIt3D Command1, 15, 1, True
MakeIt3D Command2, 15, 1, True
MakeIt3D Label1, 15, 8, True
MakeIt3D Frame1, 12, 5, True
MakeIt3D Picture1, 10, 2, True
MakeIt3D Picture2, 12, 2, True
End Sub

Para terminar, un pequeño truquito para que nuestros Menús tengan una línea de color:

El código es:

Private Sub Form_Load()
Frame1.Width = Screen.Width + 100 ' el ancho de la pantalla + 100 twips.
Frame1.Move -50, 0 ' y lo ubicamos un poco más abajo del menú
End Sub

Private Sub mnuSalir_Click()
End
End Sub

La línea es en realidad un Frame de color a elección, sin caption.

Bueno en la próxima entrega seguiremos trabajando. Un fuerte abrazo para todos.

Mirta