Главная страница
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.008 c
15-1300947227
И. Павел
2011-03-24 09:13
2011.07.10
Печать нескольких RAV-проектов на одной странице


2-1301601969
Cyberkazi
2011-04-01 00:06
2011.07.10
Отправка почты!


10-1175061542
ustas
2007-03-28 09:59
2011.07.10
InternetExplorer.Application link Click


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


2-1301559093
Matveih1
2011-03-31 12:11
2011.07.10
DBGridEh и AutoFitColWidths