summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore7
-rw-r--r--unit1.lfm165
-rw-r--r--unit1.pas1125
-rw-r--r--unit2.lfm18
-rw-r--r--unit2.pas38
-rw-r--r--vecmath.pas538
-rw-r--r--weihnachtsstern.icobin0 -> 137040 bytes
-rw-r--r--weihnachtsstern.lpi91
-rw-r--r--weihnachtsstern.lpr23
-rw-r--r--weihnachtsstern.lps176
-rw-r--r--weihnachtsstern.resbin0 -> 139052 bytes
11 files changed, 2181 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..3baa84a
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,7 @@
+*.bak
+*.ppu
+*.o
+*.tar.gz
+*~
+weihnachtsstern
+lib
diff --git a/unit1.lfm b/unit1.lfm
new file mode 100644
index 0000000..a5e7184
--- /dev/null
+++ b/unit1.lfm
@@ -0,0 +1,165 @@
+object Form1: TForm1
+ Left = 93
+ Height = 551
+ Top = 315
+ Width = 1225
+ Caption = 'Form1'
+ ClientHeight = 551
+ ClientWidth = 1225
+ Color = clBtnFace
+ DesignTimePPI = 107
+ Font.Color = clWindowText
+ Font.Height = -12
+ Font.Name = 'MS Sans Serif'
+ OnActivate = FormActivate
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnResize = FormResize
+ LCLVersion = '2.0.12.0'
+ object Image1: TImage
+ Left = 276
+ Height = 438
+ Top = 45
+ Width = 465
+ end
+ object Image2: TImage
+ Left = 740
+ Height = 438
+ Top = 45
+ Width = 465
+ end
+ object Label1: TLabel
+ Left = 9
+ Height = 13
+ Top = 7
+ Width = 48
+ Caption = 'Drehen:'
+ Font.Color = clWindowText
+ Font.Height = -12
+ Font.Name = 'MS Sans Serif'
+ ParentColor = False
+ ParentFont = False
+ end
+ object Image3: TImage
+ Tag = -1
+ Left = 0
+ Height = 331
+ Top = 152
+ Width = 278
+ OnMouseDown = Image3MouseDown
+ OnMouseMove = Image3MouseMove
+ OnMouseUp = Image3MouseUp
+ end
+ object RadioGroup1: TRadioGroup
+ Left = 0
+ Height = 55
+ Top = 36
+ Width = 206
+ AutoFill = True
+ Caption = 'Körper'
+ ChildSizing.LeftRightSpacing = 6
+ ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+ ChildSizing.EnlargeVertical = crsHomogenousChildResize
+ ChildSizing.ShrinkHorizontal = crsScaleChilds
+ ChildSizing.ShrinkVertical = crsScaleChilds
+ ChildSizing.Layout = cclLeftToRightThenTopToBottom
+ ChildSizing.ControlsPerLine = 1
+ ClientHeight = 38
+ ClientWidth = 202
+ Font.Color = clWindowText
+ Font.Height = -12
+ Font.Name = 'MS Sans Serif'
+ ItemIndex = 0
+ Items.Strings = (
+ 'Deltoidalhexakontaederstern'
+ 'Pentagonhexakontaederstern'
+ )
+ OnClick = RadioGroup1Click
+ ParentFont = False
+ TabOrder = 0
+ end
+ object CheckBox1: TCheckBox
+ Left = 62
+ Height = 21
+ Top = 6
+ Width = 98
+ Caption = 'automatisch'
+ Font.Color = clWindowText
+ Font.Height = -12
+ Font.Name = 'MS Sans Serif'
+ OnClick = CheckBox1Click
+ ParentFont = False
+ TabOrder = 1
+ end
+ object Button1: TButton
+ Left = 9
+ Height = 28
+ Top = 107
+ Width = 84
+ Caption = 'Spitze'
+ Font.Color = clWindowText
+ Font.Height = -12
+ Font.Name = 'MS Sans Serif'
+ OnClick = Button1Click
+ ParentFont = False
+ TabOrder = 2
+ end
+ object Button2: TButton
+ Left = 98
+ Height = 28
+ Top = 107
+ Width = 99
+ Caption = 'Determinante'
+ Font.Color = clWindowText
+ Font.Height = -12
+ Font.Name = 'MS Sans Serif'
+ OnClick = Button2Click
+ ParentFont = False
+ TabOrder = 3
+ end
+ object Button3: TButton
+ Left = 169
+ Height = 28
+ Top = 0
+ Width = 126
+ Caption = 'Spitzen entfernen'
+ Font.Color = clWindowText
+ Font.Height = -12
+ Font.Name = 'MS Sans Serif'
+ OnClick = Button3Click
+ ParentFont = False
+ TabOrder = 4
+ end
+ object ProgressBar1: TProgressBar
+ Left = 303
+ Height = 18
+ Top = 4
+ Width = 233
+ Font.Color = clWindowText
+ Font.Height = -12
+ Font.Name = 'MS Sans Serif'
+ ParentFont = False
+ Smooth = True
+ TabOrder = 5
+ Visible = False
+ end
+ object Button4: TButton
+ Left = 205
+ Height = 28
+ Top = 107
+ Width = 64
+ Caption = 'Test'
+ Font.Color = clWindowText
+ Font.Height = -12
+ Font.Name = 'MS Sans Serif'
+ OnClick = Button4Click
+ ParentFont = False
+ TabOrder = 6
+ end
+ object ZeichenTimer: TTimer
+ Enabled = False
+ Interval = 50
+ OnTimer = ZeichenTimerTimer
+ Top = 27
+ end
+end
diff --git a/unit1.pas b/unit1.pas
new file mode 100644
index 0000000..f098124
--- /dev/null
+++ b/unit1.pas
@@ -0,0 +1,1125 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
+ ComCtrls, vecMath, Math;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ Button1: TButton;
+ Button2: TButton;
+ Button3: TButton;
+ Button4: TButton;
+ CheckBox1: TCheckBox;
+ Image1: TImage;
+ Image2: TImage;
+ Image3: TImage;
+ Label1: TLabel;
+ ProgressBar1: TProgressBar;
+ RadioGroup1: TRadioGroup;
+ ZeichenTimer: TTimer;
+ procedure FormActivate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure ZeichenTimerTimer(Sender: TObject);
+ procedure CheckBox1Click(Sender: TObject);
+ procedure CheckBox2Click(Sender: TObject);
+ procedure Image3MouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+ procedure Image3MouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+ procedure Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
+ Y: Integer);
+ procedure FormResize(Sender: TObject);
+ procedure RadioGroup1Click(Sender: TObject);
+ procedure Button1Click(Sender: TObject);
+ procedure Button2Click(Sender: TObject);
+ procedure Button3Click(Sender: TObject);
+ procedure Button4Click(Sender: TObject);
+ private
+
+ public
+ Dim,Koerp: Integer;
+ Kanten: array of TPoint;
+ Ecken: array of TMatrix;
+ ProjektionL,
+ ProjektionR,
+ Rotation,
+ Beschl,Rot: TMatrix;
+ Zoom: extended;
+
+ procedure Drehen;
+ procedure BeschlBelegen;
+ procedure RotationInitialisieren;
+ procedure ProjektionenBelegen;
+ procedure KoerperErzeugen;
+ procedure Zeichnen;
+ procedure KantenZeichnen(Pte: array of TPoint; PZ: array of extended; drawZ: boolean; drawTo: TCanvas);
+ procedure drawColoredLine(wo: TCanvas; X1,Y1: Integer; Z1: extended; X2,Y2: Integer; Z2: Extended);
+ function farbVerlauf(x: Extended): TColor;
+ procedure SetZoom;
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ unit2;
+
+procedure TForm1.FormActivate(Sender: TObject);
+begin
+ Dim:=3;
+ Koerp:=-1;
+ RadioGroup1.OnClick(Sender);
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+var i: integer;
+begin
+ for i:=0 to length(Ecken)-1 do
+ Ecken[i].destroy;
+ ProjektionL.destroy;
+ ProjektionR.destroy;
+ Rotation.destroy;
+ Rot.destroy;
+ Beschl.destroy;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+ setlength(Ecken,0);
+ ProjektionL:=TMatrix.create;
+ ProjektionR:=TMatrix.create;
+ Rotation:=TMatrix.create;
+ Rot:=TMatrix.create;
+ Beschl:=TMatrix.create;
+end;
+
+procedure TForm1.ZeichenTimerTimer(Sender: TObject);
+var i: integer;
+begin
+ Zeichnen;
+ for i:=0 to ZeichenTimer.Interval div 10 do
+ begin
+ Drehen;
+ BeschlBelegen;
+ end;
+end;
+
+procedure TForm1.ProjektionenBelegen;
+var z,s: integer;
+ tmp: TMatrix;
+const alpha = 2*pi/360 * 10;
+begin
+ ProjektionL.destroy;
+ ProjektionL:=TMatrix.create;
+ ProjektionL.xdim:=4;
+ ProjektionL.ydim:=3;
+ for z:=0 to 2 do
+ for s:=0 to 3 do
+ ProjektionL.a[z,s]:=byte(z=s);
+
+ ProjektionR.destroy;
+ ProjektionR:=TMatrix.create;
+ ProjektionR.xdim:=4;
+ ProjektionR.ydim:=4;
+ ProjektionR.assign0;
+ ProjektionR.a[0,0]:=cos(alpha);
+ ProjektionR.a[0,2]:=sin(alpha);
+ ProjektionR.a[3,0]:=-sin(alpha);
+ ProjektionR.a[3,2]:=cos(alpha);
+ ProjektionR.a[1,1]:=1;
+ ProjektionR.a[2,3]:=1;
+
+ ProjektionR._times(ProjektionL);
+
+ tmp:=TMatrix.create;
+ tmp.xdim:=dim;
+ tmp.ydim:=4;
+ for s:=0 to dim-1 do
+ for z:=0 to 3 do
+ tmp.a[z,s]:=byte(z=s);
+
+ ProjektionR.times_(tmp);
+ ProjektionL.times_(tmp);
+end;
+
+procedure TForm1.KoerperErzeugen;
+function spiegleKante(Knr,Enr: integer; N: TMatrix): integer;
+var Es: array[boolean] of integer;
+ i: integer;
+ M,O: TMatrix;
+ bol,nk: boolean;
+ tmp: extended;
+begin
+ M:=TMatrix.create;
+ O:=TMatrix.create;
+ Es[false]:=Kanten[Knr].x;
+ Es[true]:=Kanten[Knr].y;
+ for bol:=false to true do begin
+ M.assign(Ecken[Enr]);
+ M.minus(Ecken[Es[bol]]);
+ M.transp;
+ M.times_(N);
+ tmp:=M.a[0,0];
+ M.assign(N);
+ M.times(2*tmp);
+ M.plus(Ecken[Es[bol]]);
+ tmp:=1;
+ for i:=0 to length(Ecken)-1 do begin
+ O.assign(M);
+ O.minus(Ecken[i]);
+ tmp:=min(tmp,O.len);
+ end;
+ if tmp>1e-6 then begin
+ Es[bol]:=length(Ecken);
+ setlength(Ecken,length(Ecken)+1);
+ Ecken[Es[bol]]:=TMatrix.create;
+ Ecken[Es[bol]].assign(M);
+ end
+ else begin
+ for i:=0 to length(Ecken)-1 do begin
+ O.assign(M);
+ O.minus(Ecken[i]);
+ if O.len <=1.1e-6 then begin
+ Es[bol]:=i;
+ break;
+ end;
+ end;
+ end;
+ end;
+ result:=-1;
+ nk:=true;
+ for i:=0 to length(kanten)-1 do
+ nk:=nk and ((Kanten[i].x<>Es[false]) or (Kanten[i].y<>Es[true]))
+ and ((Kanten[i].y<>Es[false]) or (Kanten[i].x<>Es[true]));
+ if nk then begin
+ setlength(Kanten,length(Kanten)+1);
+ Kanten[length(Kanten)-1].x:=Es[false];
+ Kanten[length(Kanten)-1].y:=Es[true];
+ result:=length(Kanten)-1;
+ end
+ else
+ for i:=0 to length(kanten)-1 do begin
+ if (Kanten[i].x=Es[false]) and (Kanten[i].y=Es[true]) then result:=i;
+ if (Kanten[i].y=Es[false]) and (Kanten[i].x=Es[true]) then result:=i;
+ end;
+ M.destroy;
+ O.destroy;
+end;
+
+var ral: array of array[boolean] of TMatrix;
+
+procedure rotierePunkt(Quelle: TMatrix; Achse: integer; umNull: boolean; var Ziel: TMatrix);
+var tang,otang: TMatrix;
+ tmp: extended;
+begin
+ Ziel.assign(Quelle);
+ if ral[Achse,true].len<1e-6 then exit;
+ if not umNull then Ziel.minus(ral[Achse,false]);
+ tang:=TMatrix.create;
+ otang:=TMatrix.create;
+ tang.assign(Ziel);
+ Ziel.transp;
+ Ziel.times_(ral[Achse,true]);
+ tmp:=Ziel.a[0,0];
+ Ziel.assign(ral[Achse,true]);
+ Ziel.times(tmp/sqr(ral[Achse,true].len));
+ tang.minus(Ziel);
+ if tang.len<1e-6 then begin
+ if not umNull then Ziel.plus(ral[Achse,false]);
+ tang.destroy;
+ otang.destroy;
+ exit;
+ end;
+ otang.assign(ral[Achse,true]);
+ otang.cross(tang);
+ otang.times(tang.len/otang.len*sin(ral[Achse,true].len));
+ tang.times(cos(ral[Achse,true].len));
+ Ziel.plus(tang);
+ Ziel.plus(otang);
+ if not umNull then Ziel.plus(ral[Achse,false]);
+ tang.destroy;
+ otang.destroy;
+end;
+
+procedure rotiereKante(Kante,Achse: integer);
+var M,N: TMatrix;
+ Es: array[boolean] of integer;
+ bol,gef: boolean;
+ i: integer;
+begin
+ M:=TMatrix.create;
+ N:=TMatrix.create;
+ Es[false]:=Kanten[Kante].x;
+ Es[true]:=Kanten[Kante].y;
+ for bol:=false to true do begin
+ rotierePunkt(Ecken[Es[bol]],Achse,false,M);
+ gef:=false;
+ for i:=0 to length(Ecken)-1 do begin
+ N.assign(M);
+ N.minus(Ecken[i]);
+ if N.len<1e-6 then begin
+ gef:=true;
+ Es[bol]:=i;
+ break;
+ end;
+ end;
+ if not gef then begin
+ setlength(Ecken,length(Ecken)+1);
+ Ecken[length(Ecken)-1]:=TMatrix.create;
+ Ecken[length(Ecken)-1].assign(M);
+ Es[bol]:=length(Ecken)-1;
+ end;
+ end;
+ gef:=false;
+ for i:=0 to length(Kanten)-1 do
+ gef:=gef or ((Kanten[i].x=Es[false]) and (Kanten[i].y=Es[true])) or
+ ((Kanten[i].y=Es[false]) and (Kanten[i].x=Es[true]));
+ if not gef then begin
+ setlength(Kanten,length(Kanten)+1);
+ Kanten[length(Kanten)-1].x:=Es[false];
+ Kanten[length(Kanten)-1].y:=Es[true];
+ end;
+
+ M.destroy;
+ N.destroy;
+end;
+
+var skl: array of TPoint;
+ i,j,k: integer;
+ M,N: TMatrix;
+ nsa,bol: boolean;
+ b,d,f,t,phi,tmp: extended;
+begin
+ case Koerp of
+ 0:
+ begin
+ if dim<>3 then exit;
+// b:=3/22*(7-sqrt(5)); // kurze Seite (lange Seite=1)
+ d:=3*sqrt((5-sqrt(5))/20); // kurze Diagonale
+ f:=1/11*sqrt((470+156*sqrt(5))/5); // lange Diagonale
+
+ Setlength(Ecken,16);
+ for i:=0 to length(Ecken)-1 do begin
+ Ecken[i]:=TMatrix.create;
+ Ecken[i].xdim:=1;
+ Ecken[i].ydim:=dim;
+ end;
+ Setlength(Kanten,35);
+ for i:=0 to length(Kanten)-1 do
+ Kanten[i].x:=-1;
+ Ecken[0].a[0,0]:=0;
+ Ecken[0].a[1,0]:=0;
+ Ecken[0].a[2,0]:=sqrt(1-sqr(d*cos(pi/5)/sin(2*pi/5))); // die berechnete Höhe
+ for i:=0 to 4 do begin
+ Ecken[i+1].a[0,0]:=cos(2*pi/5*i)*d*cos(pi/5)/sin(2*pi/5);
+ Ecken[i+1].a[1,0]:=sin(2*pi/5*i)*d*cos(pi/5)/sin(2*pi/5);
+ Ecken[i+1].a[2,0]:=0;
+ end;
+ M:=TMatrix.create;
+ M.xdim:=1;
+ M.ydim:=dim;
+ N:=TMatrix.create;
+ N.xdim:=1;
+ N.ydim:=dim;
+ for i:=0 to 4 do begin
+ Ecken[i+6].assign(Ecken[i+1]);
+ Ecken[i+6].plus(Ecken[(i+1) mod 5 +1]);
+ Ecken[i+6].times(-1/2);
+ Ecken[i+6].plus(Ecken[0]);
+ Ecken[i+6].times(-f/Ecken[i+6].len);
+ Ecken[i+6].plus(Ecken[0]);
+ Ecken[i+11].assign(Ecken[0]);
+ M.assign(Ecken[i+6]);
+ Ecken[i+11].times(0.5);
+ M.times(0.5);
+ Ecken[i+11].plus(M);
+ M.assign(Ecken[i+1]);
+ M.minus(Ecken[0]);
+ N.assign(Ecken[(i+1) mod 5+1]);
+ N.minus(Ecken[0]);
+ M.cross(N);
+ M.times(3/M.len);
+ Ecken[i+11].plus(M);
+ end;
+ for i:=0 to 4 do begin
+ Kanten[i].x:=0;
+ Kanten[i].y:=i+1;
+ Kanten[i+5].x:=i+1;
+ Kanten[i+5].y:=i+6;
+ Kanten[i+10].x:=i+6;
+ Kanten[i+10].y:=(i+1) mod 5 +1;
+ Kanten[i+15].x:=i+11;
+ Kanten[i+15].y:=0;
+ Kanten[i+20].x:=i+11;
+ Kanten[i+20].y:=i+1;
+ Kanten[i+25].x:=i+11;
+ Kanten[i+25].y:=i+6;
+ Kanten[i+30].x:=i+11;
+ Kanten[i+30].y:=(i+1) mod 5 +1;
+ end;
+
+ setlength(skl,5);
+ for i:=0 to 4 do begin
+ skl[i].x:=i+5;
+ skl[i].y:=(i+4) mod 5+10;
+ end;
+
+ repeat
+ nsa:=false;
+ i:=length(skl)-1;
+ while i>=0 do begin
+ M.assign(Ecken[Kanten[skl[i].x].x]);
+ M.minus(Ecken[Kanten[skl[i].x].y]);
+ N.assign(Ecken[Kanten[skl[i].y].x]);
+ N.minus(Ecken[Kanten[skl[i].y].y]);
+ N.cross(M);
+ N.times(1/N.len);
+ j:=length(skl)-1;
+ while j>=0 do begin
+ setlength(skl,length(skl)+1);
+ skl[length(skl)-1].x:=spiegleKante(skl[j].x,Kanten[skl[i].x].x,N);
+ skl[length(skl)-1].y:=spiegleKante(skl[j].y,Kanten[skl[i].x].x,N);
+ bol:=false;
+ for k:=0 to length(skl)-2 do
+ bol:=bol or ((skl[length(skl)-1].x=skl[k].x) and
+ (skl[length(skl)-1].y=skl[k].y)) or
+ ((skl[length(skl)-1].y=skl[k].x) and
+ (skl[length(skl)-1].x=skl[k].y));
+ if bol then setlength(skl,length(skl)-1)
+ else nsa:=true;
+ dec(j);
+ end;
+ dec(i);
+ end;
+ until not nsa;
+
+ for i:=0 to length(skl)-1 do begin
+ M.assign(Ecken[Kanten[skl[i].x].x]);
+ M.minus(Ecken[Kanten[skl[i].x].y]);
+ N.assign(Ecken[Kanten[skl[i].y].x]);
+ N.minus(Ecken[Kanten[skl[i].y].y]);
+ N.cross(M);
+ N.times(1/N.len);
+ j:=length(Kanten)-1;
+ while j>=0 do begin
+ spiegleKante(j,Kanten[skl[i].x].x,N);
+ dec(j);
+ end;
+ end;
+ M.destroy;
+ N.destroy;
+ end;
+ 1:
+ begin
+ if dim<>3 then exit;
+ phi:=(sqrt(5)+1)/2;
+ t:=1/12*(power(44+12*phi*(9+sqrt(81*phi-15)),1/3)+power(44+12*phi*(9-sqrt(81*phi-15)),1/3)-4);
+ b:=2*(1-2*sqr(t))/(1+2*t); // kurze Seite (lange Seite=1)
+ d:=2*(1-2*sqr(t)); // Diagonale
+ f:=sqrt(b*(b+d)); // (ganz) kurze Diagonale
+
+ Setlength(Ecken,21);
+ for i:=0 to length(Ecken)-1 do begin
+ Ecken[i]:=TMatrix.create;
+ Ecken[i].xdim:=1;
+ Ecken[i].ydim:=dim;
+ end;
+ Setlength(Kanten,45);
+ for i:=0 to length(Kanten)-1 do
+ Kanten[i].x:=-1;
+ Ecken[0].a[0,0]:=0;
+ Ecken[0].a[1,0]:=0;
+ Ecken[0].a[2,0]:=sqrt(1-sqr(d*cos(pi/5)/sin(2*pi/5))); // die berechnete Höhe
+ for i:=0 to 4 do begin
+ Ecken[i+1].a[0,0]:=cos(2*pi/5*i)*d*cos(pi/5)/sin(2*pi/5);
+ Ecken[i+1].a[1,0]:=sin(2*pi/5*i)*d*cos(pi/5)/sin(2*pi/5);
+ Ecken[i+1].a[2,0]:=0;
+ end;
+ M:=TMatrix.create;
+ M.xdim:=1;
+ M.ydim:=dim;
+ N:=TMatrix.create;
+ N.xdim:=1;
+ N.ydim:=dim;
+ for i:=0 to 4 do begin
+ Ecken[i+6].assign(Ecken[i+1]);
+ Ecken[i+6].plus(Ecken[(i+1) mod 5 +1]);
+ Ecken[i+6].times(1/2);
+ Ecken[i+6].minus(Ecken[0]);
+ Ecken[i+6].times(sqrt(sqr(b)-sqr((d-b)/2))/Ecken[i+6].len);
+ N.assign(Ecken[(i+1) mod 5 +1]);
+ N.minus(Ecken[i+1]);
+ N.times((d-b)/2/N.len);
+ Ecken[i+6].plus(N);
+ Ecken[i+6].plus(Ecken[i+1]);
+ N.times(b/N.len);
+ Ecken[i+11].assign(Ecken[i+6]);
+ Ecken[i+11].plus(N);
+ M.assign(Ecken[i+6]);
+ M.plus(Ecken[i+11]);
+ M.times(0.3);
+ Ecken[i+16].assign(Ecken[0]);
+ Ecken[i+16].times(0.7);
+ Ecken[i+16].plus(M);
+ M.assign(Ecken[i+1]);
+ M.minus(Ecken[0]);
+ N.assign(Ecken[(i+1) mod 5 +1]);
+ N.minus(Ecken[0]);
+ M.cross(N);
+ M.times(3/M.len);
+ Ecken[i+16].Plus(M);
+ end;
+ for i:=0 to 4 do begin
+ Kanten[i].x:=0;
+ Kanten[i].y:=i+1;
+ Kanten[i+5].x:=i+1;
+ Kanten[i+5].y:=i+6;
+ Kanten[i+10].x:=i+6;
+ Kanten[i+10].y:=i+11;
+ Kanten[i+15].x:=i+11;
+ Kanten[i+15].y:=(i+1) mod 5 +1;
+ Kanten[i+20].x:=0;
+ Kanten[i+20].y:=i+16;
+ Kanten[i+25].x:=i+1;
+ Kanten[i+25].y:=i+16;
+ Kanten[i+30].x:=i+6;
+ Kanten[i+30].y:=i+16;
+ Kanten[i+35].x:=i+11;
+ Kanten[i+35].y:=i+16;
+ Kanten[i+40].x:=(i+1) mod 5 +6;
+ Kanten[i+40].y:=i+16;
+ end;
+
+ setlength(ral,2);
+ for i:=0 to 3 do
+ ral[i div 2,odd(i)]:=TMatrix.create;
+ ral[0,false].assign(Ecken[0]); // die 5er-Symmetrieachse
+ ral[0,true].assign(Ecken[0]);
+ ral[0,true].times(2*pi/5/ral[0,true].len);
+
+ ral[1,false].assign(Ecken[6]); // die 3er-Symmetrieachse
+ tmp:=arccos((sqrt(3)/6*f)/sqrt(sqr(b)-sqr(f/2))); // Kippwinkel der Rotationsachse gegenüber Flächennormale
+ ral[1,true].assign(Ecken[1]);
+ ral[1,true].plus(Ecken[11]);
+ ral[1,true].times(-1/2);
+ ral[1,true].plus(Ecken[6]);
+ ral[1,true].times(1/ral[1,true].len);
+ N.assign(Ecken[1]);
+ N.minus(Ecken[11]);
+ N.cross(ral[1,true]);
+ N.times(1/N.len);
+ ral[1,true].times(sin(tmp));
+ N.times(cos(tmp));
+ ral[1,true].plus(N);
+ ral[1,true].times(2*pi/3/ral[1,true].len);
+
+ repeat
+ nsa:=false;
+ i:=length(ral)-1;
+ while i>=0 do begin
+ j:=length(ral)-1;
+ while j>=0 do begin
+ setlength(ral,length(ral)+1);
+ for bol:=false to true do begin
+ ral[length(ral)-1,bol]:=TMatrix.create;
+ rotierePunkt(ral[j,bol],i,bol,ral[length(ral)-1,bol]);
+ end;
+ bol:=false;
+ for k:=0 to length(ral)-2 do begin
+ M.assign(ral[k,false]);
+ M.minus(ral[length(ral)-1,false]);
+ if M.len<1e-6 then begin
+ M.assign(ral[k,true]);
+ M.minus(ral[length(ral)-1,true]);
+ if M.len<1e-6 then begin
+ bol:=true;
+ break;
+ end;
+ end;
+ end;
+ if bol then begin
+ ral[length(ral)-1,false].destroy;
+ ral[length(ral)-1,true].destroy;
+ setlength(ral,length(ral)-1);
+ end
+ else nsa:=true;
+ dec(j);
+ end;
+ dec(i);
+ end;
+ until not nsa;
+
+ for i:=0 to length(ral)-1 do begin
+ j:=length(Kanten)-1;
+ while j>=0 do begin
+ rotiereKante(j,i);
+ dec(j);
+ end;
+ end;
+
+ for i:=0 to 2*length(ral)-1 do
+ ral[i div 2,odd(i)].destroy;
+ setlength(ral,0);
+
+
+ M.destroy;
+ N.destroy;
+ end;
+ end{of Case};
+ M:=TMatrix.create;
+ M.assign0;
+ for i:=0 to length(Ecken)-1 do
+ M.plus(Ecken[i]);
+ M.times(-1/length(Ecken));
+ for i:=0 to length(Ecken)-1 do
+ Ecken[i].plus(M);
+ b:=0;
+ for i:=0 to length(Ecken)-1 do
+ b:=max(b,Ecken[i].len);
+ for i:=0 to length(Ecken)-1 do
+ Ecken[i].times(1/2/b);
+ M.Destroy;
+
+ for i:=0 to length(Kanten)-1 do
+ if Kanten[i].x>Kanten[i].y then begin
+ j:=Kanten[i].x;
+ Kanten[i].x:=Kanten[i].y;
+ Kanten[i].y:=j;
+ end;
+
+ for i:=0 to length(Kanten)-2 do begin
+ j:=i;
+ for k:=i+1 to length(Kanten)-1 do
+ if (Kanten[k].x<Kanten[j].x) or
+ ((Kanten[k].x=Kanten[j].x) and
+ (Kanten[k].y<Kanten[j].y)) then
+ j:=k;
+ if j>i then begin
+ k:=Kanten[j].x;
+ Kanten[j].x:=Kanten[i].x;
+ Kanten[i].x:=k;
+ k:=Kanten[j].y;
+ Kanten[j].y:=Kanten[i].y;
+ Kanten[i].y:=k;
+ end;
+ end;
+
+ SetZoom;
+end;
+
+procedure TForm1.CheckBox1Click(Sender: TObject);
+begin
+ ZeichenTimer.Enabled:=Checkbox1.Checked;
+ Image3.Visible:=not Checkbox1.Checked;
+end;
+
+procedure TForm1.CheckBox2Click(Sender: TObject);
+begin
+ ZeichenTimer.Interval:=30;
+end;
+
+procedure TForm1.KantenZeichnen(Pte: array of TPoint; PZ: array of extended; drawZ: boolean; drawTo: TCanvas);
+var i: integer;
+begin
+ if drawZ then
+ begin
+ for i:=0 to length(Kanten)-1 do
+ drawColoredLine(drawto,Pte[Kanten[i].X].X,Pte[Kanten[i].X].Y,PZ[Kanten[i].X],
+ Pte[Kanten[i].Y].X,Pte[Kanten[i].Y].Y,PZ[Kanten[i].Y]);
+ end
+ else
+ begin
+ for i:=0 to length(Kanten)-1 do
+ begin
+ drawto.MoveTo(Pte[Kanten[i].X].X,Pte[Kanten[i].X].Y);
+ drawto.LineTo(Pte[Kanten[i].Y].X,Pte[Kanten[i].Y].Y);
+ end;
+ end;
+end;
+
+procedure TForm1.drawColoredLine(wo: TCanvas; X1,Y1: Integer; Z1: extended; X2,Y2: Integer; Z2: Extended);
+var i: integer;
+ a,b,az,bz: extended;
+begin
+ if abs(X2-X1)>abs(Y1-Y2) then
+ begin
+ a:=(Y1-Y2)/(X1-X2);
+ b:=Y1-X1*a;
+ az:=(Z1-Z2)/(X1-X2);
+ bz:=Z1-X1*az;
+ if X1<X2 then
+ begin
+ for I:=X1 to X2 do
+ wo.Pixels[I,round(I*a + b)]:=farbVerlauf(I*az + bz);
+ end
+ else
+ begin
+ for I:=X2 to X1 do
+ wo.Pixels[I,round(I*a + b)]:=farbVerlauf(I*az + bz);
+ end;
+ end
+ else
+ begin
+ if Y1=Y2 then exit;
+ a:=(X1-X2)/(Y1-Y2);
+ b:=X1-Y1*a;
+ az:=(Z1-Z2)/(Y1-Y2);
+ bz:=Z1-Y1*az;
+ if Y1<Y2 then
+ begin
+ for I:=Y1 to Y2 do
+ wo.Pixels[round(I*a + b),I]:=farbVerlauf(I*az + bz);
+ end
+ else
+ begin
+ for I:=Y2 to Y1 do
+ wo.Pixels[round(I*a + b),I]:=farbVerlauf(I*az + bz);
+ end
+ end;
+end;
+
+function TForm1.farbVerlauf(x: Extended): TColor;
+begin
+ x:=5*x;
+ if x<1 then
+ begin
+ result:=min($FF,max($0,round($FF*x))) shl 16;
+ exit;
+ end;
+ x:=x-1;
+ if x<1 then
+ begin
+ result:=(min($FF,max($0,round($FF*(1-x)))) shl 16) or
+ (min($FF,max($0,round($FF*x))) shl 8);
+ exit;
+ end;
+ x:=x-1;
+ if x<1 then
+ begin
+ result:=$00FF00 or
+ min($FF,max($0,round($FF*x)));
+ exit;
+ end;
+ x:=x-1;
+ if x<1 then
+ begin
+ result:=$0000FF or
+ (min($FF,max($0,round($FF*(1-x)))) shl 8);
+ exit;
+ end;
+ x:=x-1;
+ result:=$0000FF or
+ (min($FF,max($0,round($FF*x))) shl 16);
+end;
+
+procedure TForm1.RotationInitialisieren;
+var z,s: integer;
+begin
+ Rot.xdim:=dim;
+ Rot.ydim:=dim;
+ repeat
+ for z:=0 to dim-1 do
+ for s:=0 to dim-1 do
+ Rot.a[z,s]:=0.01*random;
+ Rotation.assignId(dim);
+ Rotation.plus(Rot);
+ until Rotation.det>0;
+end;
+
+procedure TForm1.BeschlBelegen;
+var z,s: integer;
+ M: TMatrix;
+begin
+ M:=TMatrix.create;
+ M.xdim:=dim;
+ M.ydim:=dim;
+ repeat
+ for z:=0 to dim-1 do
+ for s:=0 to dim-1 do
+ M.a[z,s]:=0.02*random;
+ Beschl.assignId(dim);
+ Beschl.plus(M);
+ until Beschl.det>0;
+ Beschl.orthogonalize(true);
+ M.destroy;
+end;
+
+procedure TForm1.Drehen;
+begin
+ Rotation.assignId(dim);
+ Rotation.plus(Rot);
+ Rotation.orthogonalize(true);
+ Rot.times_(Beschl);
+ ProjektionL.times_(Rotation);
+ ProjektionR.times_(Rotation);
+end;
+
+procedure TForm1.Image3MouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+begin
+ Image3.Tag:=floor(Y*dim*(dim-1)/2/Image3.Height)+
+ X*((dim*(dim-1)) div 2);
+end;
+
+procedure TForm1.Image3MouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+begin
+ Image3.Tag:=-1;
+end;
+
+procedure TForm1.Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
+ Y: Integer);
+var M: TMatrix;
+ a1,a2: integer;
+const alpha = 2*pi/360 * 1;
+begin
+ if not(ssLeft in Shift) then exit;
+ Y:=Image3.Tag mod ((dim*(dim-1)) div 2);
+ X:=X - (Image3.Tag div ((dim*(dim-1)) div 2));
+ Image3.Tag:=Image3.Tag + X*((dim*(dim-1)) div 2);
+ M:=TMatrix.create;
+ M.assignId(dim);
+ a1:=0;
+ while Y>=0 do
+ begin
+ inc(a1);
+ Y:=Y-dim+a1;
+ end;
+ a2:=Y+dim;
+ dec(a1);
+ M.a[a1,a1]:=cos(alpha*X);
+ M.a[a1,a2]:=sin(alpha*X);
+ M.a[a2,a1]:=-sin(alpha*X);
+ M.a[a2,a2]:=cos(alpha*X);
+ ProjektionR.times_(M);
+ ProjektionL.times_(M);
+ M.destroy;
+ Zeichnen;
+end;
+
+procedure TForm1.Zeichnen;
+var Pkt: TMatrix;
+ Pkte: array[boolean] of array of TPoint;
+ PZ: array of extended;
+ i: integer;
+ b: boolean;
+ mi,ma: extended;
+begin
+ if length(Ecken)=0 then
+ exit;
+ setlength(Pkte[false],length(Ecken));
+ setlength(Pkte[true],length(Ecken));
+ setlength(PZ,length(Ecken));
+ for i:=0 to length(Pkte[false])-1 do
+ for b:=false to true do
+ begin
+ Pkt:=Ecken[i].duplicate;
+ if B then Pkt._times(ProjektionR)
+ else Pkt._times(ProjektionL);
+ PZ[i]:=Pkt.a[2,0];
+ Pkte[b,i]:=Pkt.asPoint(Zoom);
+ Pkte[b,i].x:=Pkte[b,i].x + Image1.Width div 2;
+ Pkte[b,i].y:=Pkte[b,i].y + Image1.Height div 2;
+ Pkt.destroy;
+ end;
+ mi:=PZ[0];
+ ma:=PZ[0];
+ for i:=0 to length(PZ)-1 do
+ begin
+ mi:=min(mi,PZ[i]);
+ ma:=max(ma,PZ[i]);
+ end;
+ ma:=max(ma,mi+0.00001);
+ for i:=0 to length(PZ)-1 do
+ PZ[i]:=(PZ[i]-mi)/(ma-mi);
+ Image1.Canvas.Rectangle(-10,-10,Image1.Width+10,Image1.Height+10);
+ KantenZeichnen(Pkte[true],PZ,false,Image1.Canvas);
+ Image2.Canvas.Rectangle(-10,-10,Image2.Width+10,Image2.Height+10);
+ KantenZeichnen(Pkte[false],PZ,false,Image2.Canvas);
+end;
+
+procedure TForm1.FormResize(Sender: TObject);
+var L,T: integer;
+begin
+ L:=Image1.Left;
+ T:=Image1.Top;
+ Image1.Free;
+ Image2.Free;
+ Image1:=TImage.Create(Form1);
+ Image2:=TImage.Create(Form1);
+ Image1.Parent:=Form1;
+ Image2.Parent:=Form1;
+ Image1.Left:=L;
+ Image1.Top:=T;
+ Image2.Top:=T;
+ Image1.Width:=min(Form1.ClientHeight-Image1.Top,(Form1.ClientWidth-Image1.Left) div 2);
+ Image1.Height:=Image1.Width;
+ Image2.Width:=Image1.Width;
+ Image2.Height:=Image2.Width;
+ Image2.Left:=Image1.Left+Image1.Width;
+ Progressbar1.Width:=Form1.Clientwidth-Progressbar1.Left;
+ SetZoom;
+ Zeichnen;
+end;
+
+procedure TForm1.SetZoom;
+begin
+ case Koerp of
+ 0: Zoom:=min(Image1.Width,Image1.Height)*0.9;
+ 1: Zoom:=min(Image1.Width,Image1.Height)*0.9;
+ end{of Case};
+end;
+
+procedure TForm1.RadioGroup1Click(Sender: TObject);
+var i: integer;
+begin
+ if Koerp = Radiogroup1.ItemIndex then exit;
+ Koerp:=RadioGroup1.ItemIndex;
+
+ for i:=0 to length(Ecken)-1 do
+ Ecken[i].destroy;
+ ProjektionenBelegen;
+ RotationInitialisieren;
+ BeschlBelegen;
+ KoerperErzeugen;
+ Image3.Canvas.Brush.Color:=Form1.Color;
+ Image3.Canvas.Rectangle(-10,-10,Image3.Width+10,Image3.Height+10);
+ For i:=1 to (dim*(dim-1)) div 2 do
+ begin
+ Image3.Canvas.MoveTo(10,round((I-0.5)*(Image3.Height*2/(dim*(dim-1)))));
+ Image3.Canvas.LineTo(Image3.Width-10,round((I-0.5)*(Image3.Height*2/(dim*(dim-1)))));
+ end;
+// Drehen;
+// BeschlBelegen;
+ Zeichnen;
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ Form2.Showmodal;
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+var M: TMatrix;
+ I,J,K,L,N: Longint;
+ B: Boolean;
+ Memo1: TMemo;
+ s: String;
+ x: extended;
+ fcs: array of Longint;
+begin
+ M:=TMatrix.create;
+ M.xdim:=length(Kanten)-3;
+ for I:=0 to length(Kanten)-1 do begin
+ B:=Kanten[I].x=Kanten[I].y;
+ for J:=0 to I-1 do
+ B:=B or ((Kanten[I].X=Kanten[J].X) and (Kanten[I].Y=Kanten[J].Y))
+ or ((Kanten[I].X=Kanten[J].Y) and (Kanten[I].Y=Kanten[J].X));
+ if B then M.xdim:=M.xdim-1;
+ end;
+ M.ydim:=3*length(Ecken)-9;
+ if M.xdim<>M.ydim then begin
+ if MessageDlg(
+ 'Die Anzahl der Randbedingungen ('
+ +inttostr(M.xdim)+
+ ') unterscheidet sich von der Anzahl der Freiheitsgrade ('
+ +inttostr(M.ydim)+
+ ')! Genauere Erklärung gewünscht?',mterror,[mbYes,mbNo],0) = mrYes then begin
+ Memo1:=TMemo.Create(Form1);
+ Memo1.Parent:=Form1;
+ Memo1.Left:=Image1.Left;
+ Memo1.Top:=Image1.Top;
+ Memo1.Width:=Form1.ClientWidth-Memo1.Left;
+ Memo1.Height:=Form1.ClientHeight-Memo1.Top;
+ Memo1.Lines.Clear;
+ x:=0;
+ for I:=0 to length(Ecken)-1 do
+ x:=max(x,Ecken[I].len);
+ s:='';
+ for I:=0 to length(Kanten)-1 do
+ s:=s+' '+inttostr(Kanten[I].x)+'-'+inttostr(Kanten[I].y);
+ delete(s,1,1);
+ Memo1.Lines.Add(s);
+ Memo1.Lines.Add('');
+ s:='';
+ for I:=0 to length(Ecken)-1 do
+ if Ecken[I].len>=0.98*x then
+ s:=s+' '+inttostr(I);
+ delete(s,1,1);
+ Memo1.Lines.Add(s);
+ Memo1.Lines.Add('');
+ s:='';
+ for I:=0 to length(Kanten)-1 do
+ if (Ecken[Kanten[I].x].len>=0.98*x) or
+ (Ecken[Kanten[I].y].len>=0.98*x) then
+ s:=s+' '+inttostr(Kanten[I].x)+'-'+inttostr(Kanten[I].y);
+ delete(s,1,1);
+ Memo1.Lines.Add(s);
+ Memo1.Lines.Add('');
+ s:='';
+ for i:=0 to length(Ecken)-1 do
+ if Ecken[I].len>=0.98*x then begin
+ s:=s+' '+inttostr(i)+':';
+ for j:=0 to length(Kanten)-1 do
+ if (Kanten[j].x=i) or (Kanten[j].y=i) then
+ s:=s+inttostr(Kanten[j].x+Kanten[j].y-i)+',';
+ delete(s,length(s),1);
+ end;
+ delete(s,1,1);
+ Memo1.Lines.Add(s);
+ Application.ProcessMessages;
+ MessageDlg('Memo schließen.',mtInformation,[mbOk],0);
+ Memo1.Free;
+ end;
+ exit;
+ end;
+ M.assign0;
+
+ case Radiogroup1.ItemIndex of
+ 0: begin
+ // Ecken 1,6,11
+ setlength(fcs,3);
+ fcs[0]:=1;
+ fcs[1]:=6;
+ fcs[2]:=11;
+ end;
+ 1: begin
+ // Ecken 0,1,16
+ setlength(fcs,3);
+ fcs[0]:=0;
+ fcs[1]:=1;
+ fcs[2]:=16;
+ end;
+ end{of case};
+
+ j:=0;
+ for i:=0 to length(Kanten)-1 do begin
+ K:=Kanten[i].x;
+ L:=Kanten[i].y;
+ for N:=length(fcs)-1 downto 0 do begin
+ if fcs[N]=K then K:=-1;
+ if fcs[N]=L then L:=-1;
+ if K>=fcs[N] then dec(K);
+ if L>=fcs[N] then dec(L);
+ end;
+ if K<>-1 then
+ for N:=0 to 2 do
+ M.a[j,3*K+N]:=
+ M.a[j,3*K+N]
+ + Ecken[Kanten[i].x].a[N,0]
+ - Ecken[Kanten[i].y].a[N,0];
+ if L<>-1 then
+ for N:=0 to 2 do
+ M.a[j,3*L+N]:=
+ M.a[j,3*L+N]
+ + Ecken[Kanten[i].y].a[N,0]
+ - Ecken[Kanten[i].x].a[N,0];
+ if (K<>-1) or (L<>-1) then inc(j);
+ end;
+
+ M.Progressbar:=Progressbar1;
+ Messagedlg('det M = '+floattostr(M.det(dmGauss)),mtInformation,[mbOk],0);
+ M.Free;
+end;
+
+procedure TForm1.Button3Click(Sender: TObject);
+var I,J,K,L: Longint;
+ x: extended;
+begin
+ x:=0;
+ for I:=0 to length(Ecken)-1 do
+ x:=max(x,Ecken[I].len);
+ I:=length(Ecken)-1;
+ while I>=0 do begin
+ if Ecken[I].len>=0.98*x then begin
+ for J:=I+1 to length(Ecken)-1 do
+ Ecken[J-1].assign(Ecken[J]);
+ Ecken[length(Ecken)-1].Free;
+ setlength(Ecken,length(Ecken)-1);
+ J:=length(Kanten)-1;
+ L:=0;
+ while J>=0 do begin
+ if (Kanten[J].x=I) or (Kanten[J].y=I) then begin
+ inc(L);
+ for K:=J+1 to length(Kanten)-1 do
+ Kanten[K-1]:=Kanten[K];
+ setlength(Kanten,length(Kanten)-1);
+ end
+ else begin
+ if Kanten[J].x>I then dec(Kanten[J].x);
+ if Kanten[J].y>I then dec(Kanten[J].y);
+ end;
+ dec(J);
+ end;
+ if L<>4 then Form1.Caption:=Form1.Caption+' '+inttostr(L);
+ end;
+ dec(I);
+ end;
+ x:=0;
+ for I:=0 to length(Ecken)-1 do
+ x:=max(x,Ecken[I].len);
+ for i:=0 to length(Ecken)-1 do
+ Ecken[i].times(1/2/x);
+ Zeichnen;
+end;
+
+procedure TForm1.Button4Click(Sender: TObject);
+const mindim = 4;
+ maxdim = 9;
+var M: TMatrix;
+ dm: TDetMethode;
+ I,J,K,L: Longint;
+ ts,errs: array[mindim..maxdim,TDetMethode] of extended;
+ t1,t2: extended;
+ s: string;
+begin
+ M:=TMatrix.create;
+ t2:=0;
+ for I:=mindim to maxdim do begin
+ for dm:=low(dm) to high(dm) do begin
+ ts[I,dm]:=0;
+ errs[I,dm]:=0;
+ end;
+ for J:=1 to 50 do begin
+ M.assignId(I);
+ for K:=0 to I-1 do
+ for L:=0 to I-1 do
+ if random*50<=J then
+ M.a[K,L]:=M.a[K,L]+random-0.5;
+ for dm:=low(dm) to high(dm) do begin
+ ts[I,dm]:=ts[I,dm]-now;
+ t1:=M.det(dm);
+ ts[I,dm]:=ts[I,dm]+now;
+ if dm=low(dm) then t2:=t1;
+ errs[I,dm]:=sqr(t1-t2);
+ end;
+ end;
+ end;
+ M.Free;
+ s:='';
+ for i:=mindim to maxdim do begin
+ s:=s+inttostr(i)+': ';
+ for dm:=low(dm) to high(dm) do
+ s:=s+floattostr(errs[i,dm])+' '+floattostr(ts[i,dm]*24*60*60)+';';
+ delete(s,length(s),1);
+ s:=s+#13;
+ end;
+ delete(s,length(s),1);
+ Messagedlg(s,mtinformation,[mbOk],0);
+end;
+
+end.
+
diff --git a/unit2.lfm b/unit2.lfm
new file mode 100644
index 0000000..18cdc54
--- /dev/null
+++ b/unit2.lfm
@@ -0,0 +1,18 @@
+object Form2: TForm2
+ Left = 390
+ Height = 533
+ Top = 355
+ Width = 779
+ Caption = 'Form2'
+ ClientHeight = 533
+ ClientWidth = 779
+ DesignTimePPI = 107
+ OnActivate = FormActivate
+ LCLVersion = '2.0.12.0'
+ object Image1: TImage
+ Left = 8
+ Height = 472
+ Top = 48
+ Width = 757
+ end
+end
diff --git a/unit2.pas b/unit2.pas
new file mode 100644
index 0000000..a870b32
--- /dev/null
+++ b/unit2.pas
@@ -0,0 +1,38 @@
+unit Unit2;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
+
+type
+
+ { TForm2 }
+
+ TForm2 = class(TForm)
+ Image1: TImage;
+ procedure FormActivate(Sender: TObject);
+ private
+
+ public
+
+ end;
+
+var
+ Form2: TForm2;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm2 }
+
+procedure TForm2.FormActivate(Sender: TObject);
+begin
+ //
+end;
+
+end.
+
diff --git a/vecmath.pas b/vecmath.pas
new file mode 100644
index 0000000..5e374dd
--- /dev/null
+++ b/vecmath.pas
@@ -0,0 +1,538 @@
+unit vecMath;
+
+interface
+
+uses math, Types, SysUtils, ComCtrls;
+
+Type TDetMethode = (dmLaPlace,dmLaPlace0,dmGauss);
+ TMatrix = class
+ private
+ _zanz,_sanz: integer;
+ Komps: array of array of extended; // [zeile,spalte]
+ procedure wsanz(sanz: integer);
+ procedure wzanz(zanz: integer);
+ function ra(z,s: integer): extended;
+ procedure wa(z,s: integer; _a: extended);
+ function rPart(l,t,r,b: integer): TMatrix;
+ public
+ Progressbar: TProgressbar;
+ property xdim: integer read _sanz
+ write wsanz;
+ property ydim: integer read _zanz
+ write wzanz;
+ property a[z,s: integer]: extended read ra
+ write wa;
+ property part[l,t,r,b: integer]: TMatrix read rPart;
+ constructor create;
+ destructor destroy; override;
+ function asPoint: TPoint; overload;
+ function asPoint(scale: extended): TPoint; overload;
+ procedure assign(M: TMatrix);
+ procedure assignId(dim: integer);
+ procedure assign0;
+ function duplicate: TMatrix;
+ procedure plus(M: TMatrix);
+ procedure minus(M: TMatrix);
+ procedure times(x: extended);
+ procedure times_(R: TMatrix);
+ procedure _times(L: TMatrix);
+ procedure cross(M: TMatrix);
+ function det: extended; overload;
+ function det(methode: TDetMethode): extended; overload;
+ function det_laPlace(spare_optimize: boolean): extended;
+ function det_gauss: extended;
+ procedure transp;
+ procedure orthogonalize; overload;
+ procedure orthogonalize(normalize: boolean); overload;
+ function len: extended; // only for vectors!
+ function zlen(z: integer): extended;
+ function slen(s: integer): extended;
+ function toStr: string;
+ function fromString(str: string): boolean;
+ end;
+
+implementation
+
+function istZahl(str: string): boolean;
+var hK: boolean;
+begin
+ result:=false;
+ if length(str)=0 then exit;
+ hK:=false;
+ if str[1]='-' then delete(str,1,1);
+ if length(str)=0 then exit;
+ if not (str[1] in ['0'..'9']) then exit;
+ while (length(str)>0) and ((str[1] in ['0'..'9']) or
+ ((str[1] = ',') and not hK)) do
+ begin
+ hK:=hK or (str[1]=',');
+ delete(str,1,1);
+ end;
+ result:=length(str)=0;
+end;
+
+procedure TMatrix.wsanz(sanz: integer);
+var i: integer;
+begin
+ if sanz>=0 then _sanz:=sanz;
+ setlength(Komps,_zanz);
+ for i:=0 to _zanz-1 do
+ setlength(Komps[i],_sanz);
+end;
+
+procedure TMatrix.wzanz(zanz: integer);
+var i: integer;
+begin
+ if zanz>=0 then _zanz:=zanz;
+ setlength(Komps,_zanz);
+ for i:=0 to _zanz-1 do
+ setlength(Komps[i],_sanz);
+end;
+
+function TMatrix.ra(z,s: integer): extended;
+begin
+ if (z>=0) and (z<_zanz) and
+ (s>=0) and (s<_sanz) then result:=Komps[z,s]
+ else result:=0;
+end;
+
+procedure TMatrix.wa(z,s: integer; _a: extended);
+begin
+ if (z>=0) and (z<_zanz) and
+ (s>=0) and (s<_sanz) then Komps[z,s]:=_a;
+end;
+
+function TMatrix.rPart(l,t,r,b: integer): TMatrix;
+var z,s: integer;
+begin
+ l:=max(l,0);
+ t:=max(t,0);
+ r:=max(l,r);
+ b:=max(t,b);
+ r:=min(r,xdim-1);
+ b:=min(b,ydim-1);
+ result:=TMatrix.create;
+ result.ydim:=b-t+1;
+ result.xdim:=r-l+1;
+ for z:=t to b do
+ for s:=l to r do
+ result.a[z-t,s-l]:=a[z,s];
+end;
+
+constructor TMatrix.create;
+begin
+ inherited create;
+ _zanz:=3;
+ xdim:=1;
+ Progressbar:=nil;
+end;
+
+destructor TMatrix.destroy;
+begin
+ inherited destroy;
+end;
+
+function TMatrix.asPoint: TPoint;
+begin
+ result:=asPoint(1);
+end;
+
+function TMatrix.asPoint(scale: extended): TPoint;
+begin
+ if xdim>ydim then result:=Point(round(a[0,0]*scale),
+ round(a[0,1]*scale))
+ else result:=Point(round(a[0,0]*scale),
+ round(a[1,0]*scale));
+end;
+
+procedure TMatrix.assign(M: TMatrix);
+var z,s: Integer;
+begin
+ ydim:=M.ydim;
+ xdim:=M.xdim;
+ for z:=0 to ydim-1 do
+ for s:=0 to xdim-1 do
+ a[z,s]:=M.a[z,s];
+end;
+
+function TMatrix.duplicate: TMatrix;
+begin
+ Result:=TMatrix.create;
+ Result.assign(self);
+end;
+
+procedure TMatrix.plus(M: TMatrix);
+var z,s: Integer;
+begin
+ if (M.xdim = xdim) and
+ (M.ydim = ydim) then
+ for z:=0 to ydim-1 do
+ for s:=0 to xdim-1 do
+ a[z,s]:=a[z,s]+M.a[z,s];
+end;
+
+procedure TMatrix.minus(M: TMatrix);
+var z,s: Integer;
+begin
+ if (M.xdim = xdim) and
+ (M.ydim = ydim) then
+ for z:=0 to ydim-1 do
+ for s:=0 to xdim-1 do
+ a[z,s]:=a[z,s]-M.a[z,s];
+end;
+
+procedure TMatrix.times(x: extended);
+var z,s: Integer;
+begin
+ for z:=0 to ydim-1 do
+ for s:=0 to xdim-1 do
+ a[z,s]:=x*a[z,s];
+end;
+
+function TMatrix.det: extended;
+begin
+ result:=det_laPlace(true);
+end;
+
+function TMatrix.det(methode: TDetMethode): extended;
+begin
+ case methode of
+ dmLaPlace: result:=det_laPlace(false);
+ dmLaPlace0: result:=det_laPlace(true);
+ dmGauss: result:=det_gauss;
+ else result:=-1;
+ end{of case};
+end;
+
+function TMatrix.det_laPlace(spare_optimize: boolean): extended;
+var p: array of Integer;
+ i,j,k,
+ tiefe: Integer;
+ tmp: extended;
+ UT: boolean;
+begin
+ result:=0;
+ if xdim<>ydim then exit;
+ setlength(p,xdim);
+ for i:=0 to xdim-1 do
+ p[i]:=i;
+ if assigned(Progressbar) then begin
+ Progressbar.Position:=0;
+ Progressbar.Min:=0;
+ Progressbar.Max:=1;
+ tiefe:=-1;
+ repeat
+ inc(tiefe);
+ i:=0;
+ for j:=0 to xdim-1 do
+ if a[tiefe,j]<>0 then inc(i);
+ Progressbar.Max:=
+ Progressbar.Max*i;
+ until (Progressbar.Max>=100) or (tiefe>=xdim-1);
+ Progressbar.Step:=1;
+ Progressbar.Visible:=true;
+ end
+ else tiefe:=-2;
+ repeat
+ tmp:=1;
+ for i:=0 to xdim-1 do
+ begin
+ for j:=i+1 to xdim-1 do
+ if p[i]>p[j] then tmp:=-tmp;
+ tmp:=tmp*a[i,p[i]];
+ end;
+ result:=result+tmp;
+ if spare_optimize then begin
+ i:=0;
+ while (i<xdim-1) and (a[i,p[i]]<>0) do
+ inc(i);
+ for j:=i+1 to xdim-1 do
+ p[j]:=-1;
+ end
+ else
+ i:=xdim-1;
+ UT:=true;
+ while UT and (i>=0) do
+ begin
+ repeat
+ inc(p[i]);
+ UT:=spare_optimize and (p[i]<xdim) and (a[i,p[i]]=0);
+ for j:=0 to i-1 do
+ UT:=UT or (p[i]=p[j]);
+ until not UT;
+ if p[i]>=xdim then
+ begin
+ for j:=i to xdim-1 do
+ p[i]:=-1;
+ dec(i);
+ UT:=true;
+ end;
+ end;
+ if i<=tiefe then
+ Progressbar.StepIt;
+ if i>=0 then
+ for j:=i+1 to xdim-1 do
+ repeat
+ inc(p[j]);
+ UT:=false;
+ for k:=0 to j-1 do
+ UT:=UT or (p[j]=p[k]);
+ until not UT;
+ until UT and (i<0);
+ if assigned(Progressbar) then
+ Progressbar.Visible:=false;
+end;
+
+function TMatrix.det_gauss: extended;
+var M: TMatrix;
+ I,J,K: Longint;
+ tmp,fak: extended;
+ vz: Longint;
+begin
+ result:=0;
+ if xdim<>ydim then exit;
+ M:=TMatrix.create;
+ M.assign(self);
+ vz:=1;
+ for I:=xdim-1 downto 0 do begin
+ J:=I;
+ while (J>=0) and (M.a[I,J]=0) do
+ dec(J);
+ if J<0 then begin
+ result:=0;
+ M.free;
+ exit;
+ end;
+ if J<>I then
+ for K:=0 to xdim-1 do begin
+ tmp:=M.a[K,I];
+ M.a[K,I]:=M.a[K,J];
+ M.a[K,J]:=tmp;
+ vz:=-vz;
+ end;
+ for J:=I-1 downto 0 do begin
+ fak:=M.a[J,I]/M.a[I,I];
+ for K:=0 to xdim-1 do
+ M.a[J,K]:=M.a[J,K] - fak * M.a[I,K];
+ end;
+ end;
+ result:=vz;
+ for I:=0 to xdim-1 do
+ result:=result*M.a[I,I];
+ M.free;
+end;
+
+procedure TMatrix.transp;
+var xd,yd,z,s: integer;
+ tmp: extended;
+begin
+ xd:=ydim;
+ yd:=xdim;
+ xdim:=max(xd,yd);
+ ydim:=max(xd,yd);
+ for z:=0 to ydim-1 do
+ for s:=z+1 to xdim-1 do
+ begin
+ tmp:=a[z,s];
+ a[z,s]:=a[s,z];
+ a[s,z]:=tmp;
+ end;
+ xdim:=xd;
+ ydim:=yd;
+end;
+
+function TMatrix.toStr: string;
+var z,s: integer;
+begin
+ result:='';
+ for z:=0 to ydim-1 do
+ begin
+ result:=result+#$0D#$0A;
+ for s:=0 to xdim-1 do
+ result:=result+floattostr(a[z,s])+' ';
+ delete(result,length(result),1);
+ end;
+ delete(result,1,2);
+end;
+
+function TMatrix.fromString(str: string): boolean;
+var str2: string;
+ z,s,i: integer;
+begin
+ result:=false;
+ if length(str)=0 then exit;
+ i:=length(str);
+ if str[length(str)]<>#13 then str:=str+#13;
+ while pos(#$0A,str)>0 do
+ delete(str,pos(#$0A,str),1);
+ while (i>0) do
+ begin
+ if str[i]=#13 then str:=copy(str,1,i-1)+' '+copy(str,i,length(str)+1-i);
+ dec(i);
+ end;
+ str2:=str;
+ for z:=0 to ydim-1 do
+ begin
+ for s:=0 to xdim-1 do
+ begin
+ while (length(str)>0) and (str[1]=' ') do
+ delete(str,1,1);
+ if pos(' ',str)=0 then exit;
+ if not istZahl(copy(str,1,pos(' ',str)-1)) then exit;
+ delete(str,1,pos(' ',str));
+ while (length(str)>0) and (str[1]=' ') do
+ delete(str,1,1);
+ end;
+ if (length(str)=0) or not (str[1]=#$0D) then exit;
+ delete(str,1,1);
+ end;
+ result:=true;
+ for z:=0 to ydim-1 do
+ begin
+ for s:=0 to xdim-1 do
+ begin
+ while (length(str2)>0) and (str2[1]=' ') do
+ delete(str2,1,1);
+ if pos(' ',str2)=0 then exit;
+ a[z,s]:=strtofloat(copy(str2,1,pos(' ',str2)-1));
+ delete(str2,1,pos(' ',str2));
+ while (length(str2)>0) and (str2[1]=' ') do
+ delete(str2,1,1);
+ end;
+ if (length(str2)=0) or not (str2[1]=#$0D) then exit;
+ delete(str2,1,1);
+ end;
+end;
+
+procedure TMatrix.times_(R: TMatrix);
+var L: TMatrix;
+ z,s,i: integer;
+begin
+ if R.ydim<>xdim then exit;
+ L:=duplicate;
+ xdim:=R.xdim;
+ for z:=0 to ydim-1 do
+ for s:=0 to xdim-1 do
+ begin
+ a[z,s]:=0;
+ for i:=0 to R.ydim-1 do
+ a[z,s]:=a[z,s] + L.a[z,i]*R.a[i,s];
+ end;
+end;
+
+procedure TMatrix._times(L: TMatrix);
+var R: TMatrix;
+ z,s,i: integer;
+begin
+ if ydim<>L.xdim then exit;
+ R:=duplicate;
+ ydim:=L.ydim;
+ for z:=0 to ydim-1 do
+ for s:=0 to xdim-1 do
+ begin
+ a[z,s]:=0;
+ for i:=0 to R.ydim-1 do
+ a[z,s]:=a[z,s] + L.a[z,i]*R.a[i,s];
+ end;
+end;
+
+procedure TMatrix.cross(M: TMatrix);
+var x,y,z: extended;
+begin
+ if (xdim<>1) or (M.xdim<>1) or (ydim<>3) or (M.ydim<>3) then exit; // ziemlich speziell ...
+ x:=a[1,0]*M.a[2,0]-a[2,0]*M.a[1,0];
+ y:=a[2,0]*M.a[0,0]-a[0,0]*M.a[2,0];
+ z:=a[0,0]*M.a[1,0]-a[1,0]*M.a[0,0];
+ a[0,0]:=x;
+ a[1,0]:=y;
+ a[2,0]:=z;
+end;
+
+procedure TMatrix.orthogonalize;
+begin
+ orthogonalize(false);
+end;
+
+procedure TMatrix.orthogonalize(normalize: boolean);
+var zT,z,s: integer;
+ diff,me,opp: TMatrix;
+ l: extended;
+begin
+ if det=0 then exit;
+
+ diff:=TMatrix.create;
+ diff.xdim:=xdim;
+ diff.ydim:=1;
+ for zT:=0 to ydim-1 do
+ begin
+ diff.assign0;
+ for z:=0 to zT-1 do
+ begin
+ me:=part[0,zT,xdim-1,zT];
+ l:=me.len;
+ me.transp;
+ opp:=part[0,z,xdim-1,z];
+ me._times(opp);
+ l:=me.a[0,0]/l;
+ me.destroy;
+ opp.times(l);
+ diff.plus(opp);
+ opp.destroy;
+ end;
+ for s:=0 to xdim-1 do
+ a[zT,s]:=a[zT,s]-diff.a[0,s];
+ if normalize then
+ begin
+ me:=part[0,zT,xdim-1,zT];
+ l:=me.len;
+ me.destroy;
+ for s:=0 to xdim-1 do
+ a[zT,s]:=a[zT,s]/l;
+ end;
+ end;
+end;
+
+procedure TMatrix.assignId(dim: integer);
+var z,s: integer;
+begin
+ if dim<1 then exit;
+ xdim:=dim;
+ ydim:=dim;
+ for z:=0 to dim-1 do
+ for s:=0 to dim-1 do
+ a[z,s]:=byte(z=s);
+end;
+
+procedure TMatrix.assign0;
+var z,s: integer;
+begin
+ for z:=0 to ydim-1 do
+ for s:=0 to xdim-1 do
+ a[z,s]:=0;
+end;
+
+function TMatrix.len: extended;
+begin
+ if xdim=1 then result:=slen(0)
+ else result:=zlen(0);
+end;
+
+function TMatrix.zlen(z: integer): extended;
+var s: integer;
+begin
+ result:=0;
+ for s:=0 to xdim-1 do
+ result:=result + sqr(a[z,s]);
+ result:=sqrt(result);
+end;
+
+function TMatrix.slen(s: integer): extended;
+var z: integer;
+begin
+ result:=0;
+ for z:=0 to ydim-1 do
+ result:=result + sqr(a[z,s]);
+ result:=sqrt(result);
+end;
+
+end.
diff --git a/weihnachtsstern.ico b/weihnachtsstern.ico
new file mode 100644
index 0000000..0341321
--- /dev/null
+++ b/weihnachtsstern.ico
Binary files differ
diff --git a/weihnachtsstern.lpi b/weihnachtsstern.lpi
new file mode 100644
index 0000000..4f33e80
--- /dev/null
+++ b/weihnachtsstern.lpi
@@ -0,0 +1,91 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+ <ProjectOptions>
+ <Version Value="11"/>
+ <General>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <Title Value="weihnachtsstern"/>
+ <Scaled Value="True"/>
+ <ResourceType Value="res"/>
+ <UseXPManifest Value="True"/>
+ <XPManifest>
+ <DpiAware Value="True"/>
+ </XPManifest>
+ <Icon Value="0"/>
+ </General>
+ <BuildModes Count="1">
+ <Item1 Name="Default" Default="True"/>
+ </BuildModes>
+ <PublishOptions>
+ <Version Value="2"/>
+ <UseFileFilters Value="True"/>
+ </PublishOptions>
+ <RunParams>
+ <FormatVersion Value="2"/>
+ <Modes Count="0"/>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="LCL"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="4">
+ <Unit0>
+ <Filename Value="weihnachtsstern.lpr"/>
+ <IsPartOfProject Value="True"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="unit1.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="Form1"/>
+ <HasResources Value="True"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="Unit1"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="vecmath.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="vecMath"/>
+ </Unit2>
+ <Unit3>
+ <Filename Value="unit2.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="Form2"/>
+ <HasResources Value="True"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="Unit2"/>
+ </Unit3>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="11"/>
+ <Target>
+ <Filename Value="weihnachtsstern"/>
+ </Target>
+ <SearchPaths>
+ <IncludeFiles Value="$(ProjOutDir)"/>
+ <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+ </SearchPaths>
+ <Linking>
+ <Options>
+ <Win32>
+ <GraphicApplication Value="True"/>
+ </Win32>
+ </Options>
+ </Linking>
+ </CompilerOptions>
+ <Debugging>
+ <Exceptions Count="3">
+ <Item1>
+ <Name Value="EAbort"/>
+ </Item1>
+ <Item2>
+ <Name Value="ECodetoolError"/>
+ </Item2>
+ <Item3>
+ <Name Value="EFOpenError"/>
+ </Item3>
+ </Exceptions>
+ </Debugging>
+</CONFIG>
diff --git a/weihnachtsstern.lpr b/weihnachtsstern.lpr
new file mode 100644
index 0000000..f96dbfe
--- /dev/null
+++ b/weihnachtsstern.lpr
@@ -0,0 +1,23 @@
+program weihnachtsstern;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, Unit1, vecMath, Unit2
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource:=True;
+ Application.Scaled:=True;
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.CreateForm(TForm2, Form2);
+ Application.Run;
+end.
+
diff --git a/weihnachtsstern.lps b/weihnachtsstern.lps
new file mode 100644
index 0000000..c9772ec
--- /dev/null
+++ b/weihnachtsstern.lps
@@ -0,0 +1,176 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+ <ProjectSession>
+ <Version Value="11"/>
+ <BuildModes Active="Default"/>
+ <Units Count="4">
+ <Unit0>
+ <Filename Value="weihnachtsstern.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <EditorIndex Value="-1"/>
+ <WindowIndex Value="-1"/>
+ <TopLine Value="-1"/>
+ <CursorPos X="-1" Y="-1"/>
+ <UsageCount Value="21"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="unit1.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="Form1"/>
+ <HasResources Value="True"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="Unit1"/>
+ <TopLine Value="666"/>
+ <CursorPos X="47" Y="882"/>
+ <UsageCount Value="21"/>
+ <Loaded Value="True"/>
+ <LoadedDesigner Value="True"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="vecmath.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="vecMath"/>
+ <EditorIndex Value="2"/>
+ <TopLine Value="23"/>
+ <CursorPos X="30" Y="36"/>
+ <UsageCount Value="21"/>
+ <Loaded Value="True"/>
+ </Unit2>
+ <Unit3>
+ <Filename Value="unit2.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="Form2"/>
+ <HasResources Value="True"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="Unit2"/>
+ <IsVisibleTab Value="True"/>
+ <EditorIndex Value="1"/>
+ <TopLine Value="6"/>
+ <CursorPos X="4" Y="34"/>
+ <UsageCount Value="21"/>
+ <Loaded Value="True"/>
+ <LoadedDesigner Value="True"/>
+ </Unit3>
+ </Units>
+ <JumpHistory Count="29" HistoryIndex="28">
+ <Position1>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="807" Column="10" TopLine="782"/>
+ </Position1>
+ <Position2>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="819" Column="8" TopLine="788"/>
+ </Position2>
+ <Position3>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="909" Column="2" TopLine="907"/>
+ </Position3>
+ <Position4>
+ <Filename Value="unit2.pas"/>
+ </Position4>
+ <Position5>
+ <Filename Value="unit2.pas"/>
+ <Caret Line="35" Column="3" TopLine="7"/>
+ </Position5>
+ <Position6>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="90" Column="25" TopLine="73"/>
+ </Position6>
+ <Position7>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="51" Column="10" TopLine="36"/>
+ </Position7>
+ <Position8>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="90" Column="26" TopLine="64"/>
+ </Position8>
+ <Position9>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="91" Column="8" TopLine="65"/>
+ </Position9>
+ <Position10>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="101" Column="17" TopLine="75"/>
+ </Position10>
+ <Position11>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="171" Column="19" TopLine="154"/>
+ </Position11>
+ <Position12>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="172" Column="18" TopLine="154"/>
+ </Position12>
+ <Position13>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="178" Column="17" TopLine="154"/>
+ </Position13>
+ <Position14>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="180" Column="29" TopLine="154"/>
+ </Position14>
+ <Position15>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="182" Column="20" TopLine="182"/>
+ </Position15>
+ <Position16>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="186" Column="28" TopLine="180"/>
+ </Position16>
+ <Position17>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="187" Column="35" TopLine="180"/>
+ </Position17>
+ <Position18>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="188" Column="12" TopLine="180"/>
+ </Position18>
+ <Position19>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="189" Column="12" TopLine="180"/>
+ </Position19>
+ <Position20>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="192" Column="31" TopLine="180"/>
+ </Position20>
+ <Position21>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="593" Column="15" TopLine="572"/>
+ </Position21>
+ <Position22>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="640" Column="9" TopLine="622"/>
+ </Position22>
+ <Position23>
+ <Filename Value="unit1.pas"/>
+ </Position23>
+ <Position24>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="63" Column="17" TopLine="38"/>
+ </Position24>
+ <Position25>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="112" Column="10" TopLine="86"/>
+ </Position25>
+ <Position26>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="810" Column="10" TopLine="785"/>
+ </Position26>
+ <Position27>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="833" Column="31" TopLine="808"/>
+ </Position27>
+ <Position28>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="56" Column="9" TopLine="41"/>
+ </Position28>
+ <Position29>
+ <Filename Value="unit1.pas"/>
+ <Caret Line="833" Column="32" TopLine="807"/>
+ </Position29>
+ </JumpHistory>
+ <RunParams>
+ <FormatVersion Value="2"/>
+ <Modes Count="0" ActiveMode=""/>
+ </RunParams>
+ </ProjectSession>
+</CONFIG>
diff --git a/weihnachtsstern.res b/weihnachtsstern.res
new file mode 100644
index 0000000..1adb040
--- /dev/null
+++ b/weihnachtsstern.res
Binary files differ