Source Code Histogram RGB menggunakan Delphi 7

Source Code :

unit Histo;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Chart1: TChart;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Series2: TLineSeries;
    Series3: TLineSeries;
    Series1: TLineSeries;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  HistogramR,HistogramG,HistogramB:array[0..256] of integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var BMP1:Tbitmap;
  JPG1:TJPEGImage;
  i,j,k:integer;
  warna:Tcolor;
  R,G,B:word;

begin
  BMP1:=Tbitmap.Create;
  JPG1:=TJPEGImage.Create;


  if OpenDialog1.Execute then
    JPG1.LoadFromFile(OpenDialog1.FileName);
    BMP1.Assign(JPG1);
    for k:=1 to 256 do
    begin
      HistogramR[k]:=0;
      HistogramG[k]:=0;
      HistogramB[k]:=0;
    end;

    for j:=1 to BMP1.Height-1 do
    begin
      for i:=1 to BMP1.Width-1 do
      begin
        warna := BMP1.Canvas.Pixels[i,j];
        R:=GetRValue(warna);
        g:=GetGValue(warna);
        B:=GetBValue(warna);
        HistogramR[R]:=HistogramR[R]+1;
        HistogramG[G]:=HistogramG[G]+1;
        HistogramB[B]:=HistogramB[B]+1;
      end;
    end;

    Image1.Picture.Assign(BMP1);
    BMP1.Free;
    JPG1.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i:integer;

begin

  Series1.Clear;
  Series2.Clear;
  Series3.Clear;

  for i:=1 to 256 do
  begin
    Series1.AddXY(i,HistogramR[i],'',clRed);
    Series2.AddXY(i,HistogramG[i],'',clGreen);
    Series3.AddXY(i,HistogramB[i],'',clBlue);
  end;

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Image1.Picture.Destroy;
  Series1.Clear;
  Series2.Clear;
  Series3.Clear;
end;
end.



Link Download

Lebih baru Lebih lama

Translate