[serj71298]

Здравствуйте!!!
Помогите пожалуйста по методичке собрать программу.

Заранее спасибо!!!

[angvelem]

Методичка может и хорошая, но у меня не стоит этот офис - прочесть не могу.

[Pyro]

тоже офиса нет, использую https://viewer.zoho.com/docs/hdcbdb0
некоторые картинки не хочет отображать, можно edit или export

[serj71298]

Всем спасибо! Разобрался сам, если интересно позже скину исходник или пишите в личку.

[angvelem]

Сообщение от serj71298

Всем спасибо! Разобрался сам, ...

Это уже после того как попросил мои исходники или раньше?

[serj71298]

angvelem спасибо за исходник! Сейчас посмотрел.

мой код не работал без матричного метода преобразования координат.
До этого вырисовывалась только в одной плоскости.

[serj71298]

помогите пожалуйста исправить ошибку.

Код:

unit kub;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


type
    T3DCoord=(X,Y,Z);
    T3DPoint=ARRAY[X..Z] of Real;
    TEdges=ARRAY of ARRAY [1..2] of Byte;
    TPoints=ARRAY of T3DPoint;
    TMatrix=ARRAY[1..4,1..4] of Real;
    TAxis=(AxX,AxY,AxZ);
    
var
    points: TPoints;
    edges: TEdges;
    X1:real=0;
    Y1:real=240;
    scal:real=1;
    step:real=10;
    step1:real=1;
    angles:ARRAY[AxX..AxZ] of Real=(0.0,0.0,0.0) ;

Procedure kubb;
  begin

    SetLength(points, 8);
    SetLength(edges, 12);

  //координаты точек
    points[0][X]:=0; points[0][Y]:=0; points[0][Z]:=0;
    points[1][X]:=100; points[1][Y]:=0; points[1][Z]:=0;
    points[2][X]:=150; points[2][Y]:=50; points[2][Z]:=100;
    points[3][X]:=50; points[3][Y]:=50; points[3][Z]:=100;
    points[4][X]:=0; points[4][Y]:=100; points[4][Z]:=0;
    points[5][X]:=100; points[5][Y]:=100; points[5][Z]:=0;
    points[6][X]:=150; points[6][Y]:=150; points[6][Z]:=100;
    points[7][X]:=50; points[7][Y]:=150; points[7][Z]:=100;

 // ребрa от точки в точку
    edges[0][1]:=0; edges [0][2]:=1;
    edges[1][1]:=0; edges [1][2]:=3;
    edges[2][1]:=0; edges [2][2]:=4;
    edges[3][1]:=2; edges [3][2]:=1;
    edges[4][1]:=2; edges [4][2]:=6;
    edges[5][1]:=2; edges [5][2]:=3;
    edges[6][1]:=5; edges [6][2]:=1;
    edges[7][1]:=5; edges [7][2]:=6;
    edges[8][1]:=5; edges [8][2]:=4;
    edges[9][1]:=7; edges [9][2]:=4;
    edges[10][1]:=7; edges [10][2]:=3;
    edges[11][1]:=7; edges [11][2]:=6;
 end;

procedure TForm1.FormCreate(Sender: TObject);
begin
kubb;
end;

  FUNCTION Rotate3D(p:T3DPoint; origin:T3DPoint; Axis:TAxis; alpha:REAL):T3DPoint;

     FUNCTION Multiple(m:TMatrix;m2:T3DPoint):T3DPoint;

       BEGIN
         Result[X]:=m[1,1]*m2[X]+m[1,2]*m2[Y]+m[1,3]*m2[Z]+m[1,4];
         Result[Y]:=m[2,1]*m2[X]+m[2,2]*m2[Y]+m[2,3]*m2[Z]+m[2,4];
         Result[Z]:=m[3,1]*m2[X]+m[3,2]*m2[Y]+m[3,3]*m2[Z]+m[3,4]
        END;


 
// Поворот точки p вокруг точки origin вокруг оси Axis на угол alpha
VAR matrix:TMatrix;

BEGIN
CASE Axis OF
 AxX: BEGIN
      matrix[1,1]:=1;
      matrix[1,2]:=0;
      matrix[1,3]:=0;
      matrix[1,4]:=0;
      matrix[2,1]:=0;
      matrix[2,2]:=COS(alpha);
      matrix[2,3]:=SIN(alpha);
      matrix[2,4]:=0;
      matrix[3,1]:=0;
      matrix[3,2]:=-SIN(alpha);
      matrix[3,3]:=COS(alpha);
      matrix[3,4]:=0;
      matrix[4,1]:=0;
      matrix[4,2]:=0;
      matrix[4,3]:=0;
      matrix[4,4]:=1
     END;
 AxY: BEGIN
      matrix[1,1]:=COS(alpha);
      matrix[1,2]:=0;
      matrix[1,3]:=-SIN(alpha);
      matrix[1,4]:=0;
      matrix[2,1]:=0;
      matrix[2,2]:=1;
      matrix[2,3]:=0;
      matrix[2,4]:=0;
      matrix[3,1]:=SIN(alpha);
      matrix[3,2]:=0;
      matrix[3,3]:=COS(alpha);
      matrix[3,4]:=0;
      matrix[4,1]:=0;
      matrix[4,2]:=0;
      matrix[4,3]:=0;
      matrix[4,4]:=1
     END;
 AxZ: BEGIN
      matrix[1,1]:=COS(alpha);
      matrix[1,2]:=SIN(alpha);
      matrix[1,3]:=0;
      matrix[1,4]:=0;
      matrix[2,1]:=-SIN(alpha);
      matrix[2,2]:=COS(alpha);
      matrix[2,3]:=0;
      matrix[2,4]:=0;
      matrix[3,1]:=0;
      matrix[3,2]:=0;
      matrix[3,3]:=1;
      matrix[3,4]:=0;
      matrix[4,1]:=0;
      matrix[4,2]:=0;
      matrix[4,3]:=0;
      matrix[4,4]:=1
     END;
 END;
  Result:=Multiple(matrix,p);
END;


 Procedure Draw ;
   var
   i: byte;
   j:TAxis;

    begin
      with Form1.Image1.Canvas do
        begin
          Brush.Color:=clWhite;
          FillRect (Form1.Image1.Canvas.ClipRect);
          Pen.Color:=clBlue;
          for i:=0 to Length(edges)-1 do
          FOR j:= AxX to AxZ DO
          points[i]:=Rotate3D( points[i],j, angles[j]);
           begin
            MoveTo (TRUNC(points[edges[i,1],X]*scal+X1),
                    TRUNC(points[edges[i,1],Y]*scal+Y1));
            LineTo (TRUNC(points[edges[i,2],X]*scal+X1),
                    TRUNC(points[edges[i,2],Y]*scal+Y1));
           end;
         end;
     end;


procedure TForm1.FormActivate(Sender: TObject);
begin
//Draw;
end;


 procedure TForm1.Button1Click(Sender: TObject);
begin
X1:=X1+step;
Draw;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
X1:=X1-step;
 Draw;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 Y1:=Y1-step;
Draw;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 Y1:=Y1+step;
Draw;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
 scal:= scal+step1;
 Draw;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
 scal:= scal-step1;
 Draw;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
 angles[AxX]:=angles[AxX]+1;
end;
end.

код в вложении.
заранее спасибо!

[serj71298]

Всем спасибо!!!
Ошибку нашел, кому пригодиться исходник во вложении.