
22.06.2014, 23:22
|
 |
Гуру
|
|
Регистрация: 09.03.2009
Адрес: На курорте, из окна вижу теплое Баренцево море. Бррр.
Сообщения: 4,723
Репутация: 52347
|
|
Вот вам вариант с подсчетом общего пробега:
Код:
unit Unit27;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm27 = class(TForm)
PaintBox1: TPaintBox;
Label1: TLabel;
Label2: TLabel;
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
ClickPos, CursorPos: TPoint;
Lines: Array of TRect;
end;
var
Form27: TForm27;
implementation
{$R *.dfm}
function LineSize(A, B: TPoint): Real;
begin
Result := Sqrt(Sqr(Abs(B.X - A.X)) + Sqr(Abs(B.Y - A.Y)));
end;
procedure TForm27.FormCreate(Sender: TObject);
begin
SetLength(Lines, 0);
end;
procedure TForm27.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ClickPos := Point(X, Y);
CursorPos := ClickPos;
Canvas.Pen.Color := clRed;
Canvas.Pen.Mode := pmNotXor;
Canvas.Pen.Width := 3;
end;
procedure TForm27.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in Shift
then begin
Canvas.MoveTo(ClickPos.X, ClickPos.Y);
Canvas.LineTo(CursorPos.X, CursorPos.Y);
CursorPos := Point(X, Y);
Canvas.MoveTo(ClickPos.X, ClickPos.Y);
Canvas.LineTo(X, Y);
Label1.Caption := Format('%6.2f',[LineSize(ClickPos, CursorPos)]);
end;
end;
procedure TForm27.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var
i: Integer;
Len: Real;
begin
Canvas.Pen.Mode := pmCopy;
Canvas.MoveTo(ClickPos.X, ClickPos.Y);
Canvas.LineTo(CursorPos.X, CursorPos.Y);
SetLength(Lines, Length(Lines) + 1);
Lines[High(Lines)] := Rect(ClickPos.X, ClickPos.Y, CursorPos.X, CursorPos.Y);
for i := 0 to Length(Lines) - 1
do Len := Len + LineSize(Lines[i].TopLeft, Lines[i].BottomRight);
Label2.Caption := Format('%6.2f',[Len]);
end;
end.
__________________
Жизнь такова какова она есть и больше никакова.
Помогаю за спасибо.
|