× Aktuálně z oboru

SHIELD Experience Upgrade 7 – méně hledání a více zábavy [ clanek/2018052902-shield-experience-upgrade-7-mene-hledani-a-vice-zabavy/ ]
Celá zprávička [ clanek/2018052902-shield-experience-upgrade-7-mene-hledani-a-vice-zabavy/ ]

Práce s grafikou VIII. – Černobílý obraz z rozptylem

[ http://programujte.com/profil/27-jiri-chytil/ ]Google [ ?rel=author ]       [ http://programujte.com/profil/20356-lucie-z/ ]Google [ ?rel=author ]       14. 12. 2005       8 088×

Kód funguje na principu náhoného posunu hranice pro každý bod ale v určitém rozmezí, a tím je daná drobná nepravidelnost obrázku...

Kód:


Public Sub BlackAndWhiteRozptyl(Img As PictureBox, mez As Byte, rozptyl As Byte)
    Img.DrawWidth = 1
    Img.ScaleMode = 3
    Img.AutoRedraw = True
    RGBMax = 256
    On Error Resume Next
        For x = 0 To Img.ScaleWidth
            For y = 0 To Img.ScaleHeight
                DoEvents
                Imgp = GetPixel(Img.hdc, x, y)
                b = Imgp  RGBMax  RGBMax
                g = (Imgp  RGBMax) Mod RGBMax
                r = Imgp Mod RGBMax
                                    r = (r + g + b) / 3
                                    If r >= mez + Int(Rnd * rozptyl) Then
                                    r = vbWhite
                                    Else: r = vbBlack
                                    End If
                Call SetPixel(Img.hdc, x, y, r)
            Next y
            DoEvents
        Next x
    Img.Refresh
End Sub

Funkčnost a princip celého algoritmu závisí na vzorci:


If r >= mez + Int(Rnd * rozptyl) Then

Jako hodnotu mez je dobré dát hodnotu kolem 100 a jako rozptyl hodnotu kolem 50. Pokud chcete měnit rozptyl, musíte mu upravit i mez většinou podle vzorce.


Mez = 128 - 0,5 * rozptyl

Drobné odchylky nevadí. Posouvat mez můžete, jak chcete pro ztmavení nebo zesvětlení výsledku. (čím vyšší hodnota, tím tmavší výsledek).


Článek stažen z webu Programujte.com [ http://programujte.com/clanek/2005121002-prace-s-grafikou-viii-cernobily-obraz-z-rozptylem/ ].