procedure DrawCursor(ScreenShotBitmap : TBitmap);
var
r: TRect;
CI: TCursorInfo;
Icon: TIcon;
II: TIconInfo;
begin
r := ScreenShotBitmap.Canvas.ClipRect;
Icon := TIcon.Create;
try
CI.cbSize := SizeOf(CI);
if GetCursorInfo(CI) then
if CI.Flags = CURSOR_SHOWING then
begin
Icon.Handle := CopyIcon(CI.hCursor);
if GetIconInfo(Icon.Handle, II) then
begin
ScreenShotBitmap.Canvas.Draw(
ci.ptScreenPos.x - Integer(II.xHotspot) - r.Left,
ci.ptScreenPos.y - Integer(II.yHotspot) - r.Top,
Icon
);
end;
end;
finally
Icon.Free;
end;
end;
Bu kısım OnClick Olayına eklenecek....
var
pic : TBitmap;
begin
pic := TBitmap.Create;
try
ScreenShot(0,0,Screen.Width,Screen.Height,pic);
DrawCursor(pic);
//Image1.Picture.Assign(pic);
finally
pic.FreeImage;
FreeAndNil(pic);
end;
IMAGE etiketine sahip kayıtlar gösteriliyor. Tüm kayıtları göster
IMAGE etiketine sahip kayıtlar gösteriliyor. Tüm kayıtları göster
8 Nisan 2010 Perşembe
Resim yazıcıdan nasıl alınır
procedure TForm1.Print1Click(Sender: TObject);
var
AspectRatio: Single;
OutputWidth, OutputHeight: Single;
begin
if not PrintDialog1.Execute then Exit;
Printer.BeginDoc;
try
OutputWidth:=Image3.Picture.Width;
OutputHeight:=Image3.Picture.Height;
AspectRatio := OutputWidth / OutputHeight;
if (OutputWidth
if OutputWidth < OutputHeight then
begin
OutputHeight := Printer.PageHeight;
OutputWidth := OutputHeight * AspectRatio;
end
else
begin OutputWidth := Printer.PageWidth;
OutputHeight := OutputWidth / AspectRatio;
end
end;
if OutputWidth > Printer.PageWidth then
begin
OutputWidth:=Printer.PageWidth;
OutputHeight:=OutputWidth/AspectRatio;
end;
if OutputHeight > Printer.PageHeight then
begin
OutputHeight := Printer.PageHeight;
OutputWidth := OutputHeight * AspectRatio;
end;
Printer.Canvas.StretchDraw(Rect(0,0,
trunc(OutputWidth), Trunc(OutputHeight)),
Image3.Picture.Graphic);
finally
Printer.EndDoc;
end;
end;
NOT:Uses printers;eklenecek.
var
AspectRatio: Single;
OutputWidth, OutputHeight: Single;
begin
if not PrintDialog1.Execute then Exit;
Printer.BeginDoc;
try
OutputWidth:=Image3.Picture.Width;
OutputHeight:=Image3.Picture.Height;
AspectRatio := OutputWidth / OutputHeight;
if (OutputWidth
if OutputWidth < OutputHeight then
begin
OutputHeight := Printer.PageHeight;
OutputWidth := OutputHeight * AspectRatio;
end
else
begin OutputWidth := Printer.PageWidth;
OutputHeight := OutputWidth / AspectRatio;
end
end;
if OutputWidth > Printer.PageWidth then
begin
OutputWidth:=Printer.PageWidth;
OutputHeight:=OutputWidth/AspectRatio;
end;
if OutputHeight > Printer.PageHeight then
begin
OutputHeight := Printer.PageHeight;
OutputWidth := OutputHeight * AspectRatio;
end;
Printer.Canvas.StretchDraw(Rect(0,0,
trunc(OutputWidth), Trunc(OutputHeight)),
Image3.Picture.Graphic);
finally
Printer.EndDoc;
end;
end;
NOT:Uses printers;eklenecek.
Image Mail
Resimleri delphi içerisinden nasıl mail ile gönderebiliriz.
resourcestring
SSendError = 'Error sending mail';
uses mapi;
procedure TForm1.ImageSentToMail1Click(Sender: TObject);
var MapiMessage: TMapiMessage; MError: Cardinal;
begin
with MapiMessage do
begin ulReserved := 0;
lpszSubject := nil;
lpszNoteText := PChar(Image1.Picture);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
lpOriginator := nil;
nRecipCount := 0;
lpRecips := nil;
nFileCount := 0;
lpFiles := nil;
end;
MError := MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI
or MAPI_NEW_SESSION, 0);
if MError <> 0 then MessageDlg(SSendError, mtError, [mbOK], 0);
end;
resourcestring
SSendError = 'Error sending mail';
uses mapi;
procedure TForm1.ImageSentToMail1Click(Sender: TObject);
var MapiMessage: TMapiMessage; MError: Cardinal;
begin
with MapiMessage do
begin ulReserved := 0;
lpszSubject := nil;
lpszNoteText := PChar(Image1.Picture);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
lpOriginator := nil;
nRecipCount := 0;
lpRecips := nil;
nFileCount := 0;
lpFiles := nil;
end;
MError := MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI
or MAPI_NEW_SESSION, 0);
if MError <> 0 then MessageDlg(SSendError, mtError, [mbOK], 0);
end;
Flip Reverse
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
CheckBoxFlip: TCheckBox;
Image1: TImage;
editFilename: TEdit;
EditFactor: TEdit;
CheckBoxReverse: TCheckBox;
LabelShrinkFactor: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// Flip/Reverse/Shrink bitmap
// Shrink by resampling by specified factor in both dimensions
FUNCTION FlipReverse(CONST FName: STRING;
CONST FlipIt: BOOLEAN;
CONST ReverseIt: BOOLEAN;
CONST Factor: INTEGER): TBitmap;
TYPE
TRGBTripleArray = ARRAY[WORD] OF TRGBTriple;
pRGBTripleArray = ^TRGBTripleArray;
VAR
Bitmap : TBitmap;
ColumnIn: INTEGER;
rowIn : pRGBTripleArray;
RowOut : pRGBTripleArray;
x : INTEGER;
y : INTEGER;
BEGIN
ASSERT (Factor > 0);
BitMap := TBitMap.Create;
Result := TBitMap.Create;
try
BitMap.LoadfromFile(FName);
// TRGBTripleArray Scanline is only good for pf24bit bitmap,
// so force this if necessary
IF Bitmap.PixelFormat <> pf24bit
THEN Bitmap.PixelFormat := pf24bit;
// "Output" bitmap is same size as "Input" only if Factor = 1
Result.Height := BitMap.Height DIV Factor;
Result.Width := BitMap.Width DIV Factor;
Result.PixelFormat := BitMap.PixelFormat; // pf24bit
// Only process "output" pixels and "fetch" pixels from input bitmap
// Define flip to be "top to bottom" and reverse to be "left to right"
for y := 0 TO (BitMap.Height DIV Factor)-1 do
begin
rowOut := Result.Scanline[y];
if FlipIt
then rowIn := Bitmap.Scanline[Bitmap.Height - 1 - Factor*y]
else rowIn := Bitmap.Scanline[Factor*y];
for x := 0 TO (BitMap.Width DIV Factor)-1 do
begin
if ReverseIt
then ColumnIn := Bitmap.Width - 1 - Factor*x
else ColumnIn := Factor*x;
with rowOut[x] do
begin
rgbtRed := rowIn[ColumnIn].rgbtRed;
rgbtGreen := rowIn[ColumnIn].rgbtGreen;
rgbtBlue := rowIn[ColumnIn].rgbtBlue;
end
end
end
finally
BitMap.free;
END
// Don't free result. Calling program will be responsible for that.
END;
procedure TForm1.Button1Click(Sender: TObject);
Var Bitmap: TBitmap;
begin
Bitmap := FlipReverse(EditFilename.Text, CheckBoxFlip.Checked, CheckBoxReverse.Checked,
StrToInt(EditFactor.Text));
TRY
// Display on screen
Image1.Picture.Graphic := Bitmap;
FINALLY
Bitmap.Free
END
end;end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
CheckBoxFlip: TCheckBox;
Image1: TImage;
editFilename: TEdit;
EditFactor: TEdit;
CheckBoxReverse: TCheckBox;
LabelShrinkFactor: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// Flip/Reverse/Shrink bitmap
// Shrink by resampling by specified factor in both dimensions
FUNCTION FlipReverse(CONST FName: STRING;
CONST FlipIt: BOOLEAN;
CONST ReverseIt: BOOLEAN;
CONST Factor: INTEGER): TBitmap;
TYPE
TRGBTripleArray = ARRAY[WORD] OF TRGBTriple;
pRGBTripleArray = ^TRGBTripleArray;
VAR
Bitmap : TBitmap;
ColumnIn: INTEGER;
rowIn : pRGBTripleArray;
RowOut : pRGBTripleArray;
x : INTEGER;
y : INTEGER;
BEGIN
ASSERT (Factor > 0);
BitMap := TBitMap.Create;
Result := TBitMap.Create;
try
BitMap.LoadfromFile(FName);
// TRGBTripleArray Scanline is only good for pf24bit bitmap,
// so force this if necessary
IF Bitmap.PixelFormat <> pf24bit
THEN Bitmap.PixelFormat := pf24bit;
// "Output" bitmap is same size as "Input" only if Factor = 1
Result.Height := BitMap.Height DIV Factor;
Result.Width := BitMap.Width DIV Factor;
Result.PixelFormat := BitMap.PixelFormat; // pf24bit
// Only process "output" pixels and "fetch" pixels from input bitmap
// Define flip to be "top to bottom" and reverse to be "left to right"
for y := 0 TO (BitMap.Height DIV Factor)-1 do
begin
rowOut := Result.Scanline[y];
if FlipIt
then rowIn := Bitmap.Scanline[Bitmap.Height - 1 - Factor*y]
else rowIn := Bitmap.Scanline[Factor*y];
for x := 0 TO (BitMap.Width DIV Factor)-1 do
begin
if ReverseIt
then ColumnIn := Bitmap.Width - 1 - Factor*x
else ColumnIn := Factor*x;
with rowOut[x] do
begin
rgbtRed := rowIn[ColumnIn].rgbtRed;
rgbtGreen := rowIn[ColumnIn].rgbtGreen;
rgbtBlue := rowIn[ColumnIn].rgbtBlue;
end
end
end
finally
BitMap.free;
END
// Don't free result. Calling program will be responsible for that.
END;
procedure TForm1.Button1Click(Sender: TObject);
Var Bitmap: TBitmap;
begin
Bitmap := FlipReverse(EditFilename.Text, CheckBoxFlip.Checked, CheckBoxReverse.Checked,
StrToInt(EditFactor.Text));
TRY
// Display on screen
Image1.Picture.Graphic := Bitmap;
FINALLY
Bitmap.Free
END
end;end.
Horizontal Image
procedure TForm1.Horizontal1Click(Sender: TObject);
Var
DummyImage : TImage;
X,Y : Integer;
SrcRect,DstRect : TRect;
Begin
X := Image1.Picture.Width;
Y := Image1.Picture.Height;
SrcRect := Rect(0,0,X,Y); //0,0,X,Y
DstRect := Rect(X,0,0,Y); //X,0,0,Y
DummyImage := TImage.Create(Self);
DummyImage.Width := X;
DummyImage.Height := Y;
DummyImage.Canvas.CopyRect(DstRect,Image1.Canvas,SrcRect);
Image1.Picture := DummyImage.Picture;
DummyImage.Free;
end;
Var
DummyImage : TImage;
X,Y : Integer;
SrcRect,DstRect : TRect;
Begin
X := Image1.Picture.Width;
Y := Image1.Picture.Height;
SrcRect := Rect(0,0,X,Y); //0,0,X,Y
DstRect := Rect(X,0,0,Y); //X,0,0,Y
DummyImage := TImage.Create(Self);
DummyImage.Width := X;
DummyImage.Height := Y;
DummyImage.Canvas.CopyRect(DstRect,Image1.Canvas,SrcRect);
Image1.Picture := DummyImage.Picture;
DummyImage.Free;
end;
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;
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;
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;
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;
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;
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;
Resim çevirme-02
Procedure cevir(Src, Dst: TImage);
var x,y: integer;
begin
Dst.Width:= Src.Height; Dst.Height:= Src.Width;
For x:= 0 to Src.Width-1 do begin
For y:= 0 to Src.Height-1 do begin
Dst.Canvas.Pixels[(Src.Height-1)-y,x]:= Src.Canvas.Pixels[x,y];
end;
end;
end;
var x,y: integer;
begin
Dst.Width:= Src.Height; Dst.Height:= Src.Width;
For x:= 0 to Src.Width-1 do begin
For y:= 0 to Src.Height-1 do begin
Dst.Canvas.Pixels[(Src.Height-1)-y,x]:= Src.Canvas.Pixels[x,y];
end;
end;
end;
Resim çevirme-01
Const PixelMax = 32768;
Type
pPixelArray = ^TPixelArray;
TPixelArray = Array[0..PixelMax-1] Of TRGBTriple;
Procedure RotateBitmap_ads(
SourceBitmap : TBitmap;
out DestBitmap : TBitmap;
Center : TPoint;
Angle : Double) ;
Var
cosRadians : Double;
inX : Integer;
inXOriginal : Integer;
inXPrime : Integer;
inXPrimeRotated : Integer;
inY : Integer;
inYOriginal : Integer;
inYPrime : Integer;
inYPrimeRotated : Integer;
OriginalRow : pPixelArray;
Radians : Double;
RotatedRow : pPixelArray;
sinRadians : Double;
begin
DestBitmap.Width := SourceBitmap.Width;
DestBitmap.Height := SourceBitmap.Height;
DestBitmap.PixelFormat := pf24bit;
Radians := -(Angle) * PI / 180;
sinRadians := Sin(Radians) ;
cosRadians := Cos(Radians) ;
For inX := DestBitmap.Height-1 Downto 0 Do
Begin
RotatedRow := DestBitmap.Scanline[inX];
inXPrime := 2*(inX - Center.y) + 1;
For inY := DestBitmap.Width-1 Downto 0 Do
Begin
inYPrime := 2*(inY - Center.x) + 1;
inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians) ;
inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians) ;
inYOriginal := (inYPrimeRotated - 1) Div 2 + Center.x;
inXOriginal := (inXPrimeRotated - 1) Div 2 + Center.y;
If
(inYOriginal >= 0) And
(inYOriginal <= SourceBitmap.Width-1) And
(inXOriginal >= 0) And
(inXOriginal <= SourceBitmap.Height-1)
Then
Begin
OriginalRow := SourceBitmap.Scanline[inXOriginal];
RotatedRow[inY] := OriginalRow[inYOriginal]
End
Else
Begin
RotatedRow[inY].rgbtBlue := 255;
RotatedRow[inY].rgbtGreen := 0;
RotatedRow[inY].rgbtRed := 0
End;
End;
End;
End;
{Usage:}
procedure TForm1.Button1Click(Sender: TObject) ;
Var
Center : TPoint;
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
Try
Center.y := (Image.Height div 2)+20;
Center.x := (Image.Width div 2)+0;
RotateBitmap_ads(
Image.Picture.Bitmap,
Bitmap,javascript:void(0)
Center,
Angle) ;
Angle := Angle + 15;
Image2.Picture.Bitmap.Assign(Bitmap) ;
Finally
Bitmap.Free;
End;end;
Type
pPixelArray = ^TPixelArray;
TPixelArray = Array[0..PixelMax-1] Of TRGBTriple;
Procedure RotateBitmap_ads(
SourceBitmap : TBitmap;
out DestBitmap : TBitmap;
Center : TPoint;
Angle : Double) ;
Var
cosRadians : Double;
inX : Integer;
inXOriginal : Integer;
inXPrime : Integer;
inXPrimeRotated : Integer;
inY : Integer;
inYOriginal : Integer;
inYPrime : Integer;
inYPrimeRotated : Integer;
OriginalRow : pPixelArray;
Radians : Double;
RotatedRow : pPixelArray;
sinRadians : Double;
begin
DestBitmap.Width := SourceBitmap.Width;
DestBitmap.Height := SourceBitmap.Height;
DestBitmap.PixelFormat := pf24bit;
Radians := -(Angle) * PI / 180;
sinRadians := Sin(Radians) ;
cosRadians := Cos(Radians) ;
For inX := DestBitmap.Height-1 Downto 0 Do
Begin
RotatedRow := DestBitmap.Scanline[inX];
inXPrime := 2*(inX - Center.y) + 1;
For inY := DestBitmap.Width-1 Downto 0 Do
Begin
inYPrime := 2*(inY - Center.x) + 1;
inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians) ;
inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians) ;
inYOriginal := (inYPrimeRotated - 1) Div 2 + Center.x;
inXOriginal := (inXPrimeRotated - 1) Div 2 + Center.y;
If
(inYOriginal >= 0) And
(inYOriginal <= SourceBitmap.Width-1) And
(inXOriginal >= 0) And
(inXOriginal <= SourceBitmap.Height-1)
Then
Begin
OriginalRow := SourceBitmap.Scanline[inXOriginal];
RotatedRow[inY] := OriginalRow[inYOriginal]
End
Else
Begin
RotatedRow[inY].rgbtBlue := 255;
RotatedRow[inY].rgbtGreen := 0;
RotatedRow[inY].rgbtRed := 0
End;
End;
End;
End;
{Usage:}
procedure TForm1.Button1Click(Sender: TObject) ;
Var
Center : TPoint;
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
Try
Center.y := (Image.Height div 2)+20;
Center.x := (Image.Width div 2)+0;
RotateBitmap_ads(
Image.Picture.Bitmap,
Bitmap,javascript:void(0)
Center,
Angle) ;
Angle := Angle + 15;
Image2.Picture.Bitmap.Assign(Bitmap) ;
Finally
Bitmap.Free;
End;end;
6 Nisan 2010 Salı
Image Sefia
function bmptosepia(const bmp: TBitmap; depth: Integer): Boolean;
var
color,color2:longint;
r,g,b,rr,gg:byte;
h,w:integer;
begin
for h := 0 to bmp.height do
begin
for w := 0 to bmp.width do
begin
color:=colortorgb(bmp.Canvas.pixels[w,h]);
r:=getrvalue(color);
g:=getgvalue(color);
b:=getbvalue(color);
color2:=(r+g+b) div 3;
bmp.canvas.Pixels[w,h]:=RGB(color2,color2,color2);
color:=colortorgb(bmp.Canvas.pixels[w,h]);
r:=getrvalue(color);
g:=getgvalue(color);
b:=getbvalue(color);
rr:=r+(depth*2);
gg:=g+depth;
if rr <= ((depth*2)-1) then
rr:=255;
if gg <= (depth-1) then
gg:=255;
bmp.canvas.Pixels[w,h]:=RGB(rr,gg,b);
end;end;end;
procedure TForm1.Sefia1Click(Sender: TObject);
begin
bmptosepia(image1.picture.bitmap, 100);
end;
var
color,color2:longint;
r,g,b,rr,gg:byte;
h,w:integer;
begin
for h := 0 to bmp.height do
begin
for w := 0 to bmp.width do
begin
color:=colortorgb(bmp.Canvas.pixels[w,h]);
r:=getrvalue(color);
g:=getgvalue(color);
b:=getbvalue(color);
color2:=(r+g+b) div 3;
bmp.canvas.Pixels[w,h]:=RGB(color2,color2,color2);
color:=colortorgb(bmp.Canvas.pixels[w,h]);
r:=getrvalue(color);
g:=getgvalue(color);
b:=getbvalue(color);
rr:=r+(depth*2);
gg:=g+depth;
if rr <= ((depth*2)-1) then
rr:=255;
if gg <= (depth-1) then
gg:=255;
bmp.canvas.Pixels[w,h]:=RGB(rr,gg,b);
end;end;end;
procedure TForm1.Sefia1Click(Sender: TObject);
begin
bmptosepia(image1.picture.bitmap, 100);
end;
Negatif image
procedure TForm1.Negative1Click(Sender: TObject);
var
GrayPal: TMaxLogPalette;
i: Integer;
begin
for i := 0 to 255 do
with GrayPal.palPalEntry[i] do
begin
peRed := i;
peGreen := i;
peBlue := i;
peFlags := 0; end;
grayPal.palVersion := $0300;
GrayPal.palNumEntries := 256;
Image1.Picture.Bitmap.PixelFormat := pf8bit;
Image1.Picture.Bitmap.Palette := CreatePalette( PLogPalette(@GrayPal)^ );
Image1.Picture.Bitmap.Width := Image1.Picture.Bitmap.Width;
Image1.Picture.Bitmap.Height := Image1.Picture.Bitmap.Height;
Image1.Picture.Bitmap.Canvas.Draw( 0, 0, Image1.Picture.Bitmap);
end;
var
GrayPal: TMaxLogPalette;
i: Integer;
begin
for i := 0 to 255 do
with GrayPal.palPalEntry[i] do
begin
peRed := i;
peGreen := i;
peBlue := i;
peFlags := 0; end;
grayPal.palVersion := $0300;
GrayPal.palNumEntries := 256;
Image1.Picture.Bitmap.PixelFormat := pf8bit;
Image1.Picture.Bitmap.Palette := CreatePalette( PLogPalette(@GrayPal)^ );
Image1.Picture.Bitmap.Width := Image1.Picture.Bitmap.Width;
Image1.Picture.Bitmap.Height := Image1.Picture.Bitmap.Height;
Image1.Picture.Bitmap.Canvas.Draw( 0, 0, Image1.Picture.Bitmap);
end;
Negatif image
unit NegImg;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
OrigImg: TImage;
Button1: TButton;
RadioGroup1: TRadioGroup;
Label5: TLabel;
Label6: TLabel;
OpenBtn: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure OpenBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
procedure NegativeBitmap(OrigBmp, DestBmp: TBitmap);
procedure FastNegativeBitmap(OrigBmp, DestBmp: TBitmap);
procedure InvertBitmap(OrigBmp, DestBmp: TBitmap);
const
MaxPixelCount = 32768;
type
PRGBArray = ^TRGBArray;
TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
IniTime, ElapsedTime: DWord;
begin
Label6.Caption := '';
IniTime := GetTickCount;
case RadioGroup1.ItemIndex of
0: NegativeBitmap(OrigImg.Picture.Bitmap, OrigImg.Picture.Bitmap);
1: FastNegativeBitmap(OrigImg.Picture.Bitmap, OrigImg.Picture.Bitmap);
2: InvertBitmap(OrigImg.Picture.Bitmap, OrigImg.Picture.Bitmap);
end;
ElapsedTime := GetTickCount - IniTime;
Label6.Caption := Format('%d ms', [ElapsedTime]);
end;
procedure NegativeBitmap(OrigBmp, DestBmp: TBitmap);
var
i, j, R, G, B: Integer;
TmpBmp: TBitmap;
begin
// Create a temporal bitmap. This allows to use the same bitmap
// as input or output
TmpBmp := TBitmap.Create;
try
// Assign the temporal bitmap the same characteristics as the original
TmpBmp.Width := OrigBmp.Width;
TmpBmp.Height := OrigBmp.Height;
TmpBmp.PixelFormat := OrigBmp.PixelFormat;
// For each row
for i := 0 to TmpBmp.Height - 1 do
begin
// For each column
for j := 0 to TmpBmp.Width - 1 do
begin
// r := 255 - GetRValue(OrigBmp.Canvas.Pixels[j, i]);
// g := 255 - GetGValue(OrigBmp.Canvas.Pixels[j, i]);
// b := 255 - GetBValue(OrigBmp.Canvas.Pixels[j, i]);
R := not GetRValue(OrigBmp.Canvas.Pixels[j, i]);
G := not GetGValue(OrigBmp.Canvas.Pixels[j, i]);
B := not GetBValue(OrigBmp.Canvas.Pixels[j, i]);
TmpBmp.Canvas.Pixels[j, i] := RGB(R, G, B);
end; // Column
end; // Row
// Assign the negative bitmap to the destination bitmap
DestBmp.Assign(TmpBmp);
finally
// Destroy temp bitmap
TmpBmp.Free;
end;
end;
procedure FastNegativeBitmap(OrigBmp, DestBmp: TBitmap);
var
i, j: Integer;
TmpBmp: TBitmap;
OrigRow, DestRow: PRGBArray;
begin
// Create a temporal bitmap. This allows to use the same bitmap
// as input or output
TmpBmp := TBitmap.Create;
try
// Assign the temporal bitmap the same characteristics as the original
TmpBmp.Width := OrigBmp.Width;
TmpBmp.Height := OrigBmp.Height;
OrigBmp.PixelFormat := pf24bit;
TmpBmp.PixelFormat := OrigBmp.PixelFormat;
// For each row
for i := 0 to TmpBmp.Height - 1 do
begin
// Sssign current ScanLines
OrigRow := OrigBmp.ScanLine[i];
DestRow := TmpBmp.ScanLine[i];
// For each column
for j := 0 to TmpBmp.Width - 1 do
begin
// Invert red, green, blue values
// DestRow[j].rgbtRed := 255 - OrigRow[j].rgbtRed;
// DestRow[j].rgbtGreen := 255 - OrigRow[j].rgbtGreen;
// DestRow[j].rgbtBlue := 255 - OrigRow[j].rgbtBlue;
DestRow[j].rgbtRed := not OrigRow[j].rgbtRed;
DestRow[j].rgbtGreen := not OrigRow[j].rgbtGreen;
DestRow[j].rgbtBlue := not OrigRow[j].rgbtBlue;
end;
end;
// Assign the negative bitmap to the destination bitmap
DestBmp.Assign(TmpBmp);
finally
// Destroy temp bitmap
TmpBmp.Free;
end;
end;
procedure InvertBitmap(OrigBmp, DestBmp: TBitmap);
begin
// use of the GDI InvertRect() A>PI is even faster...
InvertRect(OrigBmp.Canvas.Handle, OrigBmp.Canvas.ClipRect);
DestBmp.Assign(OrigBmp);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
try
OrigImg.Picture.LoadFromFile('Delphi.bmp'); //burada derlerken hataverebilir hatta verir bunu bir butona atasanız iyi olur
except
end;
end;
procedure TForm1.OpenBtnClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
OrigImg.Picture.LoadFromFile(OpenDialog1.FileName);
OrigImg.Refresh;
end;
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
OrigImg: TImage;
Button1: TButton;
RadioGroup1: TRadioGroup;
Label5: TLabel;
Label6: TLabel;
OpenBtn: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure OpenBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
procedure NegativeBitmap(OrigBmp, DestBmp: TBitmap);
procedure FastNegativeBitmap(OrigBmp, DestBmp: TBitmap);
procedure InvertBitmap(OrigBmp, DestBmp: TBitmap);
const
MaxPixelCount = 32768;
type
PRGBArray = ^TRGBArray;
TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
IniTime, ElapsedTime: DWord;
begin
Label6.Caption := '';
IniTime := GetTickCount;
case RadioGroup1.ItemIndex of
0: NegativeBitmap(OrigImg.Picture.Bitmap, OrigImg.Picture.Bitmap);
1: FastNegativeBitmap(OrigImg.Picture.Bitmap, OrigImg.Picture.Bitmap);
2: InvertBitmap(OrigImg.Picture.Bitmap, OrigImg.Picture.Bitmap);
end;
ElapsedTime := GetTickCount - IniTime;
Label6.Caption := Format('%d ms', [ElapsedTime]);
end;
procedure NegativeBitmap(OrigBmp, DestBmp: TBitmap);
var
i, j, R, G, B: Integer;
TmpBmp: TBitmap;
begin
// Create a temporal bitmap. This allows to use the same bitmap
// as input or output
TmpBmp := TBitmap.Create;
try
// Assign the temporal bitmap the same characteristics as the original
TmpBmp.Width := OrigBmp.Width;
TmpBmp.Height := OrigBmp.Height;
TmpBmp.PixelFormat := OrigBmp.PixelFormat;
// For each row
for i := 0 to TmpBmp.Height - 1 do
begin
// For each column
for j := 0 to TmpBmp.Width - 1 do
begin
// r := 255 - GetRValue(OrigBmp.Canvas.Pixels[j, i]);
// g := 255 - GetGValue(OrigBmp.Canvas.Pixels[j, i]);
// b := 255 - GetBValue(OrigBmp.Canvas.Pixels[j, i]);
R := not GetRValue(OrigBmp.Canvas.Pixels[j, i]);
G := not GetGValue(OrigBmp.Canvas.Pixels[j, i]);
B := not GetBValue(OrigBmp.Canvas.Pixels[j, i]);
TmpBmp.Canvas.Pixels[j, i] := RGB(R, G, B);
end; // Column
end; // Row
// Assign the negative bitmap to the destination bitmap
DestBmp.Assign(TmpBmp);
finally
// Destroy temp bitmap
TmpBmp.Free;
end;
end;
procedure FastNegativeBitmap(OrigBmp, DestBmp: TBitmap);
var
i, j: Integer;
TmpBmp: TBitmap;
OrigRow, DestRow: PRGBArray;
begin
// Create a temporal bitmap. This allows to use the same bitmap
// as input or output
TmpBmp := TBitmap.Create;
try
// Assign the temporal bitmap the same characteristics as the original
TmpBmp.Width := OrigBmp.Width;
TmpBmp.Height := OrigBmp.Height;
OrigBmp.PixelFormat := pf24bit;
TmpBmp.PixelFormat := OrigBmp.PixelFormat;
// For each row
for i := 0 to TmpBmp.Height - 1 do
begin
// Sssign current ScanLines
OrigRow := OrigBmp.ScanLine[i];
DestRow := TmpBmp.ScanLine[i];
// For each column
for j := 0 to TmpBmp.Width - 1 do
begin
// Invert red, green, blue values
// DestRow[j].rgbtRed := 255 - OrigRow[j].rgbtRed;
// DestRow[j].rgbtGreen := 255 - OrigRow[j].rgbtGreen;
// DestRow[j].rgbtBlue := 255 - OrigRow[j].rgbtBlue;
DestRow[j].rgbtRed := not OrigRow[j].rgbtRed;
DestRow[j].rgbtGreen := not OrigRow[j].rgbtGreen;
DestRow[j].rgbtBlue := not OrigRow[j].rgbtBlue;
end;
end;
// Assign the negative bitmap to the destination bitmap
DestBmp.Assign(TmpBmp);
finally
// Destroy temp bitmap
TmpBmp.Free;
end;
end;
procedure InvertBitmap(OrigBmp, DestBmp: TBitmap);
begin
// use of the GDI InvertRect() A>PI is even faster...
InvertRect(OrigBmp.Canvas.Handle, OrigBmp.Canvas.ClipRect);
DestBmp.Assign(OrigBmp);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
try
OrigImg.Picture.LoadFromFile('Delphi.bmp'); //burada derlerken hataverebilir hatta verir bunu bir butona atasanız iyi olur
except
end;
end;
procedure TForm1.OpenBtnClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
OrigImg.Picture.LoadFromFile(OpenDialog1.FileName);
OrigImg.Refresh;
end;
end;
end.
Jpeg Brightness
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, StdCtrls,jpeg;
type
TForm3 = class(TForm)
ScrollBox1: TScrollBox;
ScrollBox2: TScrollBox;
TrackBar1: TTrackBar;
OrigImage: TImage;
DestImage: TImage;
ValueLbl: TLabel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure DestImageDblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
const
MaxPixelCount = 32768;
type
pRGBArray = ^TRGBArray;
TRGBArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;
function Min(a, b: integer): integer;
function Max(a, b: integer): integer;
implementation
uses Viewer;
{$R *.DFM}
procedure TForm3.FormCreate(Sender: TObject);
var
jpg: TJpegImage;
begin
jpg := TJpegImage.Create;
OrigImage.Picture.Bitmap.PixelFormat := pf24bit;
DestImage.Picture.Bitmap.PixelFormat := pf24bit;
TrackBar1.Position := 0;
ValueLbl.Caption := '0';
end;
procedure TForm3.TrackBar1Change(Sender: TObject);
var i, j, value: integer;
OrigRow, DestRow: pRGBArray;
OrigImage,DestImage:TJPEGImage;//test
begin
// get brightness increment value
value := TTrackBar(Sender).Position;
if value <= 0 then ValueLbl.Caption := IntToStr(value)
else ValueLbl.Caption := Format('+%d', [value]);
// for each row of pixels
for i := 0 to OrigImage.Picture.Height - 1 do
begin
OrigRow := OrigImage.Picture.Bitmap.ScanLine[i];
DestRow := DestImage.Picture.Bitmap.ScanLine[i];
// for each pixel in row
for j := 0 to OrigImage.Picture.Width - 1 do
begin
// add brightness value to pixel's RGB values
if value > 0 then
begin
// RGB values must be less than 256
DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + value);
DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + value);
DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + value);
end else begin
// RGB values must be greater or equal than 0
DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + value);
DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + value);
DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + value);
end;
end;
application.ProcessMessages;
DestImage.rePaint;
end;
end;
function Min(a, b: integer): integer;
begin
if a < b then result := a
else result := b;
end;
function Max(a, b: integer): integer;
begin
if a > b then result := a
else result := b;
end;end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, StdCtrls,jpeg;
type
TForm3 = class(TForm)
ScrollBox1: TScrollBox;
ScrollBox2: TScrollBox;
TrackBar1: TTrackBar;
OrigImage: TImage;
DestImage: TImage;
ValueLbl: TLabel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure DestImageDblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
const
MaxPixelCount = 32768;
type
pRGBArray = ^TRGBArray;
TRGBArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;
function Min(a, b: integer): integer;
function Max(a, b: integer): integer;
implementation
uses Viewer;
{$R *.DFM}
procedure TForm3.FormCreate(Sender: TObject);
var
jpg: TJpegImage;
begin
jpg := TJpegImage.Create;
OrigImage.Picture.Bitmap.PixelFormat := pf24bit;
DestImage.Picture.Bitmap.PixelFormat := pf24bit;
TrackBar1.Position := 0;
ValueLbl.Caption := '0';
end;
procedure TForm3.TrackBar1Change(Sender: TObject);
var i, j, value: integer;
OrigRow, DestRow: pRGBArray;
OrigImage,DestImage:TJPEGImage;//test
begin
// get brightness increment value
value := TTrackBar(Sender).Position;
if value <= 0 then ValueLbl.Caption := IntToStr(value)
else ValueLbl.Caption := Format('+%d', [value]);
// for each row of pixels
for i := 0 to OrigImage.Picture.Height - 1 do
begin
OrigRow := OrigImage.Picture.Bitmap.ScanLine[i];
DestRow := DestImage.Picture.Bitmap.ScanLine[i];
// for each pixel in row
for j := 0 to OrigImage.Picture.Width - 1 do
begin
// add brightness value to pixel's RGB values
if value > 0 then
begin
// RGB values must be less than 256
DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + value);
DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + value);
DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + value);
end else begin
// RGB values must be greater or equal than 0
DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + value);
DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + value);
DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + value);
end;
end;
application.ProcessMessages;
DestImage.rePaint;
end;
end;
function Min(a, b: integer): integer;
begin
if a < b then result := a
else result := b;
end;
function Max(a, b: integer): integer;
begin
if a > b then result := a
else result := b;
end;end.
Jpeg To Grb Convert
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var Form1: TForm1;
implementation
uses jpeg;
{$R *.dfm}
function ConvertBitmapToGrayscale(const Bitmap: TBitmap): TBitmap;
var i, j: Integer; Grayshade, Red, Green, Blue: Byte; PixelColor: Longint;
begin
with Bitmap do
for i := 0 to Width - 1 do
for j := 0 to Height - 1 do
begin
PixelColor := ColorToRGB(Canvas.Pixels[i, j]);
Red := PixelColor;
Green := PixelColor shr 8;
Blue := PixelColor shr 16;
Grayshade := Round(0.3 * Red + 0.6 * Green + 0.1 * Blue);
Canvas.Pixels[i, j] := RGB(Grayshade, Grayshade, Grayshade);
end;
Result := Bitmap;
end;
procedure ConvertToBitmap(Source : TGraphic; Bitmap : TBitmap);
begin
try
if Bitmap = nil then
Bitmap := TBitmap.Create
Else Bitmap.FreeImage;
Bitmap.Width := Source.Width;
Bitmap.Height := Source.Height;
Bitmap.Canvas.Draw(0,0,Source);
except
showmessage('No Loaded File');
end;end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyJpeg,OperatedJpeg:TJPEGImage;
MyBitmap,OperatedBitmap:TBitmap;
Begin
if OpenDialog1.Execute then
begin
MyJpeg := TJPEGImage.Create;
MyBitmap := TBitmap.Create;
OperatedBitmap := TBitmap.Create;
OperatedJpeg := TJPEGImage.Create;
try
MyJpeg.LoadFromFile(OpenDialog1.FileName);
ConvertToBitmap(MyJpeg,MyBitmap);
// Do any Bitmap Operation Here
//For Example i Convert Bitmap To GrayScale and perform result into
//operateBitmap
OperatedBitmap := ConvertBitmapToGrayscale(MyBitmap);
//Perform operated bitmap into jpeg
OperatedJpeg.Assign(OperatedBitmap);
OperatedJpeg.SaveToFile(OpenDialog1.FileName+'-Gray.jpeg');
Showmessage('Operation Completed')
finally
MyJpeg.Free;
OperatedJpeg.Free;
end;end;end; end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var Form1: TForm1;
implementation
uses jpeg;
{$R *.dfm}
function ConvertBitmapToGrayscale(const Bitmap: TBitmap): TBitmap;
var i, j: Integer; Grayshade, Red, Green, Blue: Byte; PixelColor: Longint;
begin
with Bitmap do
for i := 0 to Width - 1 do
for j := 0 to Height - 1 do
begin
PixelColor := ColorToRGB(Canvas.Pixels[i, j]);
Red := PixelColor;
Green := PixelColor shr 8;
Blue := PixelColor shr 16;
Grayshade := Round(0.3 * Red + 0.6 * Green + 0.1 * Blue);
Canvas.Pixels[i, j] := RGB(Grayshade, Grayshade, Grayshade);
end;
Result := Bitmap;
end;
procedure ConvertToBitmap(Source : TGraphic; Bitmap : TBitmap);
begin
try
if Bitmap = nil then
Bitmap := TBitmap.Create
Else Bitmap.FreeImage;
Bitmap.Width := Source.Width;
Bitmap.Height := Source.Height;
Bitmap.Canvas.Draw(0,0,Source);
except
showmessage('No Loaded File');
end;end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyJpeg,OperatedJpeg:TJPEGImage;
MyBitmap,OperatedBitmap:TBitmap;
Begin
if OpenDialog1.Execute then
begin
MyJpeg := TJPEGImage.Create;
MyBitmap := TBitmap.Create;
OperatedBitmap := TBitmap.Create;
OperatedJpeg := TJPEGImage.Create;
try
MyJpeg.LoadFromFile(OpenDialog1.FileName);
ConvertToBitmap(MyJpeg,MyBitmap);
// Do any Bitmap Operation Here
//For Example i Convert Bitmap To GrayScale and perform result into
//operateBitmap
OperatedBitmap := ConvertBitmapToGrayscale(MyBitmap);
//Perform operated bitmap into jpeg
OperatedJpeg.Assign(OperatedBitmap);
OperatedJpeg.SaveToFile(OpenDialog1.FileName+'-Gray.jpeg');
Showmessage('Operation Completed')
finally
MyJpeg.Free;
OperatedJpeg.Free;
end;end;end; end.
Ico to Bmp Convert
procedure TForm1.ConvertIcon2BitmapClick(Sender: TObject);
var
s : string;
Icon: TIcon;
begin
OpenDialog1.DefaultExt := '.ICO';
OpenDialog1.Filter := 'icons (*.ico)|*.ICO';
OpenDialog1.Options := [ofOverwritePrompt, ofFileMustExist, ofHideReadOnly ];
if OpenDialog1.Execute then
begin
Icon := TIcon.Create;
try
Icon.Loadfromfile(OpenDialog1.FileName);
s:= ChangeFileExt(OpenDialog1.FileName,'.BMP');
Image1.Width := Icon.Width;
Image1.Height := Icon.Height;
Image1.Canvas.Draw(0,0,Icon);
Image1.Picture.SaveToFile(s);
ShowMessage(OpenDialog1.FileName + ' Saved to ' + s);
finally
Icon.Free;
end;
end;
end;
var
s : string;
Icon: TIcon;
begin
OpenDialog1.DefaultExt := '.ICO';
OpenDialog1.Filter := 'icons (*.ico)|*.ICO';
OpenDialog1.Options := [ofOverwritePrompt, ofFileMustExist, ofHideReadOnly ];
if OpenDialog1.Execute then
begin
Icon := TIcon.Create;
try
Icon.Loadfromfile(OpenDialog1.FileName);
s:= ChangeFileExt(OpenDialog1.FileName,'.BMP');
Image1.Width := Icon.Width;
Image1.Height := Icon.Height;
Image1.Canvas.Draw(0,0,Icon);
Image1.Picture.SaveToFile(s);
ShowMessage(OpenDialog1.FileName + ' Saved to ' + s);
finally
Icon.Free;
end;
end;
end;
Ico to Bmp Convert
var
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico');
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0 0 Icon );
Bitmap.SaveToFile('c:\picture.bmp');
Icon.Free;
Bitmap.Free;
end;
Icon : TIcon;
Bitmap : TBitmap;
begin
Icon := TIcon.Create;
Bitmap := TBitmap.Create;
Icon.LoadFromFile('c:\picture.ico');
Bitmap.Width := Icon.Width;
Bitmap.Height := Icon.Height;
Bitmap.Canvas.Draw(0 0 Icon );
Bitmap.SaveToFile('c:\picture.bmp');
Icon.Free;
Bitmap.Free;
end;
Bmp to Jpg Convert
//uses kısmına jpeg unitini ekleyin.
procedure TForm1.Button1Click(Sender: TObject);
var
MyJPEG : TJPEGImage;
MyBMP : TBitmap;
begin
MyBMP := TBitmap.Create;
with MyBMP do
try
LoadFromFile('c:\winnt\ACD Wallpaper.bmp');
MyJPEG := TJPEGImage.Create;
with MyJPEG do begin
Assign(MyBMP);
SaveToFile('c:\winnt\ACD Wallpaper.JPEG');
Free;
end;
finally
Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyJPEG : TJPEGImage;
MyBMP : TBitmap;
begin
MyBMP := TBitmap.Create;
with MyBMP do
try
LoadFromFile('c:\winnt\ACD Wallpaper.bmp');
MyJPEG := TJPEGImage.Create;
with MyJPEG do begin
Assign(MyBMP);
SaveToFile('c:\winnt\ACD Wallpaper.JPEG');
Free;
end;
finally
Free;
end;
end;
Kaydol:
Kayıtlar (Atom)