-
Jan 18th, 2019, 06:29 PM
#1
Thread Starter
Addicted Member
A library or ActiveX component for drawing and controlling shapes at runtime?
I am looking for something which allow me to draw polyline, polygon, circles, rectangles...etc and be able to move and or resize each shape and be able to get different measurement properties of them.
I do appreciate if anyone suggestions!
-
Jan 19th, 2019, 09:22 AM
#2
Hyperactive Member
Re: A library or ActiveX component for drawing and controlling shapes at runtime?
I'm sure you've already considered this but just in case - VB6 provides a Shape control in the toolbox which allows rudimentary shapes which you can color, fill, resize, move, etc... Do you need greater capabilities than this?
-
Jan 19th, 2019, 10:13 AM
#3
Thread Starter
Addicted Member
Re: A library or ActiveX component for drawing and controlling shapes at runtime?
Originally Posted by AAraya
I'm sure you've already considered this but just in case - VB6 provides a Shape control in the toolbox which allows rudimentary shapes which you can color, fill, resize, move, etc... Do you need greater capabilities than this?
Thanks AArya!
Of course I am aware of the shape control but I am looking for something more powerful which allows for :
- Polyline, Polygon, Arc, Ellipse, Bezier etc
- Rotation, Mirroring, transforming...etc
- Measure distance and area..etc
- Dimensions and angels
..
..
I think vbRichClient will come handy with some work from my part!
-
Jan 19th, 2019, 10:43 AM
#4
Junior Member
Re: A library or ActiveX component for drawing and controlling shapes at runtime?
-
Jan 19th, 2019, 04:21 PM
#5
Re: A library or ActiveX component for drawing and controlling shapes at runtime?
Originally Posted by labmany
I think vbRichClient will come handy with some work from my part!
Sure - and there's basically two approaches with that:
- the easier one is, to implement this using the Widget-Engine (and the DesignMode-stuff on cWidgetRoot)
- the more difficult one to implement (but with more "freedom") would be to write your own (non-Widget) Shape-Classes (using "self-managed Cairo-rendering")
Here is some Demo-Code for the easier approach (make sure to use the latest RC5-download).
Ensure an empty VB6-Project without any VB6-Forms, add the vbRichClient5-reference - and put this modMain.bas:
Code:
Option Explicit
Public fMain As New cfMain
Sub Main()
Cairo.ImageList.AddIconFromResourceFile "frmIco", "shell32", 167, 32, 32 'load an Icon into the global ImageList
fMain.Form.Show
Cairo.WidgetForms.EnterMessageLoop
End Sub
Now create a WidgetForm-HostClass, named cfMain.cls with the following code:
Code:
Option Explicit
Public WithEvents Form As cWidgetForm, WithEvents Page As cWidgetForm
Public PageWidthInch As Double, PageHeightInch As Double
Private Sub Class_Initialize()
Set Form = Cairo.WidgetForms.Create(vbSizable, "Shape-Handling at constant 96dpi (Page=8.5x11 inch)", True, 1024, 768)
Form.SetMinMaxDimensions 720, 560
Form.IconImageKey = "frmIco" 'ensure a Form-Icon per ImageList-Key (Icon was loaded in Sub Main)
Form.WidgetRoot.BackColor = &H888888
PageWidthInch = 8.5: PageHeightInch = 11 'let's define an absolute Page-Size
Set Page = Cairo.WidgetForms.CreateChild(Form.hWnd)
Page.WidgetRoot.BackColor = vbWhite
Page.WidgetRoot.DesignMode = True
Page.WidgetRoot.DesignModeGridWidth = 4
End Sub
Private Sub Form_Load() 'shape-coords are absolute inches
AddNewShape "S1", vbShapeRectangle, 0.5, 0.5, 2, 1
AddNewShape "S2", vbShapeOval, 2, 2, 2, 1
AddNewShape "S3", vbShapeRoundedRectangle, 3.5, 3.5, 2, 1
End Sub
Private Sub Form_ResizeWithDimensions(ByVal NewWidth As Long, ByVal NewHeight As Long)
Dim x, y, dx, dy
Cairo.CalcAspectFit PageWidthInch / PageHeightInch, NewWidth, NewHeight, x, y, dx, dy, 20
Page.Move x, y, dx, dy
End Sub
Private Sub Page_ResizeWithDimensions(ByVal NewWidth As Long, ByVal NewHeight As Long)
Page.WidgetRoot.Zoom = NewWidth / (PageWidthInch * 96)
End Sub
Private Sub AddNewShape(Name As String, ByVal Style As ShapeConstants, x, y, dx, dy) 'coords in inches
Dim Shape As cwShape
Set Shape = Page.Widgets.Add(New cwShape, Name, x * 96, y * 96, dx * 96, dy * 96)
Shape.Style = Style
End Sub
Finally a simple ShapeWidget-Class, named cwShape.cls with the following code:
Code:
Option Explicit
Private WithEvents W As cWidgetBase
Public Style As ShapeConstants, BorderWidth As Double, BorderRadius As Double
Private Sub Class_Initialize()
Set W = Cairo.WidgetBase
W.BackColor = -1
W.ImplementsWheelMessages = True
BorderWidth = 2
End Sub
Public Property Get Widget() As cWidgetBase: Set Widget = W: End Property
Public Property Get Widgets() As cWidgets: Set Widgets = W.Widgets: End Property
Private Sub W_Paint(CC As cCairoContext, ByVal xAbs As Single, ByVal yAbs As Single, ByVal dx_Aligned As Single, ByVal dy_Aligned As Single, UserObj As Object)
Dim ww, hh, rr, x, y, dx, dy
ww = dx_Aligned: hh = dy_Aligned
If Style Mod 2 Then Cairo.CalcAspectFit 1, ww, hh, x, y, dx, dy
rr = IIf(BorderRadius, BorderRadius, BorderWidth * 4)
CC.SetLineWidth BorderWidth
Select Case Style
Case vbShapeRectangle: CC.Rectangle 0, 0, ww, hh, True
Case vbShapeSquare: CC.Rectangle x, y, dx, dy, True
Case vbShapeOval: CC.Ellipse ww / 2, hh / 2, ww, hh, True
Case vbShapeCircle: CC.Ellipse ww / 2, hh / 2, dx, dy, True
Case vbShapeRoundedRectangle: CC.RoundedRect 0, 0, ww, hh, rr, True
Case vbShapeRoundedSquare: CC.RoundedRect x, y, dx, dy, rr, True
End Select
CC.Stroke , Cairo.CreateSolidPatternLng(W.BorderColor)
End Sub
The above 3 Code-Modules should (when no mistakes were made with the naming of them) produce the following:
HTH
Olaf
-
Jan 19th, 2019, 06:26 PM
#6
Re: A library or ActiveX component for drawing and controlling shapes at runtime?
Forgot to include PDF-Printing of the Page in the above example - but it's simple enough to add - e.g. this way:
In cwShape one needs to replace the W_Paint EventHandler-Routine with this new set (of two routines):
Code:
Private Sub W_Paint(CC As cCairoContext, ByVal xAbs As Single, ByVal yAbs As Single, ByVal dx_Aligned As Single, ByVal dy_Aligned As Single, UserObj As Object)
Draw CC, dx_Aligned, dy_Aligned 'we just delegate to the Draw-Routine below (which is also reachable from the outside, because it's Public)
End Sub
Public Sub Draw(CC As cCairoContext, ByVal dx As Double, ByVal dy As Double)
Dim rr As Double, x As Double, y As Double
If Style Mod 2 Then Cairo.CalcAspectFit 1, dx, dy, x, y, dx, dy
rr = IIf(BorderRadius, BorderRadius, BorderWidth * 4)
CC.SetLineWidth BorderWidth
Select Case Style
Case vbShapeRectangle: CC.Rectangle 0, 0, dx, dy, True
Case vbShapeSquare: CC.Rectangle x, y, dx, dy, True
Case vbShapeOval: CC.Ellipse dx / 2, dy / 2, dx, dy, True
Case vbShapeCircle: CC.Ellipse dx / 2, dy / 2, dx, dy, True
Case vbShapeRoundedRectangle: CC.RoundedRect 0, 0, dx, dy, rr, True
Case vbShapeRoundedSquare: CC.RoundedRect x, y, dx, dy, rr, True
End Select
CC.Stroke , Cairo.CreateSolidPatternLng(W.BorderColor)
W.SelectFontSettingsInto CC
CC.DrawText 0, 0, dx, dy, "Shape: " & W.Key, True, vbCenter, 4, 1
End Sub
And the PDF-Printing-stuff can just be added at the end of the Form-Hosting cfMain.cls:
Code:
Private Sub Form_DblClick() 'double-clicking the (dark-gray) Form-area will write the Page as a PDF-File into the App-Path
Dim PdfSrf As cCairoSurface, CC As cCairoContext
Set PdfSrf = Cairo.CreateSurface(PageWidthInch * 72, PageHeightInch * 72, PDFSurface)
PrintPageOn PdfSrf.CreateContext
PdfSrf.WriteContentToPDFFile App.Path & "\Page1.pdf"
End Sub
Private Sub PrintPageOn(CC As cCairoContext)
CC.ScaleDrawings 72 / 96, 72 / 96 'adjust the 96DPI-Screen-scaling to the PDFs 72Points/inch
Dim Shape As cwShape
For Each Shape In Page.Widgets
With Shape.Widget
CC.Save 'save/restore-wrapping, to isolate the translate-calls for each shape
CC.TranslateDrawings .Left, .Top
Shape.Draw CC, .Width, .Height
CC.Restore
End With
Next
End Sub
Olaf
-
Jan 20th, 2019, 05:38 AM
#7
Hyperactive Member
Re: A library or ActiveX component for drawing and controlling shapes at runtime?
Olaf, would you mind explaining to me how does the EnterMessageLoop method work with WidgetForms ? Is it necessary to be called it after a form is displayed ? Thank you.
"VB code is practically pseudocode" - Tanner Helland
"When you do things right, people won't be sure you've done anything at all" - Matt Groening
"If you wait until you are ready, it is almost certainly too late" - Seth Godin
"Believe nothing you hear, and only one half that you see" - Edgar Allan Poe
-
Jan 20th, 2019, 09:19 AM
#8
Re: A library or ActiveX component for drawing and controlling shapes at runtime?
Originally Posted by Daniel Duta
Olaf, would you mind explaining to me how does the EnterMessageLoop method work with WidgetForms ?
The EnterMessageLoop-Method encapsulates the usual MessagePump each Win-App has to enter
(to be able to show "TopLevel-hWnds" and delegate all the messages which float around in the system to the right Form)
It's basically the following (somewhat simplified):
Code:
Do While GetMessage(...) 'enters an efficient waitstate, but returns when the next Msg is placed in the queue
TranslateMessage(...)
DispatchMessage(...)
If Forms.Count = 0 Then Exit Do 'extra-exit-condition - when multiple forms are supported
Loop
The VB6-runtime hides its default-message-loop under the covers -
whilst EnterMessageLoop does it explicitely.
Originally Posted by Daniel Duta
Is it necessary to be called it after a form is displayed ? Thank you.
Not necessarily...
But if you want full Unicode- or proper MouseWheel-support + a few other things (when running RC5 cWidgetForms),
then it is recommended to use EnterMessageLoop (it is using the W-suffixed APIs throughout,
whilst the VB6-default-messagepump is implemented using the A-suffixed ANSI-APIs -
and an ANSI-loop makes Unicode-Handling a lot harder to deal with at the Control- or Widget-implementation-level.
The original VB6-MessagePump can be used with cWidgetForms though, if you include an
empty frmDummy-Form into the Project, and then (instead of calling EnterMessageLoop) change
e.g. the Sub Main() in the posted example to:
Code:
Option Explicit
Public fMain As New cfMain
Sub Main()
Cairo.ImageList.AddIconFromResourceFile "frmIco", "shell32", 167, 32, 32 'load an Icon into the global ImageList
fMain.Form.Show
'Cairo.WidgetForms.EnterMessageLoop
Load frmDummy 'use a loaded, but invisible VB6-Form-Instance, to activate the default-message-pump
End Sub
In cfMain.cls you'd have to clean up this Dummy-Form again, when the RC5-MainForm unloads:
Code:
Private Sub Form_Unload(Cancel As Integer)
Unload frmDummy 'unload the invisible Form, to unload the App properly and shutdown the VB6-MessageLoop
End Sub
HTH
Olaf
-
Jan 20th, 2019, 01:45 PM
#9
Thread Starter
Addicted Member
Re: A library or ActiveX component for drawing and controlling shapes at runtime?
Originally Posted by Louise1998
Thanks Louise, I will give it a try!
-
Jan 20th, 2019, 01:46 PM
#10
Thread Starter
Addicted Member
Re: A library or ActiveX component for drawing and controlling shapes at runtime?
Originally Posted by Schmidt
Sure - and there's basically two approaches with that:
- the easier one is, to implement this using the Widget-Engine (and the DesignMode-stuff on cWidgetRoot)
- the more difficult one to implement (but with more "freedom") would be to write your own (non-Widget) Shape-Classes (using "self-managed Cairo-rendering")
Here is some Demo-Code for the easier approach (make sure to use the latest RC5-download).
Ensure an empty VB6-Project without any VB6-Forms, add the vbRichClient5-reference - and put this modMain.bas:
Code:
Option Explicit
Public fMain As New cfMain
Sub Main()
Cairo.ImageList.AddIconFromResourceFile "frmIco", "shell32", 167, 32, 32 'load an Icon into the global ImageList
fMain.Form.Show
Cairo.WidgetForms.EnterMessageLoop
End Sub
Now create a WidgetForm-HostClass, named cfMain.cls with the following code:
Code:
Option Explicit
Public WithEvents Form As cWidgetForm, WithEvents Page As cWidgetForm
Public PageWidthInch As Double, PageHeightInch As Double
Private Sub Class_Initialize()
Set Form = Cairo.WidgetForms.Create(vbSizable, "Shape-Handling at constant 96dpi (Page=8.5x11 inch)", True, 1024, 768)
Form.SetMinMaxDimensions 720, 560
Form.IconImageKey = "frmIco" 'ensure a Form-Icon per ImageList-Key (Icon was loaded in Sub Main)
Form.WidgetRoot.BackColor = &H888888
PageWidthInch = 8.5: PageHeightInch = 11 'let's define an absolute Page-Size
Set Page = Cairo.WidgetForms.CreateChild(Form.hWnd)
Page.WidgetRoot.BackColor = vbWhite
Page.WidgetRoot.DesignMode = True
Page.WidgetRoot.DesignModeGridWidth = 4
End Sub
Private Sub Form_Load() 'shape-coords are absolute inches
AddNewShape "S1", vbShapeRectangle, 0.5, 0.5, 2, 1
AddNewShape "S2", vbShapeOval, 2, 2, 2, 1
AddNewShape "S3", vbShapeRoundedRectangle, 3.5, 3.5, 2, 1
End Sub
Private Sub Form_ResizeWithDimensions(ByVal NewWidth As Long, ByVal NewHeight As Long)
Dim x, y, dx, dy
Cairo.CalcAspectFit PageWidthInch / PageHeightInch, NewWidth, NewHeight, x, y, dx, dy, 20
Page.Move x, y, dx, dy
End Sub
Private Sub Page_ResizeWithDimensions(ByVal NewWidth As Long, ByVal NewHeight As Long)
Page.WidgetRoot.Zoom = NewWidth / (PageWidthInch * 96)
End Sub
Private Sub AddNewShape(Name As String, ByVal Style As ShapeConstants, x, y, dx, dy) 'coords in inches
Dim Shape As cwShape
Set Shape = Page.Widgets.Add(New cwShape, Name, x * 96, y * 96, dx * 96, dy * 96)
Shape.Style = Style
End Sub
Finally a simple ShapeWidget-Class, named cwShape.cls with the following code:
Code:
Option Explicit
Private WithEvents W As cWidgetBase
Public Style As ShapeConstants, BorderWidth As Double, BorderRadius As Double
Private Sub Class_Initialize()
Set W = Cairo.WidgetBase
W.BackColor = -1
W.ImplementsWheelMessages = True
BorderWidth = 2
End Sub
Public Property Get Widget() As cWidgetBase: Set Widget = W: End Property
Public Property Get Widgets() As cWidgets: Set Widgets = W.Widgets: End Property
Private Sub W_Paint(CC As cCairoContext, ByVal xAbs As Single, ByVal yAbs As Single, ByVal dx_Aligned As Single, ByVal dy_Aligned As Single, UserObj As Object)
Dim ww, hh, rr, x, y, dx, dy
ww = dx_Aligned: hh = dy_Aligned
If Style Mod 2 Then Cairo.CalcAspectFit 1, ww, hh, x, y, dx, dy
rr = IIf(BorderRadius, BorderRadius, BorderWidth * 4)
CC.SetLineWidth BorderWidth
Select Case Style
Case vbShapeRectangle: CC.Rectangle 0, 0, ww, hh, True
Case vbShapeSquare: CC.Rectangle x, y, dx, dy, True
Case vbShapeOval: CC.Ellipse ww / 2, hh / 2, ww, hh, True
Case vbShapeCircle: CC.Ellipse ww / 2, hh / 2, dx, dy, True
Case vbShapeRoundedRectangle: CC.RoundedRect 0, 0, ww, hh, rr, True
Case vbShapeRoundedSquare: CC.RoundedRect x, y, dx, dy, rr, True
End Select
CC.Stroke , Cairo.CreateSolidPatternLng(W.BorderColor)
End Sub
The above 3 Code-Modules should (when no mistakes were made with the naming of them) produce the following:
HTH
Olaf
Excellent as usual Olaf, thanks.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|