picprocasm.bas

图像处理

Attribute VB_Name = "Module3"
'Module3: PicProcASM.bas

Option Base 1
DefLng A-W
DefSng X-Z

'Public Sub ASM_ColorXEffects()
'Public Sub ASM_Magnify()
'Public Sub ASM_IncrementalPalEffects()
'Public Sub ASM_PalEffects()
'Public Sub ASM_PixelEffects()
'Public Sub ASM_Rotate()

'-----------------------------------------------------------

'For calling machine code
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpMCode As Long, _
ByVal Long1 As Long, ByVal Long2 As Single, _
ByVal Long3 As Single, ByVal Long4 As Long) As Long

Public PicPalMC() As Byte     'Array to hold machine code for Palette Effects
Public PicColorXMC() As Byte  'Array to hold machine code for ColorX Effects
Public PicRotateMC() As Byte  'Array to hold machine code for Rotations
Public PicMagnifyMC() As Byte 'Array to hold machine code for Magnifications
Public PicPixelMC() As Byte   'Array to hold machine code for Pixel Effects

'MCode Structure
Public Type MCodeStruc
   PICW As Long
   PICH As Long
   PtrPalBGR As Long
   PtrPalLineCopy As Long
   Increment As Long
   QBLongColor As Long
   OpCode As Long
End Type
Public MCODE As MCodeStruc
'-------------------------------------

Public Sub ASM_ColorXEffects()

MCODE.PICW = PICW
MCODE.PICH = PICH
MCODE.PtrPalBGR = VarPtr(PalBGR(1, 1, 1, 1))
MCODE.PtrPalLineCopy = VarPtr(PalLineCopy(1, 1))
MCODE.Increment = Increment
MCODE.QBLongColor = QBLongColor
MCODE.OpCode = 0

ptrStruc = VarPtr(MCODE.PICW)
ptMC = VarPtr(PicColorXMC(0))

' Ensure same sequence each time
'Rnd -1
'Randomize 1

Randomize

' Feedback
Answer = 99
ptAns = VarPtr(Answer)

Do


Select Case chkColorXIndex
Case 0   ' Add Random ColorX
   
   ' Difficult to get a good spacial random
   ' number in mcode without using input from
   ' timer BUT this disallowed above Win98,
   ' thus this no quicker than VB.
   
   For i = 1 To 20 * Increment

      zParam1 = Rnd
      zParam2 = Rnd
      MCODE.OpCode = 0
      res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptAns)

   Next i
   
Case 1   ' Add colored horizontal lines
      MCODE.OpCode = 1
      res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptAns)
Case 2   ' Add colored vertical lines
      MCODE.OpCode = 2
      res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptAns)
Case 3   ' Add colored dots
      MCODE.OpCode = 3
      res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptAns)
Case 4   ' Diffuse ColorX
      zParam1 = 0.9
      zParam2 = 0.1
      MCODE.OpCode = 4
      res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptAns)
      'A = Answer:Stop

Case 5   ' Diffuse ColorX UP
      zParam1 = 0.9
      zParam2 = 0.1
      MCODE.OpCode = 5
      res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptAns)
Case 6   ' Diffuse ColorX DOWN
      zParam1 = 0.9
      zParam2 = 0.1
      MCODE.OpCode = 6
      res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptAns)
Case 7   ' Diffuse ColorX LEFT
      zParam1 = 0.9
      zParam2 = 0.1
      MCODE.OpCode = 7
      res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptAns)
Case 8   ' Diffuse ColorX RIGHT
      zParam1 = 0.9
      zParam2 = 0.1
      MCODE.OpCode = 8
      res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptAns)
Case 9   ' Bright SPOT @ iXp,iYp
      zParam1 = iXp
      zParam2 = iYp
      MCODE.OpCode = 9
      res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptAns)

End Select


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

DoEvents

Loop Until Done


End Sub

Public Sub ASM_Magnify()

If zMag < 1 Then
   zdm = -0.05
Else
   zdm = 0.1
End If


MCODE.PICW = PICW
MCODE.PICH = PICH
MCODE.PtrPalBGR = VarPtr(PalBGR(1, 1, 1, 1))
MCODE.PtrPalLineCopy = VarPtr(PalLineCopy(1, 1))
MCODE.Increment = Increment
MCODE.QBLongColor = QBLongColor
MCODE.OpCode = 0

ptrStruc = VarPtr(MCODE.PICW)
ptMC = VarPtr(PicMagnifyMC(0))

zParam1 = iXp
zParam2 = iYp


Do

MAG = 10 * zMag

Select Case chkMagIndex

Case 0      ' SIMPLE MAG
   MCODE.OpCode = chkMagIndex
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, MAG)
Case 1      ' ANTI-ALIAS MAG
   MCODE.OpCode = chkMagIndex
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, MAG)

End Select


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


DoEvents

If Done = False Then    ' LOOP MAG
   
   If zMag <= 0.1 Then zdm = 0.05
   If zdm > 0 And zMag > 1 Then zdm = 0.1
   If zMag >= 10 Then zdm = -0.1
   If zdm < 0 And zMag <= 1 Then zdm = -0.05
   
   zMag = zMag + zdm * Increment
   If zMag < 0.1 Then zMag = 0.1
   If zMag > 10 Then zMag = 10
   ' Show zMag
   Form1.HSBMag.Value = 10 * zMag
   Form1.txtMag.TEXT = Str$(zMag)

End If


Loop Until Done


End Sub

Public Sub ASM_IncrementalPalEffects()

MCODE.PICW = PICW
MCODE.PICH = PICH
MCODE.PtrPalBGR = VarPtr(PalBGR(1, 1, 1, 1))
MCODE.PtrPalLineCopy = VarPtr(PalLineCopy(1, 1))
'MCODE.Increment = Increment
'MCODE.QBLongColor = QBLongColor
MCODE.OpCode = 0

ptrStruc = VarPtr(MCODE.PICW)
ptMC = VarPtr(PicPalMC(0))

' Ensure same sequence each time
Rnd -1
Randomize 1

Do

MCODE.Increment = Increment
MCODE.QBLongColor = QBLongColor

Select Case chkPALIndex
Case 0   ' Redder
   MCODE.OpCode = 0
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)
Case 1   ' Less Red
   MCODE.OpCode = 1
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)
Case 2   ' Greener
   MCODE.OpCode = 2
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)
Case 3   ' Less Green
   MCODE.OpCode = 3
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)
Case 4   ' Bluer
   MCODE.OpCode = 4
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)
Case 5   ' Less Blue
   MCODE.OpCode = 5
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)
Case 6   ' Brighter
   MCODE.OpCode = 6
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)
Case 7   ' Darker
   MCODE.OpCode = 7
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)
Case 8   ' + Rotate colors
   MCODE.OpCode = 8
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)
Case 9   ' - Rotate colors
   MCODE.OpCode = 9
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)
Case 10  ' Add Noise
   zParam1 = 255 * Rnd
   MCODE.OpCode = 10
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, 4&)

End Select


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

DoEvents

Loop Until Done


End Sub


Public Sub ASM_PalEffects()
MCODE.PICW = PICW
MCODE.PICH = PICH
MCODE.PtrPalBGR = VarPtr(PalBGR(1, 1, 1, 1))
MCODE.PtrPalLineCopy = VarPtr(PalLineCopy(1, 1))
MCODE.Increment = Increment
MCODE.QBLongColor = QBLongColor
MCODE.OpCode = 0

ptrStruc = VarPtr(MCODE.PICW)
ptMC = VarPtr(PicPalMC(0))

Select Case chkPALIndex
Case 11     ' INVERT
   MCODE.OpCode = 11
   res = CallWindowProc(ptMC, ptrStruc, Rand, 3&, 4&)
Case 12     ' GREY
   MCODE.OpCode = 12
   res = CallWindowProc(ptMC, ptrStruc, Rand, 3&, 4&)
Case 13     ' BLACKEN if R,G & B < 24
   MCODE.OpCode = 13
   res = CallWindowProc(ptMC, ptrStruc, Rand, 3&, 4&)
Case 14     ' WHITEN if R,G & B > 248
   MCODE.OpCode = 14
   res = CallWindowProc(ptMC, ptrStruc, Rand, 3&, 4&)
Case 15     ' B to W if R,G & B = 0
   MCODE.OpCode = 15
   res = CallWindowProc(ptMC, ptrStruc, Rand, 3&, 4&)
Case 16     ' W to B if R,G & B = 255
   MCODE.OpCode = 16
   res = CallWindowProc(ptMC, ptrStruc, Rand, 3&, 4&)
Case 17     ' NW to B if R,G & B <> 255
   MCODE.OpCode = 17
   res = CallWindowProc(ptMC, ptrStruc, Rand, 3&, 4&)
Case 18     ' NB to W if R,G & B <> 0
   MCODE.OpCode = 18
   res = CallWindowProc(ptMC, ptrStruc, Rand, 3&, 4&)
Case 19     ' BLACK or WHITE if R,G & B >= < 180
   MCODE.OpCode = 19
   res = CallWindowProc(ptMC, ptrStruc, Rand, 3&, 4&)


End Select
End Sub

Public Sub ASM_PixelEffects()

MCODE.PICW = PICW
MCODE.PICH = PICH
MCODE.PtrPalBGR = VarPtr(PalBGR(1, 1, 1, 1))
MCODE.PtrPalLineCopy = VarPtr(PalLineCopy(1, 1))
MCODE.Increment = Increment
MCODE.QBLongColor = QBLongColor
MCODE.OpCode = 0


ptrStruc = VarPtr(MCODE.PICW)
ptMC = VarPtr(PicPixelMC(0))

zParam1 = iXp
zParam2 = iYp

'0 SMOOTH
'1 CONTOUR
'2 EMBOSS
'3 RIPPLE
'4 RELIEF
'5 TWIRL

Do

Select Case chkPIXIndex

Case 0, 1, 2, 4, 5
   
   MCODE.Increment = Increment
   MCODE.QBLongColor = QBLongColor
   MCODE.OpCode = chkPIXIndex
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ALong)

Case 3
      
      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
      ptrWave = VarPtr(YWave(1))
   
   MCODE.OpCode = chkPIXIndex
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, ptrWave)


End Select
   
   '---------------------
   ShowPalBGR 2
   '---------------------

   If Done = False Then
      ' 2->3 to allows looping
      CopyMemory PalBGR(1, 1, 1, 3), PalBGR(1, 1, 1, 2), PalSize

   End If

DoEvents

Loop Until Done

End Sub

Public Sub ASM_Rotate()

If Done = True And zAngle = 0 Then Exit Sub

MCODE.PICW = PICW
MCODE.PICH = PICH
MCODE.PtrPalBGR = VarPtr(PalBGR(1, 1, 1, 1))
MCODE.PtrPalLineCopy = VarPtr(PalLineCopy(1, 1))
MCODE.Increment = Increment
MCODE.QBLongColor = QBLongColor
MCODE.OpCode = 0

ptrStruc = VarPtr(MCODE.PICW)
ptMC = VarPtr(PicRotateMC(0))


RANG = zAngle + 360  ' 0-360
SgnA = Sgn(zAngle)
If SgnA = 0 Then SgnA = 1

zParam1 = iXp
zParam2 = iYp


Do

'zang = zRANG * d2r#


Select Case chkRotateIndex

Case 0, 2   ' SIMPLE ROTATE   0(display)  2(perm)
   MCODE.OpCode = chkRotateIndex
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, RANG)
Case 1, 3   ' ANTI-ALIAS ROTATE   1(display)  3(perm)
   MCODE.OpCode = chkRotateIndex
   res = CallWindowProc(ptMC, ptrStruc, zParam1, zParam2, RANG)

End Select



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


DoEvents



If Done = False Then
   
   RANG = RANG + SgnA * Increment
   
   If RANG > 360 Then RANG = RANG - 360
   If RANG < -360 Then RANG = RANG + 360
   
   Form1.HSBAngle.Value = RANG \ 2 + 180
   Form1.txtAngle.TEXT = Str$(RANG \ 2)

End If


Loop Until Done


End Sub