home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD5456532000.psc / Image Processing / modAPI.bas < prev    next >
Encoding:
BASIC Source File  |  2000-05-04  |  10.6 KB  |  238 lines
  1. Attribute VB_Name = "modAPI"
  2. 'WINDOWS API DECLARATIONS
  3. Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  4. Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  5. Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  6. Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  7. Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  8. Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  9. Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  10. Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  11.  
  12. 'DECLARES PUBLIC VARIABLES
  13. Public indeks As Integer
  14. Public picforms(0 To 99) As New frmPicture
  15. Public fpath As String
  16. Public hBMPSour(0 To 99) As Long
  17. Public hDCSour(0 To 99) As Long
  18. Public hBMPDest(0 To 99) As Long
  19. Public hDCDest(0 To 99) As Long
  20. Public iCancel As Boolean
  21. Public currDir As String
  22.  
  23. Function GetRed(cValue As Long) As Long 'A function that is used to get RED value
  24.     GetRed = cValue Mod 256
  25. End Function
  26.  
  27. Function GetGreen(cValue As Long) As Long   'A function that is used to get GREEN value
  28.     GetGreen = Int((cValue / 256)) Mod 256
  29. End Function
  30.  
  31. Function GetBlue(cValue As Long) As Long    'A function that is used to get BLUE value
  32.     GetBlue = Int(cValue / 65536)
  33. End Function
  34.  
  35. Sub Lighten(pfIndex As Integer) 'Codes to make your picture lighter
  36.     Dim pX As Long, pY As Long
  37.     Dim x As Long, y As Long
  38.     Dim colorval As Long
  39.     Dim red As Long, green As Long, blue As Long
  40.     Dim red2 As Long, green2 As Long, blue2 As Long
  41.     
  42.     pX = mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth - 1
  43.     pY = mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight - 1
  44.     For x = 0 To pX
  45.         For y = 0 To pY
  46.             colorval = GetPixel(hDCSour(pfIndex), x, y)
  47.             red = GetRed(colorval)
  48.             green = GetGreen(colorval)
  49.             blue = GetBlue(colorval)
  50.             
  51.             red2 = red + 20
  52.             green2 = green + 20
  53.             blue2 = blue + 20
  54.             
  55.             If red2 >= 255 Then red2 = 255
  56.             If green2 >= 255 Then green2 = 255
  57.             If blue2 >= 255 Then blue2 = 255
  58.             If red2 <= 0 Then red2 = 0
  59.             If green2 <= 0 Then green2 = 0
  60.             If blue2 <= 0 Then blue2 = 0
  61.             
  62.             SetPixel hDCDest(pfIndex), x, y, RGB(red2, green2, blue2)
  63.         Next y
  64.     Next x
  65.     BitBlt mdiImgProcess.ActiveForm.pcbPicture.hdc, 0, 0, mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth, mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight, hDCDest(pfIndex), 0, 0, vbSrcCopy
  66.         'Copy picture into picture box
  67.     mdiImgProcess.ActiveForm.pcbPicture.Refresh
  68.     BitBlt hDCSour(pfIndex), 0, 0, mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth, mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight, mdiImgProcess.ActiveForm.pcbPicture.hdc, 0, 0, vbSrcCopy
  69.         'Refresh picture in memory
  70. End Sub
  71.  
  72. Sub Darken(pfIndex As Integer)  'Codes to make your picture darker
  73.     Dim pX As Long, pY As Long
  74.     Dim x As Long, y As Long
  75.     Dim colorval As Long
  76.     Dim red As Long, green As Long, blue As Long
  77.     Dim red2 As Long, green2 As Long, blue2 As Long
  78.     
  79.     pX = mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth - 1
  80.     pY = mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight - 1
  81.     For x = 0 To pX
  82.         For y = 0 To pY
  83.             colorval = GetPixel(hDCSour(pfIndex), x, y)
  84.             red = GetRed(colorval)
  85.             green = GetGreen(colorval)
  86.             blue = GetBlue(colorval)
  87.             
  88.             red2 = red - 20
  89.             green2 = green - 20
  90.             blue2 = blue - 20
  91.             
  92.             If red2 >= 255 Then red2 = 255
  93.             If green2 >= 255 Then green2 = 255
  94.             If blue2 >= 255 Then blue2 = 255
  95.             If red2 <= 0 Then red2 = 0
  96.             If green2 <= 0 Then green2 = 0
  97.             If blue2 <= 0 Then blue2 = 0
  98.             
  99.             SetPixel hDCDest(pfIndex), x, y, RGB(red2, green2, blue2)
  100.         Next y
  101.     Next x
  102.     BitBlt mdiImgProcess.ActiveForm.pcbPicture.hdc, 0, 0, mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth, mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight, hDCDest(pfIndex), 0, 0, vbSrcCopy
  103.         'Copy picture into picture box
  104.     mdiImgProcess.ActiveForm.pcbPicture.Refresh
  105.     BitBlt hDCSour(pfIndex), 0, 0, mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth, mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight, mdiImgProcess.ActiveForm.pcbPicture.hdc, 0, 0, vbSrcCopy
  106.         'Refresh picture in memory
  107. End Sub
  108.  
  109. Sub Grayscaling(pfIndex As Integer) 'Codes to make your picture in grayscale
  110.     Dim pX As Long, pY As Long
  111.     Dim x As Long, y As Long
  112.     Dim colorval As Long
  113.     Dim red As Long, green As Long, blue As Long
  114.     Dim red2 As Long, green2 As Long, blue2 As Long
  115.     
  116.     pX = mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth - 1
  117.     pY = mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight - 1
  118.     For x = 0 To pX
  119.         For y = 0 To pY
  120.             colorval = GetPixel(hDCSour(pfIndex), x, y)
  121.             red = GetRed(colorval)
  122.             green = GetGreen(colorval)
  123.             blue = GetBlue(colorval)
  124.             
  125.             red2 = Int((red + green + blue) / 3)
  126.             green2 = red2
  127.             blue2 = red2
  128.             
  129.             If red2 >= 255 Then red2 = 255
  130.             If green2 >= 255 Then green2 = 255
  131.             If blue2 >= 255 Then blue2 = 255
  132.             If red2 <= 0 Then red2 = 0
  133.             If green2 <= 0 Then green2 = 0
  134.             If blue2 <= 0 Then blue2 = 0
  135.             
  136.             SetPixel hDCDest(pfIndex), x, y, RGB(red2, green2, blue2)
  137.         Next y
  138.     Next x
  139.     BitBlt mdiImgProcess.ActiveForm.pcbPicture.hdc, 0, 0, mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth, mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight, hDCDest(pfIndex), 0, 0, vbSrcCopy
  140.         'Copy picture into picture box
  141.     mdiImgProcess.ActiveForm.pcbPicture.Refresh
  142.     BitBlt hDCSour(pfIndex), 0, 0, mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth, mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight, mdiImgProcess.ActiveForm.pcbPicture.hdc, 0, 0, vbSrcCopy
  143.         'Refresh picture in memory
  144. End Sub
  145.  
  146. Sub Inverting(pfIndex As Integer)   'Codes to invert color of your picture
  147.     Dim pX As Long, pY As Long
  148.     Dim x As Long, y As Long
  149.     Dim colorval As Long
  150.     Dim red As Long, green As Long, blue As Long
  151.     Dim red2 As Long, green2 As Long, blue2 As Long
  152.     
  153.     pX = mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth - 1
  154.     pY = mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight - 1
  155.     For x = 0 To pX
  156.         For y = 0 To pY
  157.             colorval = GetPixel(hDCSour(pfIndex), x, y)
  158.             red = GetRed(colorval)
  159.             green = GetGreen(colorval)
  160.             blue = GetBlue(colorval)
  161.             
  162.             red2 = 255 - red
  163.             green2 = 255 - green
  164.             blue2 = 255 - blue
  165.             
  166.             If red2 >= 255 Then red2 = 255
  167.             If green2 >= 255 Then green2 = 255
  168.             If blue2 >= 255 Then blue2 = 255
  169.             If red2 <= 0 Then red2 = 0
  170.             If green2 <= 0 Then green2 = 0
  171.             If blue2 <= 0 Then blue2 = 0
  172.             
  173.             SetPixel hDCDest(pfIndex), x, y, RGB(red2, green2, blue2)
  174.         Next y
  175.     Next x
  176.     BitBlt mdiImgProcess.ActiveForm.pcbPicture.hdc, 0, 0, mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth, mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight, hDCDest(pfIndex), 0, 0, vbSrcCopy
  177.         'Copy picture into picture box
  178.     mdiImgProcess.ActiveForm.pcbPicture.Refresh
  179.     BitBlt hDCSour(pfIndex), 0, 0, mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth, mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight, mdiImgProcess.ActiveForm.pcbPicture.hdc, 0, 0, vbSrcCopy
  180.         'Refresh picture in memory
  181. End Sub
  182.  
  183. Sub Blurring(pfIndex As Integer)    'Codes to blur your picture
  184.     Dim pX As Long, pY As Long
  185.     Dim x As Long, y As Long
  186.     Dim colorval(8) As Long
  187.     Dim red(8) As Long, green(8) As Long, blue(8) As Long
  188.     Dim red2 As Long, green2 As Long, blue2 As Long
  189.     Dim i As Integer
  190.     
  191.     pX = mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth - 1
  192.     pY = mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight - 1
  193.     For x = 1 To pX
  194.         For y = 1 To pY
  195.             colorval(0) = GetPixel(hDCSour(pfIndex), x - 1, y - 1)
  196.             colorval(1) = GetPixel(hDCSour(pfIndex), x - 1, y)
  197.             colorval(2) = GetPixel(hDCSour(pfIndex), x - 1, y + 1)
  198.             colorval(3) = GetPixel(hDCSour(pfIndex), x, y - 1)
  199.             colorval(4) = GetPixel(hDCSour(pfIndex), x, y)
  200.             colorval(5) = GetPixel(hDCSour(pfIndex), x, y + 1)
  201.             colorval(6) = GetPixel(hDCSour(pfIndex), x + 1, y - 1)
  202.             colorval(7) = GetPixel(hDCSour(pfIndex), x + 1, y)
  203.             colorval(8) = GetPixel(hDCSour(pfIndex), x + 1, y + 1)
  204.                 'Get color value in 3x3 pixels box
  205.             For i = 0 To 8
  206.                 red(i) = GetRed(colorval(i))
  207.                 green(i) = GetGreen(colorval(i))
  208.                 blue(i) = GetBlue(colorval(i))
  209.                     'Get red, green, and blue values for each pixel
  210.                 red2 = red2 + red(i)
  211.                 green2 = green2 + green(i)
  212.                 blue2 = blue2 + blue(i)
  213.                     'Make a sum of those red, green, and blue values
  214.             Next i
  215.             
  216.             red2 = Int(red2 / 9)
  217.             green2 = Int(green2 / 9)
  218.             blue2 = Int(blue2 / 9)
  219.                 'Average those sums
  220.             
  221.             If red2 >= 255 Then red2 = 255
  222.             If green2 >= 255 Then green2 = 255
  223.             If blue2 >= 255 Then blue2 = 255
  224.             If red2 <= 0 Then red2 = 0
  225.             If green2 <= 0 Then green2 = 0
  226.             If blue2 <= 0 Then blue2 = 0
  227.             
  228.             SetPixel hDCDest(pfIndex), x, y, RGB(red2, green2, blue2)
  229.         Next y
  230.     Next x
  231.     BitBlt mdiImgProcess.ActiveForm.pcbPicture.hdc, 0, 0, mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth, mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight, hDCDest(pfIndex), 0, 0, vbSrcCopy
  232.         'Copy picture into picture box
  233.     mdiImgProcess.ActiveForm.pcbPicture.Refresh
  234.     BitBlt hDCSour(pfIndex), 0, 0, mdiImgProcess.ActiveForm.pcbPicture.ScaleWidth, mdiImgProcess.ActiveForm.pcbPicture.ScaleHeight, mdiImgProcess.ActiveForm.pcbPicture.hdc, 0, 0, vbSrcCopy
  235.         'Refresh picture in memory
  236. End Sub
  237.  
  238.