Codigo fuente de VB
0
12:14 p. m. | Posted in




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

Texto plano


  1. '* Description : Ejemplo de programa para dibujar en un picturebox
  2. '**********************************************************

  4. 'Variables para almacenar las coordenadas _para los rectángulos y para los círculos
  5. Dim X1 As Long
  6. Dim Y1 As Long
  7. Dim X2 As Long
  8. Dim Y2 As Long

  10. Private Sub Combo1_Click()
  11. Label1.Caption = "Tipo de dibujo: " & Combo1.Text
  12. If Combo1.ListIndex = 1 Then
  13. Check1.Enabled = True
  14. Else
  15. Check1.Enabled = False
  16. End If
  17. End Sub

  19. Private Sub Combo1_KeyPress(KeyAscii As Integer)
  20. KeyAscii = 0
  21. End Sub

  23. Private Sub Form_Load()

  25. 'Agregamos los valores al combo1 que _muestra los posibles dibujos a realizar

  27. With Combo1
  28. .AddItem "Continuo"
  29. .AddItem "Rectangulo"
  30. .AddItem "Circulo"
  31. .AddItem "Punto"
  32. End With

  34. HScroll(0).Min = 0: HScroll(1).Min = 0: HScroll(2).Min = 0
  35. HScroll(0).Max = 255: HScroll(1).Max = 255: HScroll(2).Max = 255
  36. Combo1.ListIndex = 0

  38. End Sub

  40. Private Sub Form_Resize()

  42. 'Redimensionamos los controles
  43. On Error Resume Next

  45. Frame1.Left = (Me.Width - Frame1.Width) / 2
  46. Frame1.Top = Me.Height - (Frame1.Height + 480)

  48. Picture1.Width = Me.Width - 360
  49. Picture1.Height = Frame1.Top - 180

  51. End Sub

  53. Private Sub HScroll_Change(Index As Integer)

  55. 'Esto le da el color de borde al shape1 _de acuerdo al valor de los ScrollBar
  56. Shape1.BorderColor = RGB(HScroll(0).Value, HScroll(1).Value, HScroll(2).Value)

  58. 'Esto le da el color de fondo al shape1 _de acuerdo al valor de los ScrollBar
  59. Shape1.FillColor = RGB(HScroll(0).Value, HScroll(1).Value, HScroll(2).Value)

  61. End Sub

  63. Private Sub Picture1_MouseDown(Button As Integer, _
  64. Shift As Integer, _
  65. X As Single, Y As Single)

  67. 'Almacenamos en estas variables los valores del ratón
  68. X1 = X
  69. Y1 = Y
  70. X2 = X
  71. Y2 = Y

  73. If Combo1.Text = "Rectangulo" Or Combo1.Text = "Circulo" Then
  74. Picture1.PSet (X, Y), Shape1.FillColor
  75. End If
  76. End Sub

  78. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, _
  79. X As Single, Y As Single)

  81. If Button = vbLeftButton Then
  82. 'Línea continua
  83. If Combo1 = "Continuo" Then
  84. Picture1.Line (X1, Y1)-(X, Y), Shape1.FillColor
  85. X1 = X: Y1 = Y
  86. End If
  87. 'Para dibujar los puntos
  88. If Combo1 = "Punto" Then
  89. Picture1.PSet (X, Y), Shape1.FillColor
  90. End If
  91. End If

  93. End Sub

  95. Private Sub Picture1_MouseUp(Button As Integer, _
  96. Shift As Integer, _
  97. X As Single, _
  98. Y As Single)
  99. On Error Resume Next

  101. X1 = 0
  102. Y1 = 0
  103. 'Si estamos en modo de rectángulo
  104. If Combo1 = "Rectangulo" Then

  106. If Check1.Value = 0 Then
  107. 'Si no tiene relleno
  108. Picture1.Line (X2, Y2)-(X, Y), Shape1.FillColor, B
  109. Else
  110. 'si tiene relleno
  111. Picture1.Line (X2, Y2)-(X, Y), Shape1.FillColor, BF
  112. End If
  113. End If

  115. 'Para los círculos
  116. If Combo1 = "Circulo" Then
  117. 'sin relleno
  118. If X > X2 Then
  119. Picture1.Circle (X2, Y2), X - X2, Shape1.FillColor
  120. End If

  122. 'Con relleno
  123. If X2 > X Then
  124. Picture1.Circle (X2, Y2), X2 - X, Shape1.FillColor
  125. End If
  126. End If
  127. End Sub

Category:
��

Comments

0 responses to "Codigo fuente de VB"

Publicar un comentario