Рисование в Delphi, С помощью мыши Опции

[Shmaniche]

Надо нарисовать элипс. Самое простое что пришло в голову это поместить на форму PaintBox и написать:

Код

var
  Form1: TForm1;
  MouseButtonDown: Boolean= false;
  StartX, StartY: Integer;

implementation


procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
MouseButtonDown:=true;
StartX:=X;
StartY:=Y;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Form1.Caption:=Format ('Координаты: x=%d, y=%d ' , [X, Y]); // Координаты в заголовке.

if  MouseButtonDown=true then
PaintBox1.Canvas.Ellipse(StartX, Starty, X, Y);

end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
MouseButtonDown:=false;
end;

Но от элипса остается след, если нажатую мышку двигать назад. Как избавиться от этого следа?

Сообщение отредактировано: Shmaniche - 9.12.2012 17:46

[TarasBer]

Стирать след, оставленный на предыдущем кадре.

[Shmaniche]

Стирать след, оставленный на предыдущем кадре.

Это понятно . В общем допер.

Код

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
StartX:=X; StartY:=Y;
EndX:=X; EndY:=Y;
MouseButtonDown:=true
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if MouseButtonDown=true then // Если нажатта клавиша мыши, рисовать
begin
  Canvas.Pen.Mode := pmNot; // Установить такой вид пера, чтобы избежать следа.
  Canvas.Pen.Width := 2; // Толщина кисти
  Canvas.Brush.Style := bsClear; // Прозрачная закраска
  Canvas.Ellipse(StartX, StartY, EndX, EndY); // Рисуем элипс
  EndX:=X; EndY:=Y; // Фиксируем конечные координаты,
  Canvas.Ellipse(StartX, StartY, EndX, EndY); // и перерисовываем нарисованную фигуру, чтобы избежать следа.
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   MouseButtonDown:=false;
end;

Но при сворачивании окна все нарисованное исчезает. Как это дело зафиксировать?

Сообщение отредактировано: Shmaniche - 10.12.2012 6:49

[Shmaniche]

Дорабоотал прежний код, чтобы можно было рисовать не только элипс, но и прямоугольник, когда нажата клавиша SHIFT:

Код

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if (Button=mbLeft)
and not (ssShift in Shift)
then Circle:=true
else Circle:=false;

if ssShift in Shift
then Rectangle:=true
else Rectangle:=false;

StartX:=X; StartY:=Y;
EndX:=X; EndY:=Y;
MouseButtonDown:=true;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Canvas.Pen.Mode := pmNot;
Canvas.Pen.Width := 2;
Canvas.Brush.Style := bsClear;

if (MouseButtonDown=true) and (Rectangle=true) then // Если кнопка мыши нажата и Rect=true, то...
  begin
   Canvas.Rectangle(StartX, StartY, EndX, EndY); // рисуем прямоугльник.
   EndX:=X; EndY:=Y; // Фиксируем конечные координаты,
   Canvas.Rectangle(StartX, StartY, EndX, EndY); // и перерисовываем нарисованную фигуру, чтобы избежать следа.
  end
else // Иначе..
  if (MouseButtonDown=true) and (Circle=true) then // Если кнопка мыши нажата и Circle=true, то...
   begin
    Canvas.Ellipse(StartX, StartY, EndX, EndY); // рисуем элипс.
    EndX:=X; EndY:=Y; // Фиксируем конечные координаты,
    Canvas.Ellipse(StartX, StartY, EndX, EndY); // и перерисовываем нарисованную фигуру, чтобы избежать следа.
  end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
MouseButtonDown:=false; // Кнопка мыши отпущена.
end;

Однако заметил один глюк. Когда я отпускаю кнопку мыши и Shift, прям-ник продолжает рисоваться за мышью до тех пор пока не кликнешь левой кнопкой мыши. Как сделать так, чтобы прям-ик не рисовался после отпускание кнопки мыши и клавиши Shift?

Сообщение отредактировано: Shmaniche - 10.12.2012 8:36

[TarasBer]

> if (MouseButtonDown=true) and (Rectangle=true)

Ааааа не пиши так больше!!!!
Писать =true это как прибавлять ноль или умножать на 1. Бессмысленное действие.

if MouseButtonDown and Rectangle
и всё.
Короче у тебя условия неправильно выписаны.



if MouseButtonDown and Rectangle then begin
// хорошо, нажата кнопка мыши и был выбран прямоугольник
...
end else begin
// иначе, то есть если кнопка мыши не нажата или не был выбран прямоугольник
// то есть если был выбран круг и кнопка не нажата, то этот участок тоже выполняется
...
end;

[Shmaniche]

TarasBer

Короче у тебя условия неправильно выписаны.

Не согласен, что условия выписаны направильно. "if MouseButtonDown and Rectangle" и " if (MouseButtonDown=true) and (Rectangle=true)" дает одинаковый эффект.
Но так или иначе глюк остается.

end else begin
// иначе, то есть если кнопка мыши не нажата или не был выбран прямоугольник
// то есть если был выбран круг и кнопка не нажата, то этот участок тоже выполняется
...
end;

Если убрать строку "if (MouseButtonDown) and (Circle) then" то круг будет писаться следом за курсором даже если левая кнопка мыши не нажата.

В общем, догадался сам . Вот так правильно:

Код

if (MouseButtonDown) and (ssShift in Shift) then // Если кнопка мыши нажата и нажат Shift, то...
  begin
   Canvas.Rectangle(StartX, StartY, EndX, EndY); // рисуем прямоугльник.
   EndX:=X; EndY:=Y; // Фиксируем конечные координаты,
   Canvas.Rectangle(StartX, StartY, EndX, EndY); // и перерисовываем нарисованную фигуру, чтобы избежать следа.
  end;

Проблема теперь следующая. Когда сворачиваешь и разворачиваешь форму нарисованные фигуры на PaintBox стираются. Как сделать так, чтобы они оставались.

Сообщение отредактировано: Shmaniche - 10.12.2012 10:53

[TarasBer]

ответ неверный
рисовать надо только тогда, когда кнопка мыши нажата.
Поэтому всё, что связано с рисованием, должно быть внутри if MouseButtonDown.
Параметр shift не смотри, разрули всё на переменных MouseButtonDown и Rectangle

> Не согласен, что условия выписаны направильно.
Я про логику булевого оператора, а не про стилистику. =true - этоо стилистический ляп, а у тебя есть ещё и логический.

[Shmaniche]

TaraBer
Так, похоже разрулил :

Код

if (MouseButtonDown) then // Если нажата клавиша мыши, тогда...
  begin
   if (Rectangle) then // Если Rect=true, то...
    begin
     Canvas.Rectangle(StartX, StartY, EndX, EndY); // рисуем прямоугльник.
     EndX:=X; EndY:=Y;
     Canvas.Rectangle(StartX, StartY, EndX, EndY);
    end
   else // Иначе рисуем элипс левой кнопкой мыши.
    begin
     Canvas.Ellipse(StartX, StartY, EndX, EndY);
     EndX:=X; EndY:=Y;
     Canvas.Ellipse(StartX, StartY, EndX, EndY);
    end;
  end;

Вопрос с перерисовкой еще в силе.

[TarasBer]

> Так, похоже разрулил

Теперь верно.

> Вопрос с перерисовкой еще в силе.

Лови событие OnPaint у формы и в нём рисуй фигуру.

[Shmaniche]

Лови событие OnPaint у формы и в нём рисуй фигуру.

Код

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
if Rectangle then
  Canvas.Rectangle(StartX, StartY, EndX, EndY);
if Circle then
  Canvas.Ellipse(StartX, StartY, EndX, EndY);
end;

Когда рисую только элипс, то после сворчивания и разворчивания окна все нормально, элипс остается . Но когда добавляю прям-ник, элипс стирается и на холсте остается прям-ник. Рисую след-ую, стирается пред-ая и остается только след-ая. Как добиться чтобы оставалось более 2-х фигур?

Сообщение отредактировано: Shmaniche - 10.12.2012 13:11

[TarasBer]

А, тебе не нравится, что остаётся только последняя фигура?
Ну ещё можно убрать реакцию на OnPaint, а PaintBox заменить на TImage

[Shmaniche]

Ладно, с перерисовкой как-нибудь потом разберусь. Сейчас меня волнует другой, я хочу сделать возможность изменять цвет границы будущей фигуры, но что-то не получается.
На форму бросил компонент TMainMenu и создал пункт “PenColor”, также на форму бросил компонент “ColorDialog”. Пишу:

Код

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Canvas.Pen.Mode:=pmNot; // Установить такой вид пера, чтобы избежать следа.
Canvas.Pen.Style:=psSolid; // Сплошная линия.
Canvas.Pen.Width:=2; // Толщина кисти
Canvas.Brush.Style:=bsClear;

if (MouseButtonDown) then…
…
End;

procedure TForm1.PenColorClick(Sender: TObject);
begin
if ColorDialog1.Execute then
Canvas.Pen.Color:=ColorDialog1.Color;
end;

Нажимаю на пункт меню, выбираю цвет, но границы фигуры все равно остается черными.

Далее, обнаружил, что если убрать строку "Canvas.Pen.Mode:=pmNot;", то перекрашивание границ фигуры происходит успешно, но опять возникает след . Прочитал, что перерисовку можно делать с помощью “Repaint”:

Код

    begin
     Canvas.Ellipse(StartX, StartY, EndX, EndY);
     Repaint; // Перерисовываем фигуру, чтобы избавиться от следа, когда ее уменьшаем.
     EndX:=X; EndY:=Y;
     Canvas.Ellipse(StartX, StartY, EndX, EndY);
    end;

Но когда рядом рисуешь второй эллипс, первый исчезает .

Сообщение отредактировано: Shmaniche - 10.12.2012 14:27

[Shmaniche]

Ха-ха! Методом тыка нашел режим карандаша, который не оставляет следа и позволяет перекрасить границы в другой цвет. Это:

Код

Canvas.Pen.Mode:=pmNotXor;

А ”Repaint” можно убрать за ненадобностью. Теперь можно рисовать на холсте много фигур разного цвета.


Сообщение отредактировано: Shmaniche - 10.12.2012 17:45

[Shmaniche]

Задумал добавить возможность рисовать мышкой простую линию при нажатой клавиши Alt:

Код

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
…
if (ssAlt in Shift)  
and (Button=mbLeft)
and not (ssShift in Shift)
then Line:=true
else Line:=false;

StartX:=X; StartY:=Y;
EndX:=X; EndY:=Y;
MouseButtonDown:=true; // Кнопка мыши нажата.
end;

…

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
with Canvas do
begin
  Pen.Mode:=pmNotXor; // Этот режим помогает избавиться от следа при рисовании фигуры.
  Pen.Style:=psSolid;
  Pen.Width:=2;
  Brush.Style:=bsSolid;
end;

…

if (MouseButtonDown) and (Line) then // Если Если нажата клавиша мыши, и Line=true, то...
begin
  Canvas.MoveTo(StartX, StartY); // Рисуем фигуру откуда кликнули.
  EndX:=X; EndY:=Y; // Фиксируем конечные координаты,
  Canvas.LineTo(EndX, EndY); // Рисуем отрезок.
end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
MouseButtonDown:=false;  // Кнопка мыши отпущена.
end;

Но при рисовании линии остается ненужный след , и даже ” Pen.Mode:=pmNotXor;” не помогает , только если "Repaint" применить, но он удаляет раньше нарисованные линии. Как можно решить проблему со следом от линии? Как его стирать?


Сообщение отредактировано: Shmaniche - 10.12.2012 18:57

[TarasBer]

Да так же - брать и явно стирать.

[Shmaniche]

TaraBer
Можешь продемонстрировать?

Сообщение отредактировано: Shmaniche - 11.12.2012 9:52

[TarasBer]

Да так же, как ты эллипсы явно стирал.
Что такое xor и что этот режим рисования делает - знаешь? Основная его особенность - если нарисовать одно и то же чётное число раз, то ничего не нарисуется, а если нечётное - то нарисуется, но могут быть искажения цвета.

[Shmaniche]

Да так же, как ты эллипсы явно стирал.

Элипсы я стираю "Pen.Mode:=pmNotXor;". Это режим "not(PenColor xor ScreenColor)", но он не действует на Line.

Сообщение отредактировано: Shmaniche - 11.12.2012 12:04

[TarasBer]

Эллипс ты стираешь не выбором режима, а именно тем, что ты рисуешь его дважды.

[Shmaniche]

Эллипс ты стираешь не выбором режима, а именно тем, что ты рисуешь его дважды.

Имеешь ввиду это?

Код

   Canvas.Ellipse(StartX, StartY, EndX, EndY); // рисуем первый раз.
   EndX:=X; EndY:=Y;
   Canvas.Ellipse(StartX, StartY, EndX, EndY); // рисуем второй раз.

Похоже понял!

Код

if (MouseButtonDown) and (Line) then
begin
  Canvas.MoveTo(StartX, StartY);
  Canvas.LineTo(EndX, EndY);
  EndX:=X; EndY:=Y;
  {Рисуем второй раз, чтобы стереть след}
  Canvas.MoveTo(StartX, StartY);
  Canvas.LineTo(EndX, EndY);
end;

Сообщение отредактировано: Shmaniche - 11.12.2012 12:46