Версия для печати темы

Автор: blackhard 21.04.2008 19:31

Задача такова: Написать программу построения чертежей планиметрии "протягиванием" от выбранной точки с изображением ее промежуточного положения с возможностью обозначения точек и проведения стандартных линий в треугольнике.
Как это сделать я впринципе знаю но есть 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;

Автор: volvo 21.04.2008 19:46

Используй вот это событие:

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Image1.Canvas.LineTo(X, Y);
end;

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 21.04.2008 21:14

блин чето не получается сделать протягивание с изображением промежуточного положения.Алгоритм должен быть примерно таким: рисуем новую линию с координатами указателя мыши старую линию стираем и так до тех пор пока не нажмем кнопку.Я попробовал для начала так

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 21.04.2008 21:44

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

Автор: blackhard 21.04.2008 23:32

Цитата(volvo @ 21.04.2008 18:44)

Автор: blackhard 22.04.2008 0:35

Надеюсь последний вопрос Как очистить изображение или залить его каким-нибудь цветом?Залить белым у меня получилось так

image1.Canvas.Handle:=0;

Автор: volvo 22.04.2008 0:39

  Image1.Canvas.Brush.Color := clRed; // Здесь задаешь цвет
  Image1.Canvas.FillRect(Image1.ClientRect);

Автор: blackhard 22.04.2008 20:30

А как можно сделать чтоб при 1ом нажатии накнопку мыши линия прекращалась и от точки ее завершения сразуже тянулясь новая линия(ну это я сделал), а при двойном нажатии на кнопку линия прекращается мыш полностью от нее отвязывается и можно тянуть новую линию совершенно не связанную с предыдущей?

Автор: blackhard 23.04.2008 3:01

И еще 1 вопрос как можно сделать чтобы новая линия рисовалась не поверх старой а под ней?

Автор: andriano 23.04.2008 12:09

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

Автор: blackhard 23.04.2008 19:02

Цитата(andriano @ 23.04.2008 9:09)

Автор: andriano 23.04.2008 23:26

Цитата(blackhard @ 23.04.2008 16:02)

Автор: blackhard 24.04.2008 4:00

Цитата(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;

Автор: andriano 24.04.2008 11:22

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

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

Автор: blackhard 24.04.2008 12:58

Цитата(andriano @ 24.04.2008 8:22)

Автор: andriano 24.04.2008 23: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. Писал особенно не продумывая, просто для иллюстрации.

Автор: blackhard 24.04.2008 23:27

Цитата(andriano @ 24.04.2008 20:01)

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

Автор: blackhard 25.04.2008 15:28

Вот процедура для рисования линии по пикселям.

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;

Автор: andriano 25.04.2008 20:30

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

Автор: blackhard 25.04.2008 23:18

Цитата(andriano @ 25.04.2008 17:30)

Автор: andriano 26.04.2008 0:03

Зачем еще раз что-то УЗНАВАТЬ, что и так ЗНАЕШЬ?

Автор: blackhard 28.04.2008 2:27

Ну вот основную часть я сделал теперь все рисуется.Теперь вопрос в том как правильно сделать это "с возможностью обозначения точек и проведения стандартных линий в треугольнике." по формулировки понятно что сделать это нужно только для треугольников.Так вот как распознать что нарисовано треугольник или нет.Я решил сделать так , для каждой новой линии сохранять ее координаты

trel=record
  x1,y1,x2,y2:integer;
  end;

var
  tr:array [0..100]of trel;

Автор: andriano 28.04.2008 10:41

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

Автор: blackhard 29.04.2008 0:31

Вопрос конечно не совсем по Delphi, но по задаче.Может кто знает как выразить координаты высоты и биссектрисы. Если известны координаты всех вершин треугольника?

Автор: andriano 29.04.2008 1:08

Честно говоря, не совсем понятно, что в денном контексте означает слово "знает".
Любая формула выводится, неужели кто-то их специально запоминает?

Автор: blackhard 30.04.2008 3:16

И всетаки может ктонибудь поможет вывести формулу для нахождения координат основания высоты.У меня никак не выходит.Вот че у меня получилось:

Автор: andriano 30.04.2008 10:13

Очевидно, точка, до которой идет высота, должна лежать на одной прямой с точками противолежащей стороны. Т.е. удовлетворять тому же уравнению прямой, что и они.

Автор: #$# PaVeL #$# 2.05.2008 13:21

Хотел бы посоветовать использовать TPaintBox, a HE TImage, решение связанно с тем, что TImage делает кучу всяких ненужных перерисовок, А TPaintBox рисует только то, что ему сказали...