Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 5 152

Раздел: Delphi » Алгоритмы, преобразования
/ вопрос открыт /

Приветствую, уважаемые эксперты!
При построении четырехугольника возникла проблема, в некоторых случаях он вырисовывается в виде "конфеты". в чем может быть проблема? Для изображения фигур используется компонент Image. Смотреть код жирным шрифтом снизу.

Приложение:
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, ExtCtrls, Menus;
  8.  
  9. type
  10. TForm1 = class(TForm)
  11. Image1: TImage;
  12. MainMenu1: TMainMenu;
  13. N2: TMenuItem;
  14. N1: TMenuItem;
  15. N3: TMenuItem;
  16. N4: TMenuItem;
  17. N5: TMenuItem;
  18. N6: TMenuItem;
  19. N7: TMenuItem;
  20. N8: TMenuItem;
  21. N9: TMenuItem;
  22. procedure FormCreate(Sender: TObject);
  23. procedure N7Click(Sender: TObject);
  24. procedure N8Click(Sender: TObject);
  25. procedure N9Click(Sender: TObject);
  26. procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
  27. Shift: TShiftState; X, Y: Integer);
  28. private
  29. { Private declarations }
  30. public
  31. { Public declarations }
  32. end;
  33.  
  34. var
  35. Form1: TForm1;
  36. xx,yy:integer;
  37. tr, rec, cer:boolean;
  38. Treangl:array[1..3,1..2] of integer;
  39. Rectangl:array[1..4,1..2] of integer;
  40. Elips:array[1..3,1..2] of integer;
  41. i:integer;
  42.  
  43. implementation
  44.  
  45. {$R *.dfm}
  46.  
  47. procedure TForm1.FormCreate(Sender: TObject);
  48. begin
  49. xx:=round(Image1.Width/2);
  50. yy:=round(Image1.Height/2);
  51. Form1.Image1.Canvas.MoveTo(0,yy);
  52. Form1.Image1.Canvas.LineTo(Form1.Image1.Width,yy);//OX
  53. Form1.Image1.Canvas.MoveTo(xx,0);
  54. Form1.Image1.Canvas.LineTo(xx, Form1.Image1.Height);//OY
  55. //
  56. Form1.Image1.Canvas.MoveTo(Form1.Image1.Width,yy);
  57. Form1.Image1.Canvas.LineTo(Form1.Image1.Width-10, yy-7);
  58. Form1.Image1.Canvas.MoveTo(Form1.Image1.Width,yy);
  59. Form1.Image1.Canvas.LineTo(Form1.Image1.Width-10, yy+7);
  60. //
  61. Form1.Image1.Canvas.MoveTo(xx,0);
  62. Form1.Image1.Canvas.LineTo(xx-7,15);
  63. Form1.Image1.Canvas.MoveTo(xx,0);
  64. Form1.Image1.Canvas.LineTo(xx+7,15);
  65. //
  66. Image1.Canvas.TextOut(xx-20, yy+10, '0,0');
  67. Image1.Canvas.TextOut(2*xx-10, yy+15, 'X');
  68. Image1.Canvas.TextOut(xx-15,5,'Y');
  69. tr:=False;
  70. rec:=False;
  71. cer:=False;
  72. end;
  73.  
  74. procedure TForm1.N7Click(Sender: TObject);
  75. begin
  76. i:=1;
  77. tr:=True;
  78. rec:=False;
  79. cer:=False;
  80. end;
  81.  
  82. procedure TForm1.N8Click(Sender: TObject);
  83. begin
  84. i:=1;
  85. tr:=False;
  86. rec:=True;
  87. cer:=False;
  88. end;
  89.  
  90. procedure TForm1.N9Click(Sender: TObject);
  91. begin
  92. i:=1;
  93. tr:=False;
  94. rec:=False;
  95. cer:=True;
  96. end;
  97.  
  98. procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  99. Shift: TShiftState; X, Y: Integer);
  100. begin
  101. if tr=true then
  102. begin
  103. if i<=3 then
  104. begin
  105. Treangl[i,1]:=x;
  106. Treangl[i,2]:=y;
  107. if i=3 then
  108. begin
  109. Form1.Image1.Canvas.MoveTo(Treangl[1,1], Treangl[1,2]);
  110. Form1.Image1.Canvas.LineTo(Treangl[2,1], Treangl[2,2]);
  111. Form1.Image1.Canvas.LineTo(Treangl[3,1], Treangl[3,2]);
  112. Form1.Image1.Canvas.LineTo(Treangl[1,1], Treangl[1,2]);
  113. end;
  114. i:=i+1;
  115. end;
  116. end;
  117.  
  118. [B]if rec=true then
  119. begin
  120. if i<=4 then
  121. begin
  122. Rectangl[i,1]:=x;
  123. Rectangl[i,2]:=y;
  124. if i=4 then
  125. begin
  126. Form1.Image1.Canvas.MoveTo(Rectangl[1,1], Rectangl[1,2]);
  127. Form1.Image1.Canvas.LineTo(Rectangl[2,1], Rectangl[2,2]);
  128. Form1.Image1.Canvas.LineTo(Rectangl[3,1], Rectangl[3,2]);
  129. Form1.Image1.Canvas.LineTo(Rectangl[4,1], Rectangl[4,2]);
  130. Form1.Image1.Canvas.LineTo(Rectangl[1,1], Rectangl[1,2]);
  131.  
  132. end;
  133. i:=i+1;
  134. end;
  135. end;
  136. end;[/B]
  137.  
  138.  
  139. end.


Nostalgia Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задала: Nostalgia (статус: Посетитель)
Вопрос отправлен: 4 апреля 2011, 17:16
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Егор

Здравствуйте, Nostalgia!
мда... код - жесть...
вообще-то, вполне можно было выложить лишь процедуру TForm1.Image1MouseDown и объявление переменных. да и саму процедуру можно было порезать.

if rec=true then
эта конструкция ужасна. не надо так писать!
вот как надо:
if rec then

посмотрим код
var
...
 tr, rec, cer:boolean;
 Rectangl:array[1..4,1..2] of integer;
 i:integer;
...
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
...
  if rec then
    begin
      if i<=4 then
      begin
        Rectangl[i,1]:=x;
        Rectangl[i,2]:=y;
        if i=4 then
          begin
            Form1.Image1.Canvas.MoveTo(Rectangl[1,1], Rectangl[1,2]);
            Form1.Image1.Canvas.LineTo(Rectangl[2,1], Rectangl[2,2]);
            Form1.Image1.Canvas.LineTo(Rectangl[3,1], Rectangl[3,2]);
            Form1.Image1.Canvas.LineTo(Rectangl[4,1], Rectangl[4,2]);
            Form1.Image1.Canvas.LineTo(Rectangl[1,1], Rectangl[1,2]);
          end;
      i:=i+1;
    end;
  end;
end;

ну и ответ на "в чем может быть проблема?"
смотря как щёлкать мышью. если щёлкать "правильно", по углам прямоугольника, получим прямоугольник. если щёлкать по "конфете", её и получим.

Ответ отправил: Егор (статус: 10-ый класс)
Время отправки: 4 апреля 2011, 18:28
Оценка за ответ: 1


Мини-форум вопроса

Всего сообщений: 9; последнее сообщение — 4 апреля 2011, 21:04; участников в обсуждении: 3.
Nostalgia

Nostalgia (статус: Посетитель), 4 апреля 2011, 18:57 [#1]:

я понимаю..
нужно чтоб даже если щелкать по "конфете" вырисовывался прямоугольник...
что для этого нужно??
могу скинуть весь архив чтоб было нагляднее...
Егор

Егор (статус: 10-ый класс), 4 апреля 2011, 19:04 [#2]:

нужен именно прямоугольник (с прямыми углами) или четырёхугольник (с любыми углами)?

Цитата (Nostalgia):

могу скинуть весь архив чтоб было нагляднее...

НЕЕЕЕТ!!! не надо!
:)))
Опасайтесь багов в приведенном выше коде; я только доказал корректность, но не запускал его.
— Donald E. Knuth.
Егор

Егор (статус: 10-ый класс), 4 апреля 2011, 19:20 [#3]:

почему единица? на вопрос ответ дан.
Опасайтесь багов в приведенном выше коде; я только доказал корректность, но не запускал его.
— Donald E. Knuth.
Nostalgia

Nostalgia (статус: Посетитель), 4 апреля 2011, 19:28 [#4]:

нужен прямоугольник с любыми углами
Егор

Егор (статус: 10-ый класс), 4 апреля 2011, 19:37 [#5]:

пусть минай помогает. он тоже единицы за ответы обожает.
или вадим. он из одессы, земляк.
Опасайтесь багов в приведенном выше коде; я только доказал корректность, но не запускал его.
— Donald E. Knuth.
Nostalgia

Nostalgia (статус: Посетитель), 4 апреля 2011, 19:38 [#6]:

каков ответ таков...
я так чувствую что мне никто здесь не поможет(((((((
Nostalgia

Nostalgia (статус: Посетитель), 4 апреля 2011, 19:39 [#6]:

каков ответ таков...
я так чувствую что мне никто здесь не поможет(((((((
Мережников Андрей

Мережников Андрей (статус: Абитуриент), 4 апреля 2011, 20:18 [#7]:

Цитата (Nostalgia):

нужен прямоугольник с любыми углами

прямоугольник, по определению, может быть только с ПРЯМЫМИ углами!
Самый простой вариант - по кликам мыши определять только две диагональные вершины, а дальше уже достраивать прямоугольник по ним, правда расположен он будет только горизонтально (вертикально), но не под произвольным углом к экрану. А если самостоятельно определять координаты всех вершин, то, уж извините, что "нащелкали", то и получите.
Nostalgia

Nostalgia (статус: Посетитель), 4 апреля 2011, 20:27 [#8]:

прошу прощения, четырехугольник...
Мережников Андрей

Мережников Андрей (статус: Абитуриент), 4 апреля 2011, 21:04 [#9]:

понятно. Тогда следующий алгоритм - сначала принимаем координаты вершин, затем сортируем, чтобы не было пересечений, а затем уже строим четырехугольник. Самое сложное из этого сортировка. Но здесь уже должна помочь математика. Уравнения прямых по двум точкам составлять умеем? Проверяем на взаимное пересечение отрезки (x1,y1)-(x2,y2) и (x3,y3)-(x4,y4), а также отрезки (x1,y1)-(x4,y4) и (x2,y2)-(x3,y3). Если есть пересечение первой пары отрезков, то меняем местами координаты, например, вершин 2 и 3. Если пересечение второй пары отрезков, то вершины 3 и 4. И все в "шоколаде". Правда надо добавить проверку когда три (получается треугольник) или все четыре точки лежат на одной прямой (тогда просто отрезок).

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 10:30
Выполнено за 0.03 сек.