IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> Рисование в Delphi, С помощью мыши
Shmaniche
сообщение 9.12.2012 17:44
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


Надо нарисовать элипс. Самое простое что пришло в голову это поместить на форму 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
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
TarasBer
сообщение 9.12.2012 20:34
Сообщение #2


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 10.12.2012 5:36
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


Цитата(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 6:49
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 10.12.2012 8:22
Сообщение #4


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


Дорабоотал прежний код, чтобы можно было рисовать не только элипс, но и прямоугольник, когда нажата клавиша 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
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
TarasBer
сообщение 10.12.2012 9:26
Сообщение #5


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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

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

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



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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 10.12.2012 10:34
Сообщение #6


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


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

Сообщение отредактировано: Shmaniche - 10.12.2012 10:53
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
TarasBer
сообщение 10.12.2012 10:52
Сообщение #7


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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

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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 10.12.2012 11:03
Сообщение #8


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


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;


Вопрос с перерисовкой еще в силе.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
TarasBer
сообщение 10.12.2012 11:18
Сообщение #9


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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

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

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

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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 10.12.2012 13:10
Сообщение #10


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


Цитата(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-х фигур?

Сообщение отредактировано: Shmaniche - 10.12.2012 13:11
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
TarasBer
сообщение 10.12.2012 13:22
Сообщение #11


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 10.12.2012 13:38
Сообщение #12


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


Ладно, с перерисовкой как-нибудь потом разберусь. Сейчас меня волнует другой, я хочу сделать возможность изменять цвет границы будущей фигуры, но что-то не получается.
На форму бросил компонент 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 14:27
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 10.12.2012 16:44
Сообщение #13


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


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

Canvas.Pen.Mode:=pmNotXor;


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


Сообщение отредактировано: Shmaniche - 10.12.2012 17:45
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 10.12.2012 18:51
Сообщение #14


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


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


Сообщение отредактировано: Shmaniche - 10.12.2012 18:57
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
TarasBer
сообщение 11.12.2012 9:37
Сообщение #15


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 11.12.2012 9:52
Сообщение #16


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


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

Сообщение отредактировано: Shmaniche - 11.12.2012 9:52
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
TarasBer
сообщение 11.12.2012 10:26
Сообщение #17


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 11.12.2012 12:03
Сообщение #18


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


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

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


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

Сообщение отредактировано: Shmaniche - 11.12.2012 12:04
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
TarasBer
сообщение 11.12.2012 12:04
Сообщение #19


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

Репутация: -  62  +


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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Shmaniche
сообщение 11.12.2012 12:16
Сообщение #20


Пионер
**

Группа: Пользователи
Сообщений: 79
Пол: Мужской

Репутация: -  0  +


Цитата(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

Сообщение отредактировано: Shmaniche - 11.12.2012 12:46
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 22.10.2019 0:28
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"