1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:

procedure TForm1.Button1Click(Sender: TObject);
var
    bitmap,bitmap2,bitmapz:tbitmap;
    T1,T0 : TDatetime;
    rect:trect;
    P : PByteArray;
    p2: ^byte;
    p3,px: ^byte;

    i,j,n,k,waagerecht,senkrecht,bmw:integer;
    xm,ym:integer;
    bbinv,
    xk,yk,q,xi,yi,sq:single;

procedure ladejpg(const FileName: String; Bild: TBitMap);
var Jpeg: TJpegImage;
begin
  Jpeg:=TJpegImage.Create;
  jpeg.LoadFromFile(filename);
  Bild.Assign(Jpeg);
  jpeg.free;
end;
begin

   ladejpg(ExtractFilePath(application.ExeName)+combobox1.text+'.jpg',image1.Picture.Bitmap);
   application.ProcessMessages;

   //Verschiebung des Spiegelsmittelpunkts
   waagerecht:=bb;
   senkrecht:=bb;

   bitmap2:=tbitmap.create;
   bitmap2.assign(image1.Picture.Bitmap);
   bitmap2.PixelFormat:=pf32bit;

   bitmap:=tbitmap.Create;
   bitmap.width:=bb;
   bitmap.height:=bb;
   //Abbildung auf doppelte Größe strecken
   rect.left:=0;
   rect.Top:=0;
   rect.right:=bb;
   rect.Bottom:=bb;
   bitmap.canvas.copyrect(rect,bitmap2.Canvas,image1.clientrect);
   //Mittelpunkt
   xm:=paintbox1.Width div 2;
   ym:=paintbox1.height div 2;

   bitmapz:=tbitmap.Create;
   bmw :=paintbox1.Width;
   bitmapz.Width:= bmw;
   bitmapz.height:=paintbox1.height;
   bitmapz.PixelFormat:=pf32bit;

   bitmapz.Canvas.Brush.Color:=clwhite;
   bitmapz.Canvas.Rectangle(-1,-1,961,961);
   //version 2
   //zeilenweise pixel ermitteln
   bbinv := 1/bb;
   T0 := now;
For n := 1 to runden do
Begin
   P2 := BitMap.ScanLine[0];
   P3 := bitmapz.ScanLine[0];

   for i:=0 to bb-1 do begin
     yi:=(2*i-senkrecht)*bbinv;  //yi:=(2*i-senkrecht)/bb;
     for j:=0 to bb-1 do begin
           //Umwandeln in komplexe Koordinaten
           xi:=(2*j-waagerecht)*bbinv;
           //Transformation auf die Riemann-Kugel
           sq := xi*xi + yi*yi;
           //nur zeichnen, wenn in unterer Hälfte der Riemann-Kugel
           if sq<1.0 then begin
             q:=480/(sq+1.0);
             px := p3;
             dword(px) := dword(px) -((trunc(yi*q)+ym)*bmw + trunc(xi*q)+xm)*4;
             pDword(px)^ :=  pDword(p2)^;
{           //fuer pf24Bit mal als Gedanke
             k := pDword(p2)^ AND $00FFFFFF;
             pDword(px)^ := pDword(px)^ AND $FF000000 OR k;
}
           end;
           inc(p2,4);
     end;
     dec(p2, 8*bitmap.Width);
   end;
End;
   T1 := now;
   paintbox1.Canvas.Draw(0,0,bitmapz);

   bitmap.free;
   bitmap2.free;
   bitmapz.free;
   Label1.Caption := Format('%10.5f',[(T1-T0)/n*86400.0]);
end;