Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2011.07.10;
Скачать: [xml.tar.bz2];

Вниз

построение фигур в 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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.002 c
8-1212730666
DJ Kondakov
2008-06-06 09:37
2011.07.10
Проигрывание AVI


15-1300915800
Юрий
2011-03-24 00:30
2011.07.10
С днем рождения ! 24 марта 2011 четверг


15-1301076925
TStas
2011-03-25 21:15
2011.07.10
Что делать с ноутбуком


2-1301917302
Mishutka
2011-04-04 15:41
2011.07.10
Как перехватить момент передачи сообшения в COM Port


2-1301397141
nataly
2011-03-29 15:12
2011.07.10
CopyRect





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский