Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2011.07.10;
Скачать: CL | DM;

Вниз

построение фигур в delphi   Найти похожие ветки 

 
Елена   (2011-04-04 16:48) [0]

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

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, Menus;

type
 TForm1 = class(TForm)
   Image1: TImage;
   MainMenu1: TMainMenu;
   N2: TMenuItem;
   N1: TMenuItem;
   N3: TMenuItem;
   N4: TMenuItem;
   N5: TMenuItem;
   N6: TMenuItem;
   N7: TMenuItem;
   N8: TMenuItem;
   N9: TMenuItem;
   procedure FormCreate(Sender: TObject);
   procedure N7Click(Sender: TObject);
   procedure N8Click(Sender: TObject);
   procedure N9Click(Sender: TObject);
   procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 xx,yy:integer;
 tr, rec, cer:boolean;
 Treangl:array[1..3,1..2] of integer;
 Rectangl:array[1..4,1..2] of integer;
 Elips:array[1..3,1..2] of integer;
 i:integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 xx:=round(Image1.Width/2);
 yy:=round(Image1.Height/2);
 Form1.Image1.Canvas.MoveTo(0,yy);
 Form1.Image1.Canvas.LineTo(Form1.Image1.Width,yy);//OX
 Form1.Image1.Canvas.MoveTo(xx,0);
 Form1.Image1.Canvas.LineTo(xx, Form1.Image1.Height);//OY
 //
 Form1.Image1.Canvas.MoveTo(Form1.Image1.Width,yy);
 Form1.Image1.Canvas.LineTo(Form1.Image1.Width-10, yy-7);
 Form1.Image1.Canvas.MoveTo(Form1.Image1.Width,yy);
 Form1.Image1.Canvas.LineTo(Form1.Image1.Width-10, yy+7);
 //
 Form1.Image1.Canvas.MoveTo(xx,0);
 Form1.Image1.Canvas.LineTo(xx-7,15);
 Form1.Image1.Canvas.MoveTo(xx,0);
 Form1.Image1.Canvas.LineTo(xx+7,15);
 //
 Image1.Canvas.TextOut(xx-20, yy+10, "0,0");
 Image1.Canvas.TextOut(2*xx-10, yy+15, "X");
 Image1.Canvas.TextOut(xx-15,5,"Y");
 tr:=False;
 rec:=False;
 cer:=False;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
i:=1;
tr:=True;
rec:=False;
cer:=False;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
i:=1;
tr:=False;
rec:=True;
cer:=False;
end;

procedure TForm1.N9Click(Sender: TObject);
begin
i:=1;
tr:=False;
rec:=False;
cer:=True;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if tr=true then
   begin
     if i<=3 then
     begin
       Treangl[i,1]:=x;
       Treangl[i,2]:=y;
       if i=3 then
         begin
Form1.Image1.Canvas.MoveTo(Treangl[1,1], Treangl[1,2]);
Form1.Image1.Canvas.LineTo(Treangl[2,1], Treangl[2,2]);
Form1.Image1.Canvas.LineTo(Treangl[3,1], Treangl[3,2]);
Form1.Image1.Canvas.LineTo(Treangl[1,1], Treangl[1,2]);
         end;
       i:=i+1;
     end;
   end;

if rec=true 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;


end.


 
И. Павел ©   (2011-04-04 16:52) [1]

Нужно определить, в каком порядке нужно обходить углы в четырехугольнике.
Просто проверяйте, чтобы не одна из линий не пересекалась. Если пересекаются, отсортируйте точки по другому и т.д.


 
И. Павел ©   (2011-04-04 16:55) [2]

Уточнение: линии не должны пересекаться в своих пределах. Прямые этих линий где-то могут пересекаться, конечно.


 
OW ©   (2011-04-04 17:56) [3]

скопировал, ничего вообще не рисует
инициализации точек прямоугольника нет, кто будет делать это? мне в лом, остальным еще вломее, думаю..

на вскидку

уходить от матричного подхода
пишем функцию, соединить две точки PointToPoint
где, MoveTo первая точка, lineto вторая точка
далее PointToPoint(1,2), (2,3) (3,4) (4,1)
или DrawToPoits( array of point);
где PointToPoint(i, i+1)

и весь код нафиг не нужен, на другом форуме :) достаточно будет показывать
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]);



Страницы: 1 вся ветка

Текущий архив: 2011.07.10;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.007 c
2-1301648853
Len
2011-04-01 13:07
2011.07.10
Приложение выдает ошибку missing drivernane property


15-1300948857
brother
2011-03-24 09:40
2011.07.10
Эмулировать поведение курсора


15-1301148266
Учусь
2011-03-26 17:04
2011.07.10
[Fatal Error] Internal error: BC2241


15-1301290908
OW
2011-03-28 09:41
2011.07.10
Поиск по строке аля посковика. Генераторы запроса.


15-1300692093
brother
2011-03-21 10:21
2011.07.10
Старый ноутбук