Cos wymyslilem, choc dziala powoli. Daj na forme Image, Butoon i ProgressBar
Oto kod:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Gauges, ComCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
ProgressBar1: TProgressBar;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
bmp:TBitmap;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
bmp:=Tbitmap.Create;
bmp.Height:=Image1.Height;
bmp.Width:=Image1.Width;
bmp.Canvas.pen.Color:=clGreen;
bmp.canvas.MoveTo(0,bmp.Height div 2);
bmp.Canvas.lineto(bmp.Width,bmp.Height div 2);
bmp.Canvas.Pen.Color:=clRed;
bmp.Canvas.MoveTo(bmp.Width div 2, 0);
bmp.Canvas.lineto(bmp.Width div 2, bmp.height);
Image1.picture.assign(bmp);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
bmp.Destroy;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
bmp2:TBitmap;
x,y:integer;
SumR, SumG, SumB, count:Integer;
begin
bmp.Assign(Image1.Picture);
bmp2:=Tbitmap.Create;
Bmp2.Height:=bmp.Height;
bmp2.Width:=bmp.Width;
for x:=0 to Pred (bmp.Width) do
begin
ProgressBar1.Position:=Round(x/bmp.Width*100);
Application.ProcessMessages;
for y:=0 to Pred (bmp.Height) do
begin
count:=0;
SumR:=0;
SumG:=0;
SumB:=0;
if x>0 then
begin
inc (count);
inc(SumB, ((bmp.Canvas.Pixels[Pred(X),y]) and $ff0000) shr 16);
inc(SumG, ((bmp.Canvas.Pixels[Pred(X),y]) and $ff00) shr 8);
inc(SumR, (bmp.Canvas.Pixels[Pred(X),y]) and $ff);
end;
if x<Pred(bmp.Width) then
begin
inc (count);
inc(SumB, ((bmp.Canvas.Pixels[Succ(X),y]) and $ff0000) shr 16);
inc(SumG, ((bmp.Canvas.Pixels[Succ(X),y]) and $ff00) shr 8);
inc(SumR, (bmp.Canvas.Pixels[Succ(X),y]) and $ff);
end;
if y>0 then
begin
inc (count);
inc(SumB, ((bmp.Canvas.Pixels[x,Pred(y)]) and $ff0000) shr 16);
inc(SumG, ((bmp.Canvas.Pixels[x,Pred(y)]) and $ff00) shr 8);
inc(SumR, (bmp.Canvas.Pixels[x,Pred(y)]) and $ff);
end;
if y<Pred(bmp.Height) then
begin
inc (count);
inc(SumB, ((bmp.Canvas.Pixels[x,Succ(y)]) and $ff0000) shr 16);
inc(SumG, ((bmp.Canvas.Pixels[x,Succ(y)]) and $ff00) shr 8);
inc(SumR, (bmp.Canvas.Pixels[x,Succ(y)]) and $ff);
end;
inc(count);
inc(SumB, ((bmp.Canvas.Pixels[x,y]) and $ff0000) shr 16);
inc(SumG, ((bmp.Canvas.Pixels[x,y]) and $ff00) shr 8);
inc(SumR, (bmp.Canvas.Pixels[x,y]) and $ff);
bmp2.Canvas.Pixels[x,y]:=
rgb(sumR div count, sumG div count, sumB div count);
end;
end;
Image1.Picture.Assign(bmp2);
b
mp2.destroy;
end;
end.
--Pawel
Delphi6