PAINT AULADEINFORMATICA

CODIGO

'variables de posición actuales

Dim x1 As Double

Dim y1 As Double

Dim x2 As Double

Dim y2 As Double

'variables de posición antiguas

Dim ax1 As Double

Dim ay1 As Double

Dim ax2 As Double

Dim ay2 As Double

'variables de tipo color

Dim colorl As ColorConstants

Dim colorf As ColorConstants

Dim colorr As ColorConstants

'variables

Dim tipo_de_figura As Integer

Dim pinta As Boolean

Dim contador As Integer

Dim i As Integer

Dim relleno As Boolean

'estructura figura

Private Type figura

x1 As Double

y1 As Double

x2 As Double

y2 As Double

tipo_de_figura As Integer

colorl As ColorConstants

colorr As ColorConstants

relleno As Boolean

End Type

Dim figuras(1000) As figura

Private Sub Form_Load()

i = 0

tipo_de_figura = 1

x1 = 0

y1 = 0

r1 = 0

ax1 = 0

ay1 = 0

ar1 = 0

x2 = 0

y2 = 0

ax2 = 0

ay2 = 0

colorl = vbBlack

colorf = &HFFFFFF

colorr = &H8000000F

relleno = False

pìnta = False

contador = 0

Toolbar1.Buttons(12).Value = Checked

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim retorno As Integer

x1 = X

y1 = Y

pinta = True

End Sub

Public Function dibujar(dx1 As Double, dy1 As Double, dx2 As Double, dy2 As Double, fig As Integer, cl As ColorConstants, cr As ColorConstants, rell As Boolean)

Dim el As Double

If pinta Then

If rell Then Form1.FillStyle = opaque

r = CInt(Sqr((dx2 - dx1) ^ 2 + (dy2 - dy1) ^ 2))

If (dx1 - dx2) <> 0 Then el = (dy1 - dy2) / (dx1 - dx2)

Select Case fig

Case 0:

Form1.Circle (dx1, dy1), 10, cl

Case 1:

Form1.Line (dx1, dy1)-(dx2, dy2), cl

Case 2:

If rell Then

Form1.Line (dx1, dy1)-(dx2, dy2), cl, BF

Else

Form1.Line (dx1, dy1)-(dx2, dy2), cl, B

End If

Case 3:

If rell Then

Form1.FillStyle = 0

Form1.FillColor = cr

Else

Form1.FillStyle = 1

Form1.FillColor = vbWhite

End If

Form1.Circle (dx1, dy1), r, cl, 0, 0, el

End Select

End If

End Function

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim retorno As Integer

If pinta Then

If tipo_de_figura = 0 Then

retorno = dibujar(ax1, ay1, ax2, ay2, tipo_de_figura, colorl, colorf, False)

End If

If tipo_de_figura <> 0 Then retorno = dibujar(ax1, ay1, ax2, ay2, tipo_de_figura, colorf, colorf, relleno)

x2 = X

y2 = Y

retorno = dibujar(x1, y1, x2, y2, tipo_de_figura, colorl, colorr, False)

ax1 = x1

ay1 = y1

ax2 = x2

ay2 = y2

End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim retorno As Integer

Dim px2, py2

px2 = X

py2 = Y

If contador < 1000 Then

figuras(contador).x1 = x1

figuras(contador).y1 = y1

figuras(contador).x2 = px2

figuras(contador).y2 = py2

figuras(contador).tipo_de_figura = tipo_de_figura

figuras(contador).colorl = colorl

figuras(contador).colorr = colorr

figuras(contador).relleno = relleno

For i = 0 To contador

retorno = dibujar(figuras(i).x1, figuras(i).y1, figuras(i).x2, figuras(i).y2, figuras(i).tipo_de_figura, figuras(i).colorl, figuras(i).colorr, figuras(i).relleno)

Next i

pinta = False

End If

Label1.Caption = "(" & figuras(contador).x1 & "," & figuras(contador).y1 & ")" & "; " & "(" & figuras(contador).x2 & "," & figuras(contador).y2 & ")" & "," & " Figura tipo: " & figuras(contador).tipo_de_figura & "," & figuras(contador).colorl & "," & figuras(contador).colorr

contador = contador + 1

ax1 = 0

ay1 = 0

ax2 = 0

ay2 = 0

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

Dim Msg

Select Case Button.Index

Case 5:

CommonDialog1.ShowPrinter

On Error GoTo ErrorHandler ' Configura el controlador de errores.

PrintForm ' Imprime el formulario.

Exit Sub

ErrorHandler:

Msg = "Imposible imprimir el formulario."

MsgBox Msg ' Muestra el mensaje.

Resume Next

Case 7:

tipo_de_figura = 0:

Case 8:

tipo_de_figura = 1:

Case 9:

tipo_de_figura = 2:

Case 10:

tipo_de_figura = 3:

Case 9:

tipo_de_figura = 4:

Case 12:

CommonDialog1.ShowColor: colorl = CommonDialog1.Color

Case 13:

CommonDialog1.ShowColor: colorr = CommonDialog1.Color: Form1.FillColor = colorr

Case 15:

relleno = Toolbar1.Buttons.Item(15).Value

End Select

Label1.Caption = "figura = " & tipo_de_figura

End Sub