הנה הקוד, אבל הוא בVB
Option Explicit Private Type RGBCol R As Byte G As Byte B As Byte End Type Const MAX_SIM = 17 Const COL_RATIO = 3 Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long Private Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long Private picData() As RGBCol Private picBuffer() As Byte Dim picHDC As Long Dim picW As Single Dim picH As Single Private Sub cmbLoadPIC_Click() Dim FileNum As Long Dim X As Single Dim Y As Single FileNum = FreeFile Open App.Path & "\Peppers.pic" For Binary As #FileNum Get #FileNum, 1, picData Close #FileNum For X = 0 To picW For Y = 0 To picH Call SetPixel(picHDC, X, Y, RGB2Long(picData(X, Y))) Next Y Next X MsgBox "Loading proccess ended successfuly" End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdSavePic_Click() Dim FileNum As Long Dim X As Single Dim Y As Single For X = 0 To picW For Y = 0 To picH picData(X, Y) = ExtractRGB(GetPixel(picHDC, X, Y)) Next Y Next X FileNum = FreeFile Open App.Path & "\Peppers.pic" For Binary As #FileNum Put #FileNum, 1, picData Close #FileNum MsgBox "Saving proccess ended successfuly" End Sub Private Function ExtractRGB(longCol As Long) As RGBCol ExtractRGB.R = longCol And 255 ExtractRGB.G = (longCol And 255 ^ 2) / 255 ExtractRGB.B = (longCol And 255 ^ 3) / (255 ^ 2) End Function Private Function RGB2Long(crRGBCol As RGBCol) As Long RGB2Long = RGB(crRGBCol.R, crRGBCol.G, crRGBCol.B) End Function Private Sub Form_Load() picHDC = picIden.hDC picW = picIden.ScaleWidth picH = picIden.ScaleHeight ReDim picData(picW, picH) As RGBCol ReDim picBuffer(picW, picH) As Byte End Sub Private Sub Form_Unload(Cancel As Integer) Erase picData Erase picBuffer End Sub Private Sub frmLoadJPG_Click() picIden.Picture = LoadPicture(App.Path & "/Peppers.jpg") End Sub Private Sub picIden_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Call searchObjects(Int(X), Int(Y)) End Sub Private Sub searchObjects(X As Integer, Y As Integer) Call clearPicBuffer Call findSim(X, Y, picData(X, Y)) End Sub Private Sub findSim(ByRef X As Integer, ByRef Y As Integer, ByRef baseCol As RGBCol) Dim buffRGB As RGBCol If X < 0 Or X > picW Or Y < 0 Or Y > picH Then Exit Sub If picBuffer(X, Y) = 1 Then Exit Sub picBuffer(X, Y) = 1 Call SetPixel(picHDC, X, Y, vbRed) If getSim(picData(X, Y), ExtractRGB(GetPixel(picHDC, X + 1, Y + 1)), baseCol) Then Call findSim(X + 1, Y + 1, baseCol) If getSim(picData(X, Y), ExtractRGB(GetPixel(picHDC, X + 1, Y)), baseCol) Then Call findSim(X + 1, Y, baseCol) If getSim(picData(X, Y), ExtractRGB(GetPixel(picHDC, X + 1, Y - 1)), baseCol) Then Call findSim(X + 1, Y - 1, baseCol) If getSim(picData(X, Y), ExtractRGB(GetPixel(picHDC, X - 1, Y + 1)), baseCol) Then Call findSim(X - 1, Y + 1, baseCol) If getSim(picData(X, Y), ExtractRGB(GetPixel(picHDC, X - 1, Y)), baseCol) Then Call findSim(X - 1, Y, baseCol) If getSim(picData(X, Y), ExtractRGB(GetPixel(picHDC, X - 1, Y - 1)), baseCol) Then Call findSim(X - 1, Y - 1, baseCol) If getSim(picData(X, Y), ExtractRGB(GetPixel(picHDC, X, Y + 1)), baseCol) Then Call findSim(X, Y + 1, baseCol) If getSim(picData(X, Y), ExtractRGB(GetPixel(picHDC, X, Y - 1)), baseCol) Then Call findSim(X, Y - 1, baseCol) End Sub Private Function getSim(ByRef rgb1 As RGBCol, ByRef rgb2 As RGBCol, ByRef baseCol As RGBCol) As Boolean Dim RDif(1) As Byte Dim GDif(1) As Byte Dim BDif(1) As Byte RDif(0) = max(rgb1.R, rgb2.R) - min(rgb1.R, rgb2.R) GDif(0) = max(rgb1.G, rgb2.G) - min(rgb1.G, rgb2.G) BDif(0) = max(rgb1.B, rgb2.B) - min(rgb1.B, rgb2.B) RDif(1) = max(baseCol.R, rgb2.R) - min(baseCol.R, rgb2.R) GDif(1) = max(baseCol.G, rgb2.G) - min(baseCol.G, rgb2.G) BDif(1) = max(baseCol.B, rgb2.B) - min(baseCol.B, rgb2.B) If RDif(0) >= MAX_SIM / COL_RATIO Then getSim = False: Exit Function If GDif(0) >= MAX_SIM / COL_RATIO Then getSim = False: Exit Function If BDif(0) >= MAX_SIM / COL_RATIO Then getSim = False: Exit Function If RDif(1) >= MAX_SIM * COL_RATIO Then getSim = False: Exit Function If GDif(1) >= MAX_SIM * COL_RATIO Then getSim = False: Exit Function If BDif(1) >= MAX_SIM * COL_RATIO Then getSim = False: Exit Function getSim = ((RDif(0) + GDif(0) + BDif(0)) <= MAX_SIM) End Function Private Function min(ByRef n1 As Byte, ByRef n2 As Byte) As Byte min = IIf(n1 > n2, n2, n1) End Function Private Function max(ByRef n1 As Byte, ByRef n2 As Byte) As Byte max = IIf(n1 > n2, n1, n2) End Function Private Sub clearPicBuffer() Dim i As Integer Dim j As Integer For i = 0 To picW For j = 0 To picH picBuffer(i, j) = 0 Next j Next i End Sub
-(x)) ) #define min(x,y) ( ((x)>