Прямая линия

[Kyran29]

Уважаемые форумчани,
может, кто подскажет, как реализовать рисование ПРЯМОЙ ЛИНИИ с помощь мыши так как, например, делает это «Paint».


Смысл заключается не в том, что бы нарисовать прямую линию программно, например, так:

procedure TForm1.Button1Click(Sender: TObject);
 begin
    Form1.Image1.Canvas.MoveTo(10,15); // Начало линии
    Form1.Image1.Canvas.LineTo(350,250); // Конец линии
 end;

а в том, что пока клавиша мыши нажата, то линия тянется за «мышкой», как только клавишу отпустили, линия прямая нарисована.


Способ, описанный ниже, называется в программе «Paint» рисование линии произвольной формы:

var
 MouseButton: Boolean;


procedure TForm1.FormCreate(Sender: TObject);
 begin
   Form1.Image1.Canvas.Brush.Color := clWhite;
   Form1.Image1.Canvas.Pen.Color:=clRed;
   Form1.Image1.Canvas.Pen.Width:=3;
 end;


procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 begin
   MouseButton:= True;
   Form1.Image1.Canvas.MoveTo(X,Y); // Начало линии
 end;


procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
 begin
    if MouseButton = True // Кнопка мыши удерживается - рисуем
      then
         Form1.Image1.Canvas.LineTo(X,Y); // Конец линии
 end;


procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  begin
    MouseButton:= False; // Отпустили кнопку мыши
  end;

Вот программа в действии, линии произвольной формы получаются!

[Rin]

Если тебе надо именно прямую линию, а не "линию произвольной формы", то просто добавить несколько глобальных переменных и подкорректировать пару процедур:

var Form1:TForm1;
  c:TColor;
  old_x,old_y,move_x,move_y:integer;
.............
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   MouseButton := True;
   Form1.Image1.Canvas.MoveTo(X,Y); // Начало линии
   c:=Image1.canvas.brush.Color;
   old_x:=x;
   old_y:=y;
   move_x:=x;
   move_y:=y;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
      if MouseButton = True // Кнопка мыши удерживается - рисуем
      then
      begin
         Form1.Image1.Canvas.Pen.Color:=c;
         Form1.Image1.Canvas.MoveTo(old_X,old_Y); // Начало линии
         Form1.Image1.Canvas.LineTo(move_X,move_Y); // Конец линии
         Form1.Image1.Canvas.Pen.Color:=clRed;
         move_x:=x;
         move_y:=y;
         Form1.Image1.Canvas.MoveTo(old_X,old_Y); // Начало линии
         Form1.Image1.Canvas.LineTo(move_X,move_Y); // Конец линии
      end;
end;

Но думаю, что будет косяк с затиранием старых линий.

[Kyran29]

Rin - спасибо, вроде ближе к делу, да косяк есть с затиранием старых линей, может, посоветуешь, как этот косяк исправить?

[BDA]

Можно попробовать сделать так:
Создать невидимый битмап
При моусдауне туда копировать исходное изображение и запоминать координаты мыши
При моусмуве рисовать старое изображение в имайдж и линию по запомненным и новым координатам мыши
Чисто имхо

[Kyran29]

BDA - можно подробней? И хотя бы немного кода.

[BDA]

Вот примерчик.

[Kyran29]

BDA - Большое СПАСИБО!
Все отлично работает!

[Kyran29]

На свой вопрос я получил исчерпывающий ответ! Всем большое спасибо.
А в частности - BDA и Rin