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

> ВНИМАНИЕ!

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

> Рисование в 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 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Shmaniche
сообщение 21.12.2012 15:56
Сообщение #2


Пионер
**

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

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


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

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

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

Сообщений в этой теме
Shmaniche   Рисование в Delphi   9.12.2012 17:44
TarasBer   Стирать след, оставленный на предыдущем кадре.   9.12.2012 20:34
Shmaniche   Стирать след, оставленный на предыдущем кадре. ...   10.12.2012 5:36
Shmaniche   Дорабоотал прежний код, чтобы можно было рисовать ...   10.12.2012 8:22
TarasBer   > if (MouseButtonDown=true) and (Rectangle=true...   10.12.2012 9:26
Shmaniche   TarasBer Не согласен, что условия выписаны напра...   10.12.2012 10:34
TarasBer   ответ неверный рисовать надо только тогда, когда к...   10.12.2012 10:52
Shmaniche   TaraBer Так, похоже разрулил :) : if (MouseB...   10.12.2012 11:03
TarasBer   > Так, похоже разрулил Теперь верно. > В...   10.12.2012 11:18
Shmaniche   Лови событие OnPaint у формы и в нём рисуй фигуру...   10.12.2012 13:10
TarasBer   А, тебе не нравится, что остаётся только последняя...   10.12.2012 13:22
Shmaniche   Ладно, с перерисовкой как-нибудь потом разберусь. ...   10.12.2012 13:38
Shmaniche   Ха-ха! Методом тыка нашел режим карандаша, кот...   10.12.2012 16:44
Shmaniche   Задумал добавить возможность рисовать мышкой прост...   10.12.2012 18:51
TarasBer   Да так же - брать и явно стирать.   11.12.2012 9:37
Shmaniche   TaraBer Можешь продемонстрировать? :)   11.12.2012 9:52
TarasBer   Да так же, как ты эллипсы явно стирал. Что такое x...   11.12.2012 10:26
Shmaniche   Да так же, как ты эллипсы явно стирал. Элипсы я...   11.12.2012 12:03
TarasBer   Эллипс ты стираешь не выбором режима, а именно тем...   11.12.2012 12:04
Shmaniche   Эллипс ты стираешь не выбором режима, а именно те...   11.12.2012 12:16
TarasBer   Похоже понял! :) Всё наоборот. Ты повторно р...   11.12.2012 14:05
Shmaniche   Поразмыслив придумал как из эллипса сделать окружн...   21.12.2012 15:56


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

 



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