effects.bas

图像处理

      For iy = 1 To PICH
   
            CopyMemory PalBGR(1, 2, iy, 2), PalBGR(1, 1, iy, 2), 4 * PICW - 1
      Next iy
   
      If chkMoversIndex = 5 Then
         For iy = 1 To PICH      ' Put right line to left
            PalBGR(1, 1, iy, 2) = PalLineCopy(1, iy)
            PalBGR(2, 1, iy, 2) = PalLineCopy(2, iy)
            PalBGR(3, 1, iy, 2) = PalLineCopy(3, iy)
         Next iy
      Else     ' Put right line to ColorX,  Shift Right
         For iy = 1 To PICH      ' Put right line to left
            PalBGR(1, 1, iy, 2) = QBBlue
            PalBGR(2, 1, iy, 2) = QBGreen
            PalBGR(3, 1, iy, 2) = QBRed
         Next iy
      End If
   Next i

End Select


   '---------------------
   ShowPalBGR 2
   '---------------------


DoEvents

Loop Until Done

ReDim PalLineCopy(1, 1)


End Sub

Public Sub PixelEffects()

'Pels from 3 - calc -> 2

Do

Select Case chkPIXIndex

Case 0   ' SMOOTH

For iy = 2 To PICH - 1
For ix = 2 To PICW - 1

   Select Case Increment
   Case 1
      culB = (1& * PalBGR(1, ix - 1, iy, 3) + PalBGR(1, ix + 1, iy, 3)) / 2
      culG = (1& * PalBGR(2, ix - 1, iy, 3) + PalBGR(2, ix + 1, iy, 3)) / 2
      culR = (1& * PalBGR(3, ix - 1, iy, 3) + PalBGR(3, ix + 1, iy, 3)) / 2
   Case 2
      culB = (1& * PalBGR(1, ix, iy - 1, 3) + PalBGR(1, ix, iy + 1, 3)) / 2
      culG = (1& * PalBGR(2, ix, iy - 1, 3) + PalBGR(2, ix, iy + 1, 3)) / 2
      culR = (1& * PalBGR(3, ix, iy - 1, 3) + PalBGR(3, ix, iy + 1, 3)) / 2
   
   Case 4
      culB = (1& * PalBGR(1, ix - 1, iy - 1, 3) + PalBGR(1, ix + 1, iy - 1, 3) _
      + PalBGR(1, ix - 1, iy + 1, 3) + PalBGR(1, ix + 1, iy + 1, 3)) / 4
      culG = (1& * PalBGR(2, ix - 1, iy - 1, 3) + PalBGR(2, ix + 1, iy - 1, 3) _
      + PalBGR(2, ix - 1, iy + 1, 3) + PalBGR(2, ix + 1, iy + 1, 3)) / 4
      culR = (1& * PalBGR(3, ix - 1, iy - 1, 3) + PalBGR(3, ix + 1, iy - 1, 3) _
      + PalBGR(3, ix - 1, iy + 1, 3) + PalBGR(3, ix + 1, iy + 1, 3)) / 4
   
   Case 8
   
      culB = (1& * PalBGR(1, ix - 1, iy - 1, 3) + PalBGR(1, ix, iy - 1, 3) _
      + PalBGR(1, ix + 1, iy - 1, 3) _
      + PalBGR(1, ix - 1, iy, 3) + PalBGR(1, ix + 1, iy, 3) _
      + PalBGR(1, ix - 1, iy + 1, 3) + PalBGR(1, ix, iy + 1, 3) _
      + PalBGR(1, ix + 1, iy + 1, 3)) / 8
      culG = (1& * PalBGR(2, ix - 1, iy - 1, 3) + PalBGR(2, ix, iy - 1, 3) _
      + PalBGR(2, ix + 1, iy - 1, 3) _
      + PalBGR(2, ix - 1, iy, 3) + PalBGR(2, ix + 1, iy, 3) _
      + PalBGR(2, ix - 1, iy + 1, 3) + PalBGR(2, ix, iy + 1, 3) _
      + PalBGR(2, ix + 1, iy + 1, 3)) / 8
      culR = (1& * PalBGR(3, ix - 1, iy - 1, 3) + PalBGR(3, ix, iy - 1, 3) _
      + PalBGR(3, ix + 1, iy - 1, 3) _
      + PalBGR(3, ix - 1, iy, 3) + PalBGR(3, ix + 1, iy, 3) _
      + PalBGR(3, ix - 1, iy + 1, 3) + PalBGR(3, ix, iy + 1, 3) _
      + PalBGR(3, ix + 1, iy + 1, 3)) / 8
   
   End Select
   
   PalBGR(1, ix, iy, 2) = culB
   PalBGR(2, ix, iy, 2) = culG
   PalBGR(3, ix, iy, 2) = culR
   
Next ix

Next iy

Case 1      ' CONTOUR   3->2

For iy = PICH - 1 To 2 Step -1
For ix = PICW - 1 To 2 Step -1

      culB = (1& * PalBGR(1, ix - 1, iy - 1, 3) + PalBGR(1, ix, iy - 1, 3) _
      + PalBGR(1, ix + 1, iy - 1, 3) _
      + PalBGR(1, ix - 1, iy, 3) + PalBGR(1, ix + 1, iy, 3) _
      + PalBGR(1, ix - 1, iy + 1, 3) + PalBGR(1, ix, iy + 1, 3) _
      + PalBGR(1, ix + 1, iy + 1, 3))
      culG = (1& * PalBGR(2, ix - 1, iy - 1, 3) + PalBGR(2, ix, iy - 1, 3) _
      + PalBGR(2, ix + 1, iy - 1, 3) _
      + PalBGR(2, ix - 1, iy, 3) + PalBGR(2, ix + 1, iy, 3) _
      + PalBGR(2, ix - 1, iy + 1, 3) + PalBGR(2, ix, iy + 1, 3) _
      + PalBGR(2, ix + 1, iy + 1, 3))
      culR = (1& * PalBGR(3, ix - 1, iy - 1, 3) + PalBGR(3, ix, iy - 1, 3) _
      + PalBGR(3, ix + 1, iy - 1, 3) _
      + PalBGR(3, ix - 1, iy, 3) + PalBGR(3, ix + 1, iy, 3) _
      + PalBGR(3, ix - 1, iy + 1, 3) + PalBGR(3, ix, iy + 1, 3) _
      + PalBGR(3, ix + 1, iy + 1, 3))

      culB = 8 * PalBGR(1, ix, iy, 3) - culB + QBBlue
      culG = 8 * PalBGR(2, ix, iy, 3) - culG + QBGreen
      culR = 8 * PalBGR(3, ix, iy, 3) - culR + QBRed
      
      If culB > 255 Then culB = 255
      If culG > 255 Then culG = 255
      If culR > 255 Then culR = 255
      
      If culB < 0 Then culB = 0
      If culG < 0 Then culG = 0
      If culR < 0 Then culR = 0
      
      PalBGR(1, ix, iy, 2) = culB And 255
      PalBGR(2, ix, iy, 2) = culG And 255
      PalBGR(3, ix, iy, 2) = culR And 255
      
Next ix

Next iy

Case 2   ' EMBOSS    ' 3->2

For iy = PICH - 1 To 1 Step -1
For ix = PICW - 1 To 1 Step -1
      
      culB = Abs(1& * PalBGR(1, ix, iy, 3) - PalBGR(1, ix + 1, iy + 1, 3) - QBBlue)
      culG = Abs(1& * PalBGR(2, ix, iy, 3) - PalBGR(2, ix + 1, iy + 1, 3) - QBGreen)
      culR = Abs(1& * PalBGR(3, ix, iy, 3) - PalBGR(3, ix + 1, iy + 1, 3) - QBRed)
   
      
      If culB > 255 Then culB = 255
      If culG > 255 Then culG = 255
      If culR > 255 Then culR = 255
      
      If culB < 0 Then culB = 0
      If culG < 0 Then culG = 0
      If culR < 0 Then culR = 0
      
      PalBGR(1, ix, iy, 2) = culB
      PalBGR(2, ix, iy, 2) = culG
      PalBGR(3, ix, iy, 2) = culR

Next ix

Next iy

Case 3       ' RIPPLE   3->2
       
      WSize = PICH: If PICW > PICH Then WSize = PICW
      
      ReDim YWave(WSize)
      For i = 1 To WSize
         YWave(i) = i + Sin(i / 5) * 2 * Increment
         If YWave(i) < 1 Then YWave(i) = 1
         If YWave(i) > PICH Then YWave(i) = PICH
      Next i
      
For ix = 1 To PICW - 1
For iy = 1 To PICH - 1
   
         PalBGR(1, ix, iy, 2) = PalBGR(1, ix, YWave(iy), 3)
         PalBGR(2, ix, iy, 2) = PalBGR(2, ix, YWave(iy), 3)
         PalBGR(3, ix, iy, 2) = PalBGR(3, ix, YWave(iy), 3)
Next iy

Next ix

'Erase YWave

Case 4      ' RELIEF    3->2 back

For iy = PICH - 1 To 2 Step -1
For ix = PICW - 1 To 2 Step -1
         
   culB = 2& * PalBGR(1, ix + 1, iy + 1, 3) + PalBGR(1, ix, iy + 1, 3) + _
        PalBGR(1, ix + 1, iy, 3) - PalBGR(1, ix - 1, iy, 3) - _
        PalBGR(1, ix, iy - 1, 3) - 2& * PalBGR(1, ix - 1, iy - 1, 3)
   culG = 2& * PalBGR(2, ix + 1, iy + 1, 3) + PalBGR(2, ix, iy + 1, 3) + _
        PalBGR(2, ix + 1, iy, 3) - PalBGR(2, ix - 1, iy, 3) - _
        PalBGR(2, ix, iy - 1, 3) - 2& * PalBGR(2, ix - 1, iy - 1, 3)
      
   culR = 2& * PalBGR(3, ix + 1, iy + 1, 3) + PalBGR(3, ix, iy + 1, 3) + _
        PalBGR(3, ix + 1, iy, 3) - PalBGR(3, ix - 1, iy, 2) - _
        PalBGR(3, ix, iy - 1, 3) - 2& * PalBGR(3, ix - 1, iy - 1, 3)
      
'GoTo pass
      culB = (PalBGR(1, ix, iy, 3) + culB) \ 2 + 50
      culG = (PalBGR(2, ix, iy, 3) + culG) \ 2 + 50
      culR = (PalBGR(3, ix, iy, 3) + culR) \ 2 + 50
pass:
      If culB > 255 Then culB = QBBlue '255
      If culG > 255 Then culG = QBGreen '255
      If culR > 255 Then culR = QBRed '255
      
      If culB < 0 Then culB = 0
      If culG < 0 Then culG = 0
      If culR < 0 Then culR = 0
      
      PalBGR(1, ix, iy, 2) = culB And 255
      PalBGR(2, ix, iy, 2) = culG And 255
      PalBGR(3, ix, iy, 2) = culR And 255
      
Next ix
    
Next iy


Case 5      ' TWIRL
   
   radmax = PICW
   If PICH > PICW Then radmax = PICH
   ixc = PICW / 2
   iyc = PICH / 2
   
   Select Case Increment
   Case 1: zpimul = pi# / 2
   Case 2: zpimul = pi#
   Case 4: zpimul = 3 * pi# / 2
   Case 8: zpimul = 2 * pi#
   End Select
   
   For iy = PICH To 1 Step -1
   For ix = PICW To 1 Step -1
      
      rad = Sqr((ix - ixc) ^ 2 + (iy - iyc) ^ 2)
      zTheta = (rad / radmax) * zpimul
      zSin = Sin(zTheta)
      zCos = Cos(zTheta)
      
      'Find Surf 2 point from rotated Surf 3 or Surf 1 point
      ixs = ixc + (ix - ixc) * zCos - (iy - iyc) * zSin
   
   If ixs < 1 Or ixs > PICW Then
      PalBGR(1, ix, iy, 2) = QBBlue
      PalBGR(2, ix, iy, 2) = QBGreen
      PalBGR(3, ix, iy, 2) = QBRed
      GoTo nexixx
   End If
   
   iys = iyc + (iy - iyc) * zCos + (ix - ixc) * zSin
   
   If iys < 1 Or iys > PICH Then
      PalBGR(1, ix, iy, 2) = QBBlue
      PalBGR(2, ix, iy, 2) = QBGreen
      PalBGR(3, ix, iy, 2) = QBRed
      GoTo nexixx
   End If
   
   PalBGR(1, ix, iy, 2) = PalBGR(1, ixs, iys, 3)
   PalBGR(2, ix, iy, 2) = PalBGR(2, ixs, iys, 3)
   PalBGR(3, ix, iy, 2) = PalBGR(3, ixs, iys, 3)

nexixx:

Next ix
Next iy

End Select

   
   '---------------------
   ShowPalBGR 2
   '---------------------
   
   If Done = False Then
      ' 2->3 to allow futher pixilation
      CopyMemory PalBGR(1, 1, 1, 3), PalBGR(1, 1, 1, 2), PalSize

   End If

DoEvents

Loop Until Done


End Sub

Public Sub IncrementalPalEffects()

Do

For iy = 1 To PICH
For ix = 1 To PICW

Select Case chkPALIndex
Case 0 To 5
   Select Case chkPALIndex
      Case 0, 1: PCul = 3
      Case 2, 3: PCul = 2
      Case 4, 5: PCul = 1
   End Select
   Select Case chkPALIndex
      Case 0, 2, 4
         ' REDDER, GREENER, BLUER
         If PalBGR(PCul, ix, iy, 2) + Increment < 255 Then
            PalBGR(PCul, ix, iy, 2) = (PalBGR(PCul, ix, iy, 2) + Increment) And &HFF
         Else
            PalBGR(PCul, ix, iy, 2) = 255
         End If
      Case 1, 3, 5
         ' LESS RED, LESS GREEN, LESS BLUE
         If PalBGR(PCul, ix, iy, 2) - Increment > Increment Then
            PalBGR(PCul, ix, iy, 2) = (PalBGR(PCul, ix, iy, 2) - Increment) And &HFF
         Else
            PalBGR(PCul, ix, iy, 2) = 0
         End If
   End Select
   
Case 6   ' BRIGHTER
   For PCul = 1 To 3
      If PalBGR(PCul, ix, iy, 2) + Increment < 255 Then
         PalBGR(PCul, ix, iy, 2) = (PalBGR(PCul, ix, iy, 2) + Increment)
      Else
         PalBGR(PCul, ix, iy, 2) = 255
      End If
   Next PCul
   
Case 7   ' DARKER
   For PCul = 1 To 3
      If PalBGR(PCul, ix, iy, 2) - Increment > Increment Then
         PalBGR(PCul, ix, iy, 2) = (PalBGR(PCul, ix, iy, 2) - Increment)
      Else
         PalBGR(PCul, ix, iy, 2) = 0
      End If
   Next PCul
   
Case 8   ' + ROTATE ALL COLORS
   For PCul = 1 To 3
      PalBGR(PCul, ix, iy, 2) = (PalBGR(PCul, ix, iy, 2) + Increment) And &HFF
   Next PCul

Case 9   ' - ROTATE ALL COLORS
   For PCul = 1 To 3
      PalBGR(PCul, ix, iy, 2) = (PalBGR(PCul, ix, iy, 2) - Increment) And &HFF
   Next PCul

Case 10  ' ADD NOISE
      
      zFac = 20 * Increment
      culB = PalBGR(1, ix, iy, 2) + ((zFac * 2 + 1) * Rnd - zFac)
      culG = PalBGR(2, ix, iy, 2) + ((zFac * 2 + 1) * Rnd - zFac)
      culR = PalBGR(3, ix, iy, 2) + ((zFac * 2 + 1) * Rnd - zFac)
      
      If culB > 255 Then culB = 255
      If culG > 255 Then culG = 255
      If culR > 255 Then culR = 255
      
      If culB < 0 Then culB = 0
      If culG < 0 Then culG = 0
      If culR < 0 Then culR = 0
      
      PalBGR(1, ix, iy, 2) = culB
      PalBGR(2, ix, iy, 2) = culG
      PalBGR(3, ix, iy, 2) = culR
   

End Select
   
DoEvents

Next ix

Next iy

   '---------------------
   ShowPalBGR 2
   '---------------------

DoEvents

Loop Until Done

End Sub

Public Sub PalEffects()

For iy = 1 To PICH
For ix = 1 To PICW

Select Case chkPALIndex
Case 11  ' INVERT
   For PCul = 1 To 3
      PalBGR(PCul, ix, iy, 2) = 255 - (PalBGR(PCul, ix, iy, 2))
   Next PCul

Case 12  'GREY
   Cul = 0
   For PCul = 1 To 3
      Cul = Cul + PalBGR(PCul, ix, iy, 2)
   Next PCul
   Cul = Cul \ 3
   For PCul = 1 To 3
      PalBGR(PCul, ix, iy, 2) = Cul
   Next PCul
   
Case 13  ' BLACKEN if R & G & B <24
   Cul = 0
   For PCul = 1 To 3
      If PalBGR(PCul, ix, iy, 2) > 24 Then ' NO
         Cul = 1
         Exit For
      End If
   Next PCul
   If Cul = 0 Then
      For PCul = 1 To 3
         PalBGR(PCul, ix, iy, 2) = 0
      Next PCul
   End If

Case 14  ' WHITEN if R & G & B > 248
   Cul = 0
   For PCul = 1 To 3
      If PalBGR(PCul, ix, iy, 2) < 248 Then ' NO
         Cul = 1
         Exit For
      End If
   Next PCul
   If Cul = 0 Then
      For PCul = 1 To 3
         PalBGR(PCul, ix, iy, 2) = 255
      Next PCul
   End If