Recent Posts

Selamat datang di Coding Delphi Land Weblog kumpulan source code pemogram delphi

(Bukan maksud untuk menggurui tetapi marilah kita berbagi ilmu tuk perkembangan kemajuan teknologi kita

Sabtu, 14 November 2009

Image Mouse Move

unit Mouse1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, Math, ExtCtrls, StdCtrls;

type
TRGB = record
R : byte;
G : byte;
B : byte;
end;
TRGBArray = array[0..32767] of TRGB;
pRGBArray = ^TRGBArray;

TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image0: TImage;
Shape1: TShape;
btnEnd: TButton;
Shape2: TShape;
Shape3: TShape;
Shape4: TShape;
Shape5: TShape;
ScrollBar1: TScrollBar;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
procedure btnEndClick(Sender: TObject);
procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Shape2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Shape3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Shape4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Shape5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure MergeBitmaps(ARatio : Single);
procedure FormPaint(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);

private
{ Private-Deklarationen }
Bitmap1, Bitmap2, BitmapOut : TBitmap;
Scanlines1, Scanlines2, ScanlinesOut : array of pRGBArray;
Loaded1, Loaded2 : boolean;
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;
mDown:Integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Bitmap1 := TBitmap.Create;
Bitmap2 := TBitmap.Create;
BitmapOut := TBitmap.Create;
BitmapOut.PixelFormat := pf24bit;
Loaded1 := False;
Loaded2 := False;
Canvas.Brush.Color := clBtnFace;
Form1.ScrollBar1.Position := Form1.ScrollBar1.Max;
Image0.Top := 20; Image0.Left := 20;
Doublebuffered := True;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
button1.Click; //load picture1
button2.Click; //load picture2
end;

procedure TForm1.MergeBitmaps(ARatio : Single);
Var
x, y, W, H : integer;
Ratio, RatioMin : integer;
begin
Ratio := Round(ARatio * 256);
RatioMin := 256 - Ratio;
W := Min(Bitmap1.Width, Bitmap2.Width);
H := Min(Bitmap1.Height, Bitmap2.Height);
BitmapOut.Width := W;
BitmapOut.Height := H;
SetLength(ScanlinesOut, H);
for y := 0 to H-1 do ScanlinesOut[y] := BitmapOut.ScanLine[y];
for y := 0 to H-1 do begin
for x := 0 to W-1 do begin
ScanlinesOut[y][x].R := (Ratio*Scanlines1[y][x].R +
RatioMin*Scanlines2[y][x].R) shr 8;
ScanlinesOut[y][x].G := (Ratio*Scanlines1[y][x].G +
RatioMin*Scanlines2[y][x].G) shr 8;
ScanlinesOut[y][x].B := (Ratio*Scanlines1[y][x].B +
RatioMin*Scanlines2[y][x].B) shr 8;
end;
end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(20, 20, BitmapOut);
end;

procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Image0.Picture := Image2.Picture;
end;

procedure TForm1.Shape2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Image0.Picture := Image4.Picture;
end;

procedure TForm1.Shape3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Image0.Picture := Image3.Picture;
end;

procedure TForm1.Shape4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Image0.Picture := Image1.Picture;
end;

procedure TForm1.Shape5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Form1.ScrollBar1.Position = Form1.ScrollBar1.Max then
repeat
Form1.ScrollBar1.Position := Form1.ScrollBar1.Position -1;
sleep(50);
until Form1.ScrollBar1.Position = Form1.ScrollBar1.Min;
if Form1.ScrollBar1.Position = Form1.ScrollBar1.Min then
repeat
Form1.ScrollBar1.Position := Form1.ScrollBar1.Position +1;
sleep(50);
until Form1.ScrollBar1.Position = Form1.ScrollBar1.Max;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
MergeBitmaps(ScrollBar1.Position/100);
Canvas.Draw(20, 20, BitmapOut);
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
Row : integer;
JPeg : TJPegImage; // out if *.bmp
begin
JPeg := TJPegImage.Create; // out if *.bmp
JPeg.Assign(Form1.Image2.Picture); // out if *.bmp
Bitmap2.Assign(JPeg); // out if *.bmp
//Bitmap2.Assign(Form1.Image2.Picture ); //on if *.bmp
JPeg.Free; // out if *.bmp
Bitmap2.PixelFormat := pf24bit;
Loaded2 := True;
SetLength(Scanlines2, Bitmap2.Height);
for Row := 0 to Bitmap2.Height - 1 do
Scanlines2[Row] := Bitmap2.Scanline[Row];
if Loaded2 then begin
MergeBitmaps(ScrollBar1.Position/100);
Canvas.FillRect(ClientRect);
Canvas.Draw(20, 20, BitmapOut);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
Var
Row : integer;
JPeg : TJPegImage; // out if *.bmp
begin
JPeg := TJPegImage.Create; // out if *.bmp
JPeg.Assign (Form1.Image1.Picture); // out if *.bmp
Bitmap1.Assign(JPeg); // out if *.bmp
//Bitmap2.Assign(Form1.Image2.Picture); // on if *.bmp
JPeg.Free; // out if *.bmp
Bitmap1.PixelFormat := pf24bit;
Loaded1 := True;
SetLength(Scanlines1, Bitmap1.Height);
for Row := 0 to Bitmap1.Height - 1 do
Scanlines1[Row] := Bitmap1.Scanline[Row];
if Loaded1 then begin
MergeBitmaps(ScrollBar1.Position/100);
Canvas.FillRect(ClientRect);
Canvas.Draw(20, 20, BitmapOut);
end;
end;

procedure TForm1.btnEndClick(Sender: TObject);
begin
close;
end;

end.

0 komentar:

Posting Komentar