BSpline-based "Bezier-Art"

[Schmidt]

A small Graphics-Demo for VB6, which shows the nice effects one can produce, when Anti-Aliasing in conjunction with Color-Alpha-settings is combined with "curved Line-Output".

Here's the ~90 lines of code, to put into a single VB-Form:

'needs a reference to the free vbRichClient5-lib, which is located and available on:
'http://www.vbRichClient.com/#/en/Downloads.htm
Option Explicit
 
Private Srf As cCairoSurface, NumPoints As Single
Private pntX() As Single, pntY() As Single, sgnX() As Single, sgnY() As Single
Private WithEvents tmrRefresh As cTimer

Private Sub Form_Load()
Dim i As Long
'    Rnd -1 'uncomment, if you want to always start from the same "randomness"

    Me.ScaleMode = vbPixels
    Me.Caption = "Left-Click for Start/Stop, Right-Click to clear"
    
    NumPoints = 7
    ReDim pntX(1 To NumPoints): ReDim pntY(1 To NumPoints)
    ReDim sgnX(1 To NumPoints): ReDim sgnY(1 To NumPoints)
 
    For i = 1 To NumPoints
      pntX(i) = ScaleWidth * Rnd
      pntY(i) = ScaleHeight * Rnd
      sgnX(i) = IIf(i Mod 2, 1, -1)
      sgnY(i) = IIf(i Mod 2, -1, 1)
    Next i
    
    Set tmrRefresh = New_c.Timer(10, True)
End Sub
 
Private Sub Form_DblClick()
  tmrRefresh.Enabled = Not tmrRefresh.Enabled
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Button = 1 Then tmrRefresh.Enabled = Not tmrRefresh.Enabled
  If Button = 2 Then Set Srf = Cairo.CreateSurface(ScaleWidth, ScaleHeight) 'reset the surface
End Sub

Private Sub Form_Resize()
  Set Srf = Cairo.CreateSurface(ScaleWidth, ScaleHeight)
End Sub

Private Sub Form_Terminate()
  If Forms.Count = 0 Then New_c.CleanupRichClientDll
End Sub

Private Sub tmrRefresh_Timer()
Dim i As Integer, cc As Long

  For cc = 1 To 100 'just to perform some more operations within a single timer-event

    For i = 1 To NumPoints 'the next two lines influence the erratic point-movement (just play around)
      pntX(i) = pntX(i) + sgnX(i) * 0.0004 * Abs(pntY(i) - pntX(i))
      pntY(i) = pntY(i) + sgnY(i) * 0.1 / Abs((33 - pntY(i)) / (77 + pntX(i)))
      
      If pntX(i) < ScaleLeft Then pntX(i) = ScaleLeft: sgnX(i) = 1
      If pntX(i) > ScaleLeft + ScaleWidth Then pntX(i) = ScaleLeft + ScaleWidth: sgnX(i) = -1
      If pntY(i) < ScaleTop Then pntY(i) = ScaleTop: sgnY(i) = 1
      If pntY(i) > ScaleHeight + ScaleTop Then pntY(i) = ScaleHeight + ScaleTop: sgnY(i) = -1
    Next i
  
    Static j As Long, k As Single
    k = k + 0.34: If k > 255 Then k = 0: j = j + 1: If j > 5 Then j = 0
    Select Case j
      Case 0: draw RGB(k, 255 - k, 255)
      Case 1: draw RGB(255, k, 255 - k)
      Case 2: draw RGB(255 - k, 255, k)
      Case 3: draw RGB(0, 255 - k, k)
      Case 4: draw RGB(0, 0, 255 - k)
      Case 5: draw RGB(255 - k, k, 0)
    End Select
    
    If cc Mod 10 = 0 Then Srf.DrawToDC hDC
 
  Next cc
End Sub
 
Private Sub draw(ByVal Color As Long)
Dim i As Long, PolyArr() As Single
  ReDim PolyArr(0 To (NumPoints + 3) * 2 - 1)
  For i = 0 To NumPoints - 1 'this is just a normal copy-over
    PolyArr(2 * i) = pntX(i + 1) 'the dst-array has x at even indexes...
    PolyArr(2 * i + 1) = pntY(i + 1) 'and the y-coord at the uneven ones
  Next i
  For i = 0 To 2 'now we add 3 additional points, to "close the circle" (so to say)
    PolyArr(2 * (NumPoints + i)) = PolyArr(2 * i) 'those extra-points are copies ...
    PolyArr(2 * (NumPoints + i) + 1) = PolyArr(2 * i + 1) '...of the first 3 points
  Next i
  
  With Srf.CreateContext 'once we have filled our PolyArr, the rest is pretty simple
    .SetSourceColor Color, 0.05
    .SetLineWidth 0.5
      .PolygonSingle PolyArr, False, splNormal '... using the powerful Poly-call
    .Stroke
  End With
End Sub

The example starts out producing something like that (all Screenshots were reduced in their Pixel-dimensions for smaller upload/download-size - they look even a bit better when directly rendered):



Then, as long as not resetted continues adding more and more alpha-curves (still the same "set" as above, just some more rendered lines on it):



But one can reset the whole thing with the right Mouse and start with a fresh image, ending up with something like this:



Just play around with it (and maybe manipulate the PolyArray-xy-Coords with your own random move-formulas or parameters) ...
Have fun... :-)

Olaf