Welcome Guest! You need to login or register to make posts.

Notification

Icon
Error

Options
Go to last post Go to first unread
Fedor  
#1 Posted : Thursday, December 4, 2003 7:01:00 PM(UTC)
Fedor

Rank: Advanced Member

Groups: Member, Administration, Moderator
Joined: 7/28/2003(UTC)
Posts: 1,660

Thanks: 5 times
Was thanked: 76 time(s) in 74 post(s)
I have made a code sample in which we can draw shapes (lines, ellipses and rectangles) without flickering using DoubleBufferPaint event.

Screenshot:

UserPostedImage

Use this code:

Code:
Private blnMouseDown As Boolean
Dim objGraphics As Graphics

'Start point
Private lngStartX As Long, lngStartY As Long
'End point
Private lngEndX As Long, lngEndY As Long

Private lngPenWeight As Long
Private lngPenColor As Long
Private lngBrushColor As Long

Private Sub Form_Load()
    blnMouseDown = False
    
    'Create graphics to draw on the control
    Set objGraphics = New Graphics
    objGraphics.Engine = DrawingEngineGdiplus
    
    BitmapViewer1.Bitmap.Graphics.Engine = DrawingEngineGdiplus
    BitmapViewer1.Bitmap.CreateNew 800, 600, Format24bppRgb
    
    lngPenWeight = 5
    lngPenColor = &H80FF0000
    lngBrushColor = &H800000FF
End Sub

Private Sub Form_Resize()
    'Resize BitmapViewer control on form resize
    BitmapViewer1.Height = Me.ScaleHeight - 16
    BitmapViewer1.Width = Me.ScaleWidth - 216
End Sub

Private Sub CommandLoad_Click()
    'Load image from file
    If FileDialog1.ShowOpen Then
        On Error Resume Next
        BitmapViewer1.Bitmap.LoadFromFile FileDialog1.FileName
        If Err.Number <> 0 Then
            MsgBox "Error arrised during loading image."
            Exit Sub
        End If
        'We need to convert to Format24bppRgb to ensure that
        'Graphics will be able to draw on the bitmap. Currently
        'Graphics (both GDI and GDI+) can work on Format24bppRgb,
        'Format32bppRgb, Format32bppArgb, Format32bppPArgb
        'pixel formats
        BitmapViewer1.Bitmap.Data.ConvertTo24bppRgb True
    End If
End Sub

Private Sub CommandCreateNew_Click()
    'Create empty bitmap
    BitmapViewer1.Bitmap.CreateNew 800, 600, Format24bppRgb
End Sub

Private Sub ComboZoom_Click()
    BitmapViewer1.Zoom = CLng(Left(ComboZoom.Text, Len(ComboZoom.Text) - 2)) / 100
End Sub

Private Sub OptionGdi_Click()
    'Change drawing engine to GDI
    objGraphics.Engine = DrawingEngineGdi
    BitmapViewer1.Bitmap.Graphics.Engine = DrawingEngineGdi

    'As GDI does not support alpha channels, we should disable
    'the controls which specify opacity
    LabelPenOpacity.Enabled = False
    ComboPenOpacity.Enabled = False
    LabelBrushOpacity.Enabled = False
    ComboBrushOpacity.Enabled = False
End Sub

Private Sub OptionGdiplus_Click()
    'Change drawing engine to GDI+
    objGraphics.Engine = DrawingEngineGdiplus
    BitmapViewer1.Bitmap.Graphics.Engine = DrawingEngineGdiplus

    'GDI+ supports alpha channels, so we should enable
    'the controls which specify opacity
    LabelPenOpacity.Enabled = True
    ComboPenOpacity.Enabled = True
    LabelBrushOpacity.Enabled = True
    ComboBrushOpacity.Enabled = True
End Sub

Private Sub CommandPenColorSelect_Click()
    'Set initial color to the Color Dialog (it will be displayed
    'as "Old Color" in the Color Dialog)
    ColorDialog1.ColorArgb = lngPenColor
    If ColorDialog1.Show Then
        ShapePenColor.FillColor = ColorDialog1.ColorColorref
        'Specify opacity (alpha channel) for the selected color
        lngPenColor = BitmapViewer1.Bitmap.Color.ModifyAlpha(ColorDialog1.ColorArgb, CByte(ComboPenOpacity.Text))
    End If
End Sub

Private Sub ComboPenOpacity_Click()
    'Update opacity (alpha component) of the pen color
    lngPenColor = BitmapViewer1.Bitmap.Color.ModifyAlpha(lngPenColor, CByte(ComboPenOpacity.Text))
End Sub

Private Sub ComboPenWeight_Click()
    lngPenWeight = ComboPenWeight.Text
End Sub

Private Sub CommandBrushColorSelect_Click()
    'Set initial color to the Color Dialog (it will be displayed
    'as "Old Color" in the Color Dialog)
    ColorDialog1.ColorArgb = lngBrushColor
    If ColorDialog1.Show Then
        ShapeBrushColor.FillColor = ColorDialog1.ColorColorref
        'Specify opacity (alpha channel) for the selected color
        lngBrushColor = BitmapViewer1.Bitmap.Color.ModifyAlpha(ColorDialog1.ColorArgb, CByte(ComboBrushOpacity.Text))
    End If
End Sub

Private Sub ComboBrushOpacity_Click()
    'Update opacity (alpha component) of the brush color
    lngBrushColor = BitmapViewer1.Bitmap.Color.ModifyAlpha(lngBrushColor, CByte(ComboBrushOpacity.Text))
End Sub

Private Sub BitmapViewer1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    blnMouseDown = True
    'Set start coordinate of the shape to draw
    lngStartX = x
    lngStartY = y
    'Set end coordinate of the shape to draw
    lngEndX = x
    lngEndY = y
    'FastRefresh method will fire DoubleBufferPaint event. Here we can
    'redraw the shape
    BitmapViewer1.FastRefresh
End Sub

Private Sub BitmapViewer1_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    If blnMouseDown Then
        'Set end coordinate of drawn shape
        lngEndX = x
        lngEndY = y
        'FastRefresh method will fire DoubleBufferPaint event. Here we can
        'redraw the shape
        BitmapViewer1.FastRefresh
    End If
End Sub

Private Sub BitmapViewer1_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    If blnMouseDown Then
        'Convert start and end coordinates from control coordinate system to bitmap one
        BitmapViewer1.ControlToBitmapCoords lngStartX, lngStartY, lngStartX, lngStartY
        BitmapViewer1.ControlToBitmapCoords lngEndX, lngEndY, lngEndX, lngEndY
        blnMouseDown = False
        
        'Adjust pen and brush
        BitmapViewer1.Bitmap.Graphics.Brush.PrimaryColor = lngBrushColor
        BitmapViewer1.Bitmap.Graphics.Pen.ForeColor = lngPenColor
        BitmapViewer1.Bitmap.Graphics.Pen.Weight = lngPenWeight
        
        'Draw line on bitmap
        If OptionLine.Value Then
            BitmapViewer1.Bitmap.Graphics.DrawLine lngStartX, lngStartY, lngEndX, lngEndY
        
        'Draw rectangle on bitmap
        Else
            If lngStartX < lngEndX Then
                lngLeft = lngStartX
                lngWidth = lngEndX - lngStartX
            Else
                lngLeft = lngEndX
                lngWidth = lngStartX - lngEndX
            End If
            If lngStartY < lngEndY Then
                lngTop = lngStartY
                lngHeight = lngEndY - lngStartY
            Else
                lngTop = lngEndY
                lngHeight = lngStartY - lngEndY
            End If
            If OptionRectangle.Value Then
                BitmapViewer1.Bitmap.Graphics.DrawRectangle lngLeft, lngTop, _
                    lngWidth, lngHeight, True, True
            'Draw ellipse on bitmap
            Else
                BitmapViewer1.Bitmap.Graphics.DrawEllipse lngLeft, lngTop, _
                    lngWidth, lngHeight, True, True
            End If
        End If
    End If
End Sub

Private Sub BitmapViewer1_DoubleBufferPaint(ByVal Hdc As stdole.OLE_HANDLE)
    If blnMouseDown Then
        'Attach Graphics to the temporary DC (control's double buffer)
        objGraphics.Hdc = Hdc
        'Adjust pen and brush
        objGraphics.Brush.PrimaryColor = lngBrushColor
        objGraphics.Pen.ForeColor = lngPenColor
        'Scale pen weight proportionally to zoom
        objGraphics.Pen.Weight = lngPenWeight * BitmapViewer1.Zoom
        
        'Draw line on control
        If OptionLine.Value Then
            objGraphics.DrawLine lngStartX, lngStartY, lngEndX, lngEndY
                
        Else
            Dim lngLeft As Long, lngTop As Long, lngWidth As Long, lngHeight As Long
            If lngStartX < lngEndX Then
                lngLeft = lngStartX
                lngWidth = lngEndX - lngStartX
            Else
                lngLeft = lngEndX
                lngWidth = lngStartX - lngEndX
            End If
            If lngStartY < lngEndY Then
                lngTop = lngStartY
                lngHeight = lngEndY - lngStartY
            Else
                lngTop = lngEndY
                lngHeight = lngStartY - lngEndY
            End If
            'Draw rectangle on control
            If OptionRectangle.Value Then
                objGraphics.DrawRectangle lngLeft, lngTop, lngWidth, lngHeight, True, True
            'Draw ellipse on control
            Else
                objGraphics.DrawEllipse lngLeft, lngTop, lngWidth, lngHeight, True, True
            End If
        End If
    End If
End Sub

You can download GraphicsMill_DrawingShapes.zip with full project code.

Edited by user Monday, December 21, 2009 3:12:04 AM(UTC)  | Reason: Not specified

File Attachment(s):
GraphicsMill_DrawingShapes.zip (16kb) downloaded 221 time(s).
Fedor attached the following image(s):
GraphicsMill_DrawingShapes.jpg
Best regards,

Fedor Skvortsov

Fedor  
#2 Posted : Friday, December 5, 2003 5:14:00 PM(UTC)
Fedor

Rank: Advanced Member

Groups: Member, Administration, Moderator
Joined: 7/28/2003(UTC)
Posts: 1,660

Thanks: 5 times
Was thanked: 76 time(s) in 74 post(s)
When we draw on the control, it would be nice to be able to "clip" drawing when we are going outside of the image. Here I post how to achieve clipping in the Drawing Shapes Sample.

First of all, you need to import three GDI functions:

Code:
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SelectClipRgn Lib "gdi32" (ByVal Hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

CreateRectRgn creates a rectangle clipping region. SelectClipRegion attaches this region to given HDC. DeleteObject is necessary to free region.

The idea is very simple. When you redraw the control (in DoubleBufferPaint handler) you should attach a clipping region with size of the bitmap. Use this BitmapViewer1_DoubleBufferPaint sub:

Code:
Private Sub BitmapViewer1_DoubleBufferPaint(ByVal Hdc As stdole.OLE_HANDLE)
    If blnMouseDown Then
        'Attach Graphics to the temporary DC (control's double buffer)
        objGraphics.Hdc = Hdc
        'Adjust pen and brush
        objGraphics.Brush.PrimaryColor = lngBrushColor
        objGraphics.Pen.ForeColor = lngPenColor
        'Scale pen weight proportionally to zoom
        objGraphics.Pen.Weight = lngPenWeight * BitmapViewer1.Zoom
                
        'Set clip area
        Dim lngClipTop As Long, lngClipLeft As Long, lngClipRight As Long, lngClipBottom As Long
        BitmapViewer1.BitmapToControlCoords 0, 0, lngClipLeft, lngClipTop
        BitmapViewer1.BitmapToControlCoords BitmapViewer1.Bitmap.Data.Width, BitmapViewer1.Bitmap.Data.Height, lngClipRight, lngClipBottom

        Dim hRgn As Long
        hRgn = CreateRectRgn(lngClipLeft, lngClipTop, lngClipRight, lngClipBottom)

        SelectClipRgn Hdc, hRgn
        
        'Draw line on control
        If OptionLine.Value Then
            objGraphics.DrawLine lngStartX, lngStartY, lngEndX, lngEndY
                
        Else
            Dim lngLeft As Long, lngTop As Long, lngWidth As Long, lngHeight As Long
            If lngStartX < lngEndX Then
                lngLeft = lngStartX
                lngWidth = lngEndX - lngStartX
            Else
                lngLeft = lngEndX
                lngWidth = lngStartX - lngEndX
            End If
            If lngStartY < lngEndY Then
                lngTop = lngStartY
                lngHeight = lngEndY - lngStartY
            Else
                lngTop = lngEndY
                lngHeight = lngStartY - lngEndY
            End If
            'Draw rectangle on control
            If OptionRectangle.Value Then
                objGraphics.DrawRectangle lngLeft, lngTop, lngWidth, lngHeight, True, True
            'Draw ellipse on control
            Else
                objGraphics.DrawEllipse lngLeft, lngTop, lngWidth, lngHeight, True, True
            End If
        End If
        
        'Delete GDI resource
        DeleteObject hRgn
    End If
End Sub

Edited by user Thursday, December 20, 2007 6:40:26 PM(UTC)  | Reason: Not specified

Best regards,

Fedor Skvortsov

KgMonsok  
#3 Posted : Wednesday, July 27, 2005 1:12:00 AM(UTC)
KgMonsok

Rank: Member

Groups: Member
Joined: 7/27/2005(UTC)
Posts: 2

Hello Fedor,

Thank you for the sample. BTW, I am new to Graphics Mill for ActiveX.

Anyway is it possible to draw other custom shapes such as star or rounded rectangle and so on?

Andrew  
#4 Posted : Wednesday, July 27, 2005 1:12:00 PM(UTC)
Andrew

Rank: Advanced Member

Groups: Member, Administration
Joined: 8/2/2003(UTC)
Posts: 876

Thanks: 2 times
Was thanked: 27 time(s) in 27 post(s)
You can construct custom shapes from primitives which are available in Graphics Mill. E.g., star can be drawn with a polyline (or polygon) and rounded rectangle with a combination of lines and Bezier curves.

The only problem is that not always it is possible to draw filled shapes.

Andrew  
#5 Posted : Wednesday, July 27, 2005 1:54:00 PM(UTC)
Andrew

Rank: Advanced Member

Groups: Member, Administration
Joined: 8/2/2003(UTC)
Posts: 876

Thanks: 2 times
Was thanked: 27 time(s) in 27 post(s)
Here is an example of implementation of rounded rectangles:

Code:
' Parameters
Dim x, y, width, height, roundness

x = 40
y = 30
width = 450
height = 100 
roundness = 40
             
Dim line1x1, line1y1, line2x1, line2y1, line3x1, line3y1, line4x1, line4y1
Dim line1x2, line1y2, line2x2, line2y2, line3x2, line3y2, line4x2, line4y2
Dim horend, vertend
horend = width * roundness/200
vertend = height * roundness/200

line1x1 = x 
line1y1 = y + vertend
line1x2 = x 
line1y2 = y + height - vertend

line2x1 = x + horend
line2y1 = y + height
line2x2 = x + width  - horend
line2y2 = y + height 

line3x1 = x + width 
line3y1 = y + height - vertend
line3x2 = x + width 
line3y2 = y + vertend

line4x1 = x + horend
line4y1 = y 
line4x2 = x + width - horend
line4y2 = y 

objGraphics.DrawLine line1x1, line1y1, line1x2, line1y2
objGraphics.DrawLine line2x1, line2y1, line2x2, line2y2
objGraphics.DrawLine line3x1, line3y1, line3x2, line3y2
objGraphics.DrawLine line4x1, line4y1, line4x2, line4y2

objGraphics.DrawBezier line1x1, line1y1, x, y, x, y, line4x1, line4y1
objGraphics.DrawBezier line1x2, line1y2, x, y + height, x, y + height, line2x1, line2y1
objGraphics.DrawBezier line2x2, line2y2, x + width, y + height, x + width, y + height, line3x1, line3y1
objGraphics.DrawBezier line3x2, line3y2, x + width, y, x + width, y, line4x2, line4y2

'A rectangle for test reasons
'objGraphics.Pen.ForeColor = &h1F00FF00
'objGraphics.Pen.Weight = 3
'objGraphics.DrawRectangle x, y, width, height

Edited by user Thursday, December 20, 2007 6:41:08 PM(UTC)  | Reason: Not specified

Users browsing this topic
Guest
Forum Jump  
You cannot post new topics in this forum.
You cannot reply to topics in this forum.
You cannot delete your posts in this forum.
You cannot edit your posts in this forum.
You cannot create polls in this forum.
You cannot vote in polls in this forum.