Open Menu dzosoft
Close Menu dzosoft

   TODO SOBRE INFORMÁTICA Y TECNOLOGÍA


                             







 
 
 

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   

Descarga este proyecto


  ¡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
  • Panel de menú
  • Panel de barra de herramientas
  • Dibujar panel
  • Panel de propiedades
  •  
    Cómo crear la herramienta Paint en VB .Net
     
     

    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)
     
    Cómo crear la herramienta Paint en VB .Net
     

    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
    Public Property Title() As String Get Return _title End Get Set(ByVal value As String) _title = value End Set End Property Public Property Show() As Boolean Get Return _show End Get Set(value As Boolean) _show = value End Set End Property
    Public Property ApplicationFont() As System.Drawing.Font Get Return _ApplicationFont End Get Set(ByVal Value As System.Drawing.Font) _ApplicationFont = Value End Set End Property
    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 Public Property ApplicationBackColor() As Color Get Return _ApplicationBackColor End Get Set(ByVal Value As Color) _ApplicationBackColor = Value End Set End Property Public Property ApplicationForeColor() As Color Get Return _ApplicationForeColor End Get Set(ByVal Value As Color) _ApplicationForeColor = Value End Set End Property
    Public Property MenuBackColor() As Color Get Return _MenuBackColor End Get Set(ByVal Value As Color) _MenuBackColor = Value End Set End Property Public Property MenuForeColor() As Color Get Return _MenuForeColor End Get Set(ByVal Value As Color) _MenuForeColor = Value End Set End Property Public Sub Load() Implements ISettings.Load Dim reader As TextReader Dim fileNotFound As Boolean Dim fontName As String = ""
    Try reader = New StreamReader(Principal.xmlAppSetting) Catch ex As FileNotFoundException ' Take the defaults fileNotFound = True End Try
    If fileNotFound Then WindowSize = New System.Drawing.Size(308, 774) _ApplicationBackColor = Color.CadetBlue _ApplicationForeColor = Color.Black _MenuBackColor = Color.Black _MenuForeColor = Color.White _ApplicationFont = New Font("Arial", 8) Else Dim xr As XmlReader = XmlReader.Create(Principal.xmlAppSetting) Do While xr.Read() Dim read As Boolean = False
    If (xr.NodeType = XmlNodeType.Element) Then
    If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "Title" Then Title = xr.ReadElementString() read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "Show" Then Show = xr.ReadElementString() read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "Size" Then Dim s() As String Dim s1 As Integer Dim s2 As Integer Dim svalue = xr.ReadElementString() svalue = svalue.Replace("{", "") svalue = svalue.Replace("}", "") s = svalue.Split(",") s1 = CInt(s(0).Substring(s(0).IndexOf("=") + 1)) s2 = CInt(s(1).Substring(s(1).IndexOf("=") + 1)) WindowSize = New Size(s1, s2) read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "FontName" Then fontName = xr.ReadElementString() read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "FontSize" Then If (fontName <> "") Then ApplicationFont = New Font(fontName, CInt(xr.ReadElementString())) End If read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "BackColor" Then Dim svalue = xr.ReadElementString() ApplicationBackColor = Color.FromArgb(CInt(svalue)) read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "ForeColor" Then Dim svalue = xr.ReadElementString() ApplicationForeColor = Color.FromArgb(CInt(svalue)) read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "MenuBackColor" Then Dim svalue = xr.ReadElementString() MenuBackColor = Color.FromArgb(CInt(svalue)) read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "MenuForeColor" Then Dim svalue = xr.ReadElementString() MenuForeColor = Color.FromArgb(CInt(svalue)) read = True End If If (Not read) Then xr.Read() End If
    Else
    xr.Read() End If Loop
    xr.Close() reader.Close() End If End Sub
    Public Sub SaveSetting(_xmlAppSetting As String) Implements ISettings.SaveSetting Dim xws As XmlWriterSettings = New XmlWriterSettings() xws.Indent = True xws.NewLineOnAttributes = True Dim xw As XmlWriter = XmlWriter.Create(_xmlAppSetting, xws) xw.WriteStartDocument() xw.WriteStartElement("Settings") xw.WriteElementString("Title", Title) xw.WriteElementString("Show", Show) xw.WriteElementString("Size", WindowSize.ToString) If Not ApplicationFont Is Nothing Then xw.WriteElementString("FontName", ApplicationFont.Name) xw.WriteElementString("FontSize", ApplicationFont.Size) End If xw.WriteElementString("BackColor", ApplicationBackColor.ToArgb().ToString()) xw.WriteElementString("ForeColor", ApplicationForeColor.ToArgb().ToString()) xw.WriteElementString("MenuBackColor", MenuBackColor.ToArgb().ToString()) xw.WriteElementString("MenuForeColor", MenuForeColor.ToArgb().ToString()) xw.WriteEndElement() xw.WriteEndDocument() xw.Flush() xw.Close() End Sub
    Public Sub SaveSetting(ByRef obj As ptObject) Implements ISettings.SaveSetting End Sub Public Sub Load(obj As ptObject) Implements ISettings.Load End Sub Public Function getCountProperties() Implements ISettings.getCountProperties Return 8 End Function End Class



     

    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 Public Property DesignFont() As System.Drawing.Font Get Return _DesignFont End Get Set(ByVal Value As System.Drawing.Font) _DesignFont = Value If princ IsNot Nothing Then princ._designSettings._DesignFont = Value draw() End If End Set End Property
    Public Property DesignBackColor() As Color Get Return _DesignBackColor End Get Set(ByVal Value As Color) _DesignBackColor = Value If princ IsNot Nothing Then princ._designSettings._DesignBackColor = Value draw() End If End Set End Property Public Property DesignForeColor() As Color Get Return _DesignForeColor End Get Set(ByVal Value As Color) _DesignForeColor = Value If princ IsNot Nothing Then princ._designSettings._DesignForeColor = Value draw() End If End Set End Property Public Property DesignFillColor() As Color Get Return _DesignFillColor End Get Set(ByVal Value As Color) _DesignFillColor = Value If princ IsNot Nothing Then princ._designSettings._DesignFillColor = Value draw() End If End Set End Property
    Public Property DesignFillColor2() As Color Get Return _DesignFillColor2 End Get Set(ByVal Value As Color) _DesignFillColor2 = Value If princ IsNot Nothing Then princ._designSettings._DesignFillColor2 = Value draw() End If End Set End Property Public Property DesignDirectionText() As String Get Return _DesignDirectionText End Get Set(ByVal Value As String) _DesignDirectionText = Value If princ IsNot Nothing Then princ._designSettings._DesignDirectionText = Value draw() End If End Set End Property
    Public Property DesignBitmap() As String Get Return _DesignBitmap End Get Set(ByVal Value As String) _DesignBitmap = Value If princ IsNot Nothing Then princ._designSettings._DesignBitmap = Value draw() End If End Set End Property
    Public Sub Load() Implements ISettings.Load Dim reader As TextReader Dim fileNotFound As Boolean Dim fontName As String = "" Try reader = New StreamReader(Principal.xmlDesignSetting) Catch ex As FileNotFoundException ' Take the defaults fileNotFound = True End Try
    If fileNotFound Then WindowSize = New System.Drawing.Size(308, 774) _DesignBackColor = Color.White _DesignForeColor = Color.Black _DesignFont = New Font("Arial", 8) _DesignFillColor = Color.White _DesignFillColor2 = Color.White _DesignDirectionText = HORIZONTAL Else Dim xr As XmlReader = XmlReader.Create(Principal.xmlDesignSetting) Do While xr.Read() Dim read As Boolean = False
    If (xr.NodeType = XmlNodeType.Element) Then
    If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "Size" Then Dim s() As String Dim s1 As Integer Dim s2 As Integer Dim svalue = xr.ReadElementString() svalue = svalue.Replace("{", "") svalue = svalue.Replace("}", "") s = svalue.Split(",") s1 = CInt(s(0).Substring(s(0).IndexOf("=") + 1)) s2 = CInt(s(1).Substring(s(1).IndexOf("=") + 1)) WindowSize = New Size(s1, s2) read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "FontName" Then fontName = xr.ReadElementString() read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "FontSize" Then If (fontName <> "") Then DesignFont = New Font(fontName, CInt(xr.ReadElementString())) End If read = True End If
    If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "BackColor" Then Dim svalue = xr.ReadElementString() DesignBackColor = Color.FromArgb(CInt(svalue)) read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "ForeColor" Then Dim svalue = xr.ReadElementString() DesignForeColor = Color.FromArgb(CInt(svalue)) read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "DirectionText" Then DesignDirectionText = xr.ReadElementString() read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "FillColor" Then Dim svalue = xr.ReadElementString() DesignFillColor = Color.FromArgb(CInt(svalue)) read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "FillColor2" Then Dim svalue = xr.ReadElementString() DesignFillColor2 = Color.FromArgb(CInt(svalue)) read = True End If If xr.NodeType = XmlNodeType.Element AndAlso xr.Name = "BrushBitmap" Then DesignBitmap = xr.ReadElementString() read = True End If If (Not read) Then xr.Read() End If
    Else
    xr.Read() End If Loop
    xr.Close() reader.Close() End If End Sub Public Sub SaveSetting(_xmlDesignSetting As String) Implements ISettings.SaveSetting Dim xws As XmlWriterSettings = New XmlWriterSettings() xws.Indent = True xws.NewLineOnAttributes = True Dim xw As XmlWriter = XmlWriter.Create(_xmlDesignSetting, xws) xw.WriteStartDocument() xw.WriteStartElement("Settings") xw.WriteElementString("Size", WindowSize.ToString) If Not DesignFont Is Nothing Then xw.WriteElementString("FontName", DesignFont.Name) xw.WriteElementString("FontSize", DesignFont.Size) End If xw.WriteElementString("BackColor", DesignBackColor.ToArgb().ToString()) xw.WriteElementString("ForeColor", DesignForeColor.ToArgb().ToString()) xw.WriteElementString("DirectionText", DesignDirectionText) xw.WriteElementString("FillColor", DesignFillColor.ToArgb().ToString()) xw.WriteElementString("FillColor2", DesignFillColor2.ToArgb().ToString()) xw.WriteElementString("BrushBitmap", DesignBitmap) xw.WriteEndElement() xw.WriteEndDocument() xw.Flush() xw.Close() End Sub Public Sub SaveSetting(ByRef obj As ptObject) Implements ISettings.SaveSetting End Sub Public Sub Load(obj As ptObject) Implements ISettings.Load End Sub
    Public Function getCountProperties() Implements ISettings.getCountProperties Return 5 End Function End Class




     

    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


    Todo sobre informática y tecnología

    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


    Leave comment
              

    Guardar apodo y correo electrónico en este navegador para la próxima vez.



    Cargando...