Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Analisi Immagini (8 Fasi) - Analisi.frm

Analisi.frm

 Caricato da: P4p3r0g4
Scarica il programma completo

  1. Option Explicit
  2.  
  3. Private Declare Function SetPixel Lib "gdi32" Alias "SetPixelV" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  4. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  5. Dim color() As Long
  6. Dim colorB() As Long
  7. Dim colorG() As Long
  8. Dim colorR() As Long
  9. Dim colorRGB() As Long
  10. Dim colorContrast() As Long
  11. Dim ContrastRGB() As Long
  12. Dim colormean As Currency
  13. Dim WithEvents PicSource As PictureBox
  14. Attribute PicSource.VB_VarHelpID = -1
  15. Dim meanR As Currency
  16. Dim meanG As Currency
  17. Dim meanB As Currency
  18. Dim meanRGB As Integer
  19. Dim PWidth As Long
  20. Dim PHeight As Long
  21. Public Sub AnalizeImage(image As PictureBox)
  22. Dim x As Long
  23. Dim y As Long
  24. Set PicSource = image
  25. PHeight = PicSource.ScaleHeight - 1
  26. PWidth = PicSource.ScaleWidth - 1
  27. ReDim color(1 To PWidth, 1 To PHeight)
  28. ReDim colorRGB(1 To PWidth, 1 To PHeight)
  29. ReDim colorR(1 To PWidth, 1 To PHeight)
  30. ReDim colorG(1 To PWidth, 1 To PHeight)
  31. ReDim colorB(1 To PWidth, 1 To PHeight)
  32. ReDim colorContrast(1 To PWidth, 1 To PHeight)
  33. ReDim ContrastRGB(1 To PWidth, 1 To PHeight)
  34. Dim newR As Integer
  35. Dim newG As Integer
  36. Dim newB As Integer
  37. Dim newRGB As Integer
  38. Imgtemp.Height = PicSource.Height
  39. Imgtemp.Width = PicSource.Width
  40. Imgtemp.ScaleHeight = PicSource.ScaleHeight
  41. Imgtemp.ScaleWidth = PicSource.ScaleWidth
  42. DoEvents
  43. Scomponicolori
  44.  
  45. For x = 1 To PWidth
  46. For y = 1 To PHeight
  47. newR = contrasta(colorR(x, y), meanR)
  48. newG = contrasta(colorG(x, y), meanG)
  49. newB = contrasta(colorB(x, y), meanB)
  50. newRGB = (newR + newG + newB) / 3
  51. Call SetPixel(Picture2.hdc, x, y, RGB(newR, newG, newB))
  52. colorContrast(x, y) = AnalizzaAdiacenti(x, y)
  53. ContrastRGB(x, y) = (colorContrast(x, y) Mod 256) + Int(colorContrast(x, y) / 256) Mod 256 + Int(colorContrast(x, y) / (CLng(256) * CLng(256)))
  54. Call SetPixel(Picture3.hdc, x, y, colorContrast(x, y))
  55. Call SetPixel(Picture6.hdc, x, y, RGB(colorR(x, y), 0, 0))
  56. Call SetPixel(Picture7.hdc, x, y, RGB(0, colorG(x, y), 0))
  57. Call SetPixel(Picture8.hdc, x, y, RGB(0, 0, colorB(x, y)))
  58. If colorRGB(x, y) < colormean Then
  59. Call SetPixel(Imgtemp.hdc, x, y, vbBlack)
  60. Else
  61. Call SetPixel(Imgtemp.hdc, x, y, vbWhite)
  62. End If
  63.  
  64. If newRGB < meanRGB Then
  65. Call SetPixel(Picture4.hdc, x, y, vbBlack)
  66. Else
  67. Call SetPixel(Picture4.hdc, x, y, vbWhite)
  68. End If
  69.  
  70. If ContrastRGB(x, y) < colormean Then
  71. Call SetPixel(Picture5.hdc, x, y, vbBlack)
  72. Else
  73. Call SetPixel(Picture5.hdc, x, y, vbWhite)
  74. End If
  75.  
  76. Next y
  77. Next x
  78. StillRotating:
  79. End Sub
  80.  
  81.  
  82.  
  83. Private Sub Scomponicolori()
  84. Dim x As Long
  85. Dim y As Long
  86. For x = 1 To PWidth
  87. For y = 1 To PHeight
  88. color(x, y) = GetPixel(PicSource.hdc, x, y)
  89. If color(x, y) = -1 Then Stop
  90. colorR(x, y) = (color(x, y) Mod 256)
  91. colorG(x, y) = Int(color(x, y) / 256) Mod 256
  92. colorB(x, y) = Int(color(x, y) / (CLng(256) * CLng(256)))
  93. colorRGB(x, y) = colorR(x, y) + colorG(x, y) + colorB(x, y)
  94. meanR = meanR + colorR(x, y)
  95. meanG = meanG + colorR(x, y)
  96. meanB = meanB + colorR(x, y)
  97. colormean = colormean + colorRGB(x, y)
  98. Next y
  99. Next x
  100. colormean = colormean / ((PHeight) * (PWidth))
  101. meanR = Int(meanR / ((PHeight) * (PWidth)))
  102. meanG = Int(meanG / ((PHeight) * (PWidth)))
  103. meanB = Int(meanB / ((PHeight) * (PWidth)))
  104. meanRGB = (meanR + meanG + meanB) / 3
  105. DoEvents
  106. End Sub
  107.  
  108. Private Function AnalizzaAdiacenti(x As Long, y As Long) As Long
  109. Select Case x
  110. Case 1
  111. Select Case y
  112. Case 1
  113. AnalizzaAdiacenti = RGB(contrasta(colorR(x, y), Int((colorR(x, y + 1) + colorR(x + 1, y) + colorR(x + 1, y + 1)) / 3)), contrasta(colorG(x, y), Int((colorG(x, y + 1) + colorG(x + 1, y) + colorG(x + 1, y + 1)) / 3)), contrasta(colorB(x, y), Int((colorB(x, y + 1) + colorB(x + 1, y) + colorB(x + 1, y + 1)) / 3)))
  114. Case PHeight
  115. AnalizzaAdiacenti = RGB(contrasta(colorR(x, y), Int((colorR(x, y - 1) + colorR(x + 1, y - 1) + colorR(x + 1, y)) / 3)), contrasta(colorG(x, y), Int((colorG(x, y - 1) + colorG(x + 1, y - 1) + colorG(x + 1, y)) / 3)), contrasta(colorB(x, y), Int((colorB(x, y - 1) + colorB(x + 1, y - 1) + colorB(x + 1, y)) / 3)))
  116. Case Else
  117. AnalizzaAdiacenti = RGB(contrasta(colorR(x, y), Int((colorR(x, y - 1) + colorR(x, y + 1) + colorR(x + 1, y - 1) + colorR(x + 1, y) + colorR(x + 1, y + 1)) / 5)), contrasta(colorG(x, y), Int((colorG(x, y - 1) + colorG(x, y + 1) + colorG(x + 1, y - 1) + colorG(x + 1, y) + colorG(x + 1, y + 1)) / 5)), contrasta(colorB(x, y), Int((colorB(x, y - 1) + colorB(x, y + 1) + colorB(x + 1, y - 1) + colorB(x + 1, y) + colorB(x + 1, y + 1)) / 5)))
  118. End Select
  119. Case PWidth
  120. Select Case y
  121. Case 1
  122. AnalizzaAdiacenti = RGB(contrasta(colorR(x, y), Int((colorR(x, y + 1) + colorR(x - 1, y) + colorR(x - 1, y + 1)) / 3)), contrasta(colorG(x, y), Int((colorG(x, y + 1) + colorG(x - 1, y) + colorG(x - 1, y + 1)) / 3)), contrasta(colorB(x, y), Int((colorB(x, y + 1) + colorB(x - 1, y) + colorB(x - 1, y + 1)) / 3)))
  123. Case PHeight
  124. AnalizzaAdiacenti = RGB(contrasta(colorR(x, y), Int((colorR(x, y - 1) + colorR(x - 1, y - 1) + colorR(x - 1, y)) / 3)), contrasta(colorG(x, y), Int((colorG(x, y - 1) + colorG(x - 1, y - 1) + colorG(x - 1, y)) / 3)), contrasta(colorB(x, y), Int((colorB(x, y - 1) + colorB(x - 1, y - 1) + colorB(x - 1, y)) / 3)))
  125. Case Else
  126. AnalizzaAdiacenti = RGB(contrasta(colorR(x, y), Int((colorR(x, y - 1) + colorR(x, y + 1) + colorR(x - 1, y - 1) + colorR(x - 1, y) + colorR(x - 1, y + 1)) / 5)), contrasta(colorG(x, y), Int((colorG(x, y - 1) + colorG(x, y + 1) + colorG(x - 1, y - 1) + colorG(x - 1, y) + colorG(x - 1, y + 1)) / 5)), contrasta(colorB(x, y), Int((colorB(x, y - 1) + colorB(x, y + 1) + colorB(x - 1, y - 1) + colorB(x - 1, y) + colorB(x - 1, y + 1)) / 5)))
  127. End Select
  128. Case Else
  129. Select Case y
  130. Case 1
  131. AnalizzaAdiacenti = RGB(contrasta(colorR(x, y), Int((colorR(x - 1, y) + colorR(x - 1, y + 1) + colorR(x, y + 1) + colorR(x + 1, y) + colorR(x + 1, y + 1)) / 5)), contrasta(colorG(x, y), Int((colorG(x - 1, y) + colorG(x - 1, y + 1) + colorG(x, y + 1) + colorG(x + 1, y) + colorG(x + 1, y + 1)) / 5)), contrasta(colorB(x, y), Int((colorB(x - 1, y) + colorB(x - 1, y + 1) + colorB(x, y + 1) + colorB(x + 1, y) + colorB(x + 1, y + 1)) / 5)))
  132. Case PHeight
  133. AnalizzaAdiacenti = RGB(contrasta(colorR(x, y), Int((colorR(x - 1, y) + colorR(x - 1, y - 1) + colorR(x, y - 1) + colorR(x + 1, y) + colorR(x + 1, y - 1)) / 5)), contrasta(colorG(x, y), Int((colorG(x - 1, y) + colorG(x - 1, y - 1) + colorG(x, y - 1) + colorG(x + 1, y) + colorG(x + 1, y - 1)) / 5)), contrasta(colorB(x, y), Int((colorB(x - 1, y) + colorB(x - 1, y - 1) + colorB(x, y - 1) + colorB(x + 1, y) + colorB(x + 1, y - 1)) / 5)))
  134. Case Else
  135. AnalizzaAdiacenti = RGB(contrasta(colorR(x, y), Int((colorR(x - 1, y - 1) + colorR(x - 1, y) + colorR(x - 1, y + 1) + colorR(x, y - 1) + colorR(x, y + 1) + colorR(x + 1, y - 1) + colorR(x + 1, y) + colorR(x + 1, y + 1)) / 8)), contrasta(colorG(x, y), Int((colorG(x - 1, y - 1) + colorG(x - 1, y) + colorG(x - 1, y + 1) + colorG(x, y - 1) + colorG(x, y + 1) + colorG(x + 1, y - 1) + colorG(x + 1, y) + colorG(x + 1, y + 1)) / 8)), contrasta(colorB(x, y), Int((colorB(x - 1, y - 1) + colorB(x - 1, y) + colorB(x - 1, y + 1) + colorB(x, y - 1) + colorB(x, y + 1) + colorB(x + 1, y - 1) + colorB(x + 1, y) + colorB(x + 1, y + 1)) / 8)))
  136. End Select
  137. End Select
  138. End Function
  139.  
  140. Private Function contrasta(x As Long, xm As Currency) As Integer
  141. Dim a As Integer, xmax As Integer
  142. xmax = 255
  143. a = xmax - xm
  144. If x < xm Then
  145. contrasta = xm - Sqr(xm ^ 2 - (x) ^ 2)
  146. Else
  147. contrasta = xm + Sqr(a ^ 2 - (a - x + xm) ^ 2)
  148. End If
  149. End Function
  150.  
  151. Private Sub CmdAnalizza_Click()
  152. Call AnalizeImage(Picture1)
  153. End Sub
  154.  
  155. Private Sub Credits_Click()
  156. Imgtemp.Cls
  157. Picture1.Cls
  158. Picture2.Cls
  159. Picture3.Cls
  160. Picture4.Cls
  161. Picture5.Cls
  162. Picture6.Cls
  163. Picture7.Cls
  164. Picture8.Cls
  165. If Credits.Caption = "Credits" Then
  166. Imgtemp.BackColor = vbRed
  167. Picture1.BackColor = vbRed
  168. Picture3.BackColor = vbRed
  169. Picture5.BackColor = vbRed
  170. Picture6.BackColor = vbBlue
  171. Picture8.BackColor = vbYellow
  172. Picture4.Picture = Picture10.Picture
  173. Picture10.Picture = Picture1.Picture
  174. Picture1.Picture = Nothing
  175. Picture7.Picture = Picture9.Picture
  176. Label1.Visible = True
  177. Label2.Visible = True
  178. Label3.Visible = True
  179. Label4.Visible = True
  180. Credits.Caption = "Back"
  181. CmdAnalizza.Enabled = False
  182. Else
  183. Imgtemp.BackColor = vbWhite
  184. Picture1.BackColor = vbWhite
  185. Picture3.BackColor = vbWhite
  186. Picture5.BackColor = vbWhite
  187. Picture6.BackColor = vbWhite
  188. Picture8.BackColor = vbWhite
  189. Picture1.Picture = Picture10.Picture
  190. Picture10.Picture = Picture4.Picture
  191. Picture4.Picture = Nothing
  192. Picture9.Picture = Picture7.Picture
  193. Picture7.Picture = Nothing
  194. Label1.Visible = False
  195. Label2.Visible = False
  196. Label3.Visible = False
  197. Label4.Visible = False
  198. Credits.Caption = "Credits"
  199. CmdAnalizza.Enabled = True
  200. End If
  201. End Sub