![]() |
Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.
![]() ![]() |
![]() |
Shmaniche |
![]() ![]()
Сообщение
#1
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
Надо нарисовать элипс. Самое простое что пришло в голову это поместить на форму 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 |
TarasBer |
![]()
Сообщение
#2
|
![]() Злостный любитель ![]() ![]() ![]() ![]() ![]() Группа: Пользователи Сообщений: 1 755 Пол: Мужской Репутация: ![]() ![]() ![]() |
Стирать след, оставленный на предыдущем кадре.
-------------------- |
Shmaniche |
![]()
Сообщение
#3
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
Стирать след, оставленный на предыдущем кадре. Это понятно ![]() Код 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 |
Shmaniche |
![]() ![]()
Сообщение
#4
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
Дорабоотал прежний код, чтобы можно было рисовать не только элипс, но и прямоугольник, когда нажата клавиша 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 |
TarasBer |
![]()
Сообщение
#5
|
![]() Злостный любитель ![]() ![]() ![]() ![]() ![]() Группа: Пользователи Сообщений: 1 755 Пол: Мужской Репутация: ![]() ![]() ![]() |
> if (MouseButtonDown=true) and (Rectangle=true)
Ааааа не пиши так больше!!!! Писать =true это как прибавлять ноль или умножать на 1. Бессмысленное действие. if MouseButtonDown and Rectangle и всё. Короче у тебя условия неправильно выписаны. if MouseButtonDown and Rectangle then begin // хорошо, нажата кнопка мыши и был выбран прямоугольник ... end else begin // иначе, то есть если кнопка мыши не нажата или не был выбран прямоугольник // то есть если был выбран круг и кнопка не нажата, то этот участок тоже выполняется ... end; -------------------- |
Shmaniche |
![]()
Сообщение
#6
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
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 стираются. Как сделать так, чтобы они оставались. Сообщение отредактировано: Shmaniche - 10.12.2012 10:53 |
TarasBer |
![]()
Сообщение
#7
|
![]() Злостный любитель ![]() ![]() ![]() ![]() ![]() Группа: Пользователи Сообщений: 1 755 Пол: Мужской Репутация: ![]() ![]() ![]() |
ответ неверный
рисовать надо только тогда, когда кнопка мыши нажата. Поэтому всё, что связано с рисованием, должно быть внутри if MouseButtonDown. Параметр shift не смотри, разрули всё на переменных MouseButtonDown и Rectangle > Не согласен, что условия выписаны направильно. Я про логику булевого оператора, а не про стилистику. =true - этоо стилистический ляп, а у тебя есть ещё и логический. -------------------- |
Shmaniche |
![]() ![]()
Сообщение
#8
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
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 |
![]()
Сообщение
#9
|
![]() Злостный любитель ![]() ![]() ![]() ![]() ![]() Группа: Пользователи Сообщений: 1 755 Пол: Мужской Репутация: ![]() ![]() ![]() |
> Так, похоже разрулил
Теперь верно. > Вопрос с перерисовкой еще в силе. Лови событие OnPaint у формы и в нём рисуй фигуру. -------------------- |
Shmaniche |
![]() ![]()
Сообщение
#10
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
Лови событие 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; Когда рисую только элипс, то после сворчивания и разворчивания окна все нормально, элипс остается ![]() Сообщение отредактировано: Shmaniche - 10.12.2012 13:11 |
TarasBer |
![]()
Сообщение
#11
|
![]() Злостный любитель ![]() ![]() ![]() ![]() ![]() Группа: Пользователи Сообщений: 1 755 Пол: Мужской Репутация: ![]() ![]() ![]() |
А, тебе не нравится, что остаётся только последняя фигура?
Ну ещё можно убрать реакцию на OnPaint, а PaintBox заменить на TImage -------------------- |
Shmaniche |
![]() ![]()
Сообщение
#12
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
Ладно, с перерисовкой как-нибудь потом разберусь. Сейчас меня волнует другой, я хочу сделать возможность изменять цвет границы будущей фигуры, но что-то не получается.
На форму бросил компонент 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;", то перекрашивание границ фигуры происходит успешно, но опять возникает след ![]() Код begin Canvas.Ellipse(StartX, StartY, EndX, EndY); Repaint; // Перерисовываем фигуру, чтобы избавиться от следа, когда ее уменьшаем. EndX:=X; EndY:=Y; Canvas.Ellipse(StartX, StartY, EndX, EndY); end; Но когда рядом рисуешь второй эллипс, первый исчезает ![]() Сообщение отредактировано: Shmaniche - 10.12.2012 14:27 |
Shmaniche |
![]() ![]()
Сообщение
#13
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
Ха-ха! Методом тыка нашел режим карандаша, который не оставляет следа и позволяет перекрасить границы в другой цвет.
![]() Код Canvas.Pen.Mode:=pmNotXor; А ”Repaint” можно убрать за ненадобностью. Теперь можно рисовать на холсте много фигур разного цвета. ![]() Сообщение отредактировано: Shmaniche - 10.12.2012 17:45 |
Shmaniche |
![]()
Сообщение
#14
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
Задумал добавить возможность рисовать мышкой простую линию при нажатой клавиши 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; Но при рисовании линии остается ненужный след ![]() ![]() ![]() Сообщение отредактировано: Shmaniche - 10.12.2012 18:57 |
TarasBer |
![]()
Сообщение
#15
|
![]() Злостный любитель ![]() ![]() ![]() ![]() ![]() Группа: Пользователи Сообщений: 1 755 Пол: Мужской Репутация: ![]() ![]() ![]() |
Да так же - брать и явно стирать.
-------------------- |
Shmaniche |
![]()
Сообщение
#16
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
TaraBer
Можешь продемонстрировать? ![]() Сообщение отредактировано: Shmaniche - 11.12.2012 9:52 |
TarasBer |
![]()
Сообщение
#17
|
![]() Злостный любитель ![]() ![]() ![]() ![]() ![]() Группа: Пользователи Сообщений: 1 755 Пол: Мужской Репутация: ![]() ![]() ![]() |
Да так же, как ты эллипсы явно стирал.
Что такое xor и что этот режим рисования делает - знаешь? Основная его особенность - если нарисовать одно и то же чётное число раз, то ничего не нарисуется, а если нечётное - то нарисуется, но могут быть искажения цвета. -------------------- |
Shmaniche |
![]()
Сообщение
#18
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
|
TarasBer |
![]()
Сообщение
#19
|
![]() Злостный любитель ![]() ![]() ![]() ![]() ![]() Группа: Пользователи Сообщений: 1 755 Пол: Мужской Репутация: ![]() ![]() ![]() |
Эллипс ты стираешь не выбором режима, а именно тем, что ты рисуешь его дважды.
-------------------- |
Shmaniche |
![]() ![]()
Сообщение
#20
|
Пионер ![]() ![]() Группа: Пользователи Сообщений: 79 Пол: Мужской Репутация: ![]() ![]() ![]() |
Эллипс ты стираешь не выбором режима, а именно тем, что ты рисуешь его дважды. Имеешь ввиду это? Код 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; ![]() Сообщение отредактировано: Shmaniche - 11.12.2012 12:46 |
![]() ![]() |
![]() |
Текстовая версия | 11.09.2024 6:34 |