Delphi Mengkonversi bitmap ke sepia atau greyscale

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.Button1Click(Sender: TObject);

begin

bmptosepia(image1.picture.bitmap, 20);

end;

Delphi Bergerak pada canvas untuk menampilkan nilai X/Y

private

BmpH, BmpV : TBitmap;

OldX, OldY: Integer;

end;

var

RectSaved : boolean = false;

procedure TFormMain.FormCreate(Sender: TObject);

begin

PanelImage.DoubleBuffered := true; // This prevents that the image is blinking

LabelHint.Transparent := true;

LabelHint.Font.Color := clNave;

end;

procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

Cross(X, Y);

end;

procedure TFormMain.Cross(X, Y: Integer);

begin

Image.Canvas.Pen.Color := clBlack;

if RectSaved then

begin

Image.Canvas.CopyRect(Rect(OldX – 5, 0, OldX + 5, BmpV.Height),

BmpV.Canvas, Rect(0,0,BmpV.Width,BmpV.Height));

Image.Canvas.CopyRect(Rect(0, OldY – 5, BmpH.Width, OldY + 5),

BmpH.Canvas, Rect(0,0,BmpH.Width,BmpH.Height));

BmpH.Free;

BmpV.Free;

end;

BmpH := TBitmap.Create;

BmpH.Width := Image.Width;

BmpH.Height := 10;

BmpH.Canvas.CopyRect(Rect(0,0,BmpH.Width,BmpH.Height),

Image.Canvas,Rect(0, Y – 5, BmpH.Width, Y + 5));

BmpV := TBitmap.Create;

BmpV.Width := 10;

BmpV.Height := Image.Height;

BmpV.Canvas.CopyRect(Rect(0,0,BmpV.Width,BmpV.Height),

Image.Canvas,Rect(X – 5, 0, X + 5, BmpV.Height));

Image.Canvas.MoveTo(0, Y);

Image.Canvas.LineTo(Image.Width, Y);

Image.Canvas.MoveTo(X, 0);

Image.Canvas.LineTo(X, Image.Height);

RectSaved := true;

OldX := X;

OldY := Y;

LabelHint.Left := X + 36;

LabelHint.Top := Y – 15;

LabelHint.Caption := ‘(X:’ + IntToStr(X) + ‘ x Y:’ + IntToStr(Y) +’)';

end;

Author: swissdelphicenter.ch

Delphi – Menggambar langsung pada Desktop

var

Form1: TForm1;

Canv: TCanvas;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

Canv := TCanvas.Create;

Canv.Handle := GetWindowDC(0);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

Canv.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Canv.pen.Color := clred;

Canv.pen.Width := 20;

Canv.moveto(Screen.Width, 2);

Canv.lineto(2, 2);

Canv.lineto(2, Screen.Height);

Canv.lineto(Screen.Width, Screen.Height);

Canv.lineto(Screen.Width, 2);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

Canv.Font.Name := ‘Arial’;

Canv.Font.Size := 55;

Canv.Font.Color := clgreen;

Canv.Brush.Style := bsclear;

Canv.textout(240, Screen.Height div 2 – 30, ‘Hello to Screen !’);

end;

procedure TForm1.Button3Click(Sender: TObject);

var

myBitmap: TBitmap;

begin

myBitmap := TBitmap.Create;

try

myBitmap.LoadFromFile(‘MyImage.bmp’);

Canv.draw(100, 100, myBitmap);

finally

myBitmap.Free;

end;