{$N+} unit OPolig; (*----------------------------------------------------------------*) interface uses Types; (*----------------------------------------------------------------*) type TIndici = Word; TPerm = array[TNrElem] of TIndici; PPerm = ^TPerm; TPoligon = object nr: TIndici; {Nr de puncte in P^} P: PTabelPuncte; {Tabelul de puncte} nm: TIndici; {Nr de elemente in m^} m: PPerm; {Tabelul de permutari, folosit pu infasuratoare} lx, ly: TIndici; {Indicii punctelor extreme de minim} hx, hy: TIndici; {Indicii punctelor extreme de maxim} {Initializare si distrugere} constructor Init(size: TIndici); constructor Twin(list: PTabelPuncte; n: TIndici); destructor Done; {Redimensionare} function SetSize(size: TIndici): boolean; function Resize(size: TIndici): boolean; function SetSizeM(size: TIndici): boolean; function ResizeM(size: TIndici): boolean; function Generate(size: TIndici; mx, my: Integer): TIndici; function GenStel(size: TIndici; raz: Integer; c: TPunct): TIndici; function GenConv(size: TIndici; raz: Integer; c: TPunct): TIndici; {Citire/Scriere} function QueryInput(size: TIndici): TIndici; {Dialogul de introducere a coordonatelor} function Input(size: TIndici): TIndici; {Citire de la tastatura} function Output: TIndici; {Afisare pe ecran} function QueryFile: TIndici; {Cere numele fisierului si citeste din el punctele} function QuerySize(size: TIndici): TIndici; {Cere nr de puncte si seteaza acest nr} function LoadFromFile(FileName: string): TIndici; {Citire din fisierul FileName} function SaveToFile(FileName: string): TIndici; {Scriere in fisierul FileName} function SaveMToFile(FileName: string): TIndici; {Scriere infasuratoarea in fisierul FileName} function CopyFromTabel(t: PTabelPuncte; n: TIndici): TIndici; function CopyToTabel(var t: TabelPuncte): TIndici; {t trebuie sa contina suficient spatiu} function CopyMToTabel(var t: TabelPuncte): TIndici; {Transformati} {O(nr)} procedure Center(var g: TPunct); {g - centrul de masa} {O(nr)} function Move(dx, dy: TCoord): TNumber; {Deplaseaza originii in (dx,dy) } {O(nr)} function MoveRel(v: TPunct): TNumber; {Deplaseaza originii sistemului: O -> v } {O(nr)} procedure MoveTo(c: TPunct); {Deplaseaza centrului de masa: G -> c } {O(nr)} procedure Rotate(alfa: TNumber; o: TPunct); {Rotirea cu alfa radiani in jurul punctului o } {O(nr)} procedure RotateGrad(alfa: TNumber; o: TPunct); {Rotirea cu alfa grade in jurul punctului o } {O(NlogN)} function Infasa: TIndici; {Determinarea infasuratoarei convexe in permutarile m (Algoritmul Andrew)} {O(nr)} function Interior(s: TPunct): boolean; {Determina daca punctul s apartine interiorului poligonului} {O(nr)} function InRect(s: TPunct): boolean; {Determina daca punctul s apartine dreptunghiului cadru al poligonului} function Extrem(var l, h: TPunct): boolean; {Determina valorile extreme ale P^ (l - minime, h - maxime)} function AbsExtrem(var e: TPunct): boolean; {Determina valorile absolute extreme ale P^} {Grafica} procedure DrowPoints(color: Integer); procedure DrowPoligon(color: Integer); procedure DrowM(color: Integer); procedure DrowMPoints(color: Integer); procedure DrowRect(color: Integer); procedure FillRect(outCl, inCl: Integer); {Implementare} function GetExtrem: boolean; function GetExtremM: boolean; function IsNilExtrem: boolean; {Verifica daca punctele extreme au fost detectate} procedure NilExtrem; {Sterge indicii punctelor extreme} function IsSimplu: boolean; {Determina daca poligonul este simplu} function OnlyM: TIndici; end; (*----------------------------------------------------------------*) implementation uses CRT, IOGeom, Punct, Poligon, Graph, GrGeom; (*----------------------------------------------------------------*) {Sorteaza elementele p[m[left]..m[right]] dupa permutarile m} procedure QSort_y(p: PTabelPuncte; left, right: TIndici; var m: PPerm); var u, v, j, b: TIndici; procedure sort(e: TIndici); var i: TIndici; begin if b >= e then exit; i := b; j := e; u := m^[(b+e) div 2]; repeat with P^[u] do while (P^[m^[i]].y < y) or ((P^[m^[i]].y = y)and(P^[m^[i]].x < x)) do inc(i); with P^[u] do while (y < P^[m^[j]].y) or ((y = P^[m^[j]].y)and(x < P^[m^[j]].x)) do dec(j); if i<=j then begin v:=m^[i]; m^[i]:=m^[j]; m^[j]:=v; inc(i); dec(j); end; until i>j; sort(j); b := i; sort(e); end; begin b := left; sort(right) end; (*----------------------------------------------------------------*) procedure TPoligon.DrowPoints(color: Integer); begin drow_set_puncte(P^, nr, Color) end; (*----------------------------------------------------------------*) procedure TPoligon.DrowPoligon(color: Integer); begin drow_poligon(P^, nr, Color) end; (*----------------------------------------------------------------*) procedure TPoligon.DrowRect(color: Integer); var l, h: TPunct; begin Extrem(l, h); drow_drept(l, h, color); end; (*----------------------------------------------------------------*) procedure TPoligon.FillRect(outCl, inCl: Integer); var l, h, t: TPunct; delta, u: TNumber; begin if not Extrem(l, h) then Exit; if not GrInited then InitGr(0); AbsExtrem(t); with t do detect_ratio(x, y); delta := 1/Ratio; t.x := l.x; with t do while (x < h.x) do begin y := l.y; while (y < h.y) do begin if Interior(t) then drow_punct(t, inCl) else drow_punct(t, outCl); u := y*Ratio; repeat y := y + delta until Int(u) <> Int(y*Ratio); end; u := x*Ratio; repeat x := x + delta until Int(u) <> Int(x*Ratio); end; end; (*----------------------------------------------------------------*) procedure TPoligon.DrowMPoints(color: Integer); var i: integer; e: TPunct; begin if m = nil then Infasa; if not GrInited then InitGr(0); AbsExtrem(e); with e do detect_ratio(x, y); for i := 0 to nm-1 do drow_punct(p^[m^[i]], color); end; (*----------------------------------------------------------------*) procedure TPoligon.DrowM(color: Integer); var i, j: integer; e: TPunct; begin if m = nil then Infasa; if not GrInited then InitGr(0); SetColor(color); AbsExtrem(e); with e do detect_ratio(x, y); j := nm-1; for i := 0 to nm-1 do begin drow_segment(p^[m^[i]], p^[m^[j]]); j := i; end end; (*----------------------------------------------------------------*) function TPoligon.GetExtrem: boolean; var i: TIndici; begin GetExtrem := false; if nr < 1 then Exit; GetExtrem := true; {Determinam punctele de ordonata si abscisa minima si maxima (P^[lx], P^[ly], P^[hx], P^[hy]) } i := nr - 1; lx := i; ly := lx; hx := lx; hy := hx; while i > 0 do begin dec(i); if P^[i].x < P^[lx].x then lx := i; if P^[i].y < P^[ly].y then ly := i; if P^[hx].x < P^[i].x then hx := i; if P^[hy].y < P^[i].y then hy := i; end; end; (*----------------------------------------------------------------*) function TPoligon.GetExtremM: boolean; var i: TIndici; begin GetExtremM := false; if nm < 1 then Exit; GetExtremM := true; i := nm - 1; lx := m^[i]; ly := lx; hx := lx; hy := hx; while i > 0 do begin dec(i); if P^[m^[i]].x < P^[lx].x then lx := m^[i]; if P^[m^[i]].y < P^[ly].y then ly := m^[i]; if P^[hx].x < P^[m^[i]].x then hx := m^[i]; if P^[hy].y < P^[m^[i]].y then hy := m^[i]; end; end; (*----------------------------------------------------------------*) function TPoligon.Extrem(var l, h: TPunct): boolean; begin if IsNilExtrem and not (GetExtremM or GetExtrem) then Extrem := false else begin l.x := (P^[lx].x); h.x := (P^[hx].x); l.y := (P^[ly].y); h.y := (P^[hy].y); Extrem := true; end; end; (*----------------------------------------------------------------*) function TPoligon.AbsExtrem(var e: TPunct): boolean; var l: TPunct; begin if IsNilExtrem and not (GetExtremM or GetExtrem) then AbsExtrem := false else with e do begin x := abs(P^[lx].x); y := abs(P^[ly].y); with l do begin x := abs(P^[hx].x); y := abs(P^[hy].y); if e.x < x then e.x := x; if e.y < y then e.y := y; end; AbsExtrem := true; end; end; (*----------------------------------------------------------------*) function TPoligon.IsSimplu: boolean; var u, v, i, j: TIndici; begin if nr > 3 then begin v := 0; IsSimplu := false; for u := nr-1 downto 2 do begin j := u-1; for i := u-2 downto 0 do begin if i <> v then if intersect(P^[v], P^[u], P^[j], P^[i]) then Exit; j := i; end; v := u; end; end; IsSimplu := true; end; (*----------------------------------------------------------------*) function TPoligon.Infasa: TIndici; var i, j, u, v, a, b: TIndici; r: TNumber; begin Infasa := 0; if not SetSizeM(nr) then exit; {Alocam spatiu pentru lista de permutari} {1. Determinam punctele de ordonata minima si maxima (P^[ly], P^[hy]) } GetExtrem; {2. Separam P^ in doua submultimi, in functie de pozitia fata de vectorul (P^[a],P^[b])} u := 0; v := nr; {Amplasam punctele de ordonata minima/maxima la capetele listei} m^[u] := ly; {Sfirsitul S1} m^[v] := hy; {Inceputul S2} for i := nr-1 downto 0 do if(i<>ly)and(i<>hy)then begin r := sarrus(P^[ly], P^[hy], P^[i]); {S1} if r > 0 then begin inc(u); m^[u] := i; end else {S2} if r < 0 then begin dec(v); m^[v] := i; end else {Punctele de pe dreapta (P^[a], P^[b]) sunt ignorate (r=0)} end; {Acum P^[m^[0]..m^[u]] = S1, P^[m^[v]..m^[nr]] = S2} {3. Sortarea dupa ordonata} QSort_y(P, 1, u, m); QSort_y(P, v, nr-1, m); {4. Excludem punctele care nu sunt pe infasuratoare} {a. Verificam tripletele formate din S1} m^[u+1] := m^[nr]; {Punctul cu ordonata maxima} a := 0; {Ultimul element din infasuratoare} i := a+1; {Punctul care se verifica} j := i+1; {Un punct oarecare din S1} while i <= u do {Se verifica toate punctele pana la u, inclusiv} begin if sarrus(P^[m^[a]], P^[m^[j]], P^[m^[i]]) > 0 then begin {Miscarea inainte} inc(a); if a <> i then m^[a] := m^[i]; i := j; inc(j); end else {Miscarea inapoi} if a > 0 then begin {Daca nu s-a ajuns la primul element} i := a; dec(a); end else begin {Daca a e primul element, mergem tot inainte} i := j; inc(j); end; end; {b. Verificam tripletele formate din S2} m^[v-1] := m^[0]; {Punctul cu ordonata minima} b := nr; {Ultimul element din infasuratoare} i := b-1; {Punctul care se verifica} j := i-1; {Un punct oarecare din S2} while i >= v do {Se verifica toate punctele pana la v, inclusiv} begin if sarrus(P^[m^[b]], P^[m^[j]], P^[m^[i]]) > 0 then begin {Miscarea inainte} dec(b); if b <> i then m^[b] := m^[i]; i := j; dec(j); end else {Miscarea inapoi} if b < nr then begin {Daca nu s-a ajuns la primul element} i := b; inc(b); end else begin {Daca b e primul element, mergem tot inainte} i := j; dec(j); end; end; {5. Formam solutia: S1 + S2} inc(a); {Nr. nr de elemente din S1} for i := nr downto b do m^[a+nr-i] := m^[i]; dec(b); {Omologul lui a} ResizeM(a + nr - b); Infasa := nm; {Nr. de puncte din infasuratoare} end; (*----------------------------------------------------------------*) procedure TPoligon.Rotate(alfa: TNumber; o: TPunct); {Rotirea cu alfa radiani in jurul punctului c} var c, s: TNumber; i: TIndici; u, v: TCoord; begin if alfa = 0 then exit; c := cos(alfa); s := sin(alfa); i := 0; while i < nr do with P^[i] do begin u := x - o.x; {skimbam originea de coordonate in o} v := y - o.y; x := c * u - s * v + o.x; y := s * u + c * v + o.y; inc(i); end; NilExtrem; {La rotire punctele extreme se skimba} end; (*----------------------------------------------------------------*) procedure TPoligon.RotateGrad(alfa: TNumber; o: TPunct); begin Rotate(alfa*pi/180, o) end; (*----------------------------------------------------------------*) function TPoligon.Move(dx, dy: TCoord): TNumber; var i: TIndici; r: TNumber; begin r := sqrt(sqr(dx)+sqr(dy)); Move := r; if r = 0 then exit; i := 0; while i < nr do with P^[i] do begin x := x + dx; y := y + dy; inc(i); end; end; (*----------------------------------------------------------------*) function TPoligon.MoveRel(v: TPunct): TNumber; begin MoveRel := Move(v.x, v.y) end; {O -> v} (*----------------------------------------------------------------*) procedure TPoligon.MoveTo(c: TPunct); {G -> c} var g: TPunct; begin Center(g); dif_vec(c, c, g); with c do Move(x, y); end; (*----------------------------------------------------------------*) procedure TPoligon.Center(var g: TPunct); var i: TIndici; {g - centrul de masa al poligonului} begin g.x := 0; g.y := 0; i := 0; while i < nr do with P^[i] do begin g.x := g.x + x; g.y := g.y + y; inc(i); end; g.y := g.y / nr; g.x := g.x / nr; end; (*----------------------------------------------------------------*) function TPoligon.SetSize(size: TIndici): boolean; begin if size <> nr then begin Done; GetMem(P, (size+1)*SizeOf(TPunct)); if P = nil then nr := 0 else nr := size; end; SetSize := size = nr; end; (*----------------------------------------------------------------*) function TPoligon.Resize(size: TIndici): boolean; var t: PTabelPuncte; i: TIndici; begin if P = nil then SetSize(size); if size <> nr then begin Resize := false; SetSizeM(0); GetMem(t, (size+1)*SizeOf(TPunct)); if t = nil then exit; if P <> nil then begin if size > nr then i := nr else i := size; while i > 0 do begin dec(i); t^[i] := P^[i]; end; FreeMem(P, (nr+1)*SizeOf(TPunct)); end; P := t; nr := size; if(lx>=nr)or(ly>=nr)or(hx>=nr)or(hy>=nr)then NilExtrem; end; Resize := true; end; (*----------------------------------------------------------------*) function TPoligon.SetSizeM(size: TIndici): boolean; begin if size <> nm then begin if m <> nil then FreeMem(m, (nm+1)*SizeOf(TIndici)); GetMem(m, (size+1)*SizeOf(TIndici)); if m = nil then nm := 0 else nm := size; end; SetSizeM := size = nm; end; (*----------------------------------------------------------------*) function TPoligon.ResizeM(size: TIndici): boolean; var t: PPerm; i: TIndici; begin if size <> nm then begin; ResizeM := false; GetMem(t, (size+1)*SizeOf(TIndici)); if t = nil then exit; if m <> nil then begin if size > nm then i := nm else i := size; while i > 0 do begin dec(i); t^[i] := m^[i]; end; FreeMem(m, (nm+1)*SizeOf(TIndici)); end; m := t; nm := size; end; ResizeM := true; end; (*----------------------------------------------------------------*) function TPoligon.OnlyM: TIndici; var t: PTabelPuncte; i: TIndici; begin if (P <> nil) and (m <> nil) then begin GetMem(t, (nm+1)*SizeOf(TPunct)); i := nm; while i > 0 do begin dec(i); t^[m^[i]] := P^[i]; end; FreeMem(P, (nr+1)*SizeOf(TPunct)); P := t; nr := nm; end; OnlyM := nr; if(lx>=nr)or(ly>=nr)or(hx>=nr)or(hy>=nr)then NilExtrem; end; (*----------------------------------------------------------------*) constructor TPoligon.Init(size: TIndici); begin nr := 0; P := nil; m := nil; if not SetSize(size) then Fail; end; (*----------------------------------------------------------------*) constructor TPoligon.Twin(list: PTabelPuncte; n: TIndici); begin if list = nil then n := 0; Init(n); while n > 0 do begin dec(n); P^[n] := list^[n]; end; end; (*----------------------------------------------------------------*) destructor TPoligon.Done; begin if P <> nil then FreeMem(P, (nr+1)*SizeOf(TPunct)); if m <> nil then FreeMem(m, (nm+1)*SizeOf(TIndici)); nr := 0; P := nil; m := nil; NilExtrem; end; (*----------------------------------------------------------------*) procedure TPoligon.NilExtrem; begin lx := 0; ly := 0; hx := 0; hy := 0; end; function TPoligon.IsNilExtrem: boolean; begin IsNilExtrem := lx or ly or hx or hy = 0; end; (*----------------------------------------------------------------*) function TPoligon.QueryInput(size: TIndici): TIndici; {Dialogul de introducere a coordonatelor} var s: string; r: TNumber; v: boolean; begin PauseGr; v := true; repeat if not v then writeln('Optiune invalida! Mai incearca o data...'+endl); writeln; writeln('Alege o optiune prin tastarea literei corespunzatoare:'+endl); writeln(' I: Introducerea coordonatelor manual (implicit)'+endl + ' F: Citirea din fisier'+endl + ' G: Generarea unei multimi aleatoare de puncte'+endl + ' S: Generarea unui poligon stelat'+endl + ' C: Generarea unui poligon convex'+endl); case UpCase(ReadKey) of 'I': Input(size); 'F': QueryFile; 'G': begin write('Raza: '); readln(r); Generate(size, abs(Trunc(r)), abs(Trunc(r))) end; 'S': begin write('Raza: '); readln(r); GenStel(size, abs(Trunc(r)), ZeroP) end; 'C': begin write('Raza: '); readln(r); GenConv(size, abs(Trunc(r)), ZeroP) end; else v := false; end; clrscr; until v; ResumeGr; end; (*----------------------------------------------------------------*) function TPoligon.QueryFile: TIndici; {Cere numele fisierului si citeste din el punctele} var s: string; begin QueryFile := 0; s := ''; repeat if s <> '' then writeln('Fisierul "' + s + '" nu e valid!'); write('Nume fisier: '); readln(s); until (s = '') or (LoadFromFile(s) <> 0); QueryFile := nr; end; (*----------------------------------------------------------------*) function TPoligon.QuerySize(size: TIndici): TIndici; {Cere nr de puncte si seteaza acest nr} begin if(size = 0) then begin writeln; writeln('Introdu nr de puncte: '); readln(size); end; while not SetSize(size) do dec(size); writeln('Spatiu alocat petru ', size, ' puncte!'); QuerySize := nr; end; (*----------------------------------------------------------------*) function TPoligon.Input(size: TIndici): TIndici; var i: TIndici; begin PauseGr; QuerySize(size); i := 0; while i < nr do with P^[i] do begin write('p[',i,'](x,y): '); readln(x, y); inc(i); end; Input := nr; ResumeGr; end; (*----------------------------------------------------------------*) function TPoligon.Output: TIndici; var i: TIndici; begin PauseGr; writeln; i := 0; while i < nr do with P^[i] do begin writeln('p',i,'(x, y): (', x:8:2, ',', y:8:2,')'); inc(i); if i mod WindMax = 0 then readkey; end; Output := nr; ResumeGr; end; (*----------------------------------------------------------------*) function TPoligon.LoadFromFile(FileName: string): TIndici; var f: text; l, c: ListPuncte; i: TIndici; begin LoadFromFile := 0; if not open_file(f, FileName, 'r') then exit; Done; {Stergem punctele existente} new(l); {Cream lista de puncte} c := l; i := 0; while(not eof(f))do begin {Citirea punctelor din fisier} with c^.p do readln(f, x, y); new(c^.urm); c := c^.urm; inc(i); end; c^.urm := nil; Close(f); SetSize(i); c := l; i := 0; while c^.urm <> nil do begin {Transferul din lista in tabel} P^[i] := c^.p; c := c^.urm; Dispose(l); l := c; inc(i); end; Dispose(l); LoadFromFile := nr; {Nr de puncte citite} end; (*----------------------------------------------------------------*) function TPoligon.SaveToFile(FileName: string): TIndici; var f: text; i: TIndici; begin SaveToFile := 0; if (P=nil)or(nr=0) or not open_file(f, FileName, 'w') then exit; for i := 0 to nr-1 do with P^[i] do writeln(f, x:8:2,' ',y:8:2); close(f); SaveToFile := nr-1; end; (*----------------------------------------------------------------*) function TPoligon.SaveMToFile(FileName: string): TIndici; var f: text; i: TIndici; begin if m = nil then Infasa; SaveMToFile := 0; if (m=nil)or(nm=0) or not open_file(f, FileName, 'w') then exit; for i := 0 to nm-1 do with P^[m^[i]] do writeln(f, x:8:2,' ',y:8:2); close(f); SaveMToFile := nm-1; end; (*----------------------------------------------------------------*) function TPoligon.CopyToTabel(var t: TabelPuncte): TIndici; var i: TIndici; begin if P = nil then CopyToTabel := 0 else begin CopyToTabel := nr; i := nr; while i > 0 do begin dec(i); t[i] := P^[i]; end; end; end; (*----------------------------------------------------------------*) function TPoligon.CopyMToTabel(var t: TabelPuncte): TIndici; var i: TIndici; begin if (m = nil)and(Infasa = 0) then CopyMToTabel := 0 else begin CopyMToTabel := nm; i := nm; while i > 0 do begin dec(i); t[i] := P^[m^[i]]; end; end; end; (*----------------------------------------------------------------*) function TPoligon.CopyFromTabel(t: PTabelPuncte; n: TIndici): TIndici; begin if t = nil then n := 0; Resize(n); while n > 0 do begin dec(n); P^[n] := t^[n]; end; end; (*----------------------------------------------------------------*) function TPoligon.Generate(size: TIndici; mx, my: Integer): TIndici; begin Generate := QuerySize(size); size := nr; while size > 0 do begin dec(size); with P^[size] do begin x := random(2*mx)-mx; y := random(2*my)-my; end; end; end; (*----------------------------------------------------------------*) function TPoligon.GenStel(size: TIndici; raz: Integer; c: TPunct): TIndici; var pas: TNumber; t: TPunct; begin GenStel := 0; repeat QuerySize(size); size := 0; until nr > 3; P^[nr] := c; pas := 2 * pi / nr; {Pasul unghiular mediu de la un varf la altul} size := nr; while size > 0 do with t do begin dec(size); x := raz * 0.1 + rand_real(raz * 0.9); {ro} y := size * pas + rand_real(pas); {fi} cartez_punct(t, t); {Trecem la coordonate carteziene} sum_vec(P^[size], t, c); {Transformam punctul in sistemul de coordonate cu centrul c} end; GenStel := nr; end; (*----------------------------------------------------------------*) function TPoligon.GenConv(size: TIndici; raz: Integer; c: TPunct): TIndici; var lat, pas: TNumber; t: TPunct; u, v: TNumber; begin GenConv := 0; repeat QuerySize(size); size := 0; until nr > 3; { gen_puncte(p, nr, max_x, max_y); gen_polig_conv := Infasa(p, p, nr); } u := pi * (nr-2) / nr; {Unghiul poligonului regulat cu nr laturi} lat := (raz) * sqrt(2*(1-cos(u))); {Latura poligonului regulat de raza raz} pas := pi - u; P^[0] := ZeroP; P^[1].x := rand_real(lat)+1; P^[1].y := rand_real(lat)+1; with P^[1] do v := ArcTan2(y, x); for size := 2 to nr-1 do with t do begin y := abs(u - unghi_puncte(P^[size-2], P^[size-1], P^[0])); if pas < y then y := pas; y := v - M_PI + u + (rand_real(2*y)-y); {fi} x := lat / 10 + rand_real(lat - lat / 10); {ro} v := y; cartez_punct(t, t); {Obtinem coordonatele carteziene} sum_vec(P^[size], P^[size-1], t); {Apmlasam varful la locul sau, dupa varful precedent} end; Infasa; {Pentru orice eventualitate determinam infasuratoarea convexa} for size := 0 to nm-1 do P^[size] := P^[m^[size]]; Resize(nm); MoveTo(c); GenConv := nr; end; (*----------------------------------------------------------------*) function TPoligon.InRect(s: TPunct): boolean; begin if IsNilExtrem and not (GetExtremM or GetExtrem) then InRect := false else with s do InRect := (P^[lx].x < x)and(x < P^[hx].x)and(y < P^[ly].y)and(y < P^[hy].y) end; (*----------------------------------------------------------------*) function TPoligon.Interior(s: TPunct): boolean; var i, j, k: integer; t, u, v: TCoord; begin Interior := false; if IsNilExtrem then Interior := true; { Fie l dreapta ce trece prin s, paralela la Ox } k := 0; {Numarul de intersectii cu dreapta l la stanga lui s} j := 0; {Ultimul punct analizat} u := P^[j].y - s.y; {Ultima ordonata care nu se afla pe l} for i := nr-1 downto 0 do with P^[i] do begin if y = s.y then {P^[i] se afla pe l} if (P^[j].y = s.y) and intre_val(s.x, P^[j].x, x) then Exit else {s se afla pe latura P^[j]P^[i]} else begin {P^[i] nu se afla pe l} v := y - s.y; if u*v < 0 then begin {Domeniul a fost intersectat de dreapta l} if P^[j].y = s.y then t := P^[j].x {intersectat intr-un varf al poligonului} else t := x + (P^[j].x-x)*(s.y-y)/(P^[j].y-y); {intersectat pe o latura a poligonului} {t este abscisa punctului de intersectie cu l} with s do if t < x then inc(k) {Daca a fost intersectat la stanga de s} else if t = x then Exit; {s se afla pe latura P^[j]P^[i]} end; u := v; end; j := i; end; Interior := k and 1 <> 0; end; (*----------------------------------------------------------------*) (*----------------------------------------------------------------*) begin randomize; end.