Показать сообщение отдельно
  #17  
Старый 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.
__________________
Жизнь такова какова она есть и больше никакова.
Помогаю за спасибо.
Ответить с цитированием