8 Nisan 2010 Perşembe

Image Filter

procedure Emboss(Bitmap : TBitmap; AMount : Integer);
var
x, y, i : integer;
p1, p2: PByteArray;
begin
for i := 0 to AMount do
begin
for y := 0 to Bitmap.Height-2 do
begin
p1 := Bitmap.ScanLine[y];
p2 := Bitmap.ScanLine[y+1];
for x := 0 to Bitmap.Width do
begin
p1[x*3] := (p1[x*3]+(p2[(x+3)*3] xor $FF)) shr 1;
p1[x*3+1] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
p1[x*3+2] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
end;end;end;end;

procedure TForm1.Emboss1Click(Sender: TObject);
begin
Emboss(Image1.Picture.Bitmap,10);
end;

Brightness Image

procedure TForm1.Brightness1Click(Sender: TObject);
begin
With form1 do
with filelistbox1 do
With form3 do
begin
if (FileExt = '.BMP') then
begin
OrigImage.Picture.LoadFromFile(Filelistbox1.FileName);
DestImage.Picture.LoadFromFile(Filelistbox1.FileName);
form3.show;
end;end;end;

Arka plana resim atma (BackGround)

procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:\WINDOWS\cars.BMP');
end;

procedure TForm1.FormPaint(Sender: TObject);
var
X, Y, W, H: LongInt;
begin
with Bitmap do begin
W := Width;
H := Height;
end;
Y := 0;
while Y < Height do begin
X := 0;
while X < Width do begin
Canvas.Draw(X, Y, Bitmap);
Inc(X, W);
end;
Inc(Y, H);
end;
end;

Alias Image oluşturma

procedure AntiAlias(const i: TBitmap; var o: TBitmap);
var
Po: ^PixelA3;
P1, P2, P3, P4, P5: ^PixelA15;
x, y: Cardinal;
dekrement: Cardinal;
AntAussen, AntMitte, AntInnen: double;
begin
AntAussen := 12*4;;//12
AntMitte := 8*4; //8
AntInnen := 2; //2
dekrement := 2*(i.Width-2);
P1 := i.ScanLine[0];
P2 := i.ScanLine[1];
P3 := i.ScanLine[2];
P4 := i.ScanLine[3];
P5 := i.ScanLine[4];
for y := 2 to i.Height-4 do
begin
Po := o.ScanLine[y];
inc(Po, 1);
for x := 4 to i.Width-4 do
begin
Po^[1] := round(((P1^[4]+P1^[7]+P1^[10]+P2^[1]+ P2^[13]+ P3^[1]+ P3^[13]+P4^[1]+P4^[13]+
P5^[4]+P5^[7]+P5^[10])/ AntAussen)+((P2^[4]+P2^[7]+P2^[10]+P3^[4]+P3^[10]+P4^[4]+P4^[7]+P4^[10])/AntMitte)+
(P3^[7]/AntInnen));
Po^[2] := round(((P1^[5]+P1^[8]+P1^[11]+P2^[2]+P2^[14]+P3^[2]+P3^[14]+P4^[2]+P4^[14] +
P5^[5]+P5^[8]+P5^[11])/AntAussen)+((P2^[5]+P2^[8]+P2^[11]+P3^[5]+P3^[11]+P4^[5]+P4^[8]+P4^[11])/AntMitte) +
(P3^[8]/AntInnen));
Po^[3] := round(((P1^[6]+P1^[9]+P1^[12]+P2^[3]+P2^[15]+P3^[3]+P3^[15]+P4^[3]+P4^[15]+P5^[6]+P5^[9]+P5^[12])/AntAussen)+
((P2^[6]+P2^[9]+P2^[12]+P3^[6]+P3^[12]+P4^[6]+P4^[9]+P4^[12])/AntMitte)+(P3^[9]/AntInnen));
inc(PByte(P1), 3);inc(PByte(P2), 3);inc(PByte(P3), 3);inc(PByte(P4), 3);inc(PByte(P5), 3);
inc(Po, 1);end;
dec(PByte(P2), dekrement);
dec(PByte(P3), dekrement);
dec(PByte(P4), dekrement);
dec(PByte(P5), dekrement);
P1 := P2;P2 := P3;P3 := P4;P4 := P5;P5 := i.ScanLine[y+3];
end;end;

procedure TForm1.Antiallias1Click(Sender: TObject);
var Image1 : TBitmap;
begin
Image1 := TBitmap.Create;
Image1.Width := 141;
Image1.Height := 197;
Image1.PixelFormat := pf24Bit;
Image1 := TBitmap.Create;
Image1.Width := 141;
Image1.Height := 197;
Image1.PixelFormat := pf24Bit;
AntiAlias(Image1, Image1);
end;

Resim çevirme-03

procedure RotateBitmap(var hBitmapDC : Longint; var lWidth : Longint;
var lHeight : Longint; lRadians : real);
begin
hNewBitmapDC := CreateCompatibleDC(hBitmapDC);
lSine := Sin(lRadians);
lCosine := Cos(lRadians);
X1 := Round(-lHeight * lSine);
Y1 := Round(lHeight * lCosine);
X2 := Round(lWidth * lCosine - lHeight * lSine);
Y2 := Round(lHeight * lCosine + lWidth * lSine);
X3 := Round(lWidth * lCosine);
Y3 := Round(lWidth * lSine);
lMinX := Min(0, Min(X1, Min(X2, X3)));
lMinY := Min(0, Min(Y1, Min(Y2, Y3)));
lMaxX := Max(X1, Max(X2, X3));
lMaxY := Max(Y1, Max(Y2, Y3));
lNewWidth := lMaxX - lMinX;
lNewHeight := lMaxY - lMinY;
hNewBitmap := CreateCompatibleBitmap(hBitmapDC, lNewWidth, lNewHeight);
SelectObject(hNewBitmapDC, hNewBitmap);
For I := 0 To lNewHeight do begin
For J := 0 To lNewWidth do begin
lSourceX := Round((J +lMinX) * lCosine + (I + lMinY) * lSine);
lSourceY := Round((I + lMinY) * lCosine - (J + lMinX) * lSine);
If (lSourceX >= 0) And (lSourceX <= lWidth) And
(lSourceY >= 0) And (lSourceY <= lHeight) Then
BitBlt(hNewBitmapDC, J, I, 1, 1, hBitmapDC,
lSourceX, lSourceY, SRCCOPY);
end;
end;
lWidth := lNewWidth;
lHeight := lNewHeight;
hBitmapDC := hNewBitmapDC;
DeleteObject(hNewBitmap);
End;

procedure TForm1.Rotate1Click(Sender: TObject);
var lRadians : real;
DC : longint;
H, W : integer;
Degrees : integer;
begin
Degrees := 90;
lRadians := PI * Degrees / 180;
DC := Image1.Picture.Bitmap.Canvas.Handle;
H := Image1.Picture.Bitmap.Height;
W := Image1.Picture.Bitmap.Width;
RotateBitmap(DC, W, H, lRadians);
Image1.Width := W;
Image1.Height := H;
Image1.Picture.Bitmap.Width := W;
Image1.Picture.Bitmap.Height := H;
BitBlt(Image1.Picture.Bitmap.Canvas.Handle, 0, 0, W, H, DC, 0, 0, SRCCopy);
Image1.Refresh;
end;