Attribute VB_Name = "ModTextures"
'ModTextures.bas

' Ref 1  Matt Zucker, "The Perlin noise math FAQ", 2001,
'        http://www.cs.cmu.edu/~zucker/code/perlin-noise-math-faq.html
' Ref 2  Haim Barad et al, "Real-Time Procedural Texturing Techniques Using MMX",
'        www.gamasutra.com, 1998

Option Explicit

Public TextureType As Long   ' 0,1,2,3,4,5
Public ScaleValue As Long  ' 2 - 256
Public MarbleScale As Long ' 1 - 20
Public WoodType As Long    ' 0 - 14
Public Density As Single   ' 0 - 1
Public StalkDensity As Single ' 0 - 1
Public PebbleSize As Long     ' 3 - 12

Private PebbleDensity As Single

Public WtCul(0 To 2) As Byte  ' RGB Color mix
Public zColorWt() As Single   ' Color weighting 0,1,2 RGB

Private LastScale As Long     ' Perlinlast scales
Private PerGrid() As Long                     ' Perlin noise grid

Private RndGrid() As Byte            ' Random noise grid
Private avmin As Long, avmax As Long ' Min/Max values in RndGrid()
Private zSineAdds() As Single        ' Wood rings noise
Private ix As Long, iy As Long
' Progress bar
Private xd As Single, xp As Single



Public Sub StandardNoise()
Dim jg As Long, ig As Long
   ReDim RndGrid(0 To FullW - 1, 0 To FullH - 1) ' RndGrid size (bytes) = Picture1 size
   '-------------------------------
   ' Ensure same sequence each time
   Rnd -1
   Randomize 1
   ' Other random functions could be used
   '-------------------------------
   For jg = 0 To FullH - 1
   For ig = 0 To FullW - 1
      RndGrid(ig, jg) = (256 * Rnd) And 255   ' 0 - 255
   Next ig
   Next jg
End Sub

Public Sub PerlinGrid()
' Linear method
' RndGrid() As Byte      ' Random noise grid done @ Form_Load
' PerGrid()              ' Perlin noise grid
Dim sca As Long
Dim i As Long, j As Long
Dim ig As Long, jg As Long
Dim ix0 As Long, iy0 As Long
Dim ix1 As Long, iy1 As Long
Dim sca2zs As Long
Dim sca2zt As Long
Dim sca2zu As Long
Dim sca2zv As Long
Dim izav As Long

   ReDim PerGrid(0 To FullW - 1, 0 To FullH - 1)
   ' For max/min values in PerGrid
   avmin = 100000
   avmax = -100000
   sca = ScaleValue  ' From scrScale
   LastScale = 2
   
   Screen.MousePointer = vbHourglass
   Do
      ' Calculate even points only
      For j = FullH - 1 To 1 Step -2
         jg = ((j - 1) \ sca) + 1    ' NB Int Divide: StepY along RndGrid according to scale sca
   
      For i = FullW - 1 To 1 Step -2
         ig = ((i - 1) \ sca) + 1    ' NB Int Divide: StepX along RndGrid according to scale sca
         ' Transform rectangular coords of RndGrid to pixel grid
         ix0 = (ig - 1) * sca
         iy0 = (jg - 1) * sca
         ix1 = ig * sca
         iy1 = jg * sca
         sca2zs = RndGrid(ig, jg) * (sca - i + ix0) * (sca - j + iy0)
         sca2zt = RndGrid(ig + 1, jg) * (sca - ix1 + i) * (sca - j + iy0)
         sca2zu = RndGrid(ig, jg + 1) * (sca - i + ix0) * (sca - iy1 + j)
         sca2zv = RndGrid(ig + 1, jg + 1) * (sca - ix1 + i) * (sca - iy1 + j)
         izav = (sca2zs + sca2zt + sca2zu + sca2zv) / sca  ' in effect sca to decrease the
                                                            ' amp of higher freqs
         PerGrid(i, j) = PerGrid(i, j) + izav
         ' Fill in odd points
         PerGrid(i - 1, j) = PerGrid(i, j)
         PerGrid(i, j - 1) = PerGrid(i, j)
         PerGrid(i - 1, j - 1) = PerGrid(i, j)
         ' Find max & min for later scaling of colors
         If PerGrid(i, j) < avmin Then avmin = PerGrid(i, j)
         If PerGrid(i, j) > avmax Then avmax = PerGrid(i, j)
      Next i
      Next j
      ' Set next finer OCTAVE
      sca = sca / 2
      If sca < LastScale Then Exit Do
   Loop
   Screen.MousePointer = vbDefault
End Sub

Public Sub PerlinNoise()   ' Unsmoothed
Dim zMult As Single
'Dim ix As Long, iy As Long
   PerlinGrid
   ' Set color scale to cover 256 values
   zMult = 256 / (avmax - avmin)
   
   StartProgress HIY
   For iy = 0 To FullH - 1
   For ix = 0 To FullW - 1
      Cul = (PerGrid(ix, iy) - avmin) * zMult
      If Cul < 0 Then Cul = 0 Else If Cul > 255 Then Cul = 255
      If aSelectAccepted Then ' Selection ON
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If Not aExternal Then   ' Internal
               If MaskArray(ix - LOX, iy - LOY) = 0 Then PerlinNoiseCALC Cul
            Else  'External
               If MaskArray(ix - LOX, iy - LOY) <> 0 Then PerlinNoiseCALC Cul
            End If
         Else
            If aExternal Then PerlinNoiseCALC Cul
         End If
      Else  ' Selection OFF
         PerlinNoiseCALC Cul
      End If
   Next ix
   DrawProgress
   Next iy
   
   frmTextures.picPB.Cls
End Sub
Private Sub PerlinNoiseCALC(Cul As Long)
' Private zColorWt() As Single)
   picDATA(2, ix, iy) = Cul * zColorWt(0)
   picDATA(1, ix, iy) = Cul * zColorWt(1)
   picDATA(0, ix, iy) = Cul * zColorWt(2)
End Sub

'Private Sub PerlinNoiseCALC(ix As Long, iy As Long, zMult As Single)
'Dim Cul As Long
'   Cul = (PerGrid(ix, iy) - avmin) * zMult
'   If Cul < 0 Then Cul = 0 Else If Cul > 255 Then Cul = 255
'   picDATA(2, ix, iy) = Cul * zColorWt(0)
'   picDATA(1, ix, iy) = Cul * zColorWt(1)
'   picDATA(0, ix, iy) = Cul * zColorWt(2)
'End Sub

Public Sub Marble()
Dim zAmp As Single
   ' Perlin noise called first
   PerlinGrid
   zAmp = 0.75       ' 0.5
   
   StartProgress HIY
   For iy = 0 To FullH - 1
   For ix = 0 To FullW - 1
      If aSelectAccepted Then ' Selection ON
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If Not aExternal Then   ' Internal
               If MaskArray(ix - LOX, iy - LOY) = 0 Then MarbleCALC zAmp
            Else  'External
               If MaskArray(ix - LOX, iy - LOY) <> 0 Then MarbleCALC zAmp
            End If
         Else
            If aExternal Then MarbleCALC zAmp
         End If
      Else  ' Selection OFF
         MarbleCALC zAmp
      End If
   Next ix
   DrawProgress
   Next iy
   
   frmTextures.picPB.Cls
End Sub

Private Sub MarbleCALC(zAmp As Single)
Dim zn As Single
Dim zSinVal As Single
Dim Red As Long, Green As Long, Blue As Long
   zn = (PerGrid(ix, iy) - avmin) / (avmax - avmin)   'Range 0-1
   zn = zn * MarbleScale * pi# + 1
   zSinVal = zAmp * Sin(zn)
   
   Red = (zColorWt(0) + zSinVal) * 255
   Green = (zColorWt(1) + zSinVal) * 255
   Blue = (zColorWt(2) + zSinVal) * 255
   If Red < 0 Then Red = 0 Else If Red > 255 Then Red = 255
   If Green < 0 Then Green = 0 Else If Green > 255 Then Green = 255
   If Blue < 0 Then Blue = 0 Else If Blue > 255 Then Blue = 255
   
   picDATA(2, ix, iy) = Red
   picDATA(1, ix, iy) = Green
   picDATA(0, ix, iy) = Blue
End Sub

Public Sub SineAdds()
' For WOOD RINGS
' Slightly noisy sine additions - no phase shift
Dim t1 As Long
Dim zp As Single
Dim iz As Long
Dim ySum As Single
Dim k As Long
Dim n As Long
   ReDim zSineAdds(1 To 2 * FullW) ' Size matters
   t1 = 2 * FullW ' Period
   zp = 2 * pi#
   n = 2
   For iz = t1 \ 2 To 1 Step -1
      ySum = 0
      For k = 0 To n
        ySum = ySum + Sin(zp * iz / (t1 / 2 ^ k))
      Next k
      ' Average
      zSineAdds(iz) = ySum / (n + 1)
      ' Make symmetrical
      zSineAdds(t1 + 1 - iz) = zSineAdds(iz)
   Next iz
   'iz = iz + 1
End Sub

Public Sub WoodRings()
Dim nsa As Long
Dim Amp As Long
Dim zSA As Single
   SineAdds  ' zSineAdds(1 to 2 * FullW)
   nsa = 1   ' zSineAdds subscript
   Amp = 16  ' Has effect on wood grain
   
   StartProgress HIY
   For iy = 0 To FullH - 1
   zSA = Amp * zSineAdds(nsa)
   For ix = 0 To FullW - 1
      If aSelectAccepted Then ' Selection ON
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If Not aExternal Then   ' Internal
               If MaskArray(ix - LOX, iy - LOY) = 0 Then WoodRingsCALC zSA
            Else  'External
               If MaskArray(ix - LOX, iy - LOY) <> 0 Then WoodRingsCALC zSA
            End If
         Else
            If aExternal Then WoodRingsCALC zSA
         End If
      Else  ' Selection OFF
         WoodRingsCALC zSA
      End If
   Next ix
   nsa = nsa + 1  ' Next zSineAdd noise
   If nsa > 2 * FullW Then nsa = 1
   DrawProgress
   Next iy
   
   frmTextures.picPB.Cls
End Sub

Private Sub WoodRingsCALC(zSA As Single)
Dim ixx As Long, iyy As Long
Dim zQ As Double
Dim zR As Double
Dim zalpha As Single
Dim zS As Single
Dim zRed As Single, zGreen As Single, zBlue As Single
Dim Red As Long, Green As Long, Blue As Long
Dim zn As Single
   
   ixx = ix - (HIX + LOX) \ 2 ' Center coords of selection
   iyy = iy - (HIY + LOY) \ 2
   zalpha = zATan2(iyy, ixx)  ' Radius angle
   Select Case WoodType
   Case 0
      zR = Sqr(ixx * ixx + iyy * iyy) ' RINGS
      zS = Sin(2 * zalpha) * zR / zSA
   Case 1
      zR = Sqr(ixx * ixx + iyy * iyy) ' RINGS
      zS = Sin(2 * zalpha) * zR / (zSA * zSA)   ' Makes Rings more circular
   Case 2
      zR = Sqr(ixx * ixx + iyy * iyy) ' RINGS
      zS = Sin(7 * zalpha) * zR / zSA   ' Starred Rings
   Case 3
      zR = Abs(ixx + iyy)             ' LINES
      zS = Sin(2 * zalpha) * zR / zSA
   Case 4
      zR = Abs(ixx - iyy)             ' LINES
      zS = Sin(2 * zalpha) * zR / zSA - ixx  ' Skewed Lines
   Case 5
      zR = Abs(ixx + iyy)             ' LINES
      zS = Sin(2 * zalpha) * zR / zSA - ixx  ' Skewed Lines
   Case 6 To 13
      zn = 3 ^ (WoodType - 7)         ' CELLS small to large
      zR = Abs(ixx * ixx + iyy * iyy) / zn
      zS = Sin(2 * zalpha) * zR / zSA
   End Select
   zR = Abs(zR + zS)
   'Float divide: Range it 0-1  / 8 smaller, / 32 larger
   'zR = (zR Mod 16) / 16  'NO, CAN OVERFLOW EASILY, SO:-
   If zR > 1000000000# Then
      zR = 1000000 'zR / 1000
   Else
      zQ = (zR \ 16)
      zR = zR - zQ * 16   '(zR \ 16) * 16
      zR = zR / 16
   End If
   
   zRed = zColorWt(0) * zR + 0.1 * (1 - zR)
   If zRed > 1 Then zRed = 1
   zGreen = zColorWt(1) * zR + 0.02 * (1 - zR)
   If zGreen > 1 Then zGreen = 1
   zBlue = zColorWt(2) * zR + 0.01 * (1 - zR)
   If zBlue > 1 Then zBlue = 1
   Red = zRed * 255
   Green = zGreen * 255
   Blue = zBlue * 255
   
   If Red < 0 Then Red = 0 Else If Red > 255 Then Red = 255
   If Green < 0 Then Green = 0 Else If Green > 255 Then Green = 255
   If Blue < 0 Then Blue = 0 Else If Blue > 255 Then Blue = 255

   picDATA(2, ix, iy) = Red
   picDATA(1, ix, iy) = Green
   picDATA(0, ix, iy) = Blue
End Sub

Private Sub GetCheckRGB(Red As Long, Green As Long, Blue As Long)
   Red = zColorWt(0) * RndGrid(ix, iy)
   Green = zColorWt(1) * RndGrid(ix, iy)
   Blue = zColorWt(2) * RndGrid(ix, iy)
   
   If Red < 0 Then Red = 0 Else If Red > 255 Then Red = 255
   If Green < 0 Then Green = 0 Else If Green > 255 Then Green = 255
   If Blue < 0 Then Blue = 0 Else If Blue > 255 Then Blue = 255
End Sub


Public Sub Grains()
Dim Red As Long, Green As Long, Blue As Long
Dim LRRed As Byte, LRGreen As Byte, LRBlue As Byte
Dim BKRed As Byte, BKGreen As Byte, BKBlue As Byte
   'PerlinGrid  Done
   Randomize
   LRRed = LeftColor And &HFF&
   LRGreen = (LeftColor And &HFF00&) \ &H100&
   LRBlue = (LeftColor And &HFF0000) \ &H10000
   BKRed = RightColor And &HFF&
   BKGreen = (RightColor And &HFF00&) \ &H100&
   BKBlue = (RightColor And &HFF0000) \ &H10000
   
   
   StartProgress HIY
   For iy = 0 To FullH - 1
   For ix = 0 To FullW - 1
      If aSelectAccepted Then ' Selection ON
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If Not aExternal Then   ' Internal
               If MaskArray(ix - LOX, iy - LOY) = 0 Then
                  GrainsCALC BKRed, BKGreen, BKBlue
            If Rnd - Density > 0 Then  ' Varies density
               GetCheckRGB Red, Green, Blue
               If Red < 100 And Green < 100 And Blue < 100 Then
                  GrainsCALC LRRed, LRGreen, LRBlue
               Else
                  GrainsCALC CByte(Red), CByte(Green), CByte(Blue)
               End If
            End If

               End If
            Else  'External
               If MaskArray(ix - LOX, iy - LOY) <> 0 Then
                  GrainsCALC BKRed, BKGreen, BKBlue
            If Rnd - Density > 0 Then  ' Varies density
               GetCheckRGB Red, Green, Blue
               If Red < 100 And Green < 100 And Blue < 100 Then
                  GrainsCALC LRRed, LRGreen, LRBlue
               Else
                  GrainsCALC CByte(Red), CByte(Green), CByte(Blue)
               End If
            End If

               End If
            End If
         Else
            If aExternal Then
               GrainsCALC BKRed, BKGreen, BKBlue
            If Rnd - Density > 0 Then  ' Varies density
               GetCheckRGB Red, Green, Blue
               If Red < 100 And Green < 100 And Blue < 100 Then
                  GrainsCALC LRRed, LRGreen, LRBlue
               Else
                  GrainsCALC CByte(Red), CByte(Green), CByte(Blue)
               End If
            End If
            
            End If
         End If
      Else  ' Selection OFF
         GrainsCALC BKRed, BKGreen, BKBlue
            If Rnd - Density > 0 Then  ' Varies density
               GetCheckRGB Red, Green, Blue
               If Red < 100 And Green < 100 And Blue < 100 Then
                  GrainsCALC LRRed, LRGreen, LRBlue
               Else
                  GrainsCALC CByte(Red), CByte(Green), CByte(Blue)
               End If
            End If
      
      End If
   Next ix
   DrawProgress
   Next iy
   
   frmTextures.picPB.Cls
End Sub
Private Sub GrainsCALC(RRed As Byte, gGREEN As Byte, BBlue As Byte)
   picDATA(2, ix, iy) = RRed
   picDATA(1, ix, iy) = gGREEN
   picDATA(0, ix, iy) = BBlue
End Sub

Public Sub Stalks()
Dim ix2 As Long, iy2 As Long
'  BresLine ix,iy,ix2,iy2,Red,Green,Blue
'  BresLineCALC ix,iy,ix2,iy2,Red,Green,Blue  ' Masked
Dim Red As Long, Green As Long, Blue As Long
Dim LRRed As Byte, LRGreen As Byte, LRBlue As Byte
Dim BKRed As Byte, BKGreen As Byte, BKBlue As Byte
   'PerlinGrid  Done
   Randomize
   LRRed = LeftColor And &HFF&
   LRGreen = (LeftColor And &HFF00&) \ &H100&
   LRBlue = (LeftColor And &HFF0000) \ &H10000
   BKRed = RightColor And &HFF&
   BKGreen = (RightColor And &HFF00&) \ &H100&
   BKBlue = (RightColor And &HFF0000) \ &H10000
   
   
   StartProgress HIY
   For iy = 0 To FullH - 1
   For ix = 0 To FullW - 1
      If aSelectAccepted Then ' Selection ON
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If Not aExternal Then   ' Internal
               If MaskArray(ix - LOX, iy - LOY) = 0 Then
DrawStalksCALC1 BKRed, BKGreen, BKBlue, Red, Green, Blue, LRRed, LRGreen, LRBlue
               End If
            Else  'External
               If MaskArray(ix - LOX, iy - LOY) <> 0 Then
DrawStalksCALC1 BKRed, BKGreen, BKBlue, Red, Green, Blue, LRRed, LRGreen, LRBlue
               End If
            End If
         Else
            If aExternal Then
DrawStalksCALC1 BKRed, BKGreen, BKBlue, Red, Green, Blue, LRRed, LRGreen, LRBlue
            End If
         End If
      Else  ' Selection OFF
DrawStalksCALC2 BKRed, BKGreen, BKBlue, Red, Green, Blue, LRRed, LRGreen, LRBlue
      End If
   Next ix
   DrawProgress
   Next iy
   
   frmTextures.picPB.Cls
End Sub


Private Sub DrawStalksCALC1(BKRed As Byte, BKGreen As Byte, BKBlue As Byte, _
         Red As Long, Green As Long, Blue As Long, _
         LRRed As Byte, LRGreen As Byte, LRBlue As Byte)

Dim ix2 As Long, iy2 As Long
   picDATA(2, ix, iy) = BKRed
   picDATA(1, ix, iy) = BKGreen
   picDATA(0, ix, iy) = BKBlue
   If Rnd - StalkDensity > 0 Then  ' Varies density
      GetCheckRGB Red, Green, Blue
      If Red < 100 And Green < 100 And Blue < 100 Then
         iy2 = iy - 8 * Rnd
         ix2 = ix + 4 * (Rnd - 0.5)
         BresLineCALC ix, iy, ix2, iy2, LRRed, LRGreen, LRBlue
      Else
         iy2 = iy - 8 * Rnd
         ix2 = ix + 4 * (Rnd - 0.5)
         BresLineCALC ix, iy, ix2, iy2, CByte(Red), CByte(Green), CByte(Blue)
      End If
   End If
End Sub

Private Sub DrawStalksCALC2(BKRed As Byte, BKGreen As Byte, BKBlue As Byte, _
         Red As Long, Green As Long, Blue As Long, _
         LRRed As Byte, LRGreen As Byte, LRBlue As Byte)

Dim ix2 As Long, iy2 As Long
   picDATA(2, ix, iy) = BKRed
   picDATA(1, ix, iy) = BKGreen
   picDATA(0, ix, iy) = BKBlue
   If Rnd - StalkDensity > 0 Then  ' Varies density
      GetCheckRGB Red, Green, Blue
      If Red < 100 And Green < 100 And Blue < 100 Then
         iy2 = iy - 8 * Rnd
         ix2 = ix + 4 * (Rnd - 0.5)
         BresLine ix, iy, ix2, iy2, LRRed, LRGreen, LRBlue
      Else
         iy2 = iy - 8 * Rnd
         ix2 = ix + 4 * (Rnd - 0.5)
         BresLine ix, iy, ix2, iy2, CByte(Red), CByte(Green), CByte(Blue)
      End If
   End If
End Sub

Public Sub Pebbles()
'Public PebbleSize As Long   ' Dummy PixelSize   3-12
Dim Red As Long, Green As Long, Blue As Long
Dim LRRed As Byte, LRGreen As Byte, LRBlue As Byte
Dim BKRed As Byte, BKGreen As Byte, BKBlue As Byte
' Private PebbleDensity As Single

   'PerlinGrid  Done
   Randomize
   LRRed = LeftColor And &HFF&
   LRGreen = (LeftColor And &HFF00&) \ &H100&
   LRBlue = (LeftColor And &HFF0000) \ &H10000
   BKRed = RightColor And &HFF&
   BKGreen = (RightColor And &HFF00&) \ &H100&
   BKBlue = (RightColor And &HFF0000) \ &H10000
   
   PebbleDensity = 0.9 + (PebbleSize - 3) / 150
   
   StartProgress HIY
   For iy = 0 To FullH - 1
   For ix = 0 To FullW - 1
      If aSelectAccepted Then ' Selection ON
         If (ix >= LOX And ix <= HIX) And (iy >= LOY And iy <= HIY) Then
            If Not aExternal Then   ' Internal
               If MaskArray(ix - LOX, iy - LOY) = 0 Then
 PebblesCALC1 BKRed, BKGreen, BKBlue, Red, Green, Blue, LRRed, LRGreen, LRBlue
               End If
            Else  'External
               If MaskArray(ix - LOX, iy - LOY) <> 0 Then
 PebblesCALC1 BKRed, BKGreen, BKBlue, Red, Green, Blue, LRRed, LRGreen, LRBlue
               End If
            End If
         Else
            If aExternal Then
 PebblesCALC1 BKRed, BKGreen, BKBlue, Red, Green, Blue, LRRed, LRGreen, LRBlue
            End If
         End If
      Else  ' Selection OFF
 PebblesCALC2 BKRed, BKGreen, BKBlue, Red, Green, Blue, LRRed, LRGreen, LRBlue
      End If
   Next ix
   DrawProgress
   Next iy

   frmTextures.picPB.Cls
End Sub

Private Sub PebblesCALC1(BKRed As Byte, BKGreen As Byte, BKBlue As Byte, _
        Red As Long, Green As Long, Blue As Long, _
        LRRed As Byte, LRGreen As Byte, LRBlue As Byte)
   
   picDATA(2, ix, iy) = BKRed
   picDATA(1, ix, iy) = BKGreen
   picDATA(0, ix, iy) = BKBlue
   If Rnd - PebbleDensity > 0 Then  ' Fixed density
      GetCheckRGB Red, Green, Blue
      If Red < 100 And Green < 100 And Blue < 100 Then
         DrawRoundelCALC ix, iy, LRRed, LRGreen, LRBlue
      Else
         DrawRoundelCALC ix, iy, CByte(Red), CByte(Green), CByte(Blue)
      End If
   End If
End Sub
Private Sub PebblesCALC2(BKRed As Byte, BKGreen As Byte, BKBlue As Byte, _
        Red As Long, Green As Long, Blue As Long, _
        LRRed As Byte, LRGreen As Byte, LRBlue As Byte)
   
   picDATA(2, ix, iy) = BKRed
   picDATA(1, ix, iy) = BKGreen
   picDATA(0, ix, iy) = BKBlue
   If Rnd - PebbleDensity > 0 Then  ' Fixed density
      GetCheckRGB Red, Green, Blue
      If Red < 100 And Green < 100 And Blue < 100 Then
         DrawRoundel ix, iy, LRRed, LRGreen, LRBlue
      Else
         DrawRoundel ix, iy, CByte(Red), CByte(Green), CByte(Blue)
      End If
   End If
End Sub
 
Private Sub DrawRoundel(ByVal px As Long, ByVal py As Long, DR As Byte, DG As Byte, DB As Byte)
'Public PebbleSize As Long   ' Dummy PixelSize   3-12
Dim ix1 As Long, iy1 As Long
Dim ix2 As Long, iy2 As Long
Dim j As Long
Dim Length As Long
Dim Offset As Long

Dim offn As Long, PebbSize As Long
   offn = 0
   If (Rnd - 0.5) < 0 Then offn = 1
   PebbSize = PebbleSize + offn
   If PebbSize > 12 Then PebbSize = 12
   
   For j = 1 To PebbSize Step 2
      Length = RA(PebbSize, j) \ 10
      Offset = RA(PebbSize, j) - (10 * Length)
      ix1 = px + Offset
      iy1 = py
      ix2 = px + Offset + Length
      iy2 = py
      BresLine ix1, iy1, ix2, iy2, DR, DG, DB
      py = py - 1
   Next j
End Sub

Private Sub DrawRoundelCALC(ByVal px As Long, ByVal py As Long, DR As Byte, DG As Byte, DB As Byte)
'Public PebbleSize As Long   ' Dummy PixelSize   3-12
Dim ix1 As Long, iy1 As Long
Dim ix2 As Long, iy2 As Long
Dim j As Long
Dim Length As Long
Dim Offset As Long
   
Dim offn As Long, PebbSize As Long
   offn = 0
   If (Rnd - 0.5) < 0 Then offn = 1
   PebbSize = PebbleSize + offn
   If PebbSize > 12 Then PebbSize = 12
   
   For j = 1 To PebbSize Step 2
      Length = RA(PebbSize, j) \ 10
      Offset = RA(PebbSize, j) - (10 * Length)
      ix1 = px + Offset
      iy1 = py
      ix2 = px - Offset + Length
      iy2 = py
      BresLineCALC ix1, iy1, ix2, iy2, DR, DG, DB
      py = py - 1
   Next j
End Sub

Private Sub StartProgress(PAR As Long)
' Private xd As Single, xp As Single
   frmTextures.picPB.DrawWidth = 3
   frmTextures.picPB.Cls
   xp = 0
   xd = frmTextures.picPB.Width / PAR
   frmTextures.picPB.PSet (xp, 2), vbRed
End Sub
Private Sub DrawProgress()
Dim FW As Long
' Private xd As Single, xp As Single
   frmTextures.picPB.Line -(xp, 2), vbRed
   frmTextures.picPB.Refresh
   xp = xp + xd
   FW = frmTextures.picPB.Width
End Sub


