Помощь - Поиск - Пользователи - Календарь
Полная версия: "протягивание" линии от выбранной точки
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Делфи
blackhard
Задача такова: Написать программу построения чертежей планиметрии "протягиванием" от выбранной точки с изображением ее промежуточного положения с возможностью обозначения точек и проведения стандартных линий в треугольнике.
Как это сделать я впринципе знаю но есть 1 проблема это работа с указателем мыши.Для начала я попытался сделать так чтобы при нажатии на изображение рисовалась линия из текущего положения курсора в положение указателя мыши
procedure TForm1.Image1Click(Sender: TObject);
var
Mo: TMouse;
MX, MY: integer;
begin
MX := Mo.CursorPos.X;
MY := Mo.CursorPos.Y;
image1.canvas.LineTo(mx,my);
end;
получается чето не то линия проводится явно не к указателю мыши.Может это связано с масштабом Image1 (833x533)?подскажите.И еще какие свойства в Tmouse отвечают за нажатые кнопки мыши?
volvo
Используй вот это событие:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Image1.Canvas.LineTo(X, Y);
end;



Добавлено через 7 мин.
Цитата
Может это связано с масштабом Image1 (833x533)?
Это связано с тем, что Mouse.CursorPos хранит информацию в экранных координатах (глобальных), а тебе надо клиентские. Вот работающий код через OnClick:
procedure TForm1.Image1Click(Sender: TObject);
var
p: TPoint;
begin
p := Point(Mouse.CursorPos.X, Mouse.CursorPos.Y); // Берем координаты
p := Image1.ScreenToClient(p); // преобразуем их в локальные
Image1.Canvas.LineTo(p.X, p.Y); // отображаем
end;
blackhard
блин чето не получается сделать протягивание с изображением промежуточного положения.Алгоритм должен быть примерно таким: рисуем новую линию с координатами указателя мыши старую линию стираем и так до тех пор пока не нажмем кнопку.Я попробовал для начала так


procedure TForm1.Image1Click(Sender: TObject);
var
p: TPoint;
begin
while true do
begin
p := Point(Mouse.CursorPos.X, Mouse.CursorPos.Y);
p := Image1.ScreenToClient(p);
Image1.Canvas.lineto(p.X, p.Y);
end;
end;

думал что линия будет постоянно следовать за указателем но это никак не работает.
volvo
Тебе надо отрисовывать не по OnClick, а по OnMouseDown "захватывать" мышь, по OnMouseMove - перемещать линию, до тех пор, пока не произойдет OnMouseUp (при котором мышь "освобождается")...
blackhard
Цитата(volvo @ 21.04.2008 18:44) *

Тебе надо отрисовывать не по OnClick, а по OnMouseDown "захватывать" мышь, по OnMouseMove - перемещать линию, до тех пор, пока не произойдет OnMouseUp (при котором мышь "освобождается")...

А все теперь понял спасибо!
blackhard
Надеюсь последний вопрос smile.gif Как очистить изображение или залить его каким-нибудь цветом?Залить белым у меня получилось так
image1.Canvas.Handle:=0;
правда честно говоря я не знаю че такое Handle поэтому и спрашиваю как правильно?
volvo
  Image1.Canvas.Brush.Color := clRed; // Здесь задаешь цвет
Image1.Canvas.FillRect(Image1.ClientRect);

blackhard
А как можно сделать чтоб при 1ом нажатии накнопку мыши линия прекращалась и от точки ее завершения сразуже тянулясь новая линия(ну это я сделал), а при двойном нажатии на кнопку линия прекращается мыш полностью от нее отвязывается и можно тянуть новую линию совершенно не связанную с предыдущей?
blackhard
И еще 1 вопрос как можно сделать чтобы новая линия рисовалась не поверх старой а под ней?
andriano
1. Ввести состояние (см.конечные автоматы) и отслеживать двойной щелчок.
2. Рисовать ручками, проверяя, что та точка, которую ты хочешь закрасить, содержит цвет фона, а не линии.
blackhard
Цитата(andriano @ 23.04.2008 9:09) *

Рисовать ручками, проверяя, что та точка, которую ты хочешь закрасить, содержит цвет фона, а не линии.

Чтото не совсем понимаю как это реализовать можно пояснить?
andriano
Цитата(blackhard @ 23.04.2008 16:02) *

Чтото не совсем понимаю как это реализовать можно пояснить?

Рисуешь линию по точкам (например, алгоритмом Брезенхема), проверяя при этом, какого цвета точка, которую ты хочешь закрасить. Если цвета фона - рисуешь, если другого цвета - пропускаешь.
blackhard
Цитата(andriano @ 23.04.2008 20:26) *

Рисуешь линию по точкам (например, алгоритмом Брезенхема), проверяя при этом, какого цвета точка, которую ты хочешь закрасить. Если цвета фона - рисуешь, если другого цвета - пропускаешь.

Эх теперь возникла новая проблема(линии я рисую по пикселям) когда я вытягиваю линию и хочу ее завершить она не остается а закрашивается белым.Почему это происходит я понимаю а вот избежать этого никак не выходит


procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);

procedure DrawLine4Connected(x1,y1,x2,y2 : Integer;col:tcolor);
var
x, y, dx, dy, sx, sy, z, e, i : Integer;
Ch : Boolean;
begin
x := x1;
y := y1;
dx := Abs(x2-x1);
dy := Abs(y2-y1);
If x2-x1>0 then sx:=1 else sx:=-1;
If y2-y1>0 then sy:=1 else sy:=-1;
e := 2*dy-dx;
Ch:=dy>=dx;
if Ch then begin
z := dx;
dx := dy;
dy := z;
end;
i := 1;
repeat
image1.Canvas.Pixels[x, y]:=col;
if e<dx then begin
if Ch then y := y+sy else x := x+sx;
e := e+2*dy;
end
else begin
if Ch then x := x+sx else y := y+sy;
e := e-2*dx;
end;
i := i+1;
until i>dx+dy;
image1.Canvas.Pixels[x, y]:=col;

end;



var
p: TPoint;
begin
p := Point(Mouse.CursorPos.X, Mouse.CursorPos.Y);
p := Image1.ScreenToClient(p);
DrawLine4Connected(pfx,pfy,px,py ,clwhite);{закрашиваю предыдущюю линию}
{Image1.Canvas.lineto(fx,fy);}
if cl=true then
begin

DrawLine4Connected(fx,fy,p.X,p.Y ,clblack);{рисую новую линию}
px:=p.x;{ сохраняю текущие координаты}
py:=p.y;
pfx:=fx;
pfy:=fy;

end;

end;
Вот тут я и двигаю линию она должна завершатся при событии Image1Click и если при этом она закрашивает линию белым значит почемуто обрабатывается и Image1MouseMove?Что подправить чтоб заработало?
andriano
Ты по-русски напиши, чего хочешь добиться, что для этого делаешь, что получаешь и чем то, что получаешь, отличается от того, что хочешь.
Вполне вероятно этого уже окажется достаточным для того, чтобы найти ошибку.

Из того, что я вижу в коде: у тебя ВСЕГДА рисуется белым (подозреваю, так ты стираешь), но НЕ ВСЕГДА - черным. При таком способе рисования, естественно, белых линий и будет рисоваться больше, чем черных.
Могу повторить свой совет: ввести дополнительную переменную состояния и сделать конечный автомат.
blackhard
Цитата(andriano @ 24.04.2008 8:22) *

Ты по-русски напиши, чего хочешь добиться, что для этого делаешь, что получаешь и чем то, что получаешь, отличается от того, что хочешь.
Вполне вероятно этого уже окажется достаточным для того, чтобы найти ошибку.

Из того, что я вижу в коде: у тебя ВСЕГДА рисуется белым (подозреваю, так ты стираешь), но НЕ ВСЕГДА - черным. При таком способе рисования, естественно, белых линий и будет рисоваться больше, чем черных.
Могу повторить свой совет: ввести дополнительную переменную состояния и сделать конечный автомат.

Если по русски то вот чего я хочу: кликаю мышуой по изображению(1 раз) фиксируется точка перемещаю мыш линия от этой точки тянется за указателем мыши кликаю опять по изображению (1раз) линия завершается но мыш не освобождается (те от точки завершения старой линии тянется новая) рисую очередную линию и кликаю по изображению (2раза) линия завершается и мыш освобождается полностью(те можно проводить новую линию не связанную с предыдущим изображением).Ну вот вобщем и все работает все токо ничего невидно ( линии закрашиваются белым).Я понимаю что нужно ввести новую переменную состояния но не понимаю где изменять условие ее истинности?
andriano
Сэр знаком с таким знаком препинания как запятая?
Очень тяжело читать.
Если ты и программы так же пишешь, не удивляюсь, почему они не работают.

Значит, вводим состояния:
0. Неопределенное состояние - на всякий случай: если вдруг переменная примет это значение, будем знать, что где-то эта переменная портится.
1. "свободная мышь" - нигде ничего не рисуем.
2. нажата кнопка мыши.
3. мышь "тянет линию".
4. таймаут после двойного щелчка (кто знает, сколько сообщений о нажатии/отпускании мыши мы получим во время двойного щелчка - чтобы они нам не мешали)

Мышь находится в одном из приведенных состояний, в начале - "1".
Мы отслеживаем сообщения:
A - перемещение мыши,
B - нажатие мыши,
C - отпускание мыши,
D - двойной щелчок.

В зависимости от того, в каком состоянии мы находились, получая то или иное сообщение, мы выполняем определенное действие (в частном случае - ничего не делаем) и переходим в другое состояние.

Осталось расписать таблицу переходов и записать ее на любимом ЯВУ.
Например, для 1:
1A - ничего не делаем,
1B - переходим в режим 2,
1C - невозможная комбинация - сообщаем об ошибке,
1D - ничего не делаем.

для 2:
2A - стираем старую линию и рисуем новую,
2B - невозможная комбинация - сообщаем об ошибке,
2C - переходим в режим 3,
2D - переходим в режим 4.

для 3:
3A - стираем старую линию и рисуем новую,
3B - отрисованную линию оставляем и запоминаем точку нажаия новой линии,
3C - переходим в режим 2,
3D - переходим в режим 4.

для 4:
4A - ничего не делаем, проверяем, не вышел ли таймаут, если вышел, переходим в состояние 1,
4B - ничего не делаем, проверяем, не вышел ли таймаут, если вышел, переходим в состояние 1,
4C - ничего не делаем, проверяем, не вышел ли таймаут, если вышел, переходим в состояние 1,
4D - возобновляем таймаут.

PS. Писал особенно не продумывая, просто для иллюстрации.
blackhard
Цитата(andriano @ 24.04.2008 20:01) *

Сэр знаком с таким знаком препинания как запятая?
Очень тяжело читать.
Если ты и программы так же пишешь, не удивляюсь, почему они не работают.

Значит, вводим состояния:
0. Неопределенное состояние - на всякий случай: если вдруг переменная примет это значение, будем знать, что где-то эта переменная портится.
1. "свободная мышь" - нигде ничего не рисуем.
2. нажата кнопка мыши.
3. мышь "тянет линию".
4. таймаут после двойного щелчка (кто знает, сколько сообщений о нажатии/отпускании мыши мы получим во время двойного щелчка - чтобы они нам не мешали)

Мышь находится в одном из приведенных состояний, в начале - "1".
Мы отслеживаем сообщения:
A - перемещение мыши,
B - нажатие мыши,
C - отпускание мыши,
D - двойной щелчок.

В зависимости от того, в каком состоянии мы находились, получая то или иное сообщение, мы выполняем определенное действие (в частном случае - ничего не делаем) и переходим в другое состояние.

Осталось расписать таблицу переходов и записать ее на любимом ЯВУ.
Например, для 1:
1A - ничего не делаем,
1B - переходим в режим 2,
1C - невозможная комбинация - сообщаем об ошибке,
1D - ничего не делаем.

для 2:
2A - стираем старую линию и рисуем новую,
2B - невозможная комбинация - сообщаем об ошибке,
2C - переходим в режим 3,
2D - переходим в режим 4.

для 3:
3A - стираем старую линию и рисуем новую,
3B - отрисованную линию оставляем и запоминаем точку нажаия новой линии,
3C - переходим в режим 2,
3D - переходим в режим 4.

для 4:
4A - ничего не делаем, проверяем, не вышел ли таймаут, если вышел, переходим в состояние 1,
4B - ничего не делаем, проверяем, не вышел ли таймаут, если вышел, переходим в состояние 1,
4C - ничего не делаем, проверяем, не вышел ли таймаут, если вышел, переходим в состояние 1,
4D - возобновляем таймаут.

PS. Писал особенно не продумывая, просто для иллюстрации.

Спасибо огромное good.gifТеперь вроде все наладил.Остался последний глупый вопрос как узнать какого цвета пиксель

if pixels[x,y]=clWhite then cw:=true;

Так? Специальной ф.и я найти не могу.
blackhard

Вот процедура для рисования линии по пикселям.
procedure DrawLine4Connected(x1,y1,x2,y2 : Integer;col:tcolor);
var
x, y, dx, dy, sx, sy, z, e, i : Integer;
Ch,cl : Boolean;
begin
x := x1;
y := y1;
dx := Abs(x2-x1);
dy := Abs(y2-y1);
If x2-x1>0 then sx:=1 else sx:=-1;
If y2-y1>0 then sy:=1 else sy:=-1;
e := 2*dy-dx;
Ch:=dy>=dx;
if Ch then begin
z := dx;
dx := dy;
dy := z;
end;
i := 1;
repeat
if image1.Canvas.Pixels[x, y]=clblack then cl:=true
else cl:=false;
if cl=false then
image1.Canvas.Pixels[x, y]:=col;
if e<dx then begin
if Ch then y := y+sy else x := x+sx;
e := e+2*dy;
end
else begin
if Ch then x := x+sx else y := y+sy;
e := e-2*dx;
end;
i := i+1;
until i>dx+dy;
{ if image1.Canvas.Pixels[x, y]=clblack then cl:=true
else cl:=false;
if cl=false then }
image1.Canvas.Pixels[x, y]:=col;

end;


Я пытаюсь добится чтоб линия белого цвета не затирала линию черного цвета.Ну с алгоритмом все ясно если цвет пикселя фона отличен от цвета фона то не рисуем пиксель иначе рисуем.Таквот вся проблема в том как узнать какого цвета пиксель на фоне я попробовал так
 if image1.Canvas.Pixels[x, y]=clblack then{вот тут я пытаюсь узнать цвет пикселя фона (видимо не верно)} cl:=true
else cl:=false;
if cl=false then{тут если пиксель на фоне не черный рисуем точку}
image1.Canvas.Pixels[x, y]:=col;

Видимо if image1.Canvas.Pixels[x, y]=clblack тут проверяется не цвет пикселя фона а цвет того который я нарисовал до этого?Как правильно узнать цвет пикселя на фоне?
andriano
Надо не узнавать цвет пикселя на фоне, а заливать фон нужным тебе цветом.
blackhard
Цитата(andriano @ 25.04.2008 17:30) *

Надо не узнавать цвет пикселя на фоне, а заливать фон нужным тебе цветом.

Что-то я несовсем понимаю как это мне поможет?
andriano
Зачем еще раз что-то УЗНАВАТЬ, что и так ЗНАЕШЬ?
blackhard
Ну вот основную часть я сделал теперь все рисуется.Теперь вопрос в том как правильно сделать это "с возможностью обозначения точек и проведения стандартных линий в треугольнике." по формулировки понятно что сделать это нужно только для треугольников.Так вот как распознать что нарисовано треугольник или нет.Я решил сделать так , для каждой новой линии сохранять ее координаты
trel=record
x1,y1,x2,y2:integer;
end;

var
tr:array [0..100]of trel;
массив записей для 4х координат линий.Так вот как потом эти данные проанализировать?
andriano
Наверное, надо анализировать не потом, а сразу.
Собственно, и анализа особого не нужно: хранить лучше не отдельными линиями, а полигонами. У тебя же линию можно прерывать. Вот участок, который ты рисуешь без перерывов - будет ломаной. А если конечная точка ломаной совпадает (с заданной погрешностью) с ее началом - то будет полигон. Если полигон состоит из трех сегментов - это треугольник.
blackhard
Вопрос конечно не совсем по Delphi, но по задаче.Может кто знает как выразить координаты высоты и биссектрисы. Если известны координаты всех вершин треугольника?
andriano
Честно говоря, не совсем понятно, что в денном контексте означает слово "знает".
Любая формула выводится, неужели кто-то их специально запоминает?
blackhard
И всетаки может ктонибудь поможет вывести формулу для нахождения координат основания высоты.У меня никак не выходит.Вот че у меня получилось:
Код

k1=(Yb-Yc)/(Xb-Xc)
K2=(Xc-Xb)/(Yb-Yc)
X=(-k2*Xa+Ya-((Xb*Yc-Xc*Yb)/(Xb-Xc)))/(K1-K2)
Y=k1*X+(Xb*Yc-XcYb)/(Xb-Xc)

это координаты основания высоты проведенной из точки А.
Вот уравнение высоты:
Код

Y=k2*X-k2*Xa+Ya

Высота проводится но она либо не достает до основания либо пересекает его и идет дальше.
andriano
Очевидно, точка, до которой идет высота, должна лежать на одной прямой с точками противолежащей стороны. Т.е. удовлетворять тому же уравнению прямой, что и они.
#$# PaVeL #$#
Хотел бы посоветовать использовать TPaintBox, a HE TImage, решение связанно с тем, что TImage делает кучу всяких ненужных перерисовок, А TPaintBox рисует только то, что ему сказали...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.