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

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:

https://www.vbforums.com/images/ieimages/2023/03/8.png

https://www.vbforums.com/images/ieimages/2023/03/7.png

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.

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

Code:

---

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

---

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.

Quote:

---

Originally Posted by LorinM

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...

Quote:

---

Originally Posted by LorinM

(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.

Quote:

---

Originally Posted by LorinM

(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.

Quote:

---

Originally Posted by LorinM

(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?