Версия для печати темы
Форум «Всё о Паскале» _ Delphi _ Рисование в Delphi
Автор: Shmaniche 9.12.2012 17: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 9.12.2012 20:34
Стирать след, оставленный на предыдущем кадре.
Автор: Shmaniche 10.12.2012 5:36
Цитата(TarasBer @ 10.12.2012 0:34)
Стирать след, оставленный на предыдущем кадре.
Это понятно
. В общем допер.
Код
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 8: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 9: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 10:34
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 стираются. Как сделать так, чтобы они оставались.
Автор: TarasBer 10.12.2012 10:52
ответ неверный
рисовать надо только тогда, когда кнопка мыши нажата.
Поэтому всё, что связано с рисованием, должно быть внутри if MouseButtonDown.
Параметр shift не смотри, разрули всё на переменных MouseButtonDown и Rectangle
> Не согласен, что условия выписаны направильно.
Я про логику булевого оператора, а не про стилистику. =true - этоо стилистический ляп, а у тебя есть ещё и логический.
Автор: Shmaniche 10.12.2012 11:03
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 10.12.2012 11:18
> Так, похоже разрулил
Теперь верно.
> Вопрос с перерисовкой еще в силе.
Лови событие OnPaint у формы и в нём рисуй фигуру.
Автор: Shmaniche 10.12.2012 13: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;
Когда рисую только элипс, то после сворчивания и разворчивания окна все нормально, элипс остается
. Но когда добавляю прям-ник, элипс стирается и на холсте остается прям-ник. Рисую след-ую, стирается пред-ая и остается только след-ая. Как добиться чтобы оставалось более 2-х фигур?
Автор: TarasBer 10.12.2012 13:22
А, тебе не нравится, что остаётся только последняя фигура?
Ну ещё можно убрать реакцию на OnPaint, а PaintBox заменить на TImage
Автор: Shmaniche 10.12.2012 13: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;
Нажимаю на пункт меню, выбираю цвет, но границы фигуры все равно остается черными.
Далее, обнаружил, что если убрать строку "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 16:44
Ха-ха! Методом тыка нашел режим карандаша, который не оставляет следа и позволяет перекрасить границы в другой цвет. Это:
Код
Canvas.Pen.Mode:=pmNotXor;
А ”Repaint” можно убрать за ненадобностью. Теперь можно рисовать на холсте много фигур разного цвета.
Автор: Shmaniche 10.12.2012 18: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;
Но при рисовании линии остается ненужный след
, и даже ” Pen.Mode:=pmNotXor;” не помогает
, только если "Repaint" применить, но он удаляет раньше нарисованные линии.
Как можно решить проблему со следом от линии? Как его стирать?
Автор: TarasBer 11.12.2012 9:37
Да так же - брать и явно стирать.
Автор: Shmaniche 11.12.2012 9:52
TaraBer
Можешь продемонстрировать?
Автор: TarasBer 11.12.2012 10:26
Да так же, как ты эллипсы явно стирал.
Что такое xor и что этот режим рисования делает - знаешь? Основная его особенность - если нарисовать одно и то же чётное число раз, то ничего не нарисуется, а если нечётное - то нарисуется, но могут быть искажения цвета.
Автор: Shmaniche 11.12.2012 12:03
Цитата(TarasBer @ 11.12.2012 14:26)
Да так же, как ты эллипсы явно стирал.
Элипсы я стираю "Pen.Mode:=pmNotXor;". Это режим "not(PenColor xor ScreenColor)", но он не действует на Line.
Автор: TarasBer 11.12.2012 12:04
Эллипс ты стираешь не выбором режима, а именно тем, что ты рисуешь его дважды.
Автор: Shmaniche 11.12.2012 12:16
Цитата(TarasBer @ 11.12.2012 16:04)
Эллипс ты стираешь не выбором режима, а именно тем, что ты рисуешь его дважды.
Имеешь ввиду это?
Код
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;
Автор: TarasBer 11.12.2012 14:05
Цитата(Shmaniche @ 11.12.2012 12:16)
Похоже понял!
Всё наоборот.
Ты повторно рисуешь элемент на старом месте (стирая его) (повторно - потому что ты его уже нарисовал на этом самом месте в предыдущем кадре), потом меняешь положение, потом рисуешь на новом. Но код вроде правильный.
Автор: Shmaniche 21.12.2012 15: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;