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
Minggu, 15 November 2009
Move a cross in canvas to show X/Y values
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;
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;
0 komentar:
Posting Komentar