unit ChartUnit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Math;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);
  private
    procedure Rotate(alpha, beta, gamma: Integer);
  public
    
  end;

  TVector = array of Extended;

  TMatrix = record
    cols: Integer;
    rows: Integer;
    data: array of TVector;
  end;

  TPoint3D = record
    X, Y, Z: Extended;
  end;

var
  Form1: TForm1;

  P0, Pox, Poy, Poz, Px, Py, Pz: TPoint3D;
  oData, Data: array of array of TPoint3D;
  
implementation

{$R *.dfm}

function clearmatrix: TMatrix;
begin
  result.cols:=0;
  result.rows:=0;
  result.data:=nil;
end;

function creatematrix(cols, rows: Integer): TMatrix;
var i, j: Integer;

begin
  result.cols:=cols;
  result.rows:=rows;
  SetLength(result.data, cols);

  for i:=0 to cols-1 do
  begin
    SetLength(result.data[i], rows);

    for j:=0 to rows-1 do
      result.data[i, j]:=0;
  end;
end;

procedure destroymatrix(var mx: TMatrix);
var i: Integer;

begin
  for i:=0 to mx.cols-1 do
    Finalize(mx.data[i]);

  Finalize(mx.data);

  mx:=clearmatrix;
end;

procedure fillmatrix(var mx: TMatrix; value: Extended);
var i, j: Integer;

begin
  for j:=0 to mx.rows-1 do
    for i:=0 to mx.cols-1 do
      mx.data[i, j]:=value;
end;

function multmatrix(mxA, mxB: TMatrix): TMatrix;
var ai, aj, bi, bj: Integer;

begin
  result:=clearmatrix;

  if (mxA.cols<>mxB.rows) then
    Exit;

  result:=creatematrix(mxB.cols, mxA.rows);

  fillmatrix(result, 0);

  for aj:=0 to mxA.rows-1 do
    for bi:=0 to mxB.cols-1 do
      for ai:=0 to mxA.cols-1 do //weil: mxA.cols=mxB.rows
      begin
        bj:=ai;
        result.data[bi, aj]:=result.data[bi, aj]+mxA.data[ai, aj]*mxB.data[bi, bj];
      end
end;

//

function XSin(angle: Extended): Extended;
begin
  result:=Sin((angle*Pi)/180);
end;

function XCos(angle: Extended): Extended;
begin
  result:=Cos((angle*Pi)/180);
end;

function Point3D(X, Y, Z: Extended): TPoint3D;
begin
  result.X:=X;
  result.Y:=Y;
  result.Z:=Z;
end;

function RotateMatrix(X, Y, Z: Extended; alpha: Extended): TMatrix;
begin
  result:=creatematrix(4, 4);
                  
  with result do
  begin
    data[0, 0]:=Sqr(X)*(1-XCos(alpha))+XCos(alpha);
    data[0, 1]:=X*Y*(1-XCos(alpha))+Z*XSin(alpha);
    data[0, 2]:=X*Z*(1-XCos(alpha))-Y*XSin(alpha);
    data[0, 3]:=0;

    data[1, 0]:=X*Y*(1-XCos(alpha))-Z*XSin(alpha);
    data[1, 1]:=Sqr(Y)*(1-XCos(alpha))+XCos(alpha);
    data[1, 2]:=Y*Z*(1-XCos(alpha))+X*XSin(alpha);
    data[1, 3]:=0;

    data[2, 0]:=X*Z*(1-XCos(alpha))+Y*XSin(alpha);
    data[2, 1]:=Y*Z*(1-XCos(alpha))-X*XSin(alpha);
    data[2, 2]:=Sqr(Z)*(1-XCos(alpha))+XCos(alpha);
    data[2, 3]:=0;

    data[3, 0]:=0;
    data[3, 1]:=0;
    data[3, 2]:=0;
    data[3, 3]:=1;
  end;
end;

function XRotateMatrix(alpha: Extended): TMatrix;
begin
  result:=creatematrix(4, 4);

  with result do
  begin
    data[0, 0]:=1;
    data[0, 1]:=0;
    data[0, 2]:=0;
    data[0, 3]:=0;

    data[1, 0]:=0;
    data[1, 1]:=XCos(alpha);
    data[1, 2]:=-XSin(alpha);
    data[1, 3]:=0;

    data[2, 0]:=0;
    data[2, 1]:=XSin(alpha);
    data[2, 2]:=XCos(alpha);
    data[2, 3]:=0;

    data[3, 0]:=0;
    data[3, 1]:=0;
    data[3, 2]:=0;
    data[3, 3]:=1;
  end;
end;

function YRotateMatrix(alpha: Extended): TMatrix;
begin
  result:=creatematrix(4, 4);

  with result do
  begin
    data[0, 0]:=XCos(alpha);
    data[0, 1]:=0;
    data[0, 2]:=XSin(alpha);
    data[0, 3]:=0;

    data[1, 0]:=0;
    data[1, 1]:=1;
    data[1, 2]:=0;
    data[1, 3]:=0;

    data[2, 0]:=-XSin(alpha);
    data[2, 1]:=0;
    data[2, 2]:=XCos(alpha);
    data[2, 3]:=0;

    data[3, 0]:=0;
    data[3, 1]:=0;
    data[3, 2]:=0;
    data[3, 3]:=1;
  end;
end;

function ZRotateMatrix(alpha: Extended): TMatrix;
begin
  result:=creatematrix(4, 4);

  with result do
  begin
    data[0, 0]:=XCos(alpha);
    data[0, 1]:=-XSin(alpha);
    data[0, 2]:=0;
    data[0, 3]:=0;

    data[1, 0]:=XSin(alpha);
    data[1, 1]:=XCos(alpha);
    data[1, 2]:=0;
    data[1, 3]:=0;

    data[2, 0]:=0;
    data[2, 1]:=0;
    data[2, 2]:=1;
    data[2, 3]:=0;

    data[3, 0]:=0;
    data[3, 1]:=0;
    data[3, 2]:=0;
    data[3, 3]:=1;
  end;
end;

function Point3DToPoint2D(X, Y, Z: Extended): TPoint; overload;
begin
  result.x:=Round(1000*X/(1000+Z));
  result.y:=Round(1000*Y/(1000+Z));
end;
 
function Point3DToPoint2D(Point3D: TPoint3D): TPoint; overload;
begin
  result.x:=Round(1000*Point3D.X/(1000+Point3D.Z));
  result.y:=Round(1000*Point3D.Y/(1000+Point3D.Z));
end;

procedure Line(Canvas: TCanvas; pt1, pt2: TPoint);
begin
  Canvas.MoveTo(pt1.x, pt1.y);
  Canvas.LineTo(pt2.x, pt2.y);
end;

procedure TForm1.FormCreate(Sender: TObject);
var x, y, z: Integer;

begin
  P0:=Point3D(0,0,0);
  Pox:=Point3D(100,0,0);
  Poy:=Point3D(0,100,0);
  Poz:=Point3D(0,0,100);
  Px:=Point3D(100,0,0);
  Py:=Point3D(0,100,0);
  Pz:=Point3D(0,0,100);

  Randomize;

  SetLength(oData, 25);
  SetLength(Data, 25);

  for z:=0 to 24 do
  begin
    SetLength(oData[z], 25);
    SetLength(Data[z], 25);

    for x:=0 to 24 do
    begin
      if x=0 then
      begin
        if z=0 then
          Data[z, x]:=Point3D(x*4, Random(80), z*4)
        else
          Data[z, x]:=Point3D(x*4, Data[z-1, x].Y+Min(100, (Random(10)-5)), z*4);
      end
      else
        Data[z, x]:=Point3D(x*4, Data[z, x-1].Y+Min(100, (Random(10)-5)), z*4);

      oData[z, x]:=Data[z, x];
    end;
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
var x, y, z: Integer;
    pt0, ptx, pty, ptz: TPoint;

begin
  SetMapMode(Canvas.handle, MM_ISOTROPIC);
  SetWindowExtEx(Canvas.handle, ClientWidth, ClientHeight, nil); //darzustellende Punkte x,y
  SetViewportExtEx(Canvas.handle, ClientWidth, -ClientHeight, nil); //kippen
  SetViewportOrgEx(Canvas.handle, ClientWidth div 2, ClientHeight div 2, nil); //Nullpunkt

  pt0:=Point3DToPoint2D(P0);
  ptx:=Point3DToPoint2D(Px);
  pty:=Point3DToPoint2D(Py);
  ptz:=Point3DToPoint2D(Pz);

  Canvas.Pen.Color:=clBlack;

  Line(Canvas, pt0, ptx); Canvas.TextOut(ptx.x, ptx.y, 'X');
  Line(Canvas, pt0, pty); Canvas.TextOut(pty.x, pty.y, 'Y');
  Line(Canvas, pt0, ptz); Canvas.TextOut(ptz.x, ptz.y, 'Z');

  for z:=0 to 24 do
  begin
    Canvas.Pen.Color:=RGB($FF, $FF-z*5, z*5);

    for x:=0 to 23 do
      Line(Canvas, Point3DToPoint2D(Data[z, x]), Point3DToPoint2D(Data[z, x+1]));
  end;
end;

procedure TForm1.Rotate(alpha, beta, gamma: Integer);
var x, y, z: Integer;
    Rx, Ry, Rz, Rt, Rm, Xm, Xim, Ym, Yim, Zm, Zim: TMatrix;

    procedure FillM(var M: TMatrix; P: TPoint3D);
    begin
      M.data[0, 0]:=P.X;
      M.data[0, 1]:=P.Y;
      M.data[0, 2]:=P.Z;
      M.data[0, 3]:=0;
    end;

    function TurnP(P: TPoint3D): TPoint3D;
    var M, Mi: TMatrix;
    
    begin
      M:=creatematrix(1, 4);
      FillM(M, P);
      Mi:=multmatrix(Rm, M);

      result:=Point3D(Mi.data[0,0],Mi.data[0,1],Mi.data[0,2]);

      destroymatrix(M);
      destroymatrix(Mi);
    end;

begin
  Rx:=XRotateMatrix(-alpha);
  Ry:=YRotateMatrix(beta);
  Rz:=ZRotateMatrix(gamma);

  Rt:=multmatrix(Rx, Ry);
  Rm:=multmatrix(Rt, Rz);

  Px:=Pox;
  Py:=Poy;
  Pz:=Poz;

  Px:=TurnP(Px);
  Py:=TurnP(Py);
  Pz:=TurnP(Pz);

  for z:=0 to 24 do
    for x:=0 to 24 do
      Data[z, x]:=oData[z, x];

  for z:=0 to 24 do
    for x:=0 to 24 do
      Data[z, x]:=TurnP(Data[z, x]);

  destroymatrix(Rx);
  destroymatrix(Ry);
  destroymatrix(Rz);
  destroymatrix(Rt);
  destroymatrix(Rm);

  Invalidate;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Label1.Caption:='X: '+inttostr(TrackBar1.Position);
  Rotate(TrackBar1.Position, TrackBar2.Position, TrackBar3.Position);
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
begin
  Label2.Caption:='Y: '+inttostr(TrackBar2.Position);
  Rotate(TrackBar1.Position, TrackBar2.Position, TrackBar3.Position);
end;

procedure TForm1.TrackBar3Change(Sender: TObject);
begin
  Label3.Caption:='Z: '+inttostr(TrackBar3.Position);
  Rotate(TrackBar1.Position, TrackBar2.Position, TrackBar3.Position);
end;

end.
 


object Form1: TForm1
  Left = 226
  Top = 103
  Caption = 'Form1'
  ClientHeight = 601
  ClientWidth = 854
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnCreate = FormCreate
  OnPaint = FormPaint
  TextHeight = 13
  object Label1: TLabel
    Left = 32
    Top = 8
    Width = 7
    Height = 13
    Caption = 'X'
  end
  object Label2: TLabel
    Left = 32
    Top = 128
    Width = 7
    Height = 13
    Caption = 'Y'
  end
  object Label3: TLabel
    Left = 32
    Top = 248
    Width = 7
    Height = 13
    Caption = 'Z'
  end
  object TrackBar1: TTrackBar
    Left = 24
    Top = 24
    Width = 25
    Height = 97
    Max = 360
    Orientation = trVertical
    TabOrder = 0
    TickMarks = tmBoth
    TickStyle = tsNone
    OnChange = TrackBar1Change
  end
  object TrackBar2: TTrackBar
    Left = 24
    Top = 144
    Width = 25
    Height = 97
    Max = 360
    Orientation = trVertical
    TabOrder = 1
    TickMarks = tmBoth
    TickStyle = tsNone
    OnChange = TrackBar2Change
  end
  object TrackBar3: TTrackBar
    Left = 24
    Top = 264
    Width = 25
    Height = 97
    Max = 360
    Orientation = trVertical
    TabOrder = 2
    TickMarks = tmBoth
    TickStyle = tsNone
    OnChange = TrackBar3Change
  end
end

Zurück