Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Делфи _ Рисование в Delphi

Автор: Shmaniche 9.12.2012 21:44

Надо нарисовать элипс. Самое простое что пришло в голову это поместить на форму 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;



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

Автор: TarasBer 10.12.2012 0:34

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

Автор: Shmaniche 10.12.2012 9:36

Цитата(TarasBer @ 10.12.2012 0:34) *

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


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

Код

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 12:22

Дорабоотал прежний код, чтобы можно было рисовать не только элипс, но и прямоугольник, когда нажата клавиша 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?

Автор: TarasBer 10.12.2012 13:26

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

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

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



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

Автор: Shmaniche 10.12.2012 14:34

TarasBer

Цитата

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


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

Цитата

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


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

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

Код

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 стираются. Как сделать так, чтобы они оставались.

Автор: TarasBer 10.12.2012 14:52

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

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

Автор: Shmaniche 10.12.2012 15:03

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

Код

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 10.12.2012 15:18

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

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

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

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

Автор: Shmaniche 10.12.2012 17:10

Цитата(TarasBer @ 10.12.2012 15:18) *

Лови событие 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;


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

Автор: TarasBer 10.12.2012 17:22

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

Автор: Shmaniche 10.12.2012 17:38

Ладно, с перерисовкой как-нибудь потом разберусь. Сейчас меня волнует другой, я хочу сделать возможность изменять цвет границы будущей фигуры, но что-то не получается.
На форму бросил компонент 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;


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

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

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


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

Автор: Shmaniche 10.12.2012 20:44

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

Код

Canvas.Pen.Mode:=pmNotXor;


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

Автор: Shmaniche 10.12.2012 22:51

Задумал добавить возможность рисовать мышкой простую линию при нажатой клавиши 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;



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

Автор: TarasBer 11.12.2012 13:37

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

Автор: Shmaniche 11.12.2012 13:52

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

Автор: TarasBer 11.12.2012 14:26

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

Автор: Shmaniche 11.12.2012 16:03

Цитата(TarasBer @ 11.12.2012 14:26) *

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


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

Автор: TarasBer 11.12.2012 16:04

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

Автор: Shmaniche 11.12.2012 16:16

Цитата(TarasBer @ 11.12.2012 16:04) *

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


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

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


Похоже понял! smile.gif

Код

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;

yahoo!.gif

Автор: TarasBer 11.12.2012 18:05

Цитата(Shmaniche @ 11.12.2012 12:16) *

Похоже понял! smile.gif

Всё наоборот.
Ты повторно рисуешь элемент на старом месте (стирая его) (повторно - потому что ты его уже нарисовал на этом самом месте в предыдущем кадре), потом меняешь положение, потом рисуешь на новом. Но код вроде правильный.

Автор: Shmaniche 21.12.2012 19:56

Поразмыслив придумал как из эллипса сделать окружность:

Код

if (Button=mbLeft) // Если нажата левая клавиша мыши...
then Circle:=true // то рисуем окружность
else Circle:=false; // иначе ничего не рисуем.
...

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


smile.gif

Автор: nishaknapp 16.01.2023 7:31

Why not settling on games that is fun and at the same time your earning. Well it'll make suspense because the game is well but dude just try it and it gave me hope while pandemic is real rn. https://www.zzoomit.com/the-best-5-gambling-dens-in-the-world/