algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Przecinanie się odcinków - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 3
SłabyŚwietny
Nadesłany przez Michał Knasiecki, 03 sierpnia 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

Odcinki_d/Unit1.pas:
//Program został pobrany ze strony www.algorytm.org
//Opracował Michał Knasiecki

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,math;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Label4: TLabel;
    Edit2: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    Edit3: TEdit;
    Label7: TLabel;
    Edit4: TEdit;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Edit5: TEdit;
    Label11: TLabel;
    Edit6: TEdit;
    Label12: TLabel;
    Label13: TLabel;
    Edit7: TEdit;
    Label14: TLabel;
    Edit8: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  wsp=record    //Współrzędne
        x,y:byte;
        end;
var
  Form1: TForm1;

implementation

{$R *.DFM}
function przynaleznosc(x,y,z:wsp):boolean;
//Ta procedura sprawdza, czy punkt z należy do odcinka |xy|
var det:byte;
begin
det:=x.x*y.y+y.x*z.y+z.x*x.y-z.x*y.y-x.x*z.y-y.x*x.y;
if det<>0 then result:=false else
begin
if (min(x.x,y.x)<=z.x)and(z.x<=max(x.x,y.x)) and (min(x.y,y.y)<=z.y)and(z.y<=max(x.y,y.y)) then
result:=true else
result:=false;
end;
end;
function det(x,y,z:wsp):integer;
//Wyznacznik macierzy kwadratowej stopnia 3.
begin
result:=x.x*y.y+y.x*z.y+z.x*x.y-z.x*y.y-x.x*z.y-y.x*x.y;
end;
procedure TForm1.Button1Click(Sender: TObject);
var a,b,c,d:wsp;
begin
//Pobieranie danych
a.x:=strtoint(edit1.text);
a.y:=strtoint(edit2.text);
b.x:=strtoint(edit3.text);
b.y:=strtoint(edit4.text);
c.x:=strtoint(edit5.text);
c.y:=strtoint(edit6.text);
d.x:=strtoint(edit7.text);
d.y:=strtoint(edit8.text);
//Sprawdzanie, czy jakiś punkt należy do drugiego odcinka
if przynaleznosc(a,b,c)=true then showmessage('Odcinki się przecinają- przynależność') else
if przynaleznosc(a,b,d)=true then showmessage('Odcinki się przecinają- przynależność') else
if przynaleznosc(c,d,a)=true then showmessage('Odcinki się przecinają- przynależność') else
if przynaleznosc(c,d,b)=true then showmessage('Odcinki się przecinają- przynależność') else
//żaden punkt nie należy do drugego odcinka
if det(a,b,c)*det(a,b,d)>=0 then showmessage('Odcinki się NIE przecinają') else //znaki wyznaczników są równe
if det(c,d,a)*det(c,d,b)>=0 then showmessage('Odcinki się NIE przecinają') else
showmessage('Odcinki się przecinają- punkty leżą po przeciwnych stronach')
end;

end.
Dodaj komentarz