Probleme bei verdeckten Flächen

[Ben19]

Hallo Leute
ich bins mal wieder hab folgendes Problem mit meinem Programm.
Die Polygonausgabe funktioniert an manchen Stellen eigenartiger Weise nicht(Fläche 3 und 6), wird kein viereck angezeigt was für ein Polygon mit vier Punkten typisch wäre. Am besten ihr guckt euch das selber mal an, ihr werdet sicherlich schnell über den Fehler stolpern :).

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
const maxF = 10; maxPolyPu = 4;  pumax = 10;
type
  TFlaeche = Array [1..maxPolyPu] of integer;
  TFlaechenliste = Array [1..maxF] of TFlaeche;
  TVektor = Array [1..3] of real;
  TPunktfeld = Array [1..pumax] of TVektor;
  TAdjMatF = Array [1..maxF] of boolean;
  T2DVektor = Array[1..2] of real;
  T2DPunktfeld = Array [1..pumax] of T2DVektor;
  TFenster = record
    x1,y1,x2,y2 : real;
  end;
  TBildschirmfenster = record
    x1,y1,x2,y2 : integer;
  end;
  TPunkt = Array [1..2] of integer;
  TPixelfeld = Array [1..pumax] of TPunkt;

  TForm1 = class(TForm)
    Button11: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button11Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  {procedure liesobj( var Punktzahl : integer;
                     var Pliste : TPunktfeld;
                     var AdjMat : TAdjMat;
                     Dateiname : string); }
  procedure liesObjF(var Punktzahl : integer;
                     var PListe : TPunktfeld;
                     var Flaechenzahl : integer;
                     var FListe : TFlaechenliste;
                     Dateiname : string);
  procedure zeichnenF( Punktzahl : integer;
                           AdjMatF : TAdjMatF;
                           P : TPixelfeld;
                           Flaechenfeld:TFlaechenliste;
                           Flaechenzahl:integer);

  function transformiere(p,Fu,Fo:real;Bu,Bo:integer): integer;

  procedure initVektor(var v:TVektor;x1,x2,x3:real);

  procedure initFenster(var f: TFenster; x1,y1,x2,y2:real);

  procedure initBildschirmfenster(var f:TBildschirmfenster;x1,y1,x2,y2:integer);

  procedure Transformation ( PAnz:Integer;
                             F:TFenster;
                             B:TBildschirmfenster;
                             var D2PF:T2DPunktfeld;
                             var PF: TPixelfeld);

  procedure vecprod(a,b:TVektor; var c:TVektor);
  function skalar(v1,v2:TVektor):real;
  function betrag(v:Tvektor):real;
  procedure basisvektoren(  phi,theta : real; var n0,e1s,e2s : TVektor);
  procedure Projektion( PAnz : integer;
                        a    : real;
                        n,e1,e2:TVektor;
                        var P3 : TPunktfeld;
                        var P2 : T2DPunktfeld);
  procedure vecdiff(v1,v2:TVektor;var v:TVektor);
  procedure vecsum(v1,v2:TVektor;var v:TVektor);
  procedure vecNeg(var v:TVektor);
  procedure Sichtbarkeit(n0:TVektor;Entfernung,Punktzahl: integer;
                         var PListe: TPunktfeld; Flaechenzahl: integer;
                         var FListe: TFlaechenliste;
                         var FNormale: TPunktfeld; var AdjMatF:TAdjMatF);
var
  Form1: TForm1;
  Punktzahl : integer;
  Punktfeld,FNormale : TPunktfeld;
  AdjMatF : TAdjMatF;
  D2Punktfeld : T2DPunktfeld;
  Augpunkt,n,e1s,e2s : TVektor;
  Fenster : TFenster;
  BFenster : TBildschirmfenster;
  Pixelfeld : TPixelfeld;
  phi,theta : real;
  Flaechenzahl : integer;
  Flaechenliste : TFlaechenliste;

implementation

{$R *.dfm}


procedure liesObjF;              
var f : TEXT; k,j: integer;
begin
assign (f,Dateiname);reset(f);
readln(f, Punktzahl);
For k :=1 to Punktzahl Do
readln(f, PListe[k][1], PListe[k][2],PListe[k][3]);
readln(f,Flaechenzahl);
For k:= 1 to Flaechenzahl do
for j:= 1 to maxPolyPu do read(f,FListe[k][j]);
//readln(f,Entfernung);
//readln(f, w.x1, w.y1, w.x2, w.y2);
close(f)
end;

procedure FNormalen(Punktzahl : Integer;
                    var PListe : TPunktfeld;
                    Flaechenzahl : integer;
                    var FListe : TFlaechenliste;
                    var FNormale : TPunktfeld);
var k:integer; Schwerpunkt,u,v : TVektor;
begin
initVektor(Schwerpunkt,0.0,0.0,0.0);
for k:=1 to Punktzahl Do
 vecsum(Schwerpunkt, Pliste[k],Schwerpunkt);
 for k:=1 to 3 do
 Schwerpunkt[k]:=Schwerpunkt[k]/Punktzahl;
 for k:= 1 to Flaechenzahl do Begin
  vecdiff(PListe[FListe[k][2]], PListe[FListe[k][1]], u);
  vecdiff(PListe[FListe[k][3]], PListe[FListe[k][1]], v);
  vecprod(u,v,FNormale[k]);
  vecdiff(PListe[FListe[k][1]], Schwerpunkt,u);
  if skalar(FNormale[k],u)<0 then
  VecNeg(FNormale[k]);
  end;
end;

function transformiere(p,Fu,Fo:real;Bu,Bo:integer): integer;
begin
  result := round(Bu+((Bo-Bu)*(p-Fu))/(Fo-Fu));
end;

procedure initVektor(var v:TVektor;x1,x2,x3:real);
begin
 v[1]:=x1;
 v[2]:=x2;
 v[3]:=x3;
end;

procedure initFenster(var f: TFenster; x1,y1,x2,y2:real);
begin
  f.x1:=x1;
  f.x2:=x2;
  f.y1:=y1;
  f.y2:=y2;
end;

procedure initBildschirmfenster(var f:TBildschirmfenster;x1,y1,x2,y2:integer);
begin
  f.x1:=x1;
  f.x2:=x2;
  f.y1:=y1;
  f.y2:=y2;
end;

procedure Transformation ( PAnz:Integer;
                           F:TFenster;
                           B:TBildschirmfenster;
                           var D2PF:T2DPunktfeld;
                           var PF: TPixelfeld);
var k:integer; u,v :real;
begin
  for k:=1 to PAnz do
    begin
      u := D2PF[k][1];
      v := D2PF[k][2];
      PF[k][1]:= transformiere(u,F.x1,F.x2,B.x1,B.x2);
      PF[k][2]:= transformiere(v,F.y1,F.y2,B.y1,B.y2);
    end;
end;

procedure vecprod(a,b:TVektor; var c:TVektor);
begin
 c[1]:=a[2]*b[3]-a[3]*b[2];
 c[2]:=a[3]*b[1]-a[1]*b[3];
 c[3]:=a[1]*b[2]-a[2]*b[1];
end;

function skalar(v1,v2:TVektor):real;
begin
  result:=v1[1]*v2[1]+v1[2]*v2[2]+v1[3]*v2[3];
end;

function betrag(v:Tvektor):real;
begin
  result:=sqrt(skalar(v,v));
end;                                             

procedure basisvektoren(  phi,theta : real;
                            var n0,e1s,e2s :TVektor);
const e3:TVektor = (0,0,1);
var k:integer; vek: TVektor;
begin
  phi := phi*pi/180;
  theta:= theta*pi/180;
  initVektor(n0,sin(theta)*cos(phi),sin(theta)*sin(phi),cos(theta));
  vecprod(e3,n0,vek);
  for k:=1 to 3 do e1s[k] := vek[k]/ betrag(vek);//macht e1s zum Einheitsvektor
  vecprod(n0,e1s,e2s);
end;

procedure Projektion( PAnz : integer;
                        a    : real;
                        n,e1,e2:TVektor;
                        var P3 : TPunktfeld;
                        var P2 : T2DPunktfeld);
var h:real;k:integer; p:TVektor;
begin
  for k:=1 to PAnz do
  begin
    p:= P3[k];
    h:= a / (a - skalar(n,p));
    P2[k][1] := h* skalar(e1,p);
    P2[k][2] := h* skalar(e2,p);
  end;
end;

procedure vecdiff(v1,v2:TVektor;var v:TVektor);
begin
  v[1]:=v1[1]-v2[1];
  v[2]:=v1[2]-v2[2];
  v[3]:=v1[3]-v2[3];
end;

procedure vecsum(v1,v2:TVektor;var v:TVektor);
begin
  v[1]:=v1[1]+v2[1];
  v[2]:=v1[2]+v2[2];
  v[3]:=v1[3]+v2[3];
end;
procedure vecNeg(var v:TVektor);
begin
  v[1]:=v[1]*(-1);
  v[2]:=v[2]*(-1);
  v[3]:=v[3]*(-1);
end;
procedure Sichtbarkeit(n0:TVektor;Entfernung,Punktzahl: integer;
                         var PListe: TPunktfeld; Flaechenzahl: integer;
                         var FListe: TFlaechenliste;
                         var FNormale: TPunktfeld; var AdjMatF:TAdjMatF);
var j,k: integer; a,p: TVektor;
begin
  for j:=1 to Flaechenzahl do AdjMatF[j]:=false;
  For k:=1 to 3 do a[k]:= n0[k]* Entfernung;
  for k:= 1 to Flaechenzahl do
  begin
    vecdiff(a,PListe[FListe[k][1]],p);
    if skalar(p, FNormale[k])<0 then
    begin
      AdjMatF[k]:=true;
    end;
  end;
end;

procedure zeichnenF( Punktzahl : integer;
                   AdjMatF : TAdjMatF;
                   P : TPixelfeld;
                   Flaechenfeld:TFlaechenliste;
                   Flaechenzahl:integer);
var k,j,x1,y1,x2,y2,x3,y3,x4,y4:integer;
begin
  for j:=1 to maxF do
  begin
    if AdjMatF[j] then
             begin
             showmessage(inttostr(j));
             x1:=P[Flaechenfeld[j][1]][1];
             y1:=P[Flaechenfeld[j][1]][2];
             x2:=P[Flaechenfeld[j][2]][1];
             y2:=P[Flaechenfeld[j][2]][2];
             x3:=P[Flaechenfeld[j][3]][1];
             y3:=P[Flaechenfeld[j][3]][2];
             x4:=P[Flaechenfeld[j][4]][1];
             y4:=P[Flaechenfeld[j][4]][2];
             Form1.Canvas.Polygon([Point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]);
             end;
  end;
end;


procedure TForm1.Button11Click(Sender: TObject);
begin
  initFenster(Fenster,-4,-4,4,4);
  initBildschirmfenster(BFenster,0,400,400,0);
  liesobjF(Punktzahl, Punktfeld, Flaechenzahl, Flaechenliste,'rofl.dat');
  FNormalen(Punktzahl,Punktfeld,Flaechenzahl,Flaechenliste,FNormale);
  basisvektoren(phi,theta,n,e1s,e2s);
  Projektion(Punktzahl,betrag(Augpunkt),n,e1s,e2s,Punktfeld,D2Punktfeld);
  Transformation(Punktzahl,Fenster,BFenster,D2Punktfeld, Pixelfeld);
  Sichtbarkeit(n,10,Punktzahl,Punktfeld,Flaechenzahl,Flaechenliste,FNormale,AdjMatF);
  zeichnenF(Punktzahl,AdjMatF,Pixelfeld,Flaechenliste,Flaechenzahl);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  phi := 90;
  theta := 180;
  initVektor(Augpunkt, 20, 20, 20);
  initBildschirmfenster(BFenster,0,400,400,0);
  initFenster(Fenster,-19,-19,19,19);
end;

end.

Hier nochmal die rofl.dat datei:
8
-1 -1 -1
1 -1 -1
1 1 -1
-1 1 -1
-1 -1 1
1 -1 1
1 1 1
-1 1 1
6
1 2 3 4
1 2 6 5
2 3 6 7
3 4 8 7
4 1 5 8
5 6 8 7

Hoffe ihr könnt mir helfen und
vielen Dank im voraus
PS: Das Programm ist gedacht um verdeckte Flächen von körpern nicht darzustellen, mit Hilfe der Zentralprojektion.

[Ben19]

Hey
kann mir wirklich keiner einen Tipp geben?
Weiß echt nicht, was ich falsch gemacht hab :wall:
wäre echt nett, wenn sich jmd. die mühe machen könnte und sich das mal anschaut.
vielen dank im voraus
Ben19

[mr_emre_d]

Denkst du wirklich, dass sich jemand die Mühe macht, 311 Zeilen - nicht richtig eingerückten - Code durchzusehen ?

Versuch dein Problem - soweit das nun geht - einzukreisen -> Versuch die Stelle zu finden, an der etwas schief läuft.

MfG