![]() |
Probleme bei verdeckten Flächen
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:
Hier nochmal die rofl.dat datei:
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. 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. |
Re: Probleme bei verdeckten Flächen
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 |
Re: Probleme bei verdeckten Flächen
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 |
Alle Zeitangaben in WEZ +1. Es ist jetzt 22:13 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz