Blurowanie Bmp

0

Jak milo napisac pierwszy czerwcowy post :)
Mam pytanko : jak zbluorwac [rozmyc] bmp? i wczle nie chodzi mi tu o DelphiX, tylk o zwykla procedurke, ktora mozna wstawic do kodu. [blur powinien dzialac mniej wiecje jak blur more w PSP6]

{hello} w czerwcu --sys:> logout....

0

A co ty masz do DelphiX
Buuuuuuu.--I LOVE PrOgRaMz

0

A no mam do DelphiX, bo robie giere w OpenGlu i mam uzywac DelphiX do rozmycia bitmapy??
A ten DelphiX to wolny jakis, na wyswietlaniu Bmpy 640x480 w FullScreenie, na kompie 233Mhz, 64MB z 4MB Voodoo wyciagalo zaledwie 20FPSow no horror, a jak zaczalem muzykae odtwarzac jakas [wav 8-bit, 22khz] to tak cielo juz ze kaszana konkretna.--sys:> logout....

0

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&gt0 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&ltPred(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&gt0 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&ltPred(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

0

Dzieki pq {browar}
Wcale nie musi być szybkie potrzebne mi to do bitmap o max wielokosci 128x128, i moze to robic nawet ze 5 sekund. Zara sprawdze jak sie sprawuje :-) --sys:> logout....

1 użytkowników online, w tym zalogowanych: 0, gości: 1