Главная страница
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
1-1259091900
Misterix
2009-11-24 22:45
2011.07.10
Перетащить картинку с рабочего стола на TImage


15-1301334387
Pavia
2011-03-28 21:46
2011.07.10
Посоветуйте компонент


15-1300829404
Юрий
2011-03-23 00:30
2011.07.10
С днем рождения ! 23 марта 2011 среда


4-1243935428
Unknown user
2009-06-02 13:37
2011.07.10
Стек вызовов


15-1300947070
OW
2011-03-24 09:11
2011.07.10
Как бы Вы написали и почему?