Cómo crear la herramienta Paint en VB .Net | |
| Debo mencionar que en esta aplicación no utilicé imágenes guardadas en el disco sino matrices que representan | |
| los píxeles de la imagen, sigue el código y entenderás cómo funciona esta técnica. | |
| Puede descargar el proyecto completo aqu | |
| ¡Creemos un proyecto, por ejemplo, con el nombre dzoDraw! | |
| Insertamos el primer formulario que contiene los tres menús y el espacio para dibujar y otras ventanas tabuladas. | |
| De esta forma insertamos los cuatro paneles | |
![]() | |
Empecemos con Dibujar Panel | |
| Necesitamos la estructura más importante del proyecto que le permita crear los diversos objetos de dibujo DZODraw | |
| usando la clase DZODraw | |
Public Structure ptObject Public name As String - name of the drawn object Public X1 As Point - the left corner position Public X2 As Point - the right corner position Public XORIG1 As Point - the original position of left corner position Public XORIG2 As Point - the original position of right corner position Public penLine As Pen - the Pen using for the drawing of the object Public draw As Integer |
La variable draw puede tener uno de los siguientes valores: | |
Public Const CLEAR = 0 - to clear the drawing area
Public Const LINE = 1 - to draw line
Public Const LINEARROW = 2 - to draw line with one arrow
Public Const LINEARROWSE = 3 - to draw line with two arrows
Public Const PEN = 4 - to draw with the pen
Public Const RECTANGLE = 5 - to draw rectangle
Public Const CUBE = 6 - to draw cube
Public Const ELLIPSE = 7 - to drwa ellipse
Public Const CURVE = 8 - to draw curve
Public Const BOLT = 9 - to draw bolt
Public Const FILL = 10 - to fill area with color
Public Const SELECTION = 11 - to select object
Public Const COPY = 12 - to copy the selected object
Public Const PASTE = 13 - to past the selected object
Public Const DELETE = 14 - to delete the selected object
Public Const IIMAGE = 15 - to insert image from disk
Public Const LABEL = 16 - to insert text
Public Const GRID = 17 - to view the grid in the drawing area
Public Const ZOOM_M = 18 - to zoom -
Public Const ZOOM_P = 19 - to zoom +
Public Const EXIT_APP = 20 - to exit from the application
Public bitmap As Bitmap - the bitmap if the object need
Public text As String - the text if the object is a text
Public directionText As String - the direction of the text horizontal or vertical
Public lstPtCurve As ArrayList - the list of points that form the curved object
Public font As Font - the font used when the object is a text
Public rotation As Integer - the rotation angle of the object
Public penSize As Single - the size of the drawing pen
Public penStyle As String - the style of the drawing pen
Public FillColor As Color - the first fill color
Public FillColor2 As Color - the second fill color to combine with the first
Public ForeColor As Color - the color of the drawing pen
Public bringToFront As Boolean - to bring the object to back or to front.
Public brightness As Double - the brightness of the image if the object is a bitmap.
Public contrast As Double - the contrast of the image if the object is a bitmap.
Public gamma As Double - the gamma of the image if the object is a bitmap.
Public orderDesign As Integer - the order of drawing of the object
Public brushBitmap As String - the brushBitmap of the image if the object is a bitmap.
Public dCube As Integer - the depth of the cube object.
End Structure
Public Class DZODraw
...
|
| Estas son las listas más importantes utilizadas: | |
Public lstDrawOject As New List(Of ptObject) - List of all drawn objects Public lstRedoDrawOject As New List(Of ptObject) - List of deleted objects witch can be recovered with Ctrl+Z Public lstSelDrawOject As New List(Of ptObject) - List of all selected objects Public lstCopiedSelDrawOject As New ArrayList() - List of all copied objects ..... .... End class |
| Por lo tanto tenemos un objeto que se manipula a través de listas | |
| comencemos explicando los diversos métodos (clase DZODraw) | |
| ' Dibujar línea con el estilo seleccionado de propiedades | |
Private Sub DrawLine(pt As ptObject) Dim brushFore As New SolidBrush(pt.ForeColor) Dim penDraw As New Pen(brushFore, pt.penSize) Select Case pt.penStyle Case Principal.SOLID_STYLE penDraw.DashStyle = DashStyle.Solid Case Principal.DASH_STYLE penDraw.DashStyle = DashStyle.Dash Case Principal.DOT_STYLE penDraw.DashStyle = DashStyle.Dot Case Principal.DASDOT_STYLE penDraw.DashStyle = DashStyle.DashDot End Select g.DrawLine(penDraw, pt.X1, pt.X2) End Sub Private Sub DrawArrow(pt As ptObject, arrowStart As Boolean) Dim brushFore As New SolidBrush(pt.ForeColor) Dim penDraw As New Pen(brushFore, pt.penSize) Select Case pt.penStyle Case Principal.SOLID_STYLE penDraw.DashStyle = DashStyle.Solid Case Principal.DASH_STYLE penDraw.DashStyle = DashStyle.Dash Case Principal.DOT_STYLE penDraw.DashStyle = DashStyle.Dot Case Principal.DASDOT_STYLE penDraw.DashStyle = DashStyle.DashDot End Select If arrowStart Then drawLineArrow.ArrowEnd(g, pt, penDraw.DashStyle) Else drawLineArrow.ArrowStartEnd(g, pt, penDraw.DashStyle) End If End Sub |
| Donde drawLineArrow es un Tipo de Flecha (ver clase Flecha) | |
| Hacemos lo mismo para dibujar una elipse, rectángulo, perno, texto, cubo usando el estilo seleccionado | |
| de la pluma y el pincel seleccionado para el relleno de colores. | |
Private Sub DrawEllipse(pt As ptObject) Dim oBmp As Bitmap Dim oBrushTexture As TextureBrush Dim brushFore As New SolidBrush(pt.ForeColor) Dim penDraw As New Pen(brushFore, pt.penSize) Dim brushFill As New LinearGradientBrush(pt.X1, pt.X2, pt.FillColor, pt.FillColor2) Select Case pt.penStyle Case Principal.SOLID_STYLE penDraw.DashStyle = DashStyle.Solid Case Principal.DASH_STYLE penDraw.DashStyle = DashStyle.Dash Case Principal.DOT_STYLE penDraw.DashStyle = DashStyle.Dot Case Principal.DASDOT_STYLE penDraw.DashStyle = DashStyle.DashDot End Select g.DrawEllipse(penDraw, New Rectangle(pt.X1, New Size(pt.X2.X - pt.X1.X, pt.X2.Y - pt.X1.Y))) If pt.brushBitmap <> Nothing Then oBmp = New Bitmap(CStr(pt.brushBitmap)) oBrushTexture = New TextureBrush(oBmp) g.FillEllipse(oBrushTexture, pt.X1.X + 1, pt.X1.Y + 1, (pt.X2.X - pt.X1.X) - 1, (pt.X2.Y - pt.X1.Y) - 1) Else g.FillEllipse(brushFill, pt.X1.X + 1, pt.X1.Y + 1, (pt.X2.X - pt.X1.X) - 1, (pt.X2.Y - pt.X1.Y) - 1) End If End Sub Private Sub DrawRectangle(pt As ptObject) Dim oBmp As Bitmap Dim oBrushTexture As TextureBrush Dim brushFore As New SolidBrush(pt.ForeColor) Dim penDraw As New Pen(brushFore, pt.penSize) Dim brushFill As New LinearGradientBrush(pt.X1, pt.X2, pt.FillColor, pt.FillColor2) Select Case pt.penStyle Case Principal.SOLID_STYLE penDraw.DashStyle = DashStyle.Solid Case Principal.DASH_STYLE penDraw.DashStyle = DashStyle.Dash Case Principal.DOT_STYLE penDraw.DashStyle = DashStyle.Dot Case Principal.DASDOT_STYLE penDraw.DashStyle = DashStyle.DashDot End Select g.DrawRectangle(penDraw, New Rectangle(pt.X1, New Size(pt.X2.X - pt.X1.X, pt.X2.Y - pt.X1.Y))) If pt.brushBitmap <> Nothing Then oBmp = New Bitmap(pt.brushBitmap) oBrushTexture = New TextureBrush(oBmp) g.FillRectangle(oBrushTexture, pt.X1.X + 1, pt.X1.Y + 1, (pt.X2.X - pt.X1.X) - 1, (pt.X2.Y - pt.X1.Y) - 1) Else g.FillRectangle(brushFill, pt.X1.X + 1, pt.X1.Y + 1, (pt.X2.X - pt.X1.X) - 1, (pt.X2.Y - pt.X1.Y) - 1) End If End Sub Private Sub DrawBOLT(pt As ptObject) If pt.brushBitmap Is Nothing Then DrawBOLTWithoutTexture(pt) Else DrawBOLTWithTexture(pt) End If End Sub Private Sub DrawBOLTWithTexture(pt As ptObject) Dim oBmp As Bitmap Dim oBrushTexture As TextureBrush Dim brushFore As New SolidBrush(pt.ForeColor) Dim penDraw As New Pen(brushFore, pt.penSize) Dim brushFill As New LinearGradientBrush(pt.X1, pt.X2, pt.FillColor, pt.FillColor2) If pt.brushBitmap = "" Then DrawBOLTWithoutTexture(pt) Return End If oBmp = New Bitmap(pt.brushBitmap) oBrushTexture = New TextureBrush(oBmp) Select Case pt.penStyle Case Principal.SOLID_STYLE penDraw.DashStyle = DashStyle.Solid Case Principal.DASH_STYLE penDraw.DashStyle = DashStyle.Dash Case Principal.DOT_STYLE penDraw.DashStyle = DashStyle.Dot Case Principal.DASDOT_STYLE penDraw.DashStyle = DashStyle.DashDot End Select Dim d As Integer = CInt((pt.X2.X - pt.X1.X) / 3) Dim bl As New GraphicsPath() bl.AddEllipse(pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2) - CInt(d / 2), pt.X1.Y + CInt((pt.X2.Y - pt.X1.Y) / 2) - CInt(d / 2), d, d) bl.StartFigure() bl.AddLine(pt.X1.X, pt.X1.Y, pt.X1.X, pt.X2.Y) bl.AddLine(pt.X2.X, pt.X1.Y, pt.X2.X, pt.X2.Y) bl.AddLine(pt.X1.X, pt.X1.Y, pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2), pt.X1.Y - CInt((pt.X2.Y - pt.X1.Y) / 2)) bl.AddLine(pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2), pt.X1.Y - CInt((pt.X2.Y - pt.X1.Y) / 2), pt.X2.X, pt.X1.Y) bl.AddLine(pt.X1.X, pt.X2.Y, pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2), pt.X2.Y + CInt((pt.X2.Y - pt.X1.Y) / 2)) bl.AddLine(pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2), pt.X2.Y + CInt((pt.X2.Y - pt.X1.Y) / 2), pt.X2.X, pt.X2.Y) g.DrawPath(penDraw, bl) g.FillPath(oBrushTexture, bl) bl.Reset() bl.AddEllipse(pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2) - CInt(d / 2), pt.X1.Y + CInt((pt.X2.Y - pt.X1.Y) / 2) - CInt(d / 2), d, d) g.DrawPath(penDraw, bl) g.FillPath(brushFill, bl) End Sub Private Sub DrawBOLTWithoutTexture(pt As ptObject) Dim brushFore As New SolidBrush(pt.ForeColor) Dim penDraw As New Pen(brushFore, pt.penSize) Dim brushFill As New LinearGradientBrush(pt.X1, pt.X2, pt.FillColor, pt.FillColor2) Select Case pt.penStyle Case Principal.SOLID_STYLE penDraw.DashStyle = DashStyle.Solid Case Principal.DASH_STYLE penDraw.DashStyle = DashStyle.Dash Case Principal.DOT_STYLE penDraw.DashStyle = DashStyle.Dot Case Principal.DASDOT_STYLE penDraw.DashStyle = DashStyle.DashDot End Select Dim d As Integer = CInt((pt.X2.X - pt.X1.X) / 3) Dim bl As New GraphicsPath() bl.AddEllipse(pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2) - CInt(d / 2), pt.X1.Y + CInt((pt.X2.Y - pt.X1.Y) / 2) - CInt(d / 2), d, d) bl.StartFigure() bl.AddLine(pt.X1.X, pt.X1.Y, pt.X1.X, pt.X2.Y) bl.StartFigure() bl.AddLine(pt.X2.X, pt.X1.Y, pt.X2.X, pt.X2.Y) bl.StartFigure() bl.AddLine(pt.X1.X, pt.X1.Y, pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2), pt.X1.Y - CInt((pt.X2.Y - pt.X1.Y) / 2)) bl.StartFigure() bl.AddLine(pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2), pt.X1.Y - CInt((pt.X2.Y - pt.X1.Y) / 2), pt.X2.X, pt.X1.Y) bl.StartFigure() bl.AddLine(pt.X1.X, pt.X2.Y, pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2), pt.X2.Y + CInt((pt.X2.Y - pt.X1.Y) / 2)) bl.StartFigure() bl.AddLine(pt.X1.X + CInt((pt.X2.X - pt.X1.X) / 2), pt.X2.Y + CInt((pt.X2.Y - pt.X1.Y) / 2), pt.X2.X, pt.X2.Y) g.DrawPath(penDraw, bl) g.FillPath(brushFill, bl) g.ResetTransform() End Sub Private Sub DrawLabel(pt As ptObject) Dim oBmp As Bitmap Dim brush As LinearGradientBrush Dim oBrusht As TextureBrush If pt.brushBitmap <> Nothing Then oBmp = New Bitmap(CStr(pt.brushBitmap)) oBrusht = New TextureBrush(oBmp) If (pt.directionText = "Vertical") Then Dim strf As StringFormat = New StringFormat(StringFormatFlags.DirectionVertical) g.DrawString(pt.text, pt.font, oBrusht, pt.X1.X, pt.X1.Y, strf) Else g.DrawString(pt.text, pt.font, oBrusht, pt.X1.X, pt.X1.Y) End If Else brush = New LinearGradientBrush(pt.X1, pt.X2, pt.FillColor, pt.FillColor2) If (pt.directionText = "Vertical") Then Dim strf As StringFormat = New StringFormat(StringFormatFlags.DirectionVertical) g.DrawString(pt.text, pt.font, brush, pt.X1.X, pt.X1.Y, strf) Else g.DrawString(pt.text, pt.font, brush, pt.X1.X, pt.X1.Y) End If End If End Sub Private Sub DrawCUBE(pt As ptObject) Dim oBmp As Bitmap Dim oBrushTexture As TextureBrush Dim brushFore As New SolidBrush(pt.ForeColor) Dim penDraw As New Pen(brushFore, pt.penSize) Dim brushFill As New LinearGradientBrush(pt.X1, pt.X2, pt.FillColor, pt.FillColor2) Select Case pt.penStyle Case Principal.SOLID_STYLE penDraw.DashStyle = DashStyle.Solid Case Principal.DASH_STYLE penDraw.DashStyle = DashStyle.Dash Case Principal.DOT_STYLE penDraw.DashStyle = DashStyle.Dot Case Principal.DASDOT_STYLE penDraw.DashStyle = DashStyle.DashDot End Select g.DrawRectangle(penDraw, New Rectangle(pt.X1, New Size(pt.X2.X - pt.X1.X, pt.X2.Y - pt.X1.Y))) g.DrawRectangle(penDraw, New Rectangle(New Point(pt.X1.X + pt.dCube, pt.X1.Y - pt.dCube), New Size((pt.X2.X + pt.dCube) - (pt.X1.X + pt.dCube), ((pt.X2.Y - pt.dCube) - (pt.X1.Y - pt.dCube))))) g.DrawLine(penDraw, pt.X1.X, pt.X1.Y, pt.X1.X + pt.dCube, pt.X1.Y - pt.dCube) g.DrawLine(penDraw, pt.X1.X, pt.X2.Y, pt.X1.X + pt.dCube, pt.X2.Y - pt.dCube) g.DrawLine(penDraw, pt.X2.X, pt.X2.Y, pt.X2.X + pt.dCube, pt.X2.Y - pt.dCube) g.DrawLine(penDraw, pt.X2.X, pt.X1.Y, pt.X2.X + pt.dCube, pt.X1.Y - pt.dCube) If pt.brushBitmap <> Nothing Then oBmp = New Bitmap(pt.brushBitmap) oBrushTexture = New TextureBrush(oBmp) g.FillRectangle(oBrushTexture, pt.X1.X + 1, pt.X1.Y + 1, (pt.X2.X - pt.X1.X) - 1, (pt.X2.Y - pt.X1.Y) - 1) Else g.FillRectangle(brushFill, pt.X1.X + 1, pt.X1.Y + 1, (pt.X2.X - pt.X1.X) - 1, (pt.X2.Y - pt.X1.Y) - 1) End If End Sub |
| Para mostrar la posición del cursor del mouse (currentMouseX y currentMouseY), necesitamos una función como esta | |
Private Sub drawPosition()
Dim penPosition As New Pen(Principal._designSettings.DesignForeColor)
Dim brsFill As New SolidBrush(Principal._designSettings.DesignForeColor)
Dim brsString As New SolidBrush(source._designSettings.DesignBackColor)
Dim fnt As New Font("Arial", 8)
g.DrawRectangle(penPosition, CurrentMouseX - 1, CurrentMouseY + 20, 50, 20)
g.FillRectangle(brsFill, New Rectangle(CurrentMouseX, CurrentMouseY + 21, 49, 19))
g.DrawString(Str(CurrentMouseX) & "," & CStr(CurrentMouseY), fnt, brsString,
New PointF(CurrentMouseX, CurrentMouseY + 23))
End Sub
|
| Principal._designSettings.DesignForeColor es el color que se usa para dibujar la cadena y se guarda | |
| antes por el usuario en la configuración de la aplicación (menú de propiedades) | |
| en su lugar source._designSettings.DesignBackColor es el color de fondo del área de dibujo | |
| (drawPan ver la primera figura) | |
![]() | |
| La siguiente función le permite insertar una imagen con el brillo, contraste y gamma seleccionado. | |
Public Function AdjustImage(original As Bitmap, Optional brightness As Double = 1.0F,
Optional contrast As Double = 1.0F, Optional gamma As Double = 1.0F) As Bitmap
Dim adjustedImage = New Bitmap(original.Width, original.Height)
Dim adjustedBrightness As Double = brightness - 1.0F
Dim cMatrix As New ColorMatrix(New Single()() _
{
New Single() {contrast, 0, 0, 0, 0},
New Single() {0, contrast, 0, 0, 0},
New Single() {0, 0, contrast, 0, 0},
New Single() {0, 0, 0, 1.0F, 0},
New Single() {adjustedBrightness, adjustedBrightness, adjustedBrightness, 0, 1}})
Dim ia As New ImageAttributes()
ia.ClearColorMatrix()
ia.SetColorMatrix(cMatrix, ColorMatrixFlag.Default, ColorAdjustType.Bitmap)
ia.SetGamma(gamma, ColorAdjustType.Bitmap)
Dim g As Graphics = Graphics.FromImage(adjustedImage)
g.DrawImage(original, New Rectangle(Point.Empty, adjustedImage.Size), 0, 0, original.Width,
original.Height, GraphicsUnit.Pixel, ia)
Return adjustedImage
End Function
Private Sub DDrawImage(ByRef pt As ptObject)
pt.bitmap = AdjustImage(pt.bitmap, pt.brightness, pt.contrast, pt.gamma)
g.DrawImage(pt.bitmap, pt.X1.X, pt.X1.Y, pt.X2.X - pt.X1.X, pt.X2.Y - pt.X1.Y)
End Sub
|
| Ahora trato de explicar la función general que llama a todas las subfunciones anteriores y esta función | |
| se llama cuando se generan eventos del mouse como el evento mouse_move , mouse_up, .... | |
Public Sub Draw()
On Error Go to log
Dim oBmp As Bitmap
Dim oBrushTexture As TextureBrush
g = Graphics.FromImage(bm)
g.Transform = gmatrix
g.Clear(source._designSettings.DesignBackColor)
lstDrawOject = lstDrawOject.Cast(Of ptObject)() _
.OrderBy(Function(i As ptObject) Convert.ToBoolean(i.bringToFront)) _
.ToList()
lstSelDrawOject = lstSelDrawOject.Cast(Of ptObject)() _
.OrderBy(Function(i As ptObject) Convert.ToBoolean(i.bringToFront)) _
.ToList()
If source.nMode = Principal.DELETE Then ' If the user want remove object ,
I switch to selection mode and
I remove the selected object
from the list of the drawn objetcs
source.nMode = Principal.SELECTION ' and I put them in the list of deleted
objects because the objects can be
recovered with Ctrl+Z
For Each ptSel In lstSelDrawOject
For Each ptO In lstDrawOject
If (ptO.name = ptSel.name) Then
lstDrawOject.Remove(ptO)
lstRedoDrawOject.Add(ptO)
Exit For
End If
Next
Next
lstSelDrawOject.Clear()
End If
For Each pt In lstDrawOject
If (pt.rotation <> 0 And pt.draw <> Principal.IIMAGE) Then ' If the property rotation have
'a value I apply the rotation of the object
g.RotateTransform(pt.rotation)
End If
Select Case pt.draw ' Now we call the specific drawing function switch the
selected function in the tool bar
Case Principal.LINE
DrawLine(pt)
Case Principal.LINEARROW
DrawArrow(pt, True)
Case Principal.LINEARROWSE
DrawArrow(pt, False)
Case Principal.PEN
DrawPen(pt)
Case Principal.RECTANGLE
DrawRectangle(pt)
Case Principal.CUBE
DrawCUBE(pt)
Case Principal.CURVE
DrawCurve(pt)
Case Principal.ELLIPSE
DrawEllipse(pt)
Case Principal.BOLT
DrawBOLT(pt)
Case Principal.IIMAGE
If (pt.rotation = 0) Then
DDrawImage(pt)
Else
drawImageRot(pt)
End If
Case Principal.LABEL ' Draw the string written in the object property.
DrawLabel(pt)
End Select
If (pt.rotation <> 0) Then
g.ResetTransform()
End If
Next
For Each pt In lstTempDrawOject ' This list is temporary and allows you to draw objects
' when we are still drawing or
' moving the objects.
If (pt.rotation <> 0 And pt.draw <> Principal.IIMAGE) Then
g.RotateTransform(pt.rotation)
End If
Select Case pt.draw
Case Principal.LINE
DrawLine(pt)
Case Principal.LINEARROW
DrawArrow(pt, True)
Case Principal.LINEARROWSE
DrawArrow(pt, False)
Case Principal.RECTANGLE
DrawRectangle(pt)
Case Principal.CUBE
DrawCUBE(pt)
Case Principal.ELLIPSE
DrawEllipse(pt)
Case Principal.BOLT
DrawBOLT(pt)
Case Principal.IIMAGE
If (pt.rotation = 0) Then
DDrawImage(pt)
Else
drawImageRot(pt)
End If
End Select
If (pt.rotation <> 0) Then
g.ResetTransform()
End If
Next
For Each pt In lstSelDrawOject ' Here I draw the selected objects.
If (pt.rotation <> 0 And pt.draw <> Principal.IIMAGE) Then
g.RotateTransform(pt.rotation)
End If
Select Case pt.draw
Case Principal.LINE
DrawLine(pt)
Case Principal.LINEARROW
DrawArrow(pt, True)
Case Principal.LINEARROWSE
DrawArrow(pt, False)
Case Principal.PEN
DrawPen(pt)
Case Principal.RECTANGLE
DrawRectangle(pt)
Case Principal.CUBE
DrawCUBE(pt)
Case Principal.CURVE
DrawCurve(pt)
calcolaMinMaxCurve(pt)
Case Principal.ELLIPSE
DrawEllipse(pt)
Case Principal.BOLT
DrawBOLT(pt)
Case Principal.IIMAGE
If (pt.rotation = 0) Then
DDrawImage(pt)
Else
drawImageRot(pt)
End If
Case Principal.LABEL
DrawLabel(pt)
End Select
If (pt.rotation <> 0) Then
g.ResetTransform()
End If
DrawCursor(g, pt)
Next
If (lstCurveDrawOject.Count <> 0) Then ' In this case I draw all the lines for each
' curve object in the list.
Dim penLine As New Pen(source._designSettings.DesignForeColor)
penLine.MiterLimit = 0
Dim ptCurve As New List(Of Drawing.PointF)
Dim fd As Boolean
For Each ptC In lstCurveDrawOject
fd = False
For Each p In ptCurve
If p.X = ptC.X And p.Y = ptC.Y Then
fd = True
End If
Next
If Not fd Then
ptCurve.Add(ptC)
End If
Next
If (ptCurve.Count > 1) Then
g.DrawLines(penLine, ptCurve.ToArray())
Dim PC(ptCurve.Count) As PointF
For i = 0 To ptCurve.Count - 1
PC(i) = ptCurve(i)
Next
If source._designSettings.DesignBitmap <> Nothing Then
oBmp = New Bitmap(CStr(source._designSettings.DesignBitmap))
oBrushTexture = New TextureBrush(oBmp)
g.FillPolygon(oBrushTexture, PC)
Else
Dim brushFill As New LinearGradientBrush(PC(0), PC(ptCurve.Count - 1),
source._designSettings.DesignFillColor,
source._designSettings.DesignFillColor2)
g.FillPolygon(brushFill, PC)
End If
End If
ptCurve = Nothing
penLine = Nothing
End If
lstTempDrawOject.Clear()
If source.nMode = Principal.FILL And ptFill <> Nothing Then
Dim pt As ptObject
pt = GetObjPointToFill(ptFill) ' When I'm in the fill mode I search the object
' where I apply the fill color.
Dim brsFill As New LinearGradientBrush(pt.X1, pt.X2, source._designSettings.DesignFillColor,
source._designSettings.DesignFillColor2)
If (pt.name <> Nothing) Then
Select Case pt.draw
Case Principal.RECTANGLE
g.FillRectangle(brsFill, pt.X1.X + 1, pt.X1.Y + 1, (pt.X2.X - pt.X1.X) - 1,
(pt.X2.Y - pt.X1.Y - 1))
Case Principal.CUBE
g.FillRectangle(brsFill, pt.X1.X + 1, pt.X1.Y + 1, (pt.X2.X - pt.X1.X) - 1,
(pt.X2.Y - pt.X1.Y - 1))
g.FillRectangle(brsFill, New Rectangle(New Point(pt.X1.X + pt.dCube + 1,
pt.X1.Y - (pt.dCube - 1)),
New Size((pt.X2.X + pt.dCube + 1) - (pt.X1.X + pt.dCube + 1),
((pt.X2.Y - (pt.dCube - 1)) -
(pt.X1.Y - (pt.dCube - 1))))))
Case Principal.ELLIPSE
g.FillEllipse(brsFill, pt.X1.X + 1, pt.X1.Y + 1, (pt.X2.X - pt.X1.X) - 1,
(pt.X2.Y - pt.X1.Y - 1))
Case Principal.CURVE
Dim P(pt.lstPtCurve.Count) As PointF
For i = 0 To pt.lstPtCurve.Count - 1
P(i) = pt.lstPtCurve(i)
Next
g.FillPolygon(brsFill, P)
End Select
lstDrawOject.Remove(pt)
pt.FillColor = source._designSettings.DesignFillColor
pt.FillColor2 = source._designSettings.DesignFillColor2
pt.brushBitmap = source._designSettings.DesignBitmap
lstDrawOject.Add(pt)
End If
ptFill = Nothing
End If
If Principal.SELECTION And bMouseDown And ptSelAll <> Nothing Then
DrawCursorAll(g)
End If
If (source.bGrid) Then
DrawGrid(g)
End If
If bMouseDown Then
drawPosition()
End If
source.DrawPan.CreateGraphics().DrawImage(bm, New Point(source.DrawPan.AutoScrollPosition.X,
source.DrawPan.AutoScrollPosition.Y))
' Draw the objects in the draw panel.
exit sub
log:
Debug.Print(err.Description)
End Sub
|
| Ahora veamos cómo se llama a la función draw. | |
Evento MouseDown | |
Public Sub MouseDown(sender As Object, e As MouseEventArgs) If (e.Button = MouseButtons.Left) Then If (poMenu.isVisible) Then Dim op As ptObject = poMenu.DestroyPopupMenu() If (op.name IsNot Nothing) Then lstSelDrawOject.Clear() If op.draw = Principal.LABEL Then If op.directionText = "Vertical" Then op.X2.X = op.X1.X + op.font.GetHeight() * 3 / 2 Else op.X2.X = op.X1.X + MeasureDisplayStringWidth(op.text, op.font) + 10 End If End If lstSelDrawOject.Add(op) Draw() End If End If bMouseDown = True If (source.nMode = Principal.ZOOM_M Or source.nMode = Principal.ZOOM_P) Then ctrlKey = True End If HscrollX = source.DrawPan.HorizontalScroll.Value VscrollY = source.DrawPan.VerticalScroll.Value oldLocation.Y = 0 oldLocation.X = 0 lstDrawOject = lstDrawOject.Cast(Of ptObject)().OrderBy(Function(i As ptObject) Convert.ToBoolean(Not i.bringToFront)).ToList() If (source.nMode = Principal.SELECTION) Then If (lstSelDrawOject.Count = 1) Then Dim p As ptObject = lstSelDrawOject(0) If (e.Location.X + HscrollX) > p.X1.X - (p.rotation * 10) And (e.Location.X + HscrollX) < p.X1.X + 25 - (p.rotation * 10) And ((e.Location.Y + VscrollY) > p.X1.Y + (p.rotation * 10)) And (e.Location.Y + VscrollY < p.X1.Y + 25 + (p.rotation * 10)) And p.draw <> Principal.BOLT And p.draw <> Principal.ELLIPSE And p.draw <> Principal.LABEL Then If p.rotation < 180 Then p.rotation += 5 For Each py In lstDrawOject If py.name = p.name Then lstDrawOject.Remove(py) lstSelDrawOject.Clear() lstDrawOject.Add(p) lstSelDrawOject.Add(p) Draw() Exit Sub End If Next End If Exit Sub End If If (e.Location.X + HscrollX) > p.X2.X - (p.rotation * 10) And (e.Location.X + HscrollX) < p.X2.X + 25 And (e.Location.Y + VscrollY > p.X2.Y - 10 + (p.rotation * 10)) And (e.Location.Y + VscrollY < p.X2.Y + 21 + (p.rotation * 10)) _ And p.draw <> Principal.BOLT And p.draw <> Principal.ELLIPSE And p.draw <> Principal.LABEL Then If p.rotation > 0 Then p.rotation -= 5 If p.rotation < 0 Then p.rotation = 0 For Each py In lstDrawOject If py.name = p.name Then lstDrawOject.Remove(py) lstSelDrawOject.Clear() lstDrawOject.Add(p) lstSelDrawOject.Add(p) Draw() Exit Sub End If Next End If Exit Sub End If End If For Each pt In lstDrawOject If InRegion(e, pt) Then AddSelectionObject(pt) Draw() Exit Sub End If Next If (lstSelDrawOject.Count = 0) Then bInSelect = True ptSelAll = New Point(e.Location.X + HscrollX, (e.Location.Y + VscrollY)) oldLocation.X = 0 For Each pt In lstDrawOject If InRegion(e, pt) Then AddSelectionObject(pt) End If Next Draw() Else bInSelect = False End If Exit Sub End If ptObjectC = New ptObject ptObjectC.X1.X = e.Location.X + HscrollX ptObjectC.X1.Y = (e.Location.Y + VscrollY) ptObjectC.name = "obj" & lstDrawOject.Count + 1 ptObjectC.orderDesign = lstDrawOject.Count + 1 ptObjectC.dCube = 50 If source.nMode = Principal.LABEL Then If Not editText.Visible Then editText.Location = New Point(e.Location.X + HscrollX, (e.Location.Y + VscrollY)) editText.Visible = True editText.ForeColor = source._designSettings.DesignForeColor editText.BackColor = source._designSettings.DesignBackColor editText.Font = New Font(source._designSettings.DesignFont.Name, source._designSettings.DesignFont.Size) ptObjectC.directionText = source._designSettings.DesignDirectionText editText.Select() Exit Sub Else editTextLeave(sender, e) Exit Sub End If End If If (source.nMode = Principal.FILL) Then ptFill.X = e.Location.X + HscrollX ptFill.Y = (e.Location.Y + VscrollY) End If If (source.nMode = Principal.CURVE) Then Dim pt As New PointF(e.Location.X + HscrollX, (e.Location.Y + VscrollY)) lstCurveDrawOject.Add(pt) End If Draw() Else FinalizeCurveDraw() End If End Sub |
Evento MouseMove | |
Public Sub MouseMove(sender As Object, e As MouseEventArgs)
HscrollX = source.DrawPan.HorizontalScroll.Value
VscrollY = source.DrawPan.VerticalScroll.Value
CurrentMouseX = e.Location.X + HscrollX
CurrentMouseY = e.Location.Y + VscrollY
If (editText.Visible) Then Exit Sub
If Principal.SELECTION Then
If bMouseDown And ptSelAll <> Nothing And bInSelect Then
ptSelAllF = New Point(e.Location.X + HscrollX, (e.Location.Y + VscrollY))
For Each pt In lstDrawOject
If pt.draw = Principal.CURVE Then
calcolaMinMaxCurve(pt)
If (ptSelAll.X < pt.X1.X And ptSelAllF.X > pt.X2.X) And
(ptSelAll.Y < pt.X1.Y And ptSelAllF.Y > pt.X2.Y) Then
AddSelectionObject(pt)
End If
Else
If (pt.X1.X > ptSelAll.X And pt.X1.Y > ptSelAll.Y And _
pt.X2.X < ptSelAllF.X And pt.X2.Y < ptSelAllF.Y) Then
AddSelectionObject(pt)
End If
End If
Next
Draw()
Exit Sub
Else
If lstSelDrawOject.Count = 1 And source.nMode = Principal.SELECTION And Not bMouseDown Then
source.ResetResize()
Dim o As ptObject = lstSelDrawOject(0)
calcolaMinMaxCurve(o)
If ((e.Location.X + HscrollX) > o.X2.X - 10) And ((e.Location.X + HscrollX) < o.X2.X) And
(((e.Location.Y + VscrollY)) > o.X1.Y - 10 + (o.rotation * 10)) And
(((e.Location.Y + VscrollY)) < o.X1.Y + 10 + (o.rotation * 10)) Then
source.Cursor = Cursors.Hand
If (Not poMenu.isVisible) Then
poMenu.GetPopupMenuStyleLines(o, source.DrawPan, o.X2.X - HscrollX,
o.X1.Y - VscrollY + (o.rotation * 10),
source._objSettings)
End If
Exit Sub
End If
If (o.draw <> Principal.LABEL) Then
If ((e.Location.X + HscrollX) > ((o.X1.X - (o.rotation * 10)) +
((o.X2.X - (o.X1.X - (o.rotation * 10))) / 2)) And
((e.Location.X + HscrollX) < ((o.X1.X - (o.rotation * 10)) +
((o.X2.X - (o.X1.X - (o.rotation * 10))) / 2) + 10) And
(((e.Location.Y + VscrollY)) > o.X1.Y - 10 + (o.rotation * 10))
And (((e.Location.Y + VscrollY)) < o.X1.Y + 10 +
(o.rotation * 10)))) Then
source.Cursor = Cursors.SizeNS
source.nResizeUp = True
objResize = o
Exit Sub
End If
If ((e.Location.X + HscrollX) > ((o.X1.X - (o.rotation * 10)) +
((o.X2.X - (o.X1.X - (o.rotation * 10))) / 2)) And
((e.Location.X + HscrollX) < ((o.X1.X - (o.rotation * 10)) +
((o.X2.X - (o.X1.X - (o.rotation * 10))) / 2) + 10) And
(((e.Location.Y + VscrollY)) > o.X2.Y - 10 + (o.rotation * 10))
And (((e.Location.Y + VscrollY)) < o.X2.Y + 10 + (o.rotation * 10)))) Then
source.Cursor = Cursors.SizeNS
source.nResizeDown = True
objResize = o
Exit Sub
End If
If ((e.Location.X + HscrollX) > o.X1.X - 5 - (o.rotation * 10)
And ((e.Location.X + HscrollX) < o.X1.X + 10 - (o.rotation * 10)) And
(((e.Location.Y + VscrollY)) > o.X1.Y + ((o.X2.Y - o.X1.Y) / 2)) +
(o.rotation * 10)
And (((e.Location.Y +
VscrollY)) < o.X1.Y + ((o.X2.Y - o.X1.Y) / 2)) + 10 +
(o.rotation * 10)) Then
source.Cursor = Cursors.SizeWE
source.nResizeLeft = True
objResize = o
Exit Sub
End If
If ((e.Location.X + HscrollX) > o.X2.X And
((e.Location.X + HscrollX) < o.X2.X + 10) And
(((e.Location.Y + VscrollY)) > o.X1.Y + ((o.X2.Y - o.X1.Y) / 2))
+ (o.rotation * 10) And
(((e.Location.Y + VscrollY)) < o.X1.Y + ((o.X2.Y - o.X1.Y) / 2))
+ 10 + (o.rotation * 10)) Then
source.Cursor = Cursors.SizeWE
source.nResizeRight = True
objResize = o
Exit Sub
End If
End If
End If
End If
End If
If source.nMode = Principal.FILL And source.Cursor <> cursorFill Then
source.Cursor = cursorFill
End If
If bMouseDown Then
If source.IsInResize And Not objResize.name Is Nothing Then
If (source.nResizeLeft) Then
objResize.X1.X = e.Location.X + HscrollX
UpdateLstCurveXLeft(objResize)
End If
If (source.nResizeRight) Then
objResize.X2.X = e.Location.X + HscrollX
End If
If (source.nResizeUp) Then
objResize.X1.Y = (e.Location.Y + VscrollY)
End If
If (source.nResizeDown) Then
objResize.X2.Y = (e.Location.Y + VscrollY)
End If
For Each pt In lstDrawOject
If (pt.name = objResize.name) Then
lstDrawOject.Remove(pt)
Exit For
End If
Next
If (Not objResize.name Is Nothing) Then
lstSelDrawOject.Clear()
lstSelDrawOject.Add(objResize)
lstTempDrawOject.Add(objResize)
End If
Draw()
Exit Sub
End If
diffX = 0
If (oldLocation.X <> 0) Then
diffX = (e.Location.X + HscrollX) - oldLocation.X
End If
diffY = 0
If (oldLocation.Y <> 0) Then
diffY = ((e.Location.Y + VscrollY)) - oldLocation.Y
End If
oldLocation.Y = (e.Location.Y + VscrollY)
oldLocation.X = e.Location.X + HscrollX
If source.nMode = Principal.SELECTION Then
source.Cursor = Cursors.SizeAll
UpdateDesign(New Point(e.Location.X + HscrollX, (e.Location.Y + VscrollY)))
End If
If source.nMode = Principal.PEN Then
ptObjectC = New ptObject
source.Cursor = New Cursor("Pen.cur")
ptObjectC.name = "obj" & lstDrawOject.Count + 1
ptObjectC.orderDesign = lstDrawOject.Count + 1
ptObjectC.X1.X = e.Location.X + HscrollX
ptObjectC.X1.Y = (e.Location.Y + VscrollY)
ptObjectC.X2.X = e.Location.X + HscrollX
ptObjectC.X2.Y = (e.Location.Y + VscrollY)
ptObjectC.penLine = New Pen(source._designSettings.DesignForeColor, 1)
ptObjectC.penSize = 1
ptObjectC.bringToFront = True
ptObjectC.ForeColor = source._designSettings.DesignForeColor
ptObjectC.FillColor = source._designSettings.DesignFillColor
ptObjectC.FillColor2 = source._designSettings.DesignFillColor2
ptObjectC.penStyle = Principal.SOLID_STYLE
ptObjectC.draw = source.nMode
lstDrawOject.Add(ptObjectC)
Else
If (source.nMode > 0 And source.nMode < 10) And Not ptObjectC.name Is Nothing Then
source.Cursor = New Cursor("Pen.cur")
ptObjectC.X2.X = e.Location.X + HscrollX
ptObjectC.X2.Y = (e.Location.Y + VscrollY)
ptObjectC.penLine = New Pen(source._designSettings.DesignForeColor, 1)
ptObjectC.penSize = 1
ptObjectC.bringToFront = True
ptObjectC.ForeColor = source._designSettings.DesignForeColor
ptObjectC.FillColor = source._designSettings.DesignFillColor
ptObjectC.FillColor2 = source._designSettings.DesignFillColor2
ptObjectC.penStyle = Principal.SOLID_STYLE
ptObjectC.brushBitmap = source._designSettings.DesignBitmap
ptObjectC.draw = source.nMode
lstTempDrawOject.Add(ptObjectC)
End If
End If
Draw()
End If
End Sub
|
Evento MouseUp | |
Public Sub MouseUp(sender As Object, e As MouseEventArgs) source.Cursor = Nothing ptSelAll = Nothing ptSelAllF = Nothing ctrlKey = False HscrollX = source.DrawPan.HorizontalScroll.Value VscrollY = source.DrawPan.VerticalScroll.Value If (source.nMode <> Principal.FILL) Then source.Cursor = Cursors.Default End If bMouseDown = False If (source.nMode > 0 And source.nMode < 10) And Not source.IsInResize And source.nMode <> Principal.CURVE And source.nMode <> Principal.PEN Then ptObjectC.X2.X = e.Location.X + HscrollX ptObjectC.X2.Y = (e.Location.Y + VscrollY) ptObjectC.brushBitmap = "" ptObjectC.XORIG1.X = ptObjectC.X1.X ptObjectC.XORIG2.X = ptObjectC.X2.X ptObjectC.XORIG1.Y = ptObjectC.X1.Y ptObjectC.XORIG2.Y = ptObjectC.X2.Y ptObjectC.rotation = 0 ptObjectC.penLine = New Pen(source._designSettings.DesignForeColor, 1) ptObjectC.brushBitmap = source._designSettings.DesignBitmap ptObjectC.penStyle = Principal.SOLID_STYLE ptObjectC.penSize = 1 ptObjectC.dCube = 50 ptObjectC.draw = source.nMode ptObjectC.brightness = 1.2F ptObjectC.contrast = 1.0F ptObjectC.gamma = 1.0F ptObjectC.bitmap = source.imageBitmap ptObjectC.bringToFront = True ptObjectC.name = "obj" & lstDrawOject.Count + 1 ptObjectC.orderDesign = lstDrawOject.Count + 1 lstDrawOject.Add(ptObjectC) ptObjectC = Nothing Else If source.IsInResize Then For Each ptO In lstDrawOject If (ptO.name = objResize.name) Then lstDrawOject.Remove(ptO) Exit For End If Next If (Not objResize.name Is Nothing) Then lstDrawOject.Add(objResize) End If objResize.name = Nothing End If End If Draw() End Sub |
Evento Resize | |
Private Sub Resize(sender As Object, e As EventArgs) Draw() End Sub |
| Ahora veamos alguna función de menú. | |
Public Sub CopySelectedObject() ' This function allows us to copy the selected objects. lstCopiedSelDrawOject.Clear() For Each p In lstSelDrawOject lstCopiedSelDrawOject.Add(p) Next End Sub |
| En cambio, con este, pegue los objetos seleccionados. | |
Public Sub PasteCopiedObject() lstSelDrawOject.Clear() For Each p In lstCopiedSelDrawOject Dim pn As New ptObject pn = p pn.name = "obj" & CStr(lstDrawOject.Count + 1) pn.X1.X = pn.X1.X - 50 pn.X2.X = pn.X2.X - 50 lstSelDrawOject.Add(pn) lstDrawOject.Add(pn) Next lstCopiedSelDrawOject.Clear() source.setButtonSelectiobSelected() source.nMode = Principal.SELECTION Draw() End Sub |
| AddSelectionObject nos permite agregar un objeto a la selección | |
Public Sub AddSelectionObject(obj As ptObject) Dim b As Boolean = False For Each o In lstSelDrawOject If o.name = obj.name Then b = True Exit For End If Next If (Not b) Then lstSelDrawOject.Add(obj) End If End Sub |
La clase AppSettings | |
| Esta clase implementa la interfaz ISettings y permite guardar las propiedades de la aplicación | |
Public Interface ISettings Sub SaveSetting(_xmlAppSetting As String) Sub Load() Sub SaveSetting(ByRef obj As ptObject) Sub Load(obj As ptObject) Function getCountProperties() End Interface Public Class AppSettings : Implements ISettings Protected _size As System.Drawing.Size Dim _ApplicationFont As Font Dim _ApplicationBackColor As Color = New Color() Dim _ApplicationForeColor As Color = New Color() Dim _MenuBackColor As Color = New Color() Dim _MenuForeColor As Color = New Color() Dim _title As String Dim _show As Boolean Dim _number As Short |
Clase de configuración de diseño | |
| Esta clase implementa la interfaz ISettings y permite guardar las propiedades de dibujo | |
public Class DesignSettings : Implements ISettings Protected _size As System.Drawing.Size Const HORIZONTAL = "Horizonal" Private _DesignFont As Font Private _DesignBackColor As Color = New Color() Private _DesignForeColor As Color = New Color() Private _DesignDirectionText As String = HORIZONTAL Private _DesignFillColor As Color = New Color() Private _DesignFillColor2 As Color = New Color() Private _PenStyle As String = Principal.SOLID_STYLE Private _PenSize As String = "1" Private _Text As String Private _bringToFront As Boolean = False Private colorCombination As String Private _DesignBitmap As String Private princ As Principal Public Sub setPrincipal(ByRef _princ As Principal) princ = _princ End Sub Private Sub draw() If princ IsNot Nothing Then princ.UpdateColors() End If End Sub Public Property WindowSize() As System.Drawing.Size Get Return _size End Get Set(ByVal value As System.Drawing.Size) _size = value End Set End Property |
La clase PopupMenu muestra el menú cuando se hace clic con el botón derecho del mouse | |
Public Class PopupMenu Private clrBack As Color Private clrForColor As Color Private panMenu As Panel Private par As Panel Private propertyGrid As PPropertyGrid Private objDzoDraw As DZODraw Public isVisible As Boolean = False Public Sub New(_designer As DZODraw, _clrBack As Color, _clrForeColor As Color) clrBack = _clrBack clrForColor = _clrForeColor objDzoDraw = _designer End Sub Public Function DestroyPopupMenu() As ptObject isVisible = False Dim o As ptObject = propertyGrid.getPtObj() If (panMenu IsNot Nothing) Then propertyGrid = Nothing par.Controls.Remove(panMenu) panMenu = Nothing End If Return o End Function Public Function GetPopupMenuStyleLines(ByRef pt As ptObject, p As Panel, x As Integer, y As Integer, objSetting As ISettings) As Panel panMenu = New Panel panMenu.BorderStyle = BorderStyle.FixedSingle panMenu.Width = 200 panMenu.BackColor = clrBack panMenu.ForeColor = clrForColor panMenu.Height = objSetting.getCountProperties() * 40 + 100 propertyGrid = New PPropertyGrid(objDzoDraw, panMenu, objSetting, "") propertyGrid.setPtObject(pt) propertyGrid.Create(p) panMenu.Visible = True panMenu.Location = New Point(x, y) propertyGrid.Width = panMenu.Width propertyGrid.Height = panMenu.Height propertyGrid.Left = 0 propertyGrid.Top = 0 propertyGrid.Select() par = p isVisible = True Return panMenu End Function End Class |
| Codificación feliz |
También te puede interesar |
![]() |
Usar VB .Net y Active Directory |
Captura Webcam en VB.NET |
forma 3D, curva 3D y bola 3D en VB .Net usando GDI+ |
Usando ChatGPT en VB .Net |
|