Attribute VB_Name = "ModExtras"
' ModExtras.bas

' More Effects Adders, Wraps & Plasma

Option Explicit


Private Type RECT
    Left As Long
    TOp As Long
    Right As Long
    Bottom As Long
End Type

Private REC As RECT

'Public hRgnPic
'Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

Private Declare Function PtInRect Lib "USER32" _
   (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long

Private Declare Function SetRect Lib "USER32" _
(lpRect As RECT, ByVal x1 As Long, ByVal y1 As Long, _
  ByVal x2 As Long, ByVal y2 As Long) As Long
  
'Private REC As RECT
'SetRect REC, 0, 0, FullW - 1, FullH - 1
'If PtInRect(REC, XX, YY) <> 0 Then ' Inside REC
'  If = 0 then outside REC


Public AdderIndex As Integer

Public Enum EADDER
   [SStreaks] = 0
   [CCircles]
   [DDiagonal]
   [XEllipses]
   [BarsH]
   [BarsV]
   [BarsHV]
   [PPepper]
   [SGradAB]
   [SGradLR]
   [SGradCross]
   [SSpokes]
   [TThicklinesH]
   [TThicklinesV]
   [TThickLeftColor]
   [NNet]
   [HHexagons] = 16
   [SSquares] = 17
   [WWavesH]
   [WWavesV]
   [WWavesHV]
   [TTriangles] = 21
   [JigSaw] = 22
   [ABlindsH]
   [ABlindsV]
   [ABorder] = 25
   [LinesH]
   [LinesV]
   [WrapCyl]
   [WrapEll]
   [WrapCone]
   [XSwarm] = 31
   [PlasmaXY] = 32
   [AMaze] = 33
End Enum

' Public aUseRightColor As Boolean
' Public BresLine for drawing lines into an array in ModMaths

Private ix As Long, iy As Long
Private ixx As Long, iyy As Long   ' Mask coords for Public MaskArray()

Private ERED As Long, EGREEN As Long, EBLUE As Long
Private RR As Byte, GG As Byte, BB As Byte
Private CH As Long, CW As Long

Private picData2() As Byte

' For JigSaw

Public XJ() As Single, YJ()  As Single   ' Offset lug pattern
Public XLugCen As Single, YLugCen As Single
Public LugRadius As Single
Public ncols As Long, nrows As Long
Public XLine() As Single, YLine() As Single
Public XLine2() As Single, YLine2() As Single

Private zAng As Single
Private dx As Single, DY As Single
Private Mul As Single
Private kx() As Long, ky() As Long
Private MX() As Single, cx() As Single
Private MY() As Single, cy() As Single
' y = m.x + c
Private Tension As Single

' Scrollbar value etc for Wraps & Plasma
Public SVWP As Long
Public xindent() As Single
Public Wdiam() As Long


' For Plasma
Public WrapX As Boolean
Public WrapY As Boolean
Public PaletteMaxIndex As Long   ' default 255
'Public DoubledPalArr() As Byte

Private IndexArray() As Integer

' For Maze
Private MW As Long, MH As Long   ' Maze Width & Height
Private SW() As Long, WW() As Long  ' South & West Walls
Private Visited() As Long
Private PathList() As Long
Private NCount As Long
Private Spac As Long

'<<<< Progress bar >>>>>>>>>>
Private xd As Single, xp As Single

Public Sub Swarm(PAR As Long)
' PAR -90 - +90
   'If PAR > -5 And PAR < 0 Then PAR = -5
   'If PAR < 5 And PAR >= 0 Then PAR = 5
   picDATA() = picDATAORG()
   
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   StartProgress (HIY / 8)
   If aSelectAccepted Then
      For iy = LOY To HIY
      iyy = iy - LOY
      For ix = LOX To HIX
         ixx = ix - LOX
         If MaskArray(ixx, iyy) = 0 Then SwarmCALC PAR, ix, iy
      Next ix
      DrawProgress
      Next iy
   Else
      For iy = LOY To HIY
      For ix = LOX To HIX
         SwarmCALC PAR, ix, iy
      Next ix
      DrawProgress
      Next iy
   End If

Else  'aSelectAccepted & External

   StartProgress (HIY / 8)
      For iy = 0 To FullH - 1
      For ix = 0 To FullW - 1
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then SwarmCALC PAR, ix, iy
         Else
            SwarmCALC PAR, ix, iy
         End If
      Next ix
      DrawProgress
      Next iy

End If

   frmExtras.picPB.Cls
End Sub

Public Sub SwarmCALC(PAR As Long, ix As Long, iy As Long)
' PAR -90 to -5, +5 to +90
Dim PAR88 As Long
Dim cosA As Single, sinA As Single
Dim i As Long, j As Long
Dim Rand As Single
Dim midx As Long, midy

If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   Rand = 4 * Rnd
   PAR88 = PAR '* 2  ' TLE
   midx = (HIX + LOX) / 2
   midy = HIY
   cosA = Cos(Rand * PAR88 * d2r#)
   sinA = Atn(Rand * PAR88 * d2r#)
   i = midx + CSng(ix - midx) * cosA + CSng(iy - midy) * sinA
   j = midy + CSng(iy - midy) * cosA - CSng(ix - midx) * sinA
   
   If i >= LOX And i <= HIX Then
   If j >= LOY And j <= HIY Then
      picDATA(0, ix, iy) = picDATAORG(0, i, j)
      picDATA(1, ix, iy) = picDATAORG(1, i, j)
      picDATA(2, ix, iy) = picDATAORG(2, i, j)
   End If
   End If

Else  'aSelectAccepted & External
   
   Rand = 4 * Rnd
   PAR88 = PAR '* 2  ' TLE
   midx = (FullW - 1) / 2
   midy = FullH - 1
   cosA = Cos(Rand * PAR88 * d2r#)
   sinA = Atn(Rand * PAR88 * d2r#)
   i = midx + CSng(ix - midx) * cosA + CSng(iy - midy) * sinA
   j = midy + CSng(iy - midy) * cosA - CSng(ix - midx) * sinA
   
   If i >= 0 And i <= FullW - 1 Then
   If j >= 0 And j <= FullH - 1 Then
      picDATA(0, ix, iy) = picDATAORG(0, i, j)
      picDATA(1, ix, iy) = picDATAORG(1, i, j)
      picDATA(2, ix, iy) = picDATAORG(2, i, j)
   End If
   End If

End If

End Sub

Public Sub BlindsHorz(Hit As Long)
' HIT = blind size
Dim Offset As Long
   picDATA() = picDATAORG()
   Offset = 0
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   StartProgress (HIY)
   If aSelectAccepted Then
      For iy = LOY To HIY
      iyy = iy - LOY
      For ix = LOX To HIX
         ixx = ix - LOX
         If MaskArray(ixx, iyy) = 0 Then BlindsHorzCALC Hit, Offset
      Next ix
      Offset = Offset + 1
      If Offset > Hit Then Offset = 0
      DrawProgress
      Next iy
   Else
      For iy = LOY To HIY
      For ix = LOX To HIX
         BlindsHorzCALC Hit, Offset
      Next ix
      Offset = Offset + 1
      If Offset > Hit Then Offset = 0
      DrawProgress
      Next iy
   End If
   
Else  'aSelectAccepted & External
   
   StartProgress (HIY)
      For iy = 0 To FullH - 1
      For ix = 0 To FullW - 1
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then BlindsHorzCALC Hit, Offset
         Else
            BlindsHorzCALC Hit, Offset
         End If
      Next ix
      Offset = Offset + 1
      If Offset > Hit Then Offset = 0
      DrawProgress
      Next iy
   
End If
   
   frmExtras.picPB.Cls
End Sub

Private Sub BlindsHorzCALC(Hit As Long, Offset As Long)
      EBLUE = picDATAORG(0, ix, iy)
      EGREEN = picDATAORG(1, ix, iy)
      ERED = picDATAORG(2, ix, iy)
      EBLUE = EBLUE - (Offset * EBLUE) / Hit
      EGREEN = EGREEN - (Offset * EGREEN) / Hit
      ERED = ERED - (Offset * ERED) / Hit
      If EBLUE < 0 Then EBLUE = 255 '0
      If EGREEN < 0 Then EGREEN = 255 '0
      If ERED < 0 Then ERED = 255 '0
      picDATA(0, ix, iy) = EBLUE
      picDATA(1, ix, iy) = EGREEN
      picDATA(2, ix, iy) = ERED
End Sub

Public Sub BlindsVert(Hit As Long)
' HIT = blind size
Dim Offset As Long
   picDATA() = picDATAORG()
   Offset = 0
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   StartProgress (HIY)
   If aSelectAccepted Then
      For ix = LOX To HIX
      ixx = ix - LOX
      For iy = LOY To HIY
         iyy = iy - LOY
         If MaskArray(ixx, iyy) = 0 Then BlindsVertCALC Hit, Offset
      Next iy
      Offset = Offset + 1
      If Offset = Hit Then Offset = 0
      DrawProgress
      Next ix
   Else
      For ix = LOX To HIX
      For iy = LOY To HIY
         BlindsVertCALC Hit, Offset
      Next iy
      Offset = Offset + 1
      If Offset = Hit Then Offset = 0
      DrawProgress
      Next ix
   End If
   
Else  'aSelectAccepted & External
   
      For ix = 0 To FullW - 1
      For iy = 0 To FullH - 1
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then BlindsVertCALC Hit, Offset
         Else
            BlindsVertCALC Hit, Offset
         End If
      Next iy
      Offset = Offset + 1
      If Offset = Hit Then Offset = 0
      DrawProgress
      Next ix
   
End If
   frmExtras.picPB.Cls
End Sub

Private Sub BlindsVertCALC(Hit As Long, Offset As Long)
      EBLUE = picDATAORG(0, ix, iy)
      EGREEN = picDATAORG(1, ix, iy)
      ERED = picDATAORG(2, ix, iy)
      EBLUE = EBLUE - (Offset * EBLUE) / Hit
      EGREEN = EGREEN - (Offset * EGREEN) / Hit
      ERED = ERED - (Offset * ERED) / Hit
      If EBLUE < 0 Then EBLUE = 0
      If EGREEN < 0 Then EGREEN = 0
      If ERED < 0 Then ERED = 0
      picDATA(0, ix, iy) = EBLUE
      picDATA(1, ix, iy) = EGREEN
      picDATA(2, ix, iy) = ERED
End Sub

Public Sub Border(zPTHICKLINE As Single)
' zPTHICKLINE  .0 -> 0.5
' Public zRL As Single, zGL As Single, zBL As Single
' Private CH As Long, CW As Long
Dim k As Long
Dim TY As Single, TX As Single
Dim LR As Byte, LG As Byte, LB As Byte
Dim RR As Byte, RG As Byte, RB As Byte
Dim zlo As Single, zhi As Single
Dim zYSteps As Single
Dim zXSteps As Single
Dim ziy As Single, zix As Single

   picDATA() = picDATAORG()
   If zPTHICKLINE = 0 Then Exit Sub
   
   LngToRGB LeftColor, LR, LG, LB
   LngToRGB RightColor, RR, RG, RB
   
SetRect REC, LOX, LOY, HIX, HIY
'If PtInRect(REC, XX, YY) <> 0 Then ' Inside REC
'  If = 0 then outside REC

   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   TY = zPTHICKLINE * CH
   If TY < 1 Then TY = 1
   TX = zPTHICKLINE * CW

   If TX < 1 Then TX = 1
   
' Make border same width
If TX < TY Then
   TY = TX
Else
   TX = TY
End If

   If FullW > FullH Then
      NSteps = FullW \ 2 ' Arbitrary steps
   Else
      NSteps = FullH \ 2
   End If
   
   ' Bottom
   zlo = LOY
   zhi = LOY - 1 + TY
   zYSteps = Abs(zhi - zlo) / NSteps
   If zYSteps = 0 Then zYSteps = 0.01
   GetColorSteps
   For ziy = zlo To zhi Step zYSteps
      If ziy > LOY - 1 Then
      If ziy <= HIY Then
         If aSelectAccepted Then
               For ix = LOX To HIX
                  If MaskArray(ix - LOX, ziy - LOY) = 0 Then BorderBotTopCALC ziy, zBL, zGL, zRL
               Next ix
         Else
               For ix = LOX To HIX
                  BorderBotTopCALC ziy, zBL, zGL, zRL
               Next ix
         End If
         GetNextColors
      End If
      End If
   Next ziy
   
   ' Top
   zlo = HIY - TY + 1
   zhi = HIY
   GetColorStepsReversed
   For ziy = zlo To zhi Step zYSteps
      If ziy > LOY - 1 Then
      If ziy <= HIY Then
         If aSelectAccepted Then
            For ix = LOX To HIX
               If MaskArray(ix - LOX, ziy - LOY) = 0 Then BorderBotTopCALC ziy, zBL, zGL, zRL
            Next ix
         Else
            For ix = LOX To HIX
               BorderBotTopCALC ziy, zBL, zGL, zRL
            Next ix
         End If
         GetNextColors
      End If
      End If
   Next ziy

   ' Left
   zlo = LOX
   zhi = LOX - 1 + TX
   zXSteps = Abs(zhi - zlo) / NSteps
   If zXSteps = 0 Then zXSteps = 0.01
   GetColorSteps
   k = 0
   For zix = zlo To zhi Step zXSteps
      If zix > LOX - 1 Then
      If zix <= HIX Then
         If aSelectAccepted Then
            For iy = LOY + k * zYSteps To LOY - 1 + CH - k * zYSteps
               If MaskArray(zix - LOX, iy - LOY) = 0 Then BorderLefRitCALC zix, zBL, zGL, zRL
            Next iy
         Else
            For iy = LOY + k * zYSteps To LOY - 1 + CH - k * zYSteps
               BorderLefRitCALC zix, zBL, zGL, zRL
            Next iy
         End If
         k = k + 1
         GetNextColors
      End If
      End If
   Next zix

   ' Right
   zlo = HIX - TX + 1
   zhi = HIX
   GetColorSteps
   k = 0
   StartProgress (zhi)
   For zix = zhi To zlo Step -zXSteps
      If zix > LOX - 1 Then
      If zix <= HIX Then
         If aSelectAccepted Then
            For iy = LOY + k * zYSteps To HIY - k * zYSteps
               If MaskArray(zix - LOX, iy - LOY) = 0 Then BorderLefRitCALC zix, zBL, zGL, zRL
            Next iy
         Else
            For iy = LOY + k * zYSteps To HIY - k * zYSteps
               BorderLefRitCALC zix, zBL, zGL, zRL
            Next iy
         End If
         k = k + 1
         GetNextColors
      End If
      End If
      DrawProgress
   Next zix
   
Else  'aSelectAccepted & External

   CH = FullH - 1
   CW = FullW - 1
   
   TY = zPTHICKLINE * CH
   If TY < 1 Then TY = 1
   TX = zPTHICKLINE * CW

   If TX < 1 Then TX = 1
   
' Make border same width
If TX < TY Then
   TY = TX
Else
   TX = TY
End If

   If FullW > FullH Then
      NSteps = FullW \ 2 ' Arbitrary steps
   Else
      NSteps = FullH \ 2
   End If
   
   ' Bottom
   zlo = 0
   zhi = TY
   zYSteps = Abs(zhi - zlo) / NSteps
   If zYSteps = 0 Then zYSteps = 0.01
   GetColorSteps
   For ziy = zlo To zhi Step zYSteps
      If (ziy >= 0) And (ziy <= FullH - 1) Then
         For ix = 0 To FullW - 1
            If PtInRect(REC, ix, ziy) <> 0 Then  ' ie inside
               If MaskArray(ix - LOX, ziy - LOY) <> 0 Then BorderBotTopCALC ziy, zBL, zGL, zRL
            Else
               BorderBotTopCALC ziy, zBL, zGL, zRL
            End If
         Next ix
         GetNextColors
      End If
   Next ziy
   
   ' Top
   zlo = FullH - 1 - TY + 1
   zhi = FullH - 1
   GetColorStepsReversed
   For ziy = zlo To zhi Step zYSteps
      If (ziy > 0) And (ziy <= FullH - 1) Then
         For ix = 0 To FullW - 1
            If PtInRect(REC, ix, ziy) <> 0 Then  ' ie inside
               If MaskArray(ix - LOX, ziy - LOY) <> 0 Then BorderBotTopCALC ziy, zBL, zGL, zRL
            Else
               BorderBotTopCALC ziy, zBL, zGL, zRL
            End If
         Next ix
         GetNextColors
      End If
   Next ziy

   ' Left
   zlo = 0
   zhi = TX
   zXSteps = Abs(zhi - zlo) / NSteps
   If zXSteps = 0 Then zXSteps = 0.01
   GetColorSteps
   k = 0
   For zix = zlo To zhi Step zXSteps
      If (zix >= 0) And (zix <= FullW - 1) Then
         For iy = k * zYSteps To -1 + CH - k * zYSteps
            If PtInRect(REC, zix, iy) <> 0 Then  ' ie inside
               If MaskArray(zix - LOX, iy - LOY) <> 0 Then BorderLefRitCALC zix, zBL, zGL, zRL
            Else
               BorderLefRitCALC zix, zBL, zGL, zRL
            End If
         Next iy
         k = k + 1
         GetNextColors
      End If
   Next zix


   ' Right
   zlo = FullW - 1 - TX + 1
   zhi = FullW - 1
   GetColorSteps
   k = 0
   StartProgress (zhi)
   For zix = zhi To zlo Step -zXSteps
      If (zix >= 0) And (zix <= FullW - 1) Then
         For iy = k * zYSteps To FullH - 1 - k * zYSteps
            If PtInRect(REC, zix, iy) <> 0 Then  ' ie inside
               If MaskArray(zix - LOX, iy - LOY) <> 0 Then BorderLefRitCALC zix, zBL, zGL, zRL
            Else
               BorderLefRitCALC zix, zBL, zGL, zRL
            End If
         Next iy
         k = k + 1
         GetNextColors
      End If
      DrawProgress
      Next zix
End If
   
   frmExtras.picPB.Cls
End Sub
Private Sub BorderBotTopCALC(ziy As Single, zBL As Single, zGL As Single, zRL As Single)
   picDATA(0, ix, ziy) = zBL
   picDATA(1, ix, ziy) = zGL
   picDATA(2, ix, ziy) = zRL
End Sub
Private Sub BorderLefRitCALC(zix As Single, zBL As Single, zGL As Single, zRL As Single)
   picDATA(0, zix, iy) = zBL
   picDATA(1, zix, iy) = zGL
   picDATA(2, zix, iy) = zRL
End Sub

Public Sub AddCircles(zPLENS As Single)
' zPLENS 0.5 -> 10

' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long

Dim zA As Single
Dim zD As Single
Dim ixv As Long
Dim iyv As Long
Dim zRM As Single
Dim zix As Single, ziy As Single
   
   picDATA() = picDATAORG()
   
   GetLorRColor

If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   zD = Sqr(CW * CW + CH * CH)
   zRM = zD / (16 * zPLENS)
   StartProgress ((HIY + zRM - LOY) / (2 * zRM)) ' ??
   For ziy = LOY To HIY + zRM Step 2 * zRM
   For zix = LOX To HIX + zRM Step 2 * zRM
      If aSelectAccepted Then
         For zA = 0 To 2 * pi# Step 0.01
            ixv = zix + zRM * Cos(zA)
            iyv = ziy + zRM * Sin(zA)
            If (ixv >= LOX And ixv <= HIX) And (iyv >= LOY And iyv <= HIY) Then
               If MaskArray(ixv - LOX, iyv - LOY) = 0 Then AddCirclesCALC ixv, iyv
            End If
         Next zA
      Else
         For zA = 0 To 2 * pi# Step 0.01
            ixv = zix + zRM * Cos(zA)
            iyv = ziy + zRM * Sin(zA)
            If (ixv >= LOX And ixv <= HIX) And (iyv >= LOY And iyv <= HIY) Then
               AddCirclesCALC ixv, iyv
            End If
         Next zA
      End If
   Next zix
   DrawProgress
   Next ziy
   
Else   ' aSelectAccepted and External
   CH = FullH - 1
   CW = FullW - 1
   
   zD = Sqr(CW * CW + CH * CH)
   zRM = zD / (16 * zPLENS)
   StartProgress ((HIY + zRM) / (2 * zRM))  ' ??
   For ziy = 0 To FullH - 1 + zRM Step 2 * zRM
   For zix = 0 To FullW - 1 + zRM Step 2 * zRM
         For zA = 0 To 2 * pi# Step 0.01
            ixv = zix + zRM * Cos(zA)
            iyv = ziy + zRM * Sin(zA)
            If (ixv >= LOX And ixv <= HIX) And (iyv >= LOY And iyv <= HIY) Then
               If MaskArray(ixv - LOX, iyv - LOY) <> 0 Then AddCirclesCALC ixv, iyv
            Else
               If (ixv >= 0 And ixv <= FullW - 1) And (iyv >= 0 And iyv <= FullH - 1) Then
                  AddCirclesCALC ixv, iyv
               End If
            End If
         Next zA
   Next zix
   DrawProgress
   Next ziy
   
End If

   frmExtras.picPB.Cls
End Sub
Private Sub AddCirclesCALC(ixv As Long, iyv As Long)
' Private RR As Byte, RG As Byte, RB As Byte
   picDATA(0, ixv, iyv) = BB
   picDATA(1, ixv, iyv) = GG
   picDATA(2, ixv, iyv) = RR
End Sub


Public Sub AddDiagNet(PDNET As Long)
' PDNET  1 -> 200
' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim n As Long
Dim zix As Single, ziy As Single
Dim sstep As Single
   
   picDATA() = picDATAORG()
   
   GetLorRColor

If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   n = 0
   ' / TL
   zix = HIX
   sstep = (CH / PDNET)
   If sstep = 0 Then sstep = 0.1
   For ziy = LOY To HIY Step sstep
      ' BresLine ix1,iy1,ix2,iy2,R,G,B,ND
      
      If aSelectAccepted Then
         BresLineCALC LOX, CLng(ziy), CLng(zix), HIY, RR, GG, BB
      Else
         BresLine LOX, CLng(ziy), CLng(zix), HIY, RR, GG, BB
      End If
      n = n + 1
      zix = HIX - n * (CW / PDNET)
   Next ziy
   ' / BR
   n = 0
   ziy = HIY
   For zix = LOX To HIX Step (CW / PDNET)
      If aSelectAccepted Then
         BresLineCALC CLng(zix), LOY, HIX, ziy, RR, GG, BB
      Else
         BresLine CLng(zix), LOY, HIX, ziy, RR, GG, BB
      End If
      n = n + 1
      ziy = HIY - n * (CH / PDNET)
   Next zix
   ' \ BL
   n = 0
   zix = LOX
   For ziy = LOY To HIY Step (CH / PDNET)
      If aSelectAccepted Then
         BresLineCALC LOX, CLng(ziy), CLng(zix), LOY, RR, GG, BB
      Else
         BresLine LOX, CLng(ziy), CLng(zix), LOY, RR, GG, BB
      End If
      n = n + 1
      zix = LOX + n * (CW / PDNET)
   Next ziy
   ' \ TR
   n = 0
   ziy = LOY
   StartProgress ((HIX - LOX) / (CW / PDNET)) ' ??
   For zix = LOX To HIX Step (CW / PDNET)
      If aSelectAccepted Then
         BresLineCALC CLng(zix), HIY, HIX, ziy, RR, GG, BB
      Else
         BresLine CLng(zix), HIY, HIX, ziy, RR, GG, BB
      End If
      n = n + 1
      ziy = LOY + n * (CH / PDNET)
   DrawProgress
   Next zix
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   n = 0
   ' / TL
   zix = FullW - 1
   sstep = (CH / PDNET)
   If sstep = 0 Then sstep = 0.1
   For ziy = 0 To FullH - 1 Step sstep
      BresLineCALC 0, CLng(ziy), CLng(zix), FullH - 1, RR, GG, BB
      n = n + 1
      zix = FullW - 1 - n * (CW / PDNET)
   Next ziy
   ' / BR
   n = 0
   ziy = FullH - 1
   For zix = 0 To FullW - 1 Step (CW / PDNET)
      BresLineCALC CLng(zix), 0, FullW - 1, ziy, RR, GG, BB
      n = n + 1
      ziy = FullH - 1 - n * (CH / PDNET)
   Next zix
   ' \ BL
   n = 0
   zix = 0
   For ziy = 0 To FullH - 1 Step (CH / PDNET)
      BresLineCALC 0, CLng(ziy), CLng(zix), 0, RR, GG, BB
      n = n + 1
      zix = 0 + n * (CW / PDNET)
   Next ziy
   ' \ TR
   n = 0
   ziy = 0
   StartProgress ((HIX - LOX) / (CW / PDNET)) ' ??
   For zix = 0 To FullW - 1 Step (CW / PDNET)
      BresLineCALC CLng(zix), FullH - 1, FullW - 1, ziy, RR, GG, BB
      n = n + 1
      ziy = 0 + n * (CH / PDNET)
   DrawProgress
   Next zix
   
End If
   
   frmExtras.picPB.Cls
End Sub


Public Sub AddEllipses(zPLENS As Single)
' zPLENS  0.5 -> 4
' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim zA As Single
Dim zD As Single
Dim ixv As Long
Dim iyv As Long
Dim zRM As Single
Dim zix As Single, ziy As Single
   
   picDATA() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   zD = Sqr(CW * CW + CH * CH)
   zRM = zD / (8 * zPLENS)
   
   StartProgress (HIY + zRM - LOY) / (zRM) ' ??
   For ziy = LOY To HIY + zRM Step zRM
   For zix = LOX To HIX + zRM Step 2 * zRM
      If aSelectAccepted Then
         For zA = 0 To 2 * pi# Step 0.01
            ixv = zix + zRM * Cos(zA)
            iyv = ziy + zRM * Sin(zA) / 2
            If (ixv >= LOX And ixv <= HIX) And (iyv >= LOY And iyv <= HIY) Then
               ixx = ixv - LOX
               iyy = iyv - LOY
               If MaskArray(ixx, iyy) = 0 Then AddEllipsesCALC ixv, iyv
            End If
         Next zA
      Else
         For zA = 0 To 2 * pi# Step 0.01
            ixv = zix + zRM * Cos(zA)
            iyv = ziy + zRM * Sin(zA) / 2
            If (ixv >= LOX And ixv <= HIX) And (iyv >= LOY And iyv <= HIY) Then
               AddEllipsesCALC ixv, iyv
            End If
         Next zA
      End If
   Next zix
   DrawProgress
   Next ziy
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   zD = Sqr(CW * CW + CH * CH)
   zRM = zD / (8 * zPLENS)
   
   StartProgress (HIY + zRM - LOY) / (zRM) ' ??
   
   For ziy = 0 To FullH - 1 + zRM Step zRM
   For zix = 0 To FullW - 1 + zRM Step 2 * zRM
      For zA = 0 To 2 * pi# Step 0.01
         ixv = zix + zRM * Cos(zA)
         iyv = ziy + zRM * Sin(zA) / 2
         If (ixv >= LOX And ixv <= HIX) And (iyv >= LOY And iyv <= HIY) Then
            If MaskArray(ixv - LOX, iyv - LOY) <> 0 Then AddEllipsesCALC ixv, iyv
         Else
            If (ixv >= 0 And ixv <= FullW - 1) And (iyv >= 0 And iyv <= FullH - 1) Then
               AddEllipsesCALC ixv, iyv
            End If
         End If
      Next zA
   Next zix
   DrawProgress
   Next ziy

End If

frmExtras.picPB.Cls
End Sub
Private Sub AddEllipsesCALC(ixv As Long, iyv As Long)
   picDATA(0, ixv, iyv) = BB
   picDATA(1, ixv, iyv) = GG
   picDATA(2, ixv, iyv) = RR
End Sub


Public Sub AddHBars(PLINES As Long)
' PLINES  1 -> 40
' Private CH As Long, CW As Long
Dim iiy As Long
Dim sstep As Single
   picDATA() = picDATAORG()
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   sstep = (CH / PLINES)
   If sstep < 1 Then sstep = 1
   
   NSteps = 10
   GetColorSteps
   
   StartProgress (HIY - LOY) / sstep
   For iy = LOY To HIY Step sstep
      For ix = LOX To HIX
         GetColorSteps
         If aSelectAccepted Then
            For iiy = iy To iy + 9
               If iiy <= HIY Then
                  If MaskArray(ix - LOX, iiy - LOY) = 0 Then AddHBarsCALC iiy, zBL, zGL, zRL
               End If
            Next iiy
         Else
            For iiy = iy To iy + 9
               If iiy <= HIY Then
                  AddHBarsCALC iiy, zBL, zGL, zRL
               End If
            Next iiy
         End If
      Next ix
      DrawProgress
   Next iy
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   sstep = (CH / PLINES)
   If sstep < 1 Then sstep = 1
   
   NSteps = 10
   GetColorSteps
   
   StartProgress (HIY - LOY) / sstep
   For iy = 0 To FullH - 1 Step sstep
      For ix = 0 To FullW - 1
         GetColorSteps
            For iiy = iy To iy + 9
               If iiy <= FullH - 1 Then
                  If (ix >= LOX And ix <= HIX) And (iiy >= LOY And iiy <= HIY) Then
                     If MaskArray(ix - LOX, iiy - LOY) <> 0 Then AddHBarsCALC iiy, zBL, zGL, zRL
                  Else
                     AddHBarsCALC iiy, zBL, zGL, zRL
                  End If
               End If
            Next iiy
      Next ix
      DrawProgress
   Next iy
   
End If

   frmExtras.picPB.Cls
End Sub
Private Sub AddHBarsCALC(iiy As Long, zBL As Single, zGL As Single, zRL As Single)
   picDATA(0, ix, iiy) = zBL
   picDATA(1, ix, iiy) = zGL
   picDATA(2, ix, iiy) = zRL
   GetNextColors
End Sub

Public Sub AddVBars(PLINES As Long)
' PLINES 1 -> 40
' Private CH As Long, CW As Long
Dim iix As Long
Dim sstep As Single
   picDATA() = picDATAORG()
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   sstep = (CW / PLINES)
   If sstep < 1 Then sstep = 1
   
   NSteps = 10
   GetColorSteps
   
   StartProgress (HIX - LOX) / sstep
   
   For ix = LOX To HIX Step sstep
      For iy = LOY To HIY
         GetColorSteps
         If aSelectAccepted Then
            For iix = ix To ix + 9
               If iix <= HIX Then
                  If MaskArray(iix - LOX, iy - LOY) = 0 Then AddVBarsCALC iix, zBL, zGL, zRL
               End If
            Next iix
         Else
            For iix = ix To ix + 9
               If iix <= HIX Then
                  AddVBarsCALC iix, zBL, zGL, zRL
               End If
            Next iix
         End If
      Next iy
      DrawProgress
   Next ix

Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   sstep = (CW / PLINES)
   If sstep < 1 Then sstep = 1
   
   NSteps = 10
   GetColorSteps
   
   StartProgress (HIX - LOX) / sstep
   For ix = 0 To FullW - 1 Step sstep
      For iy = 0 To FullH - 1
         GetColorSteps
            For iix = ix To ix + 9
               If iix <= FullW - 1 Then
                  If (iix >= LOX And iix <= HIX) And (iy >= LOY And iy <= HIY) Then
                     If MaskArray(iix - LOX, iy - LOY) <> 0 Then AddVBarsCALC iix, zBL, zGL, zRL
                  Else
                     AddVBarsCALC iix, zBL, zGL, zRL
                  End If
               End If
            Next iix
      Next iy
      DrawProgress
   Next ix

End If

   frmExtras.picPB.Cls
End Sub
Private Sub AddVBarsCALC(iix As Long, zBL As Single, zGL As Single, zRL As Single)
   picDATA(0, iix, iy) = zBL
   picDATA(1, iix, iy) = zGL
   picDATA(2, iix, iy) = zRL
   GetNextColors
End Sub
Public Sub AddHVBars(PLINES As Long)
' PLINES 1 -> 40
   ReDim picData2(0 To 3, 0 To FullW - 1, 0 To FullH - 1)
   picData2() = picDATAORG()
   AddHBars PLINES
   picDATAORG() = picDATA()
   AddVBars PLINES
   picDATAORG() = picData2()
End Sub

Public Sub PepperEm(PAR As Long)
' Par 1 to 4
' Private RR As Byte, GG As Byte, BB As Byte

Dim n As Long
   
   picDATA() = picDATAORG()
   ReDim picData2(0 To 3, 0 To FullW - 1, 0 To FullH - 1)
   picData2() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   StartProgress (PAR * HIY - 1)
   For n = 1 To PAR
      picData2() = picDATA()
      For iy = LOY To HIY
      For ix = LOX To HIX
         If aSelectAccepted Then
            If MaskArray(ix - LOX, iy - LOY) = 0 Then
               If (Rnd - 0.01) < 0 Then PepperEmCALC
            End If
         Else
            If (Rnd - 0.01) < 0 Then PepperEmCALC
         End If
      Next ix
      DrawProgress
      Next iy
      picDATA() = picData2()
      frmExtras.Refresh
  Next n
  picDATA() = picData2()
  
Else   ' aSelectAccepted and External
  
   StartProgress (PAR * HIY - 1)
   For n = 1 To PAR
      picData2() = picDATA()
      For iy = 0 To FullH - 1
      For ix = 0 To FullW - 1
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then
               If (Rnd - 0.01) < 0 Then PepperEmCALC
            End If
         Else
            If (Rnd - 0.01) < 0 Then PepperEmCALC
         End If
      Next ix
      DrawProgress
      Next iy
      picDATA() = picData2()
      frmExtras.Refresh
  Next n
  picDATA() = picData2()
  
End If

  frmExtras.picPB.Cls
End Sub

Private Sub PepperEmCALC()
   picData2(0, ix, iy) = BB
   picData2(1, ix, iy) = GG
   picData2(2, ix, iy) = RR
End Sub


Public Sub GradientAB(PSHADE As Long)
' PSHADE  -127 -> +127
   picDATA() = picDATAORG()
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   StartProgress (HIX)
   For ix = LOX To HIX
   For iy = LOY To HIY
      If aSelectAccepted Then
         If MaskArray(ix - LOX, iy - LOY) = 0 Then ShadeHCALC PSHADE
      Else
         ShadeHCALC PSHADE
      End If
   Next iy
   DrawProgress
   Next ix
Else   ' aSelectAccepted and External
   
   StartProgress (HIX)
   For ix = 0 To FullW - 1
   For iy = 0 To FullH - 1
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then ShadeHCALC PSHADE
         Else
            ShadeHCALC PSHADE
         End If
   Next iy
   DrawProgress
   Next ix
   
End If
   frmExtras.picPB.Cls
End Sub

Private Sub ShadeHCALC(zA As Long)   ' ZA -127 to 127
' Private ERED As Long, EGREEN As Long, EBLUE As Long
' Private ix As Long, iy As Long
Dim zB As Single
Dim Alpha As Single
Dim SR As Single, SG As Single, sb As Single
Dim dGrey As Single
Dim YInc As Single

   zB = 1 + (zA + 127) / 2 ' 1 - 128
   If zA < 0 Then
      YInc = (HIY - iy)
   Else ' ZA > = 0
      YInc = (iy - LOY)
      zB = Abs(zB - 127)   ' 126 - 1
   End If
   
   Alpha = zB + (255 / (HIY - LOY) * YInc)
   dGrey = (Alpha * (255 - Alpha)) / 255
   
   SR = picDATAORG(2, ix, iy)
   SR = (SR * Alpha) / 255
   ERED = SR + dGrey
   
   SG = picDATAORG(1, ix, iy)
   SG = (SG * Alpha) / 255
   EGREEN = SG + dGrey
   
   sb = picDATAORG(0, ix, iy)
   sb = (sb * Alpha) / 255
   EBLUE = sb + dGrey

   CheckSet ERED, EGREEN, EBLUE, ix, iy
   
End Sub

Public Sub GradientLR(PSHADE As Long)
' PSHADE -127 -> +127
Dim PS As Long
PS = -PSHADE
   picDATA() = picDATAORG()
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   StartProgress (HIY)
   For iy = LOY To HIY
   For ix = LOX To HIX
      If aSelectAccepted Then
         iyy = iy - LOY
         ixx = ix - LOX
         If MaskArray(ixx, iyy) = 0 Then ShadeVCALC PS
      Else
         ShadeVCALC PS
      End If
   Next ix
   DrawProgress
   Next iy
   
Else   ' aSelectAccepted and External
   
   StartProgress (HIY)
   For iy = 0 To FullH - 1
   For ix = 0 To FullW - 1
      If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
         If MaskArray(ix - LOX, iy - LOY) <> 0 Then ShadeVCALC PS
      Else
         ShadeVCALC PS
      End If
   Next ix
   DrawProgress
   Next iy
   
End If

   frmExtras.picPB.Cls
End Sub

Public Sub ShadeVCALC(zA As Long)   ' ZA -127 to +127
' Private ERED As Long, EGREEN As Long, EBLUE As Long
' Private ix As Long, iy As Long
Dim zB As Single
Dim Alpha As Single
Dim SR As Single, SG As Single, sb As Single
Dim dGrey As Single
Dim XInc As Single

   zB = 1 + (zA + 127) / 2
   If zA < 0 Then
      XInc = (HIX - ix)
   Else ' ZA > = 0
      XInc = (ix - LOX)
      zB = Abs(zB - 127)
   End If
   
   Alpha = zB + (255 / (HIX - LOX) * XInc)
   dGrey = (Alpha * (255 - Alpha)) / 255
   
   SR = picDATAORG(2, ix, iy)
   SR = (SR * Alpha) / 255
   ERED = SR + dGrey
   
   SG = picDATAORG(1, ix, iy)
   SG = (SG * Alpha) / 255
   EGREEN = SG + dGrey
   
   sb = picDATAORG(0, ix, iy)
   sb = (sb * Alpha) / 255
   EBLUE = sb + dGrey

   CheckSet ERED, EGREEN, EBLUE, ix, iy
      
End Sub

Public Sub GradientCross(PSHADE As Long)
' PSHADE  -70 -> -30
   
   picDATA() = picDATAORG()
   ' Shade Horz & Vert
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   StartProgress (HIX)
   For ix = LOX To HIX 'Step -1
   For iy = LOY To HIY  'Step -1
      If aSelectAccepted Then
         If MaskArray(ix - LOX, iy - LOY) = 0 Then ShadeHVCALC PSHADE
      Else
         ShadeHVCALC PSHADE
      End If
   Next iy
   DrawProgress
   Next ix
   
Else   ' aSelectAccepted and External
   
   StartProgress (HIX)
   For ix = 0 To FullW - 1
   For iy = 0 To FullH - 1
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then ShadeHVCALC PSHADE
         Else
            ShadeHVCALC PSHADE
         End If
   Next iy
   DrawProgress
   Next ix

End If

   frmExtras.picPB.Cls
End Sub


Private Sub ShadeHVCALC(zA As Long)
' Private ERED As Long, EGREEN As Long, EBLUE As Long
' Private ix As Long, iy As Long
Dim zB As Single
   EBLUE = picDATAORG(0, ix, iy)
   EGREEN = picDATAORG(1, ix, iy)
   ERED = picDATAORG(2, ix, iy)

   zB = 256 * Abs(1 - 2 * (ix - LOX) / (HIX - LOX + 1))
   'zB = 256 * Abs(2 * (ix - LOX) / (HIX - LOX + 1))
   EBLUE = zA * (zB + EBLUE) \ 256 + EBLUE
   EGREEN = zA * (zB + EGREEN) \ 256 + EGREEN
   ERED = zA * (zB + ERED) \ 256 + ERED
   
   zB = 256 * Abs(1 - 2 * (iy - LOY) / (HIY - LOY + 1))
   EBLUE = zA * (zB + EBLUE) \ 256 + EBLUE
   EGREEN = zA * (zB + EGREEN) \ 256 + EGREEN
   ERED = zA * (zB + ERED) \ 256 + ERED
   
   ERED = 1.5 * ERED
   EGREEN = 1.5 * EGREEN
   EBLUE = 1.5 * EBLUE
   CheckSet ERED, EGREEN, EBLUE, ix, iy
End Sub

Private Sub ShadeHVCALCXX(ByVal zA As Long)   ' ZA -127 to +127
' Private ERED As Long, EGREEN As Long, EBLUE As Long
' Private ix As Long, iy As Long
' Private CH As Long, CW As Long
Dim zB As Single
Dim Alpha As Single
Dim SR As Single, SG As Single, sb As Single
Dim dGrey As Single
Dim YInc As Single
Dim XInc As Single
Dim ERED1 As Long, EGREEN1 As Long, EBLUE1 As Long
Dim ERED2 As Long, EGREEN2 As Long, EBLUE2 As Long
Dim ERED3 As Long, EGREEN3 As Long, EBLUE3 As Long
Dim ERED4 As Long, EGREEN4 As Long, EBLUE4 As Long
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   ' Above Below
   zB = 1 + (zA + 127) / 2
   If zA < 0 Then
      YInc = (HIY - iy)
   Else ' ZA > = 0
      YInc = (iy - LOY)
      zB = Abs(zB - 127)
   End If

   Alpha = zB + (255 / (HIY - LOY) * YInc)
   dGrey = (Alpha * (255 - Alpha)) / 255

If ix < (LOX + CW / 2) And (iy < LOY + CH / 2) Then
   SR = picDATAORG(2, ix, iy)
   SR = (SR * Alpha) / 255
   ERED1 = SR + dGrey
   SG = picDATAORG(1, ix, iy)
   SG = (SG * Alpha) / 255
   EGREEN1 = SG + dGrey
   sb = picDATAORG(0, ix, iy)
   sb = (sb * Alpha) / 255
   EBLUE1 = sb + dGrey
   CheckSet ERED1, EGREEN1, EBLUE1, ix, iy
ElseIf (ix >= LOX + CW / 2) And (iy < LOY + CH / 2) Then
   SR = picDATAORG(2, ix, HIY - iy)
   SR = (SR * Alpha) / 255
   ERED2 = SR + dGrey
   SG = picDATAORG(1, ix, HIY - iy)
   SG = (SG * Alpha) / 255
   EGREEN2 = SG + dGrey
   sb = picDATAORG(0, ix, HIY - iy)
   sb = (sb * Alpha) / 255
   EBLUE2 = sb + dGrey
   CheckSet ERED2, EGREEN2, EBLUE2, ix, HIY - iy
End If
   
'   ' Left Right
   zB = 1 + (zA + 127) / 2
   If zA < 0 Then
      XInc = (HIX - ix)
   Else ' ZA > = 0
      XInc = (ix - LOX)
      zB = Abs(zB - 127)
   End If
   Alpha = zB + (255 / (HIX - LOX) * XInc)
   dGrey = (Alpha * (255 - Alpha)) / 255
If ix < (LOX + CW / 2) And (iy >= LOY + CH / 2) Then
   SR = picDATAORG(2, HIX - ix, iy)
   SR = (SR * Alpha) / 255
   ERED3 = SR + dGrey
   SG = picDATAORG(1, HIX - ix, iy)
   SG = (SG * Alpha) / 255
   EGREEN3 = SG + dGrey
   sb = picDATAORG(0, HIX - ix, iy)
   sb = (sb * Alpha) / 255
   EBLUE3 = sb + dGrey
   CheckSet ERED3, EGREEN3, EBLUE3, HIX - ix, iy

ElseIf (ix >= LOX + CW / 2) And (iy > LOY + CH / 2) Then
   SR = picDATAORG(2, HIX - ix, HIY - iy)
   SR = (SR * Alpha) / 255
   ERED4 = SR + dGrey
   SG = picDATAORG(1, HIX - ix, HIY - iy)
   SG = (SG * Alpha) / 255
   EGREEN4 = SG + dGrey
   sb = picDATAORG(0, HIX - ix, HIY - iy)
   sb = (sb * Alpha) / 255
   EBLUE4 = sb + dGrey
   CheckSet ERED4, EGREEN4, EBLUE4, HIX - ix, HIY - iy
End If

End Sub

Private Sub CheckSet(Red As Long, Green As Long, Blue As Long, iix As Long, iiy As Long)
   
   If Blue < 0 Then Blue = 0 Else If Blue > 255 Then Blue = 255
   If Green < 0 Then Green = 0 Else If Green > 255 Then Green = 255
   If Red < 0 Then Red = 0 Else If Red > 255 Then Red = 255
   picDATA(0, iix, iiy) = Blue
   picDATA(1, iix, iiy) = Green
   picDATA(2, iix, iiy) = Red

End Sub

Public Sub AddSpokes(PSPOKES As Long)
' PSPOKES 1 -> 400
' Private CH As Long, CW As Long
Dim zradi As Single
Dim zphi As Single
Dim xc As Single, yc As Single
Dim zRMax As Single
Dim ASP As Single
   
   picDATA() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   xc = CW / 2
   yc = CH / 2
   zRMax = Abs(CW - xc)
   If Abs(CH - yc) > Abs(CW - xc) Then
      zRMax = Abs(CH - yc)
   End If
   xc = LOX - 1 + CW / 2
   yc = LOY - 1 + CH / 2
   ASP = CW / CH
   If CW < CH Then ASP = CH \ CW
   StartProgress (zRMax)
   For zradi = 1 To 2 * zRMax
   For zphi = 0 To 360 Step 360 / (ASP * PSPOKES)
      ix = xc + zradi * Sin(zphi * d2r#)
      iy = yc + zradi * Cos(zphi * d2r#)
      If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
         If aSelectAccepted Then
            If MaskArray(ix - LOX, iy - LOY) = 0 Then SetRRGGBB
         Else
            SetRRGGBB
         End If
      End If
   Next zphi
   DrawProgress
   Next zradi
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   xc = CW / 2
   yc = CH / 2
   zRMax = Abs(CW - xc)
   If Abs(CH - yc) > Abs(CW - xc) Then
      zRMax = Abs(CH - yc)
   End If
   ASP = CW / CH
   If CW < CH Then ASP = CH \ CW
   StartProgress (zRMax)
   For zradi = 1 To 2 * zRMax
   For zphi = 0 To 360 Step 360 / (ASP * PSPOKES)
      ix = xc + zradi * Sin(zphi * d2r#)
      iy = yc + zradi * Cos(zphi * d2r#)
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then SetRRGGBB
         Else
            If (ix >= 0 And ix <= FullW - 1) And (iy >= 0 And iy <= FullH - 1) Then
               SetRRGGBB
            End If
         End If
   Next zphi
   DrawProgress
   Next zradi
   
End If

   frmExtras.picPB.Cls
End Sub

Public Sub AddThickLineH(zPTHICKLINE As Single)
' zPTHICKLINE  .0 -> 1.0
' Private CH As Long, CW As Long
Dim TY As Single
   picDATA() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   TY = zPTHICKLINE * CH
   If TY < 1 Then TY = 1
   
   StartProgress (LOY - 1 + CH / 2 + TY / 2)
   For iy = LOY - 1 + CH / 2 - TY / 2 To LOY - 1 + CH / 2 + TY / 2
   If (iy > LOY - 1) And (iy <= HIY) Then
      For ix = LOX To HIX
         If aSelectAccepted Then
            If MaskArray(ix - LOX, iy - LOY) = 0 Then SetRRGGBB
         Else
            SetRRGGBB
         End If
      Next ix
   End If
   DrawProgress
   Next iy
   
Else   ' aSelectAccepted and External

   CH = FullH - 1
   CW = FullW - 1
   
   TY = zPTHICKLINE * CH
   If TY < 1 Then TY = 1
   
   StartProgress (CH / 2 + TY / 2)
   
   For iy = 1 + CH / 2 - TY / 2 To CH / 2 + TY / 2
   If (iy >= 0) And (iy <= FullH - 1) Then
      For ix = 0 To FullW - 1
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then SetRRGGBB
         Else
            SetRRGGBB
         End If
      Next ix
   End If
   DrawProgress
   Next iy
   
End If

   frmExtras.picPB.Cls
End Sub

Private Sub SetRRGGBB()
   picDATA(0, ix, iy) = BB
   picDATA(1, ix, iy) = GG
   picDATA(2, ix, iy) = RR
End Sub

Public Sub AddThickLineV(zPTHICKLINE As Single)
' zPTHICKLINE  .0 -> 1.0
' Private CH As Long, CW As Long
Dim TX As Single
   picDATA() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   TX = zPTHICKLINE * CW
   If TX < 1 Then TX = 1
   StartProgress (LOX - 1 + CW / 2 + TX / 2)
   For ix = LOX - 1 + CW / 2 - TX / 2 To LOX - 1 + CW / 2 + TX / 2
   If (ix >= LOX) And (ix <= HIX) Then
      For iy = LOY To HIY
         If aSelectAccepted Then
            If MaskArray(ix - LOX, iy - LOY) = 0 Then SetRRGGBB
         Else
            SetRRGGBB
         End If
      Next iy
   End If
   DrawProgress
   Next ix

Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   TX = zPTHICKLINE * CW
   If TX < 1 Then TX = 1
   StartProgress (CW / 2 + TX / 2)
   For ix = CW / 2 - TX / 2 To CW / 2 + TX / 2
   If (ix >= 0) And (ix <= FullW - 1) Then
      For iy = 0 To FullH - 1
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then SetRRGGBB
         Else
            SetRRGGBB
         End If
      Next iy
   End If
   DrawProgress
   Next ix
   
End If

   frmExtras.picPB.Cls
End Sub

Public Sub ThickenLeftColor(PAR As Long)
' Par 1 - 5
' Private  RR As Byte, GG As Byte, BB As Byte
Dim n As Long
   LngToRGB LeftColor, RR, GG, BB
   
   picDATA() = picDATAORG()
   ReDim picData2(0 To 3, 0 To FullW - 1, 0 To FullH - 1)
   picData2() = picDATAORG()
 
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   StartProgress (HIX)
   For n = 1 To PAR
      picData2() = picDATA()
      ' (1,1)
      For iy = LOY + 1 To HIY - 1 Step 2
      For ix = LOX + 1 To HIX - 1 Step 2
         If aSelectAccepted Then
            If MaskArray(ix - LOX, iy - LOY) = 0 Then
               ThickenWholeImage2
            End If
         Else
            ThickenWholeImage2
         End If
      Next ix
      Next iy
      ' (2,1)
      For ix = LOX + 2 To HIX - 1 Step 2
      For iy = LOY + 1 To HIY - 1 Step 2
         If aSelectAccepted Then
            If MaskArray(ix - LOX, iy - LOY) = 0 Then
               ThickenWholeImage2
            End If
         Else
            ThickenWholeImage2
         End If
      Next iy
      Next ix
      ' (2,2)
      For iy = LOY + 2 To HIY - 1 Step 2
      For ix = LOX + 2 To HIX - 1 Step 2
         If aSelectAccepted Then
            If MaskArray(ix - LOX, iy - LOY) = 0 Then
               ThickenWholeImage2
            End If
         Else
            ThickenWholeImage2
         End If
      Next ix
      Next iy
      ' (1,2)
      For ix = LOX + 1 To HIX - 1 Step 2
      For iy = LOY + 2 To HIY - 1 Step 2
         If aSelectAccepted Then
            If MaskArray(ix - LOX, iy - LOY) = 0 Then
               ThickenWholeImage2
            End If
         Else
            ThickenWholeImage2
         End If
      Next iy
      DrawProgress
      Next ix
      picDATA() = picData2()
   Next n   ' Next PAR
   picDATA() = picData2()
   
Else   ' aSelectAccepted and External
   
   StartProgress (HIX)
   For n = 1 To PAR
      picData2() = picDATA()
      ' (1,1)
      For iy = 1 To FullH - 2 Step 2
      For ix = 1 To FullW - 2 Step 2
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then
               ThickenWholeImage2
            End If
         Else
            ThickenWholeImage3
         End If
      Next ix
      Next iy
      ' (2,1)
      For ix = 2 To FullW - 2 Step 2
      For iy = 1 To FullH - 2 Step 2
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then ThickenWholeImage2
         Else
            ThickenWholeImage3
         End If
      Next iy
      Next ix
      ' (2,2)
      For iy = 2 To FullH - 2 Step 2
      For ix = 2 To FullW - 2 Step 2
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then ThickenWholeImage2
         Else
            ThickenWholeImage3
         End If
      Next ix
      Next iy
      ' (1,2)
      For ix = 1 To FullW - 2 Step 2
      For iy = 2 To FullH - 2 Step 2
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then ThickenWholeImage2
         Else
            ThickenWholeImage3
         End If
      Next iy
      DrawProgress
      Next ix
      picDATA() = picData2()
   Next n   ' Next PAR
   picDATA() = picData2()

End If

   frmExtras.picPB.Cls
End Sub

Public Sub ThickenWholeImage2()
' picData2() <- picDATA()
' Private ix as Long, iy As Long
   If picDATA(0, ix, iy) = BB And _
      picDATA(1, ix, iy) = GG And _
      picDATA(2, ix, iy) = RR Then
      
      picData2(0, ix, iy) = picDATA(0, ix, iy)
      picData2(1, ix, iy) = picDATA(1, ix, iy)
      picData2(2, ix, iy) = picDATA(2, ix, iy)
      
      If ix - 1 >= LOX Then
         picData2(0, ix - 1, iy) = picDATA(0, ix, iy)
         picData2(1, ix - 1, iy) = picDATA(1, ix, iy)
         picData2(2, ix - 1, iy) = picDATA(2, ix, iy)
      End If
      If ix + 1 <= HIX Then
         picData2(0, ix + 1, iy) = picDATA(0, ix, iy)
         picData2(1, ix + 1, iy) = picDATA(1, ix, iy)
         picData2(2, ix + 1, iy) = picDATA(2, ix, iy)
      End If
      If iy + 1 <= HIY Then
         picData2(0, ix, iy + 1) = picDATA(0, ix, iy)
         picData2(1, ix, iy + 1) = picDATA(1, ix, iy)
         picData2(2, ix, iy + 1) = picDATA(2, ix, iy)
      End If
      If iy - 1 >= LOY Then
         picData2(0, ix, iy - 1) = picDATA(0, ix, iy)
         picData2(1, ix, iy - 1) = picDATA(1, ix, iy)
         picData2(2, ix, iy - 1) = picDATA(2, ix, iy)
      End If
   End If
End Sub

Public Sub ThickenWholeImage3()
' picData2() <- picDATA()
' Private ix as Long, iy As Long
   If picDATA(0, ix, iy) = BB And _
      picDATA(1, ix, iy) = GG And _
      picDATA(2, ix, iy) = RR Then
      
      picData2(0, ix, iy) = picDATA(0, ix, iy)
      picData2(1, ix, iy) = picDATA(1, ix, iy)
      picData2(2, ix, iy) = picDATA(2, ix, iy)
      
      If ix - 1 >= 0 Then
         picData2(0, ix - 1, iy) = picDATA(0, ix, iy)
         picData2(1, ix - 1, iy) = picDATA(1, ix, iy)
         picData2(2, ix - 1, iy) = picDATA(2, ix, iy)
      End If
      If ix + 1 <= FullW Then
         picData2(0, ix + 1, iy) = picDATA(0, ix, iy)
         picData2(1, ix + 1, iy) = picDATA(1, ix, iy)
         picData2(2, ix + 1, iy) = picDATA(2, ix, iy)
      End If
      If iy + 1 <= FullH Then
         picData2(0, ix, iy + 1) = picDATA(0, ix, iy)
         picData2(1, ix, iy + 1) = picDATA(1, ix, iy)
         picData2(2, ix, iy + 1) = picDATA(2, ix, iy)
      End If
      If iy - 1 >= 0 Then
         picData2(0, ix, iy - 1) = picDATA(0, ix, iy)
         picData2(1, ix, iy - 1) = picDATA(1, ix, iy)
         picData2(2, ix, iy - 1) = picDATA(2, ix, iy)
      End If
   End If
End Sub



Public Sub AddLinesH(PLINES As Long) 'Public Sub AddThickLineHV(zPTHICKLINE As Single)
'' zPTHICKLINE  .0 -> 1.0
'   ReDim picData2(0 To 3, 0 To FullW - 1, 0 To FullH - 1)
'   picData2() = picDATAORG()
'   AddThickLineH zPTHICKLINE
'   picDATAORG() = picDATA()
'   AddThickLineV zPTHICKLINE
'   picDATAORG() = picData2()
'End Sub

' PLINES 1 - 400
' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim sstep As Single
   
   picDATA() = picDATAORG()
   
   GetLorRColor

If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   sstep = (CH / PLINES)
   If sstep < 1 Then sstep = 1
   
   StartProgress (HIY / sstep)
   
   For iy = LOY To HIY Step sstep
      For ix = LOX To HIX
         If aSelectAccepted Then
            If MaskArray(ix - LOX, iy - LOY) = 0 Then SetRRGGBB
         Else
            SetRRGGBB
         End If
      Next ix
      DrawProgress
   Next iy
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   sstep = (CH / PLINES)
   If sstep < 1 Then sstep = 1
   
   StartProgress (HIY / sstep)
   
   For iy = 0 To FullH - 1 Step sstep
      For ix = 0 To FullW - 1
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then SetRRGGBB
         Else
            SetRRGGBB
         End If
      Next ix
      DrawProgress
   Next iy
   
End If

   frmExtras.picPB.Cls
End Sub

Public Sub AddLinesV(PLINES As Long)
' PLINES 1 - 400
' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim sstep As Single
   picDATA() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   sstep = (CH / PLINES)
   If sstep < 1 Then sstep = 1
   
   StartProgress (HIX / sstep)
   
   For ix = LOX To HIX Step sstep
   For iy = LOY To HIY
         If aSelectAccepted Then
            If MaskArray(ix - LOX, iy - LOY) = 0 Then SetRRGGBB
         Else
            SetRRGGBB
         End If
   Next iy
   DrawProgress
   Next ix

Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   sstep = (CH / PLINES)
   If sstep < 1 Then sstep = 1
   
   StartProgress (HIX / sstep)
   
   For ix = 0 To FullW - 1 Step sstep
   For iy = 0 To FullH - 1
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If MaskArray(ix - LOX, iy - LOY) <> 0 Then SetRRGGBB
         Else
            SetRRGGBB
         End If
   Next iy
   DrawProgress
   Next ix
   
End If

frmExtras.picPB.Cls
End Sub

Public Sub AddNet(PLINES As Long)
' PLINES 1 - 400
' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim sstep As Single
   
   picDATA() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   sstep = (CH / PLINES)
   If sstep < 1 Then sstep = 1
   For iy = LOY To HIY Step sstep
   For ix = LOX To HIX
      If aSelectAccepted Then
         If MaskArray(ix - LOX, iy - LOY) = 0 Then SetRRGGBB
      Else
         SetRRGGBB
      End If
   Next ix
   Next iy
   sstep = (CH / PLINES)
   If sstep < 1 Then sstep = 1
   StartProgress (HIX / sstep)
   For ix = LOX To HIX Step sstep
   For iy = LOY To HIY
      If aSelectAccepted Then
         If MaskArray(ix - LOX, iy - LOY) = 0 Then SetRRGGBB
      Else
         SetRRGGBB
      End If
   Next iy
   DrawProgress
   Next ix
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   sstep = (CH / PLINES)
   If sstep < 1 Then sstep = 1
   For iy = 0 To FullH - 1 Step sstep
   For ix = 0 To FullW - 1
      If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
         If MaskArray(ix - LOX, iy - LOY) <> 0 Then SetRRGGBB
      Else
         SetRRGGBB
      End If
   Next ix
   Next iy
   
   sstep = (CH / PLINES)
   If sstep < 1 Then sstep = 1
   StartProgress (HIX / sstep)
   For ix = 0 To FullW - 1 Step sstep
   For iy = 0 To FullH - 1
      If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
         If MaskArray(ix - LOX, iy - LOY) <> 0 Then SetRRGGBB
      Else
         SetRRGGBB
      End If
   Next iy
   DrawProgress
   Next ix
   
End If

   frmExtras.picPB.Cls
End Sub

Public Sub AddHexagons(zPRAD As Single)
' Zrad .5 to 4.0
' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim zA As Single
Dim zD As Single
Dim ixv As Long
Dim iyv As Long
Dim pixv As Long
Dim piyv As Long
Dim zRM As Single
Dim zix As Single, ziy As Single
   
   picDATA() = picDATAORG()
   
   GetLorRColor

If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   zD = Sqr(CW * CW + CH * CH)
   zRM = zD / (16 * zPRAD)
   StartProgress ((HIY + zRM - LOY) / (2 * zRM))
   For ziy = LOY To HIY + zRM Step Sqr(3) * zRM
   For zix = LOX To HIX + zRM Step 2 * zRM
         pixv = zix + zRM
         piyv = ziy
         For zA = 0 To 2 * pi# Step pi# / 3
            ixv = zix + zRM * Cos(zA)
            iyv = ziy + zRM * Sin(zA)
            If aSelectAccepted Then
               BresLineCALC pixv, piyv, ixv, iyv, RR, GG, BB
            Else
               BresLine pixv, piyv, ixv, iyv, RR, GG, BB
            End If
            pixv = ixv
            piyv = iyv
         Next zA
   Next zix
   DrawProgress
   Next ziy
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   zD = Sqr(CW * CW + CH * CH)
   zRM = zD / (16 * zPRAD)
   
   StartProgress ((HIY + zRM) / (2 * zRM))
   
   For ziy = 0 To FullH - 1 + zRM Step Sqr(3) * zRM
   For zix = 0 To FullW - 1 + zRM Step 2 * zRM
         pixv = zix + zRM
         piyv = ziy
         For zA = 0 To 2 * pi# Step pi# / 3
            ixv = zix + zRM * Cos(zA)
            iyv = ziy + zRM * Sin(zA)
               BresLineCALC pixv, piyv, ixv, iyv, RR, GG, BB
            pixv = ixv
            piyv = iyv
         Next zA
   Next zix
   DrawProgress
   Next ziy
   
End If

   frmExtras.picPB.Cls
End Sub

Public Sub AddSquares(zPRAD As Single)
' zPar 0.5 to 15
' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim zD As Single
Dim zRM As Single
Dim n As Long
   picDATA() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   zD = Sqr(CW * CW + CH * CH)
   zRM = zD / (16 * zPRAD)
   StartProgress ((HIY + zRM - LOY) / (2 * zRM))
   n = 0
   For iy = LOY To HIY + zRM Step zRM + 4
   For ix = LOX To HIX + zRM Step zRM + 4
      If aSelectAccepted Then
         BresLineCALC ix, iy, ix + zRM, iy, RR, GG, BB
         BresLineCALC ix, iy, ix, iy + zRM, RR, GG, BB
         BresLineCALC ix + zRM, iy + zRM, ix + zRM, iy, RR, GG, BB
         BresLineCALC ix + zRM, iy + zRM, ix, iy + zRM, RR, GG, BB
      Else
         BresLine ix, iy, ix + zRM, iy, RR, GG, BB
         BresLine ix, iy, ix, iy + zRM, RR, GG, BB
         BresLine ix + zRM, iy + zRM, ix + zRM, iy, RR, GG, BB
         BresLine ix + zRM, iy + zRM, ix, iy + zRM, RR, GG, BB
      End If
   Next ix
   DrawProgress
   Next iy
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   zD = Sqr(CW * CW + CH * CH)
   zRM = zD / (16 * zPRAD)
   StartProgress ((HIY + zRM - LOY) / (2 * zRM))
   n = 0
   For iy = 0 To FullH - 1 + zRM Step zRM + 4
   For ix = 0 To FullW - 1 + zRM Step zRM + 4
         BresLineCALC ix, iy, ix + zRM, iy, RR, GG, BB
         BresLineCALC ix, iy, ix, iy + zRM, RR, GG, BB
         BresLineCALC ix + zRM, iy + zRM, ix + zRM, iy, RR, GG, BB
         BresLineCALC ix + zRM, iy + zRM, ix, iy + zRM, RR, GG, BB
   Next ix
   DrawProgress
   Next iy
   
End If
   frmExtras.picPB.Cls
End Sub

Public Sub AddTriangles(zPRAD As Single)
' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim zD As Single
Dim zRM As Single
Dim n As Long
   picDATA() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   zD = Sqr(CW * CW + CH * CH)
   zRM = zD / (16 * zPRAD)
   StartProgress ((HIY + zRM - LOY) / (2 * zRM))
   n = 0
   For iy = LOY To HIY + zRM Step zRM + 4
   For ix = LOX To HIX + zRM Step zRM + 4
      If aSelectAccepted Then
         BresLineCALC ix, iy, ix + zRM, iy, RR, GG, BB
         BresLineCALC ix + zRM, iy, ix + zRM \ 2, iy + zRM, RR, GG, BB
         BresLineCALC ix + zRM \ 2, iy + zRM, ix, iy, RR, GG, BB
      Else
         BresLine ix, iy, ix + zRM, iy, RR, GG, BB
         BresLine ix + zRM, iy, ix + zRM \ 2, iy + zRM, RR, GG, BB
         BresLine ix + zRM \ 2, iy + zRM, ix, iy, RR, GG, BB
      End If
   Next ix
   DrawProgress
   Next iy
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   zD = Sqr(CW * CW + CH * CH)
   zRM = zD / (16 * zPRAD)
   StartProgress ((HIY + zRM - LOY) / (2 * zRM))
   n = 0
   For iy = 0 To FullH - 1 + zRM Step zRM + 4
   For ix = 0 To FullW - 1 + zRM Step zRM + 4
         BresLineCALC ix, iy, ix + zRM, iy, RR, GG, BB
         BresLineCALC ix + zRM, iy, ix + zRM \ 2, iy + zRM, RR, GG, BB
         BresLineCALC ix + zRM \ 2, iy + zRM, ix, iy, RR, GG, BB
   Next ix
   DrawProgress
   Next iy
   
End If

   frmExtras.picPB.Cls
End Sub

Public Sub AddHWaves(PLINES As Long)
' PLINES  0 -> 30
' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim jj As Long, zix As Single
Dim zA As Single
Dim zziy As Single
   picDATA() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   zA = (10 + PLINES) / 2
   StartProgress (HIY / (CH / (PLINES + 1)))
   For zziy = LOY To HIY Step CH / (PLINES + 1)
      For zix = LOX To HIX + zA Step 1 / zA
         If zix > LOX - 1 Then
         If zix <= HIX Then
            jj = zziy + zA * Sin(zix * 2 * zA / CW)
            If jj > LOY - 1 Then
            If jj <= HIY Then
               If aSelectAccepted Then
                  If MaskArray(zix - LOX, jj - LOY) = 0 Then AddHWavesCALC zix, jj
               Else
                  AddHWavesCALC zix, jj
               End If
            End If
            End If
         End If
         End If
      Next zix
      DrawProgress
   Next zziy
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   zA = (10 + PLINES) / 2
   StartProgress (HIY / (CH / (PLINES + 1)))
   For zziy = 0 To FullH - 1 Step CH / (PLINES + 1)
      For zix = 0 To FullW - 1 + zA Step 1 / zA
         If (zix >= 0) And (zix <= FullW - 1) Then
            
            jj = zziy + zA * Sin(zix * 2 * zA / CW)
            If (jj >= LOY And jj <= HIY) And (zix >= LOX And zix <= HIX) Then
               If MaskArray(zix - LOX, jj - LOY) <> 0 Then AddHWavesCALC zix, jj
            Else
               If (jj >= 0) And (jj <= FullH - 1) Then AddHWavesCALC zix, jj
            End If
         
         End If
      Next zix
      DrawProgress
   Next zziy

End If
   frmExtras.picPB.Cls
End Sub
Private Sub AddHWavesCALC(zix As Single, jj As Long)
   picDATA(0, zix, jj) = BB
   picDATA(1, zix, jj) = GG
   picDATA(2, zix, jj) = RR
End Sub

Public Sub AddVWaves(PLINES As Long)
' PLINES  0 -> 30
' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim ii As Long, ziy As Single
Dim zA As Single
Dim zzix As Single
   picDATA() = picDATAORG()
   
   GetLorRColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   
   CH = HIY - LOY
   CW = HIX - LOX
   
   zA = (10 + PLINES) / 2
   StartProgress (HIX / (CW / (PLINES + 1)))
   For zzix = LOX To HIX Step CW / (PLINES + 1)
      For ziy = LOY To HIY + 2 * zA Step 1 / zA
         If (ziy >= LOY) And (ziy <= HIY) Then
            ii = zzix + zA * Sin(ziy * 2 * zA / CH)
            If (ii >= LOX) And (ii <= HIX) Then
               If aSelectAccepted Then
                  If MaskArray(ii - LOX, ziy - LOY) = 0 Then AddVWavesCALC ii, ziy
               Else
                  AddVWavesCALC ii, ziy
               End If
            End If
         End If
      Next ziy
   DrawProgress
   Next zzix
   
Else   ' aSelectAccepted and External
   
   CH = FullH - 1
   CW = FullW - 1
   
   zA = (10 + PLINES) / 2
   StartProgress (HIX / (CW / (PLINES + 1)))
   For zzix = 0 To FullW - 1 Step CW / (PLINES + 1)
      For ziy = 0 To (FullH - 1) + 2 * zA Step 1 / zA
         If (ziy >= 0) And (ziy <= FullH - 1) Then
            ii = zzix + zA * Sin(ziy * 2 * zA / CH)
            If (ziy >= LOY And ziy <= HIY) And (ii >= LOX And ii <= HIX) Then
               If MaskArray(ii - LOX, ziy - LOY) <> 0 Then AddVWavesCALC ii, ziy
            Else
               If (ii >= 0) And (ii <= FullW - 1) Then AddVWavesCALC ii, ziy
            End If
         End If
      Next ziy
   DrawProgress
   Next zzix
   
End If

   frmExtras.picPB.Cls
End Sub
Private Sub AddVWavesCALC(ii As Long, ziy As Single)
   picDATA(0, ii, ziy) = BB
   picDATA(1, ii, ziy) = GG
   picDATA(2, ii, ziy) = RR
End Sub

Public Sub AddHVWaves(PLINES As Long)
' PLINES  0 -> 30
   ReDim picData2(0 To 3, 0 To FullW - 1, 0 To FullH - 1)
   picData2() = picDATAORG()
   AddHWaves PLINES
   picDATAORG() = picDATA()
   AddVWaves PLINES
   picDATAORG() = picData2()
End Sub

Public Sub Streaks(PAR As Long)
' Streaks
' Par 1 - 15
' Private RR As Byte, GG As Byte, BB As Byte
' Private CH As Long, CW As Long
Dim i As Long, j As Long
   picDATA() = picDATAORG()
   
   HLXY
   
   StartProgress (HIY / (10 * (16 - PAR)))
   For iy = LowerY To HigherY Step (10 * (16 - PAR))
   For ix = LowerX To HigherX Step (10 * (16 - PAR))
      i = ix * Rnd
      j = iy * Abs(Rnd)
      BB = picDATAORG(0, i, j)
      GG = picDATAORG(1, i, j)
      RR = picDATAORG(2, i, j)
      If aSelectAccepted Then
         BresLineCALC ix, iy, i, HigherY - j - 1, RR, GG, RR
      Else
         BresLine ix, iy, i, HigherY - j - 1, RR, GG, RR
      End If
   Next ix
   DrawProgress
   Next iy
   
   
   frmExtras.picPB.Cls
End Sub

Public Sub AddJigSaw(ByVal PAR As Single)
' PAR = 2 to scrMax
' GRID
'                                 FullW
'                              Columns   -> X
'      kx(0,0),ky(0,0)  kx(2,0),ky(2,0)        kx(ncols,0),ky(ncols,0)
'             ---------------------------------------------
'             |       |        |        |        |        |
'             |       |        |        |        |        |
'             |       |        |        |        |        |
'           (0,1)---(1,1)----(2,1)----(3,1)----(4,1)(ncols,0)
'             |       |        |        |        |        |
'             |       |        |        |        |        |
'             |       |        |        |        |        |
'             ---------------(2,2)-------------------------
'   Rows      |       |        |        |        |        |
'    FullH        |       |        |        |        |        |
'             |       |        |        |        |        |
'    |        ------------------------(3,3)----------------
'    Y        |       |        |        |        |        |
'             |       |        |        |        |        |
'             |       |        |        |        |        |
'           (0,4)---(1,4)----------------------(4,4)(ncols,4)
'             |       |        |        |        |        |
'             |       |        |        |        |        |
'             |       |        |        |        |        |
'             ---------------------------------------------
'  kx(0,nrows),ky(0,nrows)                 kx(ncols,nrows),ky(ncols,nrows)

' Private RR As Byte, RG As Byte, RB As Byte
' Private CH As Long, CW As Long
Dim k As Long
Dim j As Long
Dim ranmul As Long
Dim neww As Single, newh As Single
Dim xofft As Long, xoffb As Long
Dim yoffl As Long, yoffr As Long
Dim px As Long, py As Long
Dim swap As Single
Dim yoff As Single
   
   Tension = 0.5
   
   picDATA() = picDATAORG()
   
   GetLorRColor
   
   HLXY

   CH = HigherY - LowerY
   CW = HigherX - LowerX
   
   ' 9 pt side lines
   Randomize
   yoff = 0.4 + Rnd / 3
   XLine(0) = 0: YLine(0) = 0
   XLine(1) = 8: YLine(1) = 2 * yoff
   XLine(2) = 15: YLine(2) = 1 * yoff
   XLine(3) = 16: YLine(3) = 0 * yoff
   
   Randomize
   yoff = 0.4 + Rnd / 3
   XLine2(0) = 0: YLine2(0) = 0
   XLine2(1) = 1: YLine2(1) = 1 * yoff
   XLine2(2) = 6: YLine2(2) = 2 * yoff
   XLine2(3) = 13: YLine2(3) = 0 * yoff
   XLine2(4) = 16: YLine2(4) = 0 * yoff

   If CH < CW Then
      nrows = PAR
      If PAR <= 4 Then  ' Make equal for small rows & columns
         ncols = nrows
      Else
         ncols = (HigherX - LowerX) \ 60
      End If
   Else
      ncols = PAR
      If PAR <= 4 Then
         nrows = ncols
      Else
         nrows = (HigherY - LowerY) \ 60
      End If
   End If
   
   If ncols < 2 Then ncols = 2
   If nrows < 2 Then nrows = 2
   neww = CW / ncols
   newh = CH / nrows
   If ncols < 2 Then
      ncols = 2
      neww = CW / ncols
   End If
   If nrows < 2 Then
      nrows = 2
      newh = CH / nrows
   End If
   
   
   ReDim kx(0 To ncols, 0 To nrows)
   ReDim ky(0 To ncols, 0 To nrows)
   
   Randomize
   ' Fill edge coords
   For k = 0 To nrows
      kx(0, k) = LowerX
      kx(ncols, k) = HigherX - 1
   Next k
   For k = 0 To ncols
      ky(k, 0) = LowerY
      ky(k, nrows) = HigherY - 1
   Next k
   ' Set vertical lines
   ranmul = 19 + 2 * (Rnd - 0.5)
   If ncols = 2 Then ranmul = 0
   For k = 1 To ncols - 1
      xofft = ranmul * Rnd
      xoffb = ranmul * Rnd
      kx(k, 0) = LowerX + k * neww + xofft
      kx(k, nrows) = LowerX + k * neww + xoffb
   Next k
   ' Set horizontal lines
   ranmul = 19 + 2 * (Rnd - 0.5)
   If nrows = 2 Then ranmul = 0
   For k = 1 To nrows - 1
      yoffl = ranmul * Rnd
      yoffr = ranmul * Rnd
      ky(0, k) = LowerY + k * newh + yoffl
      ky(ncols, k) = LowerY + k * newh + yoffr
   Next k
   ' Find intersections
   ReDim MX(1 To ncols - 1)
   ReDim cx(1 To ncols - 1)
   ReDim MY(1 To nrows - 1)
   ReDim cy(1 To nrows - 1)
   
   ' x vert lines  slopes & cuts
   For k = 1 To ncols - 1
      MX(k) = kx(k, nrows) - kx(k, 0)
      If MX(k) <> 0 Then
         MX(k) = (ky(k, nrows) - ky(k, 0)) / MX(k)
      Else
         MX(k) = 1000
      End If
      cx(k) = ky(k, 0) - MX(k) * kx(k, 0)
   Next k
   ' y horz lines  slopes & cuts
   For k = 1 To nrows - 1
      MY(k) = kx(ncols, k) - kx(0, k)
      If MY(k) <> 0 Then
         MY(k) = (ky(ncols, k) - ky(0, k)) / MY(k)
      Else
         MY(k) = 1000
      End If
      cy(k) = ky(0, k) - MY(k) * kx(0, k)
   Next k
   ' Calc intersections
   For j = 1 To nrows - 1
   For k = 1 To ncols - 1
      kx(k, j) = (cy(j) - cx(k)) / (MX(k) - MY(j))
      ky(k, j) = MY(j) * kx(k, j) + cy(j)
   Next k
   Next j
   
   ' Draw all vertical sides
   StartProgress (nrows)
   For j = 1 To nrows '- 1
   For k = 1 To ncols - 1
      xs = kx(k, j - 1)
      ys = ky(k, j - 1)
      px = kx(k, j)
      py = ky(k, j)
      ' Lugs randomly to left/right
      swap = Rnd - 0.5
      If swap < 0 Then
         swap = xs
         xs = px
         px = swap
         swap = ys
         ys = py
         py = swap
      End If
      DrawSide xs, ys, px, py, RR, GG, BB
   Next k
   DrawProgress
   Next j
   ' Draw all horizontal sides
   StartProgress (nrows)
   For j = 1 To nrows - 1
   For k = 1 To ncols
      xs = kx(k - 1, j)
      ys = ky(k - 1, j)
      px = kx(k, j)
      py = ky(k, j)
      ' Lugs randomly to up/down
      swap = Rnd - 0.5
      If swap < 0 Then
      swap = xs
      xs = px
      px = swap
      swap = ys
      ys = py
      py = swap
      End If
      DrawSide xs, ys, px, py, RR, GG, BB
   Next k
   DrawProgress
   Next j
   
   ' Box inside
   If aSelectAccepted Then
      BresLineCALC LowerX + 1, LowerY, LowerX + 1, HigherY, RR, GG, BB      ' Left
      BresLineCALC HigherX - 1, HigherY, HigherX - 1, LowerY, RR, GG, BB      ' Right
      BresLineCALC LowerX + 1, LowerY + 1, HigherX, LowerY + 1, RR, GG, BB  ' Bottom
      BresLineCALC HigherX, HigherY - 1, LowerX + 1, HigherY - 1, RR, GG, BB  ' Top
   Else
      BresLine LowerX + 1, LowerY, LowerX + 1, HigherY, RR, GG, BB      ' Left
      BresLine HigherX - 1, HigherY, HigherX - 1, LowerY, RR, GG, BB      ' Right
      BresLine LowerX + 1, LowerY + 1, HigherX, LowerY + 1, RR, GG, BB  ' Bottom
      BresLine HigherX, HigherY - 1, LowerX + 1, HigherY - 1, RR, GG, BB  ' Top
   End If

   
   frmExtras.picPB.Cls
End Sub

Private Sub DrawSide(ByVal xs As Long, ByVal ys As Long, ByVal xp As Long, ByVal yp As Long, _
                     RR As Byte, GG As Byte, BB As Byte)
Dim LineLen As Single
Dim LLug As Single
Dim x1 As Single, y1 As Single
Dim x2 As Single, y2 As Single
Dim xc As Single, yc As Single
      dx = xp - xs
      DY = yp - ys
      zAng = zATan2(DY, dx)
      LineLen = Sqr(dx * dx + DY * DY)
      Mul = LineLen / 100 '80      ' arbitrary
      'If Mul > 1 Then Mul = 1
      If Mul > 0.75 Then Mul = 0.75
      LLug = 11 * Mul         ' half lug along line
      dx = LLug * Cos(zAng)   ' offsets to beginning & end of lug on line
      DY = LLug * Sin(zAng)
      xc = (xp + xs) / 2  ' Centre of line
      yc = (yp + ys) / 2
      x1 = xc - dx        ' pts where lug joins line
      y1 = yc - DY
      x2 = xc + dx
      y2 = yc + DY
      ' NB Draws lug to left of line direction
      DrawLug x1, y1, zAng, Mul, RR, GG, BB
      LineLen = Sqr((xs - x1) ^ 2 + (ys - y1) ^ 2)
      Mul = LineLen / 16 ' arbitrary
      DrawLine1 xs, ys, zAng, Mul, RR, GG, BB
      LineLen = Sqr((xp - x2) ^ 2 + (yp - y2) ^ 2)
      Mul = LineLen / 16 ' arbitrary
      DrawLine2 x2, y2, zAng, Mul, RR, GG, BB
End Sub

Private Sub DrawLug(ByVal x As Single, ByVal y As Single, zangle As Single, Mul As Single, _
          RR As Byte, GG As Byte, BB As Byte)
' Private XJ() As Single, YJ() As Single  ' Offset lug pattern
' zAngle in radians
Dim pts(0 To 9) As PointF
Dim zcos As Single, zsin As Single
Dim k As Long
   zcos = Cos(zangle)
   zsin = Sin(zangle)
   pts(0).x = x - 1
   pts(0).y = y - 1
   ' Rotate lug into line & Draw
   For k = 1 To 9
      pts(k).x = pts(k - 1).x + (Mul * XJ(k)) * zcos - (Mul * YJ(k)) * zsin
      pts(k).y = pts(k - 1).y + (Mul * YJ(k)) * zcos + (Mul * XJ(k)) * zsin
   Next k
   ModSpline.DrawCurve 0.01, Tension, pts, RR, GG, BB
   
   ' TEST
   ' Lug center
'   xlc = xr(0) + (Mul * XLugCen) * zcos - (Mul * YLugCen) * zsin
'   ylc = yr(0) + (Mul * YLugCen) * zcos + (Mul * XLugCen) * zsin
'   picDRAW.PSet (xlc, ylc), vbBlue
'
'   LRad = Mul * LugRadius
'   picDRAW.Line (xlc, ylc)-(xr(7), yr(7)), vbBlue  ' From centre to edge of lug
End Sub


Private Sub DrawLine1(ByVal x As Single, ByVal y As Single, zangle As Single, Mul As Single, _
          RR As Byte, GG As Byte, BB As Byte)
Dim pts(0 To 3) As PointF
Dim zcos As Single, zsin As Single
Dim k As Long
   zcos = Cos(zangle)
   zsin = Sin(zangle)
   pts(0).x = x - 1
   pts(0).y = y - 1
   ' Rotate Line Draw
   For k = 1 To 3
      pts(k).x = pts(0).x + (Mul * XLine(k)) * zcos - (Mul * YLine(k)) * zsin
      pts(k).y = pts(0).y + (Mul * YLine(k)) * zcos + (Mul * XLine(k)) * zsin
   Next k
   ModSpline.DrawCurve 0.01, Tension, pts, RR, GG, BB
End Sub

Private Sub DrawLine2(ByVal x As Single, ByVal y As Single, zangle As Single, Mul As Single, _
          RR As Byte, GG As Byte, BB As Byte)
Dim pts(0 To 4) As PointF
Dim zcos As Single, zsin As Single
Dim k As Long
   zcos = Cos(zangle)
   zsin = Sin(zangle)
   pts(0).x = x - 1
   pts(0).y = y - 1
   ' Rotate Line Draw
   For k = 1 To 4
      pts(k).x = pts(0).x + (Mul * XLine2(k)) * zcos - (Mul * YLine2(k)) * zsin
      pts(k).y = pts(0).y + (Mul * YLine2(k)) * zcos + (Mul * XLine2(k)) * zsin
   Next k
   ModSpline.DrawCurve 0.01, Tension, pts, RR, GG, BB
End Sub

Public Sub Wrapper()
' SVWP  Scrollbar value from frmExtras = 0 to CW

' Private CH As Long, CW As Long

' xindent(0 To CH)  & Wdiam(0 To CH) filled in by
' CylinderPreCalc, EllipsePreCalc or ConePreCalc
' called from frmExtras.cmdEff_Click


Dim iy As Long, ix As Long, dx As Integer
Dim prefac As Single
   picDATA() = picDATAORG()
   If aUseRightColor Then FillpicDATAwithRightColor
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   CH = HIY - LOY
   CW = HIX - LOX - 1
Else
   CH = FullH - 1
   CW = FullW - 1
End If
   
   prefac = 2 * pi# / CW
   
   StartProgress (CSng(CH))
   
'If SVWP <> 0 Then Stop
   
   For iy = 0 To CH
      'If SVWP + CW / 2 - 1 < CW Then
      If SVWP + CW / 2 < CW Then
         For ix = SVWP To SVWP + CW / 2
            dx = (1 - Cos(prefac * (ix - SVWP))) * CW / 2
            dx = dx * Wdiam(iy) / CW
            dx = dx + xindent(iy)
            Transfer ix, iy, dx, CW   ' to picDATA()
         Next ix
      Else
         'For ix = SVWP To CW + 1
         For ix = SVWP To CW
            dx = (1 - Cos(prefac * (ix - SVWP))) * CW / 2
            dx = dx * Wdiam(iy) / CW
            dx = dx + xindent(iy)
            Transfer ix, iy, dx, CW  ' to picDATA()
         Next ix
         'For ix = 0 To SVWP - CW / 2 + 1
         For ix = 0 To SVWP - CW / 2
            dx = (1 - Cos(prefac * (ix - SVWP))) * CW / 2
            dx = dx * Wdiam(iy) / CW
            dx = dx + xindent(iy)
            Transfer ix, iy, dx, CW  ' to picDATA()
         Next ix
      End If
      DrawProgress
   Next iy
   
   frmExtras.picPB.Cls
End Sub

Private Sub Transfer(ix As Long, iy As Long, dx As Integer, CW As Long)
' From Wrapper
' Private ERED As Long, EGREEN As Long, EBLUE As Long
Dim HH As Long
Dim Lx As Long, LY As Long

Dim UX As Long, Uy As Long

If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   Lx = LOX
   LY = LOY
   HH = LY + iy
Else
   Lx = 0
   LY = 0
   HH = iy
   If aExternal Then
      UX = UBound(MaskArray(), 1)
      Uy = UBound(MaskArray(), 2)
   End If
End If
   
If HH <= UBound(picDATA(), 3) Then
      
      If aSelectAccepted Then
         If Not aExternal Then   ' Internal
            If MaskArray(dx, iy) = 0 Then
               TransferCALC ix, iy, dx, CW, HH, Lx
            End If
         Else  ' aselectAccepted & External

            If ((dx - LOX) >= 0 And (dx - LOX) <= UX) And ((iy - LOY) >= 0 And (iy - LOY) <= Uy) Then
               If MaskArray(dx - LOX, iy - LOY) <> 0 Then TransferCALC ix, iy, dx, CW, HH, Lx
            Else
               TransferCALC ix, iy, dx, CW, HH, Lx
            End If
         End If
      Else  ' Not aselectAccepted
         TransferCALC ix, iy, dx, CW, HH, Lx
      End If
   
End If
End Sub

Private Sub TransferCALC(ix As Long, iy As Long, dx As Integer, CW As Long, HH As Long, Lx As Long)
' Private ERED As Long, EGREEN As Long, EBLUE As Long
' Private CH As Long, CW As Long
         If ix <= CW Then
            EBLUE = picDATAORG(0, Lx + ix, HH)
            EGREEN = picDATAORG(1, Lx + ix, HH)
            ERED = picDATAORG(2, Lx + ix, HH)
            If dx <= CW + 1 Then
               picDATA(0, Lx + dx, HH) = EBLUE
               picDATA(1, Lx + dx, HH) = EGREEN
               picDATA(2, Lx + dx, HH) = ERED
               If dx < CW Then
                  picDATA(0, Lx + dx + 1, HH) = EBLUE
                  picDATA(1, Lx + dx + 1, HH) = EGREEN
                  picDATA(2, Lx + dx + 1, HH) = ERED
                  If dx < CW - 1 Then
                     picDATA(0, Lx + dx + 2, HH) = EBLUE
                     picDATA(1, Lx + dx + 2, HH) = EGREEN
                     picDATA(2, Lx + dx + 2, HH) = ERED
                     If dx < CW - 2 Then
                        picDATA(0, Lx + dx + 3, HH) = EBLUE
                        picDATA(1, Lx + dx + 3, HH) = EGREEN
                        picDATA(2, Lx + dx + 3, HH) = ERED
                     End If
                  End If
               End If
            End If
         End If
End Sub


Public Sub CylinderPreCalc()
' Private CH As Long, CW As Long
Dim iy As Long
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   CH = HIY - LOY
   CW = HIX - LOX - 1
Else
   CH = FullH - 1
   CW = FullW - 1
End If

   ReDim xindent(0 To CH)
   ReDim Wdiam(0 To CH)
   For iy = 0 To CH
      xindent(iy) = 0
      Wdiam(iy) = CW
   Next iy
   SVWP = 0
End Sub

Public Sub EllipsePreCalc()
' (x-xc)^2   (y-yc)^2
' -------- + -------- = 1
'   a^2        b^2
' Private CH As Long, CW As Long
Dim xc As Single, yc As Single
Dim iy As Long
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   CH = HIY - LOY
   CW = HIX - LOX - 1
Else
   CH = FullH - 1
   CW = FullW - 1
End If
   
   xc = CW / 2
   yc = CH / 2
   
   ReDim xindent(0 To CH)
   ReDim Wdiam(0 To CH)
   For iy = 0 To CH
      xindent(iy) = -xc * Sqr(1 - ((iy + 0) - yc) ^ 2 / yc ^ 2) + xc
      Wdiam(iy) = CW - 2 * xindent(iy)
   Next iy
   SVWP = 0
End Sub

Public Sub ConePreCalc()
'       H
' Y = - --- * X + H
'       xc

'     (H-Y) * xc
' X = -----
'       H
' Private CH As Long, CW As Long
Dim xc As Single
Dim iy As Long
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   CH = HIY - LOY
   CW = HIX - LOX - 1
Else
   CH = FullH - 1
   CW = FullW - 1
End If
   xc = CW / 2
   
   ReDim xindent(0 To CH)
   ReDim Wdiam(0 To CH)

   ' Find indent and diameter of each slice through cone
   For iy = 0 To CH
      xindent(CH - iy) = xc * (CH - iy) / CH
      Wdiam(CH - iy) = CW - 2 * xindent(CH - iy)
   Next iy
   SVWP = 0
End Sub

Public Sub Plasma()
' For REF
'      ' At cmdEff
'      With scrEff: .Min = 8:
'          If CW >= CH Then
'            .Max = CW / 8: .LargeChange = 4
'            If CW < 4 Then
'              .Min = 1
'              .Max = CW
'              .LargeChange = 1
'            End If
'          Else
'            .Max = CH / 8: .LargeChange = 4
'            If CH < 4 Then
'              .Min = 1
'              .Max = CH
'              .LargeChange = 1
'            End If
'          End If
'          .Value = .Min
'      At AdderAction
'      SVWP = scrEff.Value Starting at Min=1 or 8

' CORE PLASMA ROUTINE
' Adapted & extended from a QB prog by Alan King 1996
'Public WrapX As Boolean
'Public WrapY As Boolean
' Private CH As Long, CW As Long
Dim Noise As Long
Dim Stepsize As Long
Dim StartStepsize As Long
Dim ix As Long, iy As Long
Dim kx As Long, ky As Long
Dim RndNoise As Single
Dim Col As Long
Dim PaletteMaxIndex As Long
Dim smax As Long, smin As Long
Dim sdiv As Single
Dim zMul As Single
Dim Index As Integer
   
Dim UX As Long, Uy As Long
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   CH = HIY - LOY
   CW = HIX - LOX - 1
Else
   CH = FullH - 1
   CW = FullW - 1
   If aExternal Then
      UX = UBound(MaskArray(), 1)
      Uy = UBound(MaskArray(), 2)
   End If
End If
   


'   CH = HIY - LOY
'   CW = HIX - LOX

   ReDim IndexArray(0 To CW, 0 To CH)   ' Integers
   PaletteMaxIndex = 255 ' 511 for DoubledPalARR()
   'Randomize Timer
   ' PaletteMaxIndex = 255
   ' Graininess & scale also depends on palette
   ' Rapidly changing palettes will be grainier
   ' StartNoise = 0   ' graininess
   ' StartStepsize = 32  ' scale
   
   Noise = 0 'StartNoise    ' From Graininess (default = 0) not changed here
   StartStepsize = SVWP     ' From scrollbar on frmExtras
   Stepsize = StartStepsize
   RndNoise = 0      ' Redundant here but can be used to change graininess
   Do
      For iy = 0 To CH Step Stepsize
      For ix = 0 To CW Step Stepsize
         'If Noise > 0 Then RndNoise = (Rnd * (2 * Noise) - Noise) * Stepsize
         If iy + Stepsize >= CH Then
            If WrapY Then
              Col = IndexArray(ix, 1) '+ RndNoise ' Gives vertical wrapping
            Else
              Col = IndexArray(ix, CH)  '+ RndNoise
            End If
         ElseIf ix + Stepsize >= CW Then
            If WrapX Then
               Col = IndexArray(1, iy) '+ RndNoise  ' Gives horizontal wrapping
            Else
               Col = IndexArray(CW, iy)  '+ RndNoise
            End If
         ElseIf Stepsize = StartStepsize Then
            Col = Rnd * (2 * PaletteMaxIndex) - PaletteMaxIndex
         Else
             Col = IndexArray(ix, iy)
             Col = Col + IndexArray(ix + Stepsize, iy)
             Col = Col + IndexArray(ix, iy + Stepsize)
             Col = Col + IndexArray(ix + Stepsize, iy + Stepsize)
             Col = Col \ 4 '+ RndNoise
         End If
         If Stepsize > 1 Then 'BoxLine
             For ky = iy To iy + Stepsize
                 If ky <= CH Then
                     For kx = ix To ix + Stepsize
                         If kx <= CW Then IndexArray(kx, ky) = Col
                     Next kx
                 End If
             Next ky
         End If
         If Stepsize <= 1 Then IndexArray(ix, iy) = Col
      Next ix
      Next iy
      Stepsize = Stepsize \ 2
   Loop Until Stepsize <= 1
   
   ' Find Col max/min
   smax = -10000
   smin = 10000
   For iy = CH To 0 Step -1
   For ix = CW To 0 Step -1
      Col = IndexArray(ix, iy)
      If Col < smin Then smin = Col
      If Col > smax Then smax = Col
   Next ix
   Next iy
   ' Scale colors indices to range
   ' & put full RGB() palette into ColArray()
   ' & keep new IndexArray()
   sdiv = (smax - smin)
   If sdiv <= 0 Then sdiv = 1
   zMul = PaletteMaxIndex / sdiv
   
   StartProgress (CSng(CH))

   For iy = CH To 0 Step -1
   For ix = CW To 0 Step -1
      Index = (IndexArray(ix, iy) - smin) * zMul
      ' Check Index in range
      If Index < 0 Then
         Index = 0
      End If
      If Index > PaletteMaxIndex Then
         Index = PaletteMaxIndex
      End If
      ' Put in new Index
      IndexArray(ix, iy) = Index

      If aSelectAccepted Then
      
         If Not aExternal Then
            
            If MaskArray(ix, iy) = 0 Then
               picDATA(0, LOX + ix, LOY + iy) = PalARR(0, Index)
               picDATA(1, LOX + ix, LOY + iy) = PalARR(1, Index)
               picDATA(2, LOX + ix, LOY + iy) = PalARR(2, Index)
            End If
         
         Else  ' aExternal
            
            If ((ix - LOX) >= 0 And (ix - LOX) <= UX) And ((iy - LOY) >= 0 And (iy - LOY) <= Uy) Then
               If MaskArray(ix - LOX, iy - LOY) <> 0 Then
                  picDATA(0, ix, iy) = PalARR(0, Index)
                  picDATA(1, ix, iy) = PalARR(1, Index)
                  picDATA(2, ix, iy) = PalARR(2, Index)
               
               End If
            Else
               picDATA(0, ix, iy) = PalARR(0, Index)
               picDATA(1, ix, iy) = PalARR(1, Index)
               picDATA(2, ix, iy) = PalARR(2, Index)
            End If
         
         End If
      Else
         picDATA(0, ix, iy) = PalARR(0, Index)
         picDATA(1, ix, iy) = PalARR(1, Index)
         picDATA(2, ix, iy) = PalARR(2, Index)
      End If
   Next ix
   DrawProgress
   Next iy
   Erase IndexArray()
   
   frmExtras.picPB.Cls
End Sub

Public Sub MakeMaze(PAR As Long)
   
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then
   CH = HIY - LOY
   CW = HIX - LOX
   
   If CW < CH Then
      Spac = CW / PAR
   Else
      Spac = CH / PAR
   End If
   
   MW = CW / Spac - 2
   MH = CH / Spac - 2
Else  ' External
   If FullW < FullH Then
      Spac = FullW / PAR
   Else
      Spac = FullH / PAR
   End If
   
   MW = FullW / Spac - 2
   MH = FullH / Spac - 2
End If
   
   NCount = (MW + 2) * (MH + 2)
   GenerateMaze MW, MH, WW(), SW()
   DrawMaze MW, MH, WW(), SW(), Spac

End Sub

Private Sub GenerateMaze(MW As Long, MH As Long, WW() As Long, SW() As Long)
Dim CurrentRoom As Long, y As Long, x As Long
Dim Exits(0 To 3) As Long, ExitNCount As Long, Selection As Long
Dim PathNCount As Long, UnvisitedRoomNCount As Long

' Creation Date: 12-Jul-2000 by Jonathan D. Kirwan
' but no longer available.
' Method is similar to other refs

   ' Set walls to 0 ie NOT broken
   ReDim WW(0 To NCount - 1)
   ReDim SW(0 To NCount - 1)
   ReDim Visited(0 To NCount - 1)
   
   ' Initialise boundaries as visited   TRUE = -1
   y = (MW + 2) * (MH + 1) - 1
   For x = 0 To MW + 2
      Visited(x) = -1
      Visited(x + y) = -1
   Next x
   x = MW + MW + 3
   For y = 1 To MH
      Visited(x) = -1
      Visited(x + 1) = -1
      x = x + MW + 2
   Next y
   
   PathNCount = 0
   ReDim PathList(0 To MW * MH) As Long

   UnvisitedRoomNCount = MW * MH
   y = Int(Rnd * UnvisitedRoomNCount)
   CurrentRoom = (1 + y \ MW) * (MW + 2) + (y Mod MW) + 1
   
   Do While UnvisitedRoomNCount > 1
      UnvisitedRoomNCount = UnvisitedRoomNCount - 1
      Visited(CurrentRoom) = -1
      Do
         ' Look N,S, W & E
         ExitNCount = 0
         ' If NOT TRUE (IE FALSE <> -1) then not visited
         ' N
         If Not Visited(CurrentRoom - MW - 2) Then
            Exits(ExitNCount) = 1
            ExitNCount = ExitNCount + 1
         End If
         ' S
         If Not Visited(CurrentRoom + MW + 2) Then
            Exits(ExitNCount) = 2
            ExitNCount = ExitNCount + 1
         End If
         ' W
         If Not Visited(CurrentRoom - 1) Then
            Exits(ExitNCount) = 3
            ExitNCount = ExitNCount + 1
         End If
         ' E
         If Not Visited(CurrentRoom + 1) Then
            Exits(ExitNCount) = 4
            ExitNCount = ExitNCount + 1
         End If
         If ExitNCount >= 1 Then
            ' At least one room not visited
            Exit Do
         End If
         
         ' All rooms already visited
         ' Get another room
         y = Int(Rnd * PathNCount)
         CurrentRoom = PathList(y)
         PathNCount = PathNCount - 1
         PathList(y) = PathList(PathNCount)
      Loop
      
      PathList(PathNCount) = CurrentRoom
      PathNCount = PathNCount + 1
      
      Selection = Int(Rnd * ExitNCount)
      Select Case Exits(Selection)
      Case 1   ' N
         CurrentRoom = CurrentRoom - MW - 2
         SW(CurrentRoom) = -1 ' TRUE, therefore mark wall as broken
      Case 2   ' S
         SW(CurrentRoom) = -1
         CurrentRoom = CurrentRoom + MW + 2
      Case 3   ' E
         WW(CurrentRoom) = -1
         CurrentRoom = CurrentRoom - 1
      Case 4   ' W
         CurrentRoom = CurrentRoom + 1
         WW(CurrentRoom) = -1
      End Select
   Loop
   ' UnvisitedRoomNCount = 1
   ' Break horizontal walls at Top-Left & Bottom-Right
   ' for Entry & Exit points.
   SW(1) = -1
   y = (MH + 1) * (MW + 2) - 2
   SW((MH + 1) * (MW + 2) - 2) = -1 ' /30 =154

End Sub

Private Sub DrawMaze(MW As Long, MH As Long, WW() As Long, SW() As Long, sp As Long)
Dim y As Long, x As Long, m As Long
Dim q As Long, r As Long

   picDATA() = picDATAORG()
   
   GetLorRColor

   'sp = Spac
If Not aSelectAccepted Or (aSelectAccepted And (Not aExternal)) Then

   For x = 1 To MW
      q = LOX + (x - 1) * sp + sp
      If x > 1 Then  ' Bottom wall with gap
         If aSelectAccepted Then
            BresLineCALC q, LOY + y + sp, q + sp, LOY + y + sp, RR, GG, BB
         Else
            BresLine q, LOY + y + sp, q + sp, LOY + y + sp, RR, GG, BB
         End If
         
      End If
   Next x
   m = 0
   For y = 1 To MH
      m = m + MW + 2
      ' Vertical walls
      For x = 1 To MW
         q = LOX + (x - 1) * sp + sp
         r = LOY + (y - 1) * sp + sp
         If Not WW(m + x) Then   ' If NOT TRUE (ie Not -1)
                                 ' then NOT broken, so draw it!
            If aSelectAccepted Then
               BresLineCALC q, r, q, r + sp, RR, GG, BB
            Else
               BresLine q, r, q, r + sp, RR, GG, BB
            End If
         
         End If
      Next x
      ' x=MW+1
      ' Right wall
      q = LOX + (x - 1) * sp + sp
      r = LOY + (y - 1) * sp + sp
      If Not WW(m + MW + 1) Then
            If aSelectAccepted Then
               BresLineCALC q, r, q, r + sp, RR, GG, BB
            Else
               BresLine q, r, q, r + sp, RR, GG, BB
            End If
      End If
      ' Horizontal walls, including top wall
      For x = 1 To MW
         q = LOX + (x - 1) * sp + sp
         r = LOY + (y - 1) * sp + 2 * sp
         If Not SW(m + x) Then
            If aSelectAccepted Then
               BresLineCALC q, r, q + sp, r, RR, GG, BB
            Else
               BresLine q, r, q + sp, r, RR, GG, BB
            End If
         End If
      Next x
   Next y

Else   ' aSelectAccepted and External

   For x = 1 To MW
      q = (x - 1) * sp + sp
      If x > 1 Then  ' Bottom wall with gap
         BresLineCALC q, y + sp, q + sp, y + sp, RR, GG, BB
      End If
   Next x
   
   m = 0
   For y = 1 To MH
      m = m + MW + 2
      ' Vertical walls
      For x = 1 To MW
         q = (x - 1) * sp + sp
         r = (y - 1) * sp + sp
         If Not WW(m + x) Then   ' If NOT TRUE (ie Not -1)
                                 ' then NOT broken, so draw it!
            BresLineCALC q, r, q, r + sp, RR, GG, BB
         
         End If
      Next x
      ' x=MW+1
      ' Right wall
      q = (x - 1) * sp + sp
      r = (y - 1) * sp + sp
      If Not WW(m + MW + 1) Then
         BresLineCALC q, r, q, r + sp, RR, GG, BB
      End If
      
      ' Horizontal walls, including top wall
      For x = 1 To MW
         q = (x - 1) * sp + sp
         r = (y - 1) * sp + 2 * sp
         If Not SW(m + x) Then
            BresLineCALC q, r, q + sp, r, RR, GG, BB
         End If
      Next x
   Next y
End If
End Sub

Private Sub GetLorRColor()
' Private RR As Byte, GG As Byte, BB As Byte
   If aUseRightColor Then
      LngToRGB RightColor, RR, GG, BB
   Else
      LngToRGB LeftColor, RR, GG, BB
   End If
End Sub
   
Private Sub StartProgress(ByVal zPAR As Single)
' Private xd As Single, xp As Single
' EG: Par = PRELIEF * FullH
   frmExtras.picPB.DrawWidth = 3
   frmExtras.picPB.Cls
   xp = 0
   xd = frmExtras.picPB.Width / zPAR
   frmExtras.picPB.PSet (xp, 2), vbRed
End Sub
Private Sub DrawProgress()
' Private xd As Single, xp As Single
   frmExtras.picPB.Line -(xp, 2), vbRed
   frmExtras.picPB.Refresh
   xp = xp + xd
End Sub

