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;

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.