dcsimg
Results 1 to 10 of 10

Thread: A library or ActiveX component for drawing and controlling shapes at runtime?

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Sep 2015
    Posts
    172

    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!

  2. #2
    Hyperactive Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    293

    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?

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Sep 2015
    Posts
    172

    Re: A library or ActiveX component for drawing and controlling shapes at runtime?

    Quote Originally Posted by AAraya View Post
    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!

  4. #4
    Junior Member
    Join Date
    Jan 2019
    Posts
    26

    Re: A library or ActiveX component for drawing and controlling shapes at runtime?


  5. #5
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,376

    Re: A library or ActiveX component for drawing and controlling shapes at runtime?

    Quote Originally Posted by labmany View Post
    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

  6. #6
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,376

    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

  7. #7
    Hyperactive Member Daniel Duta's Avatar
    Join Date
    Feb 2011
    Location
    Bucharest, Romania
    Posts
    341

    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" - Reed Kimble

  8. #8
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,376

    Re: A library or ActiveX component for drawing and controlling shapes at runtime?

    Quote Originally Posted by Daniel Duta View Post
    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.

    Quote Originally Posted by Daniel Duta View Post
    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

  9. #9

    Thread Starter
    Addicted Member
    Join Date
    Sep 2015
    Posts
    172

    Re: A library or ActiveX component for drawing and controlling shapes at runtime?

    Thanks Louise, I will give it a try!

  10. #10

    Thread Starter
    Addicted Member
    Join Date
    Sep 2015
    Posts
    172

    Re: A library or ActiveX component for drawing and controlling shapes at runtime?

    Quote Originally Posted by Schmidt View Post
    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
  •  



Featured


Click Here to Expand Forum to Full Width