Помощь - Поиск - Пользователи - Календарь
Полная версия: Рисование в Delphi
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Делфи
Shmanich
Надо нарисовать элипс. Самое простое что пришло в голову это поместить на форму 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
Стирать след, оставленный на предыдущем кадре.
Shmanich
Цитата(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;


Но при сворачивании окна все нарисованное исчезает. Как это дело зафиксировать?
Shmanich
Дорабоотал прежний код, чтобы можно было рисовать не только элипс, но и прямоугольник, когда нажата клавиша 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
> if (MouseButtonDown=true) and (Rectangle=true)

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

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



if MouseButtonDown and Rectangle then begin
// хорошо, нажата кнопка мыши и был выбран прямоугольник
...
end else begin
// иначе, то есть если кнопка мыши не нажата или не был выбран прямоугольник
// то есть если был выбран круг и кнопка не нажата, то этот участок тоже выполняется
...
end;
Shmanich
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
ответ неверный
рисовать надо только тогда, когда кнопка мыши нажата.
Поэтому всё, что связано с рисованием, должно быть внутри if MouseButtonDown.
Параметр shift не смотри, разрули всё на переменных MouseButtonDown и Rectangle

> Не согласен, что условия выписаны направильно.
Я про логику булевого оператора, а не про стилистику. =true - этоо стилистический ляп, а у тебя есть ещё и логический.
Shmanich
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
> Так, похоже разрулил

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

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

Лови событие OnPaint у формы и в нём рисуй фигуру.
Shmanich
Цитата(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
А, тебе не нравится, что остаётся только последняя фигура?
Ну ещё можно убрать реакцию на OnPaint, а PaintBox заменить на TImage
Shmanich
Ладно, с перерисовкой как-нибудь потом разберусь. Сейчас меня волнует другой, я хочу сделать возможность изменять цвет границы будущей фигуры, но что-то не получается.
На форму бросил компонент 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.
Shmanich
Ха-ха! Методом тыка нашел режим карандаша, который не оставляет следа и позволяет перекрасить границы в другой цвет. smile.gif Это:
Код

Canvas.Pen.Mode:=pmNotXor;


А ”Repaint” можно убрать за ненадобностью. Теперь можно рисовать на холсте много фигур разного цвета. smile.gif
Shmanich
Задумал добавить возможность рисовать мышкой простую линию при нажатой клавиши 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
Да так же - брать и явно стирать.
Shmanich
TaraBer
Можешь продемонстрировать? smile.gif
TarasBer
Да так же, как ты эллипсы явно стирал.
Что такое xor и что этот режим рисования делает - знаешь? Основная его особенность - если нарисовать одно и то же чётное число раз, то ничего не нарисуется, а если нечётное - то нарисуется, но могут быть искажения цвета.
Shmanich
Цитата(TarasBer @ 11.12.2012 14:26) *

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


Элипсы я стираю "Pen.Mode:=pmNotXor;". Это режим "not(PenColor xor ScreenColor)", но он не действует на Line.
TarasBer
Эллипс ты стираешь не выбором режима, а именно тем, что ты рисуешь его дважды.
Shmanich
Цитата(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
Цитата(Shmaniche @ 11.12.2012 12:16) *

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

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

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
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. The Best 5 Gambling Dens In The World
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.