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.
Re: DrawingControls for VB6: Shape and Line controls replacement with anti-aliasing
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
Re: DrawingControls for VB6: Shape and Line controls replacement with anti-aliasing
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.
Re: DrawingControls for VB6: Shape and Line controls replacement with anti-aliasing
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.
Re: DrawingControls for VB6: Shape and Line controls replacement with anti-aliasing
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?