Пиксели

[Мика]

В PictureBox у меня загружена картинка.
Как отыскать пиксели одного цвета предположем RGB(255, 0, 0)
и заменить их на предположем RGB(0, 255, 0)

[Mikle]

Код: Выделить всё

dim FirstColor as long, SecondColor as long

FirstColor= RGB(255, 0, 0)
SecondColor= RGB(0, 255, 0)

For y=0 to picture1.height-1
  For x=0 to picture1.width-1
    If point(x,y)=FirstColor then Pset (x,y),SecondColor
  next x
next y


Я не проверял, но смысл понятен.

[Black_Star]

Советую вместо Point использовать GetPixel. Результат будет раз в 5 быстрее

[Мика]

Спасиб

[Amed]

Советую вместо PSet использовать SetPixel. Результат будет раз в 5 быстрее

[Black_Star]

Ето точно !

[v-adix]

что за GetPixel и SetPixel?

[Vovik]

что за GetPixel и SetPixel?

Get - полуить(дословно)
Set - соответственно, установить..
Pixel - я думаю ясно...ПИКСЕЛЬ(точка)
Делай вывод...

[v-adix]

с англ. яз. у меня в порядке, я только не понял как применять эти ф-ции. не работает!

[A.A.Z.]

Ну раз

с англ. яз. у меня в порядке

тогда

Declaration:
Declare Function GetPixel Lib "gdi32" Alias "GetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Description:
The GetPixel function retrieves the red, green, blue (RGB) color value of the pixel at the specified coordinates.

Parameters:
· hdc
Identifies the device context.

· nXPos
Specifies the logical x-coordinate of the pixel to be examined.

· nYPos
Specifies the logical y-coordinate of the pixel to be examined.

Return values:
If the function succeeds, the return value is an RGB value. If the pixel is outside of the current clipping region, the return value is CLR_INVALID.




Declaration:
Declare Function SetPixel Lib "gdi32" Alias "SetPixel" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Description:
The SetPixel function sets the pixel at the specified coordinates to the specified color.

Parameters:
· hdc
Identifies the device context.

· X
Specifies the x-coordinate, in logical units, of the point to be set.

· Y
Specifies the y-coordinate, in logical units, of the point to be set.

· crColor
Specifies the color to be used to paint the point.

Return values:
If the function succeeds, the return value is the RGB value that the function sets the pixel to. This value may differ from the color specified by crColor; that happens when an exact match for the specified color cannot be found.

If the function fails, the return value is -1. To get extended error information, call GetLastError.



Sample (Один и тот же для обеих функций):

Код: Выделить всё

'This project needs:
'- two picture boxes
'- a button
Private Type POINTAPI
    X As Long
    Y As Long
End Type

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 Declare Function PaintDesktop Lib "user32" (ByVal hdc As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Const ScrCopy = &HCC0020
Const Yellow = &HFFFF&
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim Cnt1 As Byte, Cnt2 As Byte, Point As POINTAPI
    'Set the graphic mode to persistent
    Me.AutoRedraw = True
    'API uses pixels
    Me.ScaleMode = vbPixels
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
    'No borders
    Picture1.BorderStyle = 0: Picture2.BorderStyle = 0
    'Set the button's caption
    Command1.Caption = "Paint && Stretch"
    'Set the graphic mode to 'non persistent'
    Picture1.AutoRedraw = False: Picture2.AutoRedraw = False
    For Cnt1 = 0 To 100 Step 3
        For Cnt2 = 0 To 100 Step 3
            'Set the start-point's coördinates
            Point.X = Cnt1: Point.Y = Cnt2
            'Move the active point
            MoveToEx Me.hdc, Cnt1, Cnt2, Point
            'Draw a line from the active point to the given point
            LineTo Me.hdc, 200, 200
        Next Cnt2
    Next Cnt1
    For Cnt1 = 0 To 100 Step 5
        For Cnt2 = 0 To 100 Step 5
            'Draw a pixel
            SetPixel Me.hdc, Cnt1, Cnt2, Yellow
        Next Cnt2
    Next Cnt1
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim XX As Long, YY As Long, A As Long
    XX = X: YY = Y
    'Set the picturebox' backcolor
    Picture2.BackColor = GetPixel(Picture1.hdc, XX, YY)
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Dim XX As Long, YY As Long, A As Long
        XX = X: YY = Y
        'Set the picturebox' backcolor
        Picture2.BackColor = GetPixel(Picture1.hdc, XX, YY)
    End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim XX As Long, YY As Long, A As Long
    XX = X: YY = Y
    'Set the picturebox' backcolor
    Picture2.BackColor = GetPixel(Picture1.hdc, XX, YY)
End Sub
Private Sub Command1_Click()
    'Set the width and height
    Picture2.Width = 100: Picture2.Height = 100
    Picture1.Width = 50: Picture1.Height = 50
    'No pictures
    Picture1.Picture = LoadPicture("")
    DoEvents
    Copy the desktop to our picturebox
    PaintDesktop Picture1.hdc
    'Stretch the picture
    StretchBlt Picture2.hdc, 0, 0, 100, 100, Picture1.hdc, 0, 0, 50, 50, ScrCopy
End Sub


Во.

[v-adix]

Грэйт thanx!
Ещё кое что: как получить цвет пикселя? в RGB?
напр, в picturebox пиксель 3x67 чтобы в три переменных (Red, Green, Blue) были соотв. цвет

[Mikle]

Color=GetPixel...
R=Color\65536
G=(Color and 65535)\256
B=Color and 255

[Black_Star]

А шуму-то, шуму!!!

[Мика]

Дааа конечно первый тормозит по страшному делает секунд 30
А второй по быстрей
короче всем спасибо!!