Массив точек нарисованной линии

[Serge_Bliznykov]

Всё работает!

Сообщение от spirit-ua

у меня не отображается линия при нажатии на кн. Line

Так и не должна.
Вы после нажатия на кнопку "Line" мышкой + лев.кн.мышки тыкайте в поле для рисования.
Один раз клацнули мышкой - первая точка.
Второй раз - вторая точка и готовая линия.

[spirit-ua]

Так и не должна.
Вы после нажатия на кнопку "Line" мышкой + лев.кн.мышки тыкайте в поле для рисования.
Один раз клацнули мышкой - первая точка.
Второй раз - вторая точка и готовая линия.

точно, не додумался

[Igor[Игорь]]

Сообщение от spirit-ua

TMarker что за зверь?
У меня D7

У меня тоже Delphi 7.
Это мой самописный, маленький квадратик.
Вот его модуль.

unit UMarker;

interface

uses windows, controls, classes, messages, sysutils, graphics, forms;

type TMarker = class(TCustomControl)

private
  FBorderColor: TColor;
  FFillColor: TColor;
  procedure LoadCursors;
  procedure SetBorderColor(Value: TColor);
  function GetBorderColor: TColor;
  procedure SetFillColor(Value: TColor);
  function GetFillColor: TColor;

protected
  procedure Paint; override;

public
  constructor Create(AOwner: TComponent);override;

published
  property BorderColor: TColor read GetBorderColor write SetBorderColor;
  property FillColor: TColor read GetFillColor write SetFillColor;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseUp;
  property Visible;

end;

const
  crSizeAll=1;

procedure Register;

implementation

{$R UMarker.res}

constructor TMarker.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
LoadCursors;
Height:=9;
Width:=9;
Color:=clblack;
Cursor:=crSizeAll;
end;

procedure TMarker.Paint;
begin
with inherited Canvas do begin
Pen.Color:=FBorderColor;
Brush.Color:=FFillColor;
Rectangle(0,0,Width,Height);
end;
end;

procedure TMarker.LoadCursors;
begin
Screen.Cursors[crSizeAll]:=LoadCursor(HInstance,'crSizeAll');
end;

procedure TMarker.SetBorderColor(Value: TColor);
begin
FBorderColor:=Value;
Repaint;
end;

function TMarker.GetBorderColor: TColor;
begin
result:=FBorderColor;
end;

procedure TMarker.SetFillColor(Value: TColor);
begin
FFillColor:=Value;
Repaint;
end;

function TMarker.GetFillColor: TColor;
begin
result:=FFillColor;
end;

procedure Register;
begin
  RegisterComponents('NIVSamples', [TMarker]);
end;

end.

[Pavia]

Доработал свой пример. Добавил функционал. Устранил пару недочётов.



Чтобы на рисовать линию надо пару раз нажать левой кнопкой. В режиме выделения перемещаем линию или хватаем за точку и редактируем.
Перемещение листа правой кнопкой и масштабирование доступно в любом режиме. Также работают клавиши ESC и Delete.