algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Histogram - wyrównywanie - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 4
SłabyŚwietny
Nadesłany przez Tomasz Lubiński, 12 października 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

Histogram_d - wyrownanie/Unit1.pas:
//Histogram - wyrównanie histogramu
//(c) 2005 Tomasz Lubinski
//www.algorytm.org

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, chartfx3, jpeg, ExtCtrls, StdCtrls, TeeProcs, TeEngine, Chart,
  Series, ComCtrls;

type
  LUTType = Array[0..255] of Double;

  TForm1 = class(TForm)
    Button1: TButton;
    ObrazKolorowy: TImage;
    Histogram1: TChart;
    Series1: TLineSeries;
    Series2: TLineSeries;
    Series3: TLineSeries;
    ObrazMono: TImage;
    Histogram2: TChart;
    LineSeries1: TLineSeries;
    Chart3: TChart;
    LineSeries2: TLineSeries;
    WynikKolorowy: TImage;
    WynikMono: TImage;
    Series4: TLineSeries;
    Series5: TLineSeries;
    Series6: TLineSeries;
    procedure Button1Click(Sender: TObject);
    procedure UpdateLUT(D: LUTType; var LUT: LUTType; series: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  LUTr, LUTg, LUTb, LUTgray: LUTType;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
    i, j, rvalue, gvalue, bvalue, grayvalue: Integer;
    sumR, sumG, sumB, sumGray: Double;
    numberOfPixels: Double;
    r, g, b, gray: Array [0..255] of Double;
    Dr, Dg, Db, Dgray: LUTType;
    color: TColor;
begin
for i := 0 to 255 do
    begin
        r[i] := 0;
        g[i] := 0;
        b[i] := 0;
        gray[i] := 0;
    end;

//oblicz dystrybuante
for i := 0 to ObrazKolorowy.Width-1 do
    for j := 0 to ObrazKolorowy.Height-1 do
        begin
            color := ObrazKolorowy.Canvas.Pixels[i,j];
            r[GetRValue(color)] := r[GetRValue(color)] + 1;
            g[GetGValue(color)] := g[GetGValue(color)] + 1;
            b[GetBValue(color)] := b[GetBValue(color)] + 1;
            color := ObrazMono.Canvas.Pixels[i,j];
            gray[GetRValue(color)] := gray[GetRValue(color)] + 1;
        end;
numberOfPixels := (ObrazMono.Width) * (ObrazMono.Height);
sumR := 0;
sumG := 0;
sumB := 0;
sumGray := 0;
for i := 0 to 255 do
    begin
        sumR := sumR + r[i]/numberOfPixels;
        sumG := sumG + g[i]/numberOfPixels;
        sumB := sumB + b[i]/numberOfPixels;
        sumGray := sumGray + gray[i]/numberOfPixels;
        Dr[i] := sumR;
        Dg[i] := sumG;
        Db[i] := sumB;
        Dgray[i] := sumGray;
    end;

//przelicz tablice LUT, tak by wyrownac histogram
updateLUT(Dr, LUTr, 1);
updateLUT(Dg, LUTg, 2);
updateLUT(Db, LUTb, 3);
updateLUT(Dgray, LUTgray, 0);

for i := 0 to 255 do
    begin
        r[i] := 0;
        g[i] := 0;
        b[i] := 0;
        gray[i] := 0;
    end;

for i := 0 to ObrazKolorowy.Width-1 do
    for j := 0 to ObrazKolorowy.Height-1 do
        begin
            color := ObrazKolorowy.Canvas.Pixels[i,j];
            rvalue := GetRValue(color);
            gvalue := GetGValue(color);
            bvalue := GetBValue(color);
            //zmien wartosc wedlug tablicy LUT
            color := Round(LUTr[rvalue]) +
                    (Round(LUTg[gvalue]) shl 8) +
                    (Round(LUTb[bvalue]) shl 16);
            //oblicz histogram
            WynikKolorowy.Canvas.Pixels[i,j] := color;
            r[GetRValue(color)] := r[GetRValue(color)] + 1;
            g[GetGValue(color)] := g[GetGValue(color)] + 1;
            b[GetBValue(color)] := b[GetBValue(color)] + 1;
        end;
Histogram1.SeriesList.Series[0].Clear;
Histogram1.SeriesList.Series[1].Clear;
Histogram1.SeriesList.Series[2].Clear;
Histogram1.SeriesList.Series[0].AddArray(r);
Histogram1.SeriesList.Series[1].AddArray(g);
Histogram1.SeriesList.Series[2].AddArray(b);

for i := 0 to ObrazMono.Width-1 do
    for j := 0 to ObrazMono.Height-1 do
        begin
            color := ObrazMono.Canvas.Pixels[i,j];
            grayvalue := GetRValue(color);
            //zmien wartosc wedlug tablicy LUT
            color := Round(LUTgray[grayvalue]) +
                    (Round(LUTgray[grayvalue]) shl 8) +
                    (Round(LUTgray[grayvalue]) shl 16);
            //oblicz histogram
            WynikMono.Canvas.Pixels[i,j] := color;
            gray[GetRValue(color)] := gray[GetRValue(color)] + 1;
        end;
Histogram2.SeriesList.Series[0].Clear;
Histogram2.SeriesList.Series[0].AddArray(gray);
end;

//przelicz nowe wartosci tablicy LUT
//wyswietl wartosci tablicy LUT
procedure TForm1.UpdateLUT(D: LUTType; var LUT: LUTType; series: Integer);
var
    i: Integer;
    D0min: double;
begin
//znajdz pierwszą niezerową wartosc dystrybuanty
i := 0 ;
while D[i] = 0 do
    i := i + 1;
D0min := D[i];

for i := 0 to 255 do
    LUT[i] := Round(((D[i] - D0min) / (1 - D0min)) * (256 - 1)) ;

Chart3.SeriesList.Series[series].Clear;
Chart3.SeriesList.Series[series].AddArray(LUT);
end;


end.
Dodaj komentarz