dotNETportal.cz

zdravím,

dával sem tuto otázku i na builder.cz ale nikdo mi neodpověděl a asi to nebude tak lehké, proto ji dávám i sem, pokud by někoho něco napadlo.

Protože mám rád fotky, dělám si EasyEditor na ně a extrémně mně zaujala možnost histogramu. Bohužel nad tím už trávím celý den a nejde mi jej naprogramovat. Na webu jsou maximálně zdrojové kódy pro C#, které mi nejdou převést pomocí konvertoru a z hlavy jej nepřepíšu.

Výsledek by měl být takovýto: http://digiarena.zive.cz/Files/Obrazky/t...

Nevíte o nějakém tutoriálu popř. nápadu, jak "inteligentně" začít? Zkoušel jsem to i z hlavy mnohokrát naprogramovat, ale mám (časový) problém s algoritmem.

Jak jsem jej dělal:

1) Načtu si obrázek (zkoušel jsem to na 800x600 px) do PictureBoxu

2) Beru pixel po pixelu a uchovávám si hodnotu (A, R, G, cool smiley

3) Aplikuju seřazení, tj. spočítám, kolikrát se daná hdonota tam vyskytovala

4) Pak jsem z toho shopen namalovat graf, ale jen jedné barvy

5) hlavní problém - než se mi to zpracuje, trvá to cca 10-15 minut což je neúnosné, proto Vás prosím o nějakou radu co a jak.

histogram není nic těžkého,

máte tři pole:

Dim RCount(255) As Integer
Dim GCount(255) As Integer
Dim BCount(255) As Integer

Pak procházíte obrázek pixel po pixelu a vždy do pole příslušené barvy přičtete 1. Například:

RCount(hodnota_R_pixelu) += 1
GCount(hodnota_G_pixelu) += 1
BCount(hodnota_B_pixelu) += 1

Při tomto přičítání si ukládejte ještě nejvyšší hodnotu pro každou barvu, například:

If RCount(hodnota_R_pixelu)>MaximalniHodnotaR Then _
   MaximalniHodnotaR = RCount(hodnota_R_pixelu)

A když toto provedete pro každý pixel, máte v polích RCount, GCount, BCount výsledné grafy. Ty ještě vydělíte maximální hodnotou a vynásobíte požadovanou výškou grafu a vykreslíte.

Pokud není něco jasné, klidně se zeptejte, vzal jsem to dost narychlo.

Myšlenku jsem sice pochopil, ale nechápu jak to aplikovat, přesněji spíš, jak poznám, kam příslučnou barvu zařadit, zda je R/G/B a kam si uložím a pak vytáhnu, jaký odstín barvy to je (abych mohl namalovat graf)

Dávám kód, čím si beru pixel:

        'Definice proměnných
        Dim bmp As Bitmap = New Bitmap(pb1.Image)
        Dim gfx As Graphics = Graphics.FromImage(bmp)

        Using g As Graphics = Graphics.FromImage(bmp)
            For y As Integer = 0 To bmp.Height - 1
                For x As Integer = 0 To bmp.Width - 1
                    Dim c As Drawing.Color = bmp.GetPixel(x, y)
	    'Tady si nastavuji/beru pixel
                    'bmp.SetPixel(x, y, System.Drawing.Color.FromArgb(c.R, c.G * 0.9, c.B * 0.9))
                Next
            Next
        End Using
        pb1.Image = bmp
        gfx.Dispose()

Tak jsem se s tím popral, ale není to doladěné. Je to zatím pouze pro červenou barvu a výstup je proveden v AxMSChart (MS Chart control)

Problémy:

a) Vytvořím si tak grafy jen orientované na jendu složku (R/G/B) ale nejsem schopen je nějak dát dohromady pro výsledný efekt

b) je to vytvořeno v AxMSChart - to by ani nevadilo, ale jak se tam dá změnit, aby byla barva u všech sloupclů stejná a zbavit se mřížky apod.?

Kód (pouze pro červenou složku)

        'honodty
        Dim bmp As Bitmap = New Bitmap(pb1.Image)
        Dim gfx As Graphics = Graphics.FromImage(bmp)
        Dim RCount(255) As Integer
        Dim maxR As Integer = Nothing

        Using g As Graphics = Graphics.FromImage(bmp)
            For y As Integer = 0 To bmp.Height - 1
                For x As Integer = 0 To bmp.Width - 1
                    Dim c As Drawing.Color = bmp.GetPixel(x, y)

                    RCount(c.R) += 1
                    If RCount(c.R) > maxR Then maxR = RCount(c.R)

                Next x
            Next y
        End Using
        pb1.Image = bmp
        gfx.Dispose()


        'vypsi hdnot do txt pole
        Dim hodnoty As String = Nothing
        Dim a As Integer
        For a = 0 To RCount.Length - 1
            hodnoty &= RCount(a) / maxR & vbCrLf
        Next a

        txtRed.Text = hodnoty


        'namalovani grafu MS CHAR
        Dim data(0, 0 To 255) As Integer
        Dim b As Integer
        For b = 0 To RCount.Length - 1
            data(0, b) = RCount(b) / maxR * 100
        Next b

        AxMSChart1.ChartData = data

Vyleze z toho graf a tyto hodnoty (kter= si nechávám vypsat jen teď pro kontrolu)

...

0,808695652173913

0,495652173913044

0,721739130434783

0,91304347826087

1

0,830434782608696

0,743478260869565

0,678260869565217

0,560869565217391

0,582608695652174

0,478260869565217

0,552173913043478

...

Ještě malý dodatek: Kód jsem poupravil apod. a jede mi (kupodivu) až na to, že ty diagramy jsou barevný jako papoušek místo jedné barvy a furt nevím, jak udělat "to černé" tj. výsledek všech barev:

Originál (to kvítko):

http://digiarena.zive.cz/default.aspx?se...

Můj výsledek:

http://bckline.cz/petr/others/histogram_...

Světlost barvy z jednotlivých složek se počítá podle vzorce 0.3 * R + 0.59 * G + 0.11 * B. Každá barevná složka totiž k výsledné světlosti přispívá jiným dílem. Pak již není problém udělat graf. Celý program by vydal na samostatný článek, takhle je to dost narychlo:

Public Class MainForm

    Dim max As Integer = 0   'maximální počet pixelů stejné úrovně
    Dim im As Bitmap
    Dim pR(255) As Integer   'počet pixelů s červenou složkou dané intenzity
    Dim pG(255) As Integer   'počet pixelů se zelenou složkou dané intenzity
    Dim pB(255) As Integer   'počet pixelů s modrou složkou dané intenzity
    Dim pS(255) As Integer   'počet pixelů se světlostí dané intenzity

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'nechat uživatele vybrat obrázek a načíst ho do proměnné im
        If OpenFileDialog1.ShowDialog() <> Windows.Forms.DialogResult.OK Then End
        im = Image.FromFile(OpenFileDialog1.FileName)

        ''TOHLE FUNGUJE POMALU PRO VELKÉ OBRÁZKY
        ''--------------------------------------
        'For y As Integer = 0 To im.Height - 1       'projít všechny pixely obrázku
        '    For x As Integer = 0 To im.Width - 1
        '        Dim c As Color = im.GetPixel(x, y)   'GetPixel je pomalé, volejte jej jen jednou a výsledek si uložte
        '        pR(c.R) += 1    'přičíst červený pixel
        '        pG(c.G) += 1    'přičíst zelený pixel
        '        pB(c.B) += 1    'přičíst modrý pixel
        '        pS(c.R * 0.3 + c.G * 0.59 + c.B * 0.11) += 1   'přičíst světlost
        '    Next
        'Next

        'RYCHLEJŠÍ METODA
        '----------------
        'získá se bitová kopie obrázku
        Dim bd As Imaging.BitmapData = im.LockBits(New Rectangle(0, 0, im.Width, im.Height), Imaging.ImageLockMode.ReadOnly, Imaging.PixelFormat.Format24bppRgb)
        Dim pixely(bd.Width * bd.Height * 3 - 1) As Byte
        Runtime.InteropServices.Marshal.Copy(bd.Scan0, pixely, 0, pixely.Length)
        im.UnlockBits(bd)
        'teď pracujeme s jednotlivými pixely jako s bajty
        For i As Integer = 0 To pixely.Length - 1 Step 3        'skákat po 3 bajtech
            Dim b As Byte = pixely(i)       'první bajt z trojice je modrá
            Dim g As Byte = pixely(i + 1)   'druhý bajt z trojice je zelená
            Dim r As Byte = pixely(i + 2)   'třetí bajt z trojice je červená
            pR(r) += 1
            pG(g) += 1
            pB(b) += 1
            pS(r * 0.3 + g * 0.59 + b * 0.11) += 1
        Next

        'zjistit maximum
        For i As Integer = 0 To 255
            If pR(i) > max Then max = pR(i)
            If pG(i) > max Then max = pG(i)
            If pB(i) > max Then max = pB(i)
            If pS(i) > max Then max = pS(i)
        Next

        'uvolnit obrázek z paměti
        im = Nothing
    End Sub

    Public Sub Graf(ByVal g As Graphics, ByVal p As Pen, ByVal pole() As Integer, ByVal vyska As Integer)
        'vykreslit graf
        For i As Integer = 0 To 255
            Dim v As Integer = vyska * pole(i) / max
            g.DrawLine(p, i, 255, i, 255 - v)
        Next
    End Sub

    Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint
        Graf(e.Graphics, Pens.Red, pR, PictureBox1.Height)
    End Sub

    Private Sub PictureBox2_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox2.Paint
        Graf(e.Graphics, Pens.Green, pG, PictureBox2.Height)
    End Sub

    Private Sub PictureBox3_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox3.Paint
        Graf(e.Graphics, Pens.Blue, pB, PictureBox3.Height)
    End Sub

    Private Sub PictureBox4_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox4.Paint
        Graf(e.Graphics, Pens.Black, pS, PictureBox4.Height)
    End Sub
End Class

Navíc protože je metoda GetPixel strašně pomalá (obrázek 800x600 mi trval na slabším stroji cca minutu), je lepší pomocí Marshal.Copy vytáhnout z obrázku pole bajtů. Pokud pole rozsekáme po třech bajtech, získáme jednotlivé pixely - první bajt je modrá složka, druhý zelená a třetí červená.

Ještě k polím pR, pG, pB a pS - včechny sledované položky (červená, zelená, modrá i světlost) mají hodnoty od 0 do 255. Takže v poli pR(40) bude počet pixelů v celém obrázku, jejichž červená složka má hodnotu 40, v poli pS(150) bude zaser počet pixelů se světlostí 150. Pak již jednoduše vykreslím graf - abych 4x neopisoval de facto stejný kód, udělal jsem si proceduru. Pokud to chcete spustit, dejte na formulář 4 pictureboxy o velikosti 256x256 pixelů a jeden OpenFileDialog.

Tento kód je sice mnohonásobně rychlejší, ovšem výsledný histogram neodpovídá realitě (viz článek na digiarene, jak je dekomponovan ten cerveny kvet)

Dekuju za upresneni toho, jak se dela vysledny histogram jasu, ovsem co se tyka presnosti, zustanu radsi u sveho zpusobu pixel po pixelu... prestoze to trva dele, je presny a jdu hledat algoritmus, ktery by to urychlil (nebo prepsat do assmebleru)

To je nesmysl - když se podíváte na výsledné obrázky z mého a jejich programu pro ten obrázek květu, tvar grafů je stejný. Problém je akorát v tom, že já počítám maximum pro všechny složky dohromady a oni jej asi počítají zvlášť. Pokud dáte výpočet maxima do procedury Graf a budete jej zvlášť určovat jen pro pole, které právě vykreslujete, vyjde Vám to stejně. Tento kód přidejte na začátek procedury Graf před samotné vykreslení:

    'zjistit maximum
    max = 0
    For i As Integer = 0 To 255
        If pole(i) > max Then max = pole(i)
    Next

Akorát jsem si všimnul jedné věci - oni v grafu nemají vykreslenou úroveň 0 a 255, zkrátka ty krajní neuvažují, aby jim ten graf lépe vyšel.

Rychlá metoda pro práci s pixely dělá úplně to samé, co pomalá. Assembler z Visual Basic .NET opravdu použít nemůžete.

Zvláštní, že můj kód Vám do červeného, zeleného i modrého grafu vykresluje stejný graf - a to podle hodnot modré složky (která je správně). Asi se špatně namapovaly události na PictureBoxy, podívejte se schválně, jestli má každý PictureBox svoji událost. Visual Studio si totiž při kopírování kódu dělá co chce a občas něco přehodí, pokud se to to týká událostí. Mě to totiž pro ten obrázek květu opravdu vykresluje grafy správně, jako na ostatních dvou obrázcích.

Vše je namapováno správně :-/

Není zač se omlouvat, sám bych to řešil o hodné déle a hlavně by mi to dlouho trvalo, než by se výsledek vypočetl. Jinak díky za upřesnění chyby.

Btw, doufám že nevadí když udělám torchu OT, ale jedna věc by mně zajímala. pokud je možné takto extrémně rychle vykreslovat, je možné obejít rychlost vykreslovní např. i u tvorby efektů? jako ukázku dávám např. vytvoření barevného nádechu do červena:

        'Barevný nádech červený +
        Dim bmp As Bitmap = New Bitmap(pb1.Image)
        Dim gfx As Graphics = Graphics.FromImage(bmp)

        Using g As Graphics = Graphics.FromImage(bmp)
            For y As Integer = 0 To bmp.Height - 1
                For x As Integer = 0 To bmp.Width - 1
                    Dim c As Drawing.Color = bmp.GetPixel(x, y)
                    bmp.SetPixel(x, y, System.Drawing.Color.FromArgb(c.R, c.G * 0.9, c.B * 0.9))
                Next
            Next
        End Using
        pb1.Image = bmp
        gfx.Dispose()