Рисование в Delphi, С помощью мыши |
Прежде чем задать вопрос, смотрите 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 |
Shmaniche |
10.12.2012 8:22
Сообщение
#2
|
Пионер Группа: Пользователи Сообщений: 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 |
Текстовая версия | 4.05.2024 5:29 |