DrawingControls for VB6: Shape and Line controls replacement with anti-aliasing

[Eduardo-]

This is a further development of the ShapeEx control.

In this case, it is in an ocx project and has been added the companion control LineEx, that is a Line control replacement.

The main advantage is the anti-aliasing, that means better quality for the figures.
A second advantage is that there are more shapes and the LineEx control is able to draw arrows.
A third advantage is more properties that means more features, more versatility. In the test form you can check all the properties of the ShapeEx control.

Download from GitHub.

Screen shots:





If you want, you should be able to replace the old Shape and Line controls by editing the source code files (*.frm, etc.).
Changing VB.Shape to DrawingCtrls.ShapeEx and VB.Line to DrawingCtrls.LineEx
But you first need to reference the OCX in the project first.
Of course, always make a backup before such an operation.

Note: this version of the ShapeEx control includes the possibility of filling the shapes with a texture pattern.
For doing so, set the FillStyle property to seFSTexture and load the image for the texture in the FillTexture property.

[vb6forever]

Elroy: This is not a control but what I've used for years. Have to reference GDI MoveToEx, LineTo
and REM kDEBUGON and DoError.

Public Sub DrawLineDashWide(objPBox As PictureBox, ByVal X1 As _
    Single, ByVal Y1 As Single, ByVal X2 As Single, ByVal _
    Y2 As Single, ByVal dash_length As Single, ByVal _
    skip_length As Single, ByVal draw_width As Integer)
'Draw Wide Dashed Lines


   #If kDEBUGON Then
       Debug.Print "Begin DrawLineDashWide"
   #End If

   On Error GoTo Error_DrawLineDashWide
   
   '-----------------
   
   Dim i As Integer
   Dim i_max As Integer
   Dim dash_dx As Single
   Dim dash_dy As Single
   Dim skip_dx As Single
   Dim skip_dy As Single
   Dim Length As Single
   Dim X As Single
   Dim Y As Single
   
   'API
   Dim ptPoint As POINTAPI
   Dim dl As Long

   '*******
   'STARTUP
   '*******
   objPBox.DrawWidth = draw_width
   
   ' Get vectors in the desired direction
   ' with the right length.
   skip_dx = X2 - X1
If skip_dx = 0 Then Exit Sub
   
   skip_dy = Y2 - Y1
If skip_dy = 0 Then Exit Sub
   
   Length = Sqr(skip_dx * skip_dx + skip_dy * skip_dy)
   dash_dx = skip_dx / Length * dash_length
   dash_dy = skip_dy / Length * dash_length
   skip_dx = skip_dx / Length * skip_length
   skip_dy = skip_dy / Length * skip_length
    
   '*******
   'MAIN
   '*******
   X = X1
   Y = Y1
   i_max = Int(Length / (dash_length + skip_length))
   For i = 1 To i_max

      dl = MoveToEx(objPBox.hdc, X, Y, ptPoint)
      dl = LineTo(objPBox.hdc, X + dash_dx, Y + dash_dy)
      '      objPBox.Line (X, Y)-Step(dash_dx, dash_dy)   'Orig VB
      
      X = X + dash_dx + skip_dx
      Y = Y + dash_dy + skip_dy
   Next i

   ' See how much line is undrawn.
   Length = Length - i_max * (dash_length + skip_length)
   If Length > dash_length Then
   
      dl = MoveToEx(objPBox.hdc, X, Y, ptPoint)
      dl = LineTo(objPBox.hdc, X + dash_dx, Y + dash_dy)
'        objPBox.Line (X, Y)-Step(dash_dx, dash_dy)
   Else
      dl = MoveToEx(objPBox.hdc, X, Y, ptPoint)
      dl = LineTo(objPBox.hdc, X2, Y2)
'        objPBox.Line (X, Y)-(X2, Y2)
   End If
    
   '*******
   'WRAPUP
   '*******
   
   #If kDEBUGON Then
       Debug.Print "End DrawLineDashWide"
   #End If

   Exit Sub

Error_DrawLineDashWide:

   With TError
      .Type = ERR_CRITICAL
      .Src = mstrModule & "DrawLineDashWide"
      .Action = MsgAndLog
   End With
   
   Call DoError
    
End Sub

[LorinM]

Eduardo, Today downloaded from GitHub.
Unfortunately this excellent code does not run.
On a Window 7 Pro laptop.
Tried running Test uncompiled.
(1) Note to register .ocx would be nice.
Once registered
(2) One of the Shape parameters is unrecognized (looks like it was changed at the shape but not in the code.
(3) Click on demonstrating Lines button the IDE crashes.
(4) Killing the IDE and trying to run, caused brand new errors complaining about some .TMP file not being found, continuing, now other Shape parameters are unknown.

Please get it running uncompiled.

Thank you for such impressive code.

[Eduardo-]

does not run.
On a Window 7 Pro laptop.

I'm not able to test on Windows 7 now. I don't see any reason why it could not work, since the functions that are used here are available from Windows 2000. And I think I tested this on Windows XP, but...

(2) One of the Shape parameters is unrecognized (looks like it was changed at the shape but not in the code.

Yes, property Clickable changed to ClickMode. It is fixed now.

(3) Click on demonstrating Lines button the IDE crashes.
(4) Killing the IDE and trying to run, caused brand new errors complaining about some .TMP file not being found, continuing, now other Shape parameters are unknown.

Please get it running uncompiled.

Thank you for such impressive code.

You need to close all IDE instances and open the VBG file again.

[Eduardo-]

(3) Click on demonstrating Lines button the IDE crashes.

About that issue, I remember that there was an error like that long ago, but it has been fixed also long ago. Are you using the current version or something that you had downloaded some time ago?