Как сделать "растяжение" фигур (как в paint е)?

← →
Arsen © (2004-04-16 20:36) [0]

Рисую, например, прямоугольник. Нажал мышкой и потащил - прямоугольник прорисовывается за мышкой. На canvas"е. Надо чтоб этот прямоугольник не портил другие фигуры - не оставлял на них точки инверсного цвета. Подскажите пожалуйста!

← →
Думкин © (2004-04-17 05:06) [1]

Недавно я приводил код с помощью которого можно было делать такое для линий. Немного модификации и будет работать и для прямоугольников. Находится в этом же форуме но где-то по веткам ниже - поищи и найдешь. Удачи.

← →
Arsen © (2004-04-17 10:48) [2]

Спасибо, нашел.

← →
Arsen © (2004-04-17 12:07) [3]

В коде есть один огромный минус - скорость работы сводится к скорости цикла перерисовки линии. Очень медленно. Не пойдет. Нужен кардинально другой метод.

← →
Sanek_metaller © (2004-04-17 13:01) [4]

Если Вы имеете ввиду "Растянуть/Наклонить" то попробуйте:поставить свойство Streach (примерно так пишется) :=true и изменяйте Width & Height

← →
Думкин © (2004-04-17 13:24) [5]

> [3] Arsen © (17.04.04 12:07)

Я согласен, что код первичный - но он дает место для оптимизации, про его неоптимальность - я там же и указал. Та задача решалась, равно как и ваша - но иную - у меня есть решения в голове, а в коде повозится немного надо - сие удовольствие вам.
Но взгляните на статью А.Радионова и Б.Новгородцева - оно тоже поможет (на этом сайте). А еще лучше - книгу Ф.Юаня.

← →
Думкин © (2004-04-17 13:30) [6]

И в вопросе медленно -я готов с вами поспорить. Это не может быть "просто медленно" - вопрос в ином. Все в Винде быстро - даже в 95, просто иногда это используют "криво". Удачи.

← →
Думкин © (2004-04-18 08:16) [7]

Вообще, что касается быстро-медленно. Я как-то на работе писал программу на П-3 и она "графически притормаживала", я взял ее домой на П-166, и повозившись на выходных убрал тормоза на П-166, и соответственно на П-3. И иногда изменив работу с графикой на П-3, я замечал что тормоза уходили и на П-166. Проблема в алгоритмах, зачастую.
Ровно также у меня было и с одной игрой. Там вне графики. Обработку хода я снизил с 50 секунд на П-3 до 1 секунды на П-166.
Это очень интересно, и не надо сразу ругаться на "чьи-то" тормоза - вполне вероятно, что они у вас.

← →
Отто фон Бисмарк (2004-04-18 13:26) [8]

Я сейчас как раз желаю ту же задачу...
только я установил значение PaintBox1.Canvas.Pen.Mode:=pmnotxor;
но тогда пришлось ещё создать процедуру, которая обращает цвета при прорисовки фигуры...
это конечно тоже не выход
есть ещё вариант...
сохранять инфу о каждой нарисованной фигуры в динамичских списках, и на событии MouseMove просто очищать экран, рисовать текущую линию и прорисовывать все остальные фигуры, хранящиеся в списках...

← →
Думкин © (2004-04-18 14:13) [9]

> [8] Отто фон Бисмарк (18.04.04 13:26)
> сохранять инфу о каждой нарисованной фигуры в динамичских
> списках, и на событии MouseMove просто очищать экран, рисовать
> текущую линию и прорисовывать все остальные фигуры, хранящиеся
> в списках...

Для TPaintBox - это в корне не верно.

← →
Отто фон Бисмарк (2004-04-18 14:21) [10]

Удалено модератором
Примечание: Задай свой вопрос с своей ветки, никто не ограничевает, а исполдьзовать чужую ветку не стоит

← →
Arsen © (2004-04-18 16:34) [11]

Как сделать, чтобы при растягивании стиралась последняя нарисованая фигура, т.к. происходит порча картинки под рисуемой фигурой?

← →
Думкин © (2004-04-18 20:34) [12]

> [11] Arsen © (18.04.04 16:34)

Стиралась или нет? Какая порча?
Видимо речь идет о стилях кисти. Почитайте: TBrush.Style+F1.

← →
Отто фон Бисмарк (2004-04-18 21:54) [13]

Arsen..скажи плиз, где лежат зарисовки г-на Думкина...
а то у меня карточка по метрам... мне по архивам шарится слишком разорительно...

http://delphimaster.net/view/8-1081418501/

Там для рисуемого объекта будет мерцание, на что и указал автор сабжа, но как и писал выше - его вполне можно избежать, принцип довольно прост. Удачи.

← →
Отто фон Бисмарк (2004-04-19 13:23) [15]

Думкин...спасибо за сслыку...
только вот у меня есть несколько иное видине вопроса...

Form1: TForm1;
xt,yt,xtime,ytime:integer;
implementation

{$R *.dfm}

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
If ((xt<0) or (yt<0)) then exit;
//--------------------------------
if SB2.Down=true then //если нажат SpeedButton
begin
If ((xtime<>x) or (ytime<>y)) then
begin
PaintBox1.Canvas.Pen.Mode:=pmnotxor;
PaintBox1.Canvas.Pen.Color:=clred;
PaintBox1.canvas.MoveTo(xt,yt);
PaintBox1.Canvas.LineTo(Xtime,Ytime);
PaintBox1.canvas.MoveTo(xt,yt);
PaintBox1.Canvas.LineTo(X,Y);
xtime:=X;ytime:=Y;
end;
end;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
xt:=x;yt:=y;xtime:=x;ytime:=y;
d:=true;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
xt:=-1;
yt:=-1;
d:=false;
end;

//---------------------------------------

Но здесь есть один большой минус - цвета буду инверсными, по отношению к фону...
Можно добавить к событию
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if SB2.Down=true then begin
PaintBox1.Canvas.Pen.Mode:=pmcopy;
PaintBox1.canvas.Pen.Color:=clred;
PaintBox1.canvas.MoveTo(xt,yt);
PaintBox1.Canvas.LineTo(X,Y);
end;
xt:=-1;
yt:=-1;
d:=false;
end;
//-------------------------------
Тогда при отпускании кнопки, линия окажется нарисованной правильным цветом, однако в процессе прорисовки, пока линия тянется за курсором, цвет её будет инверсным по отношению к фону...
Я долго думал, как от этого избавиться, но не нашёл ничего лучше, чем создать процедуру, которая бы делала цвет в момент прорисовки инверсным заданному..т.е. отображался бы нормальный цвет. Но это можно сделать лишь для 10 цветов..и то - геморой ещё тот. Если кто знает как проще - скажите!

Можно так:
unit uMain; interface type TfMain = class(TForm) pbMain : TPaintBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure pbMainMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure pbMainMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } x1,x2 : TPoint; inDraw : boolean; bmS, bmD : TBitMap; procedure WMPaint (var Message: TWMPaint); message WM_Paint; public { Public declarations } end; var fMain: TfMain; implementation {$R *.dfm} procedure TfMain.FormCreate(Sender: TObject); begin bmS := TBitMap.Create; bmS.Width := pbMain.Width; bmS.Height := pbMain.Height; bmS.Canvas.Pen.Color := clRed; bmS.Canvas.Brush.Color := clYellow; bmS.Canvas.FloodFill( 1, 1, clWhite, fsSurface); bmS.Canvas.Brush.Style := bsClear; bmD := TBitMap.Create; bmD.Width := pbMain.Width; bmD.Height := pbMain.Height; bmD.Canvas.Pen.Mode := pmNotXor; bmD.Canvas.Pen.Color := clBlue; bmD.Canvas.Pen.Style := psDot; bmD.Canvas.Brush.Style := bsClear; inDraw := false end; procedure TfMain.FormDestroy(Sender: TObject); begin bmS.Free; bmD.Free end; procedure TfMain.WMPaint; begin BitBlt(bmD.Canvas.Handle, 0, 0, bmD.Width, bmD.Height, bmS.Canvas.Handle, 0, 0, SRCCOPY); if inDraw then begin x2 := pbMain.ScreenToClient(Mouse.CursorPos); bmD.Canvas.Rectangle(Rect(x1.X,x1.Y,x2.X,x2.Y)) end; BitBlt(pbMain.Canvas.Handle, 0, 0, pbMain.Width, pbMain.Height, bmD.Canvas.Handle, 0, 0, SRCCOPY); end; procedure TfMain.pbMainMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inDraw := true; x1 := pbMain.ScreenToClient(Mouse.CursorPos) end; procedure TfMain.pbMainMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inDraw := false; x2 := pbMain.ScreenToClient(Mouse.CursorPos); bmS.Canvas.Rectangle(Rect(x1.X,x1.Y,x2.X,x2.Y)) end;

А вообще в Демках идущих с дельфи - есть пример.

Думкин, Отто фон Бисмарк - спасибо! На основе Вашего текста и текста Отто фон Бисмарка сделал свою рисовалку. Работает.

← →
Lenor (2004-05-17 15:34) [18]

Есть вариант -- на mouse up чего-то, на чем ты рисуешь, пиши Image.Canvas.Pen.mode:=pmcopy;

на mouse down
image.canvas.Pen.mode:=pmnotxor;

И все прекрасно работает.

← →
SNV-Soft (2004-07-23 18:14) [19]

а мне посоветовали ExtLib...если прямоугольники
двигать надо!!!

Как сделать "растяжение" фигур (как в paint е)? Найти похожие ветки