Dim LY 'Декларираме променлива в която да запомняме до кой ред сме вече заменили пикселите

 

Dim NovCvet ' Декларираме променлива за новия цвят

'Декларираме АПИ функция за взимане цвета от даден обект с кординати x,y

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

'Декларираме АПИ функция за въвеждане на цвят  в даден обект с кординати x,y

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 Sub Command1_Click()

    NovCvet = vbBlue ' Въвеждаме новия цвят в променливата NovCvet

    Timer100.Enabled = True ' Пускаме таймера

End Sub

 

'Таймер, който използваме, за да е възможно прекъсване на процедурата по всяко време

Private Sub Timer100_Timer()

    For i = 1 To Int(Picture1.Width) ' Цикъл обхождащ картинката от първия до последния пиксел на даден ред

        For j = LY To LY + 100 ' Цикъл по височина в слуачая се прекъсва на всеки 100 реда, но може и да са повече редове

            PixCol = GetPixel(Picture1.hdc, i, j) ' Взимаме цвета на конкретния пиксел

            If PixCol = &HFF Then ' Проверяваме дали е червен ( &HFF )

           

            '1.Вариант с функцията SetPixel - при минимизиранезаместени пиксели изчезват

                'Picture1.AutoRedraw = False

                'SetPixel Picture1.hdc, i, j, NovCvet ' Ако е червен го заместваме с NovCvet

                'Picture1.AutoRedraw = True

            '2. Вариант с метода PaintPicture - при минимизиране картинката се запазва и може да бъде записана

                Picture1.AutoRedraw = True 'Задаваме възможност за авомапречертаване

                Picture1.PaintPicture Picture2.Picture, i, j, 1, 1, 0, 0, 1, 1 ' Копираме пиксел по пилсел

            End If

        Next j

    Next i

    LY = j  'Запомняме по височина докъде сме стигнали, за следващата работа на таймера

   

    If LY >= Picture1.Height Then ' Ако сме достигнали последния ред на картинката спираме таймера

        Timer100.Enabled = False

        MsgBox "Пиксели заместени", vbInformation, Form1.Caption

    End If

End Sub