Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Графика и игры
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 29.11.2008, 23:36
shorox shorox вне форума
Прохожий
 
Регистрация: 29.11.2008
Сообщения: 2
Репутация: 10
По умолчанию Нарисовать однополосный гиперболоид

Граждане помогите, никак не могу создать изображение однополостного гиперболоида на канве, так же нужно реализовать процедуры для 5 кнопок, 2 из них масштабирование фигуры, а 3 - поворот по осям. Заранее спасибо всем помогающим.

Последний раз редактировалось shorox, 30.11.2008 в 00:22.
Ответить с цитированием
  #2  
Старый 30.11.2008, 19:32
shorox shorox вне форума
Прохожий
 
Регистрация: 29.11.2008
Сообщения: 2
Репутация: 10
По умолчанию

Вот чтото наподобии, что и как тут можно изменить чтобы получился однополостный гиперболоид?

Код:
unit Unit1;

interface

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

type
  matrix = array[1..4,1..4] of real;
  vector = array[1..4] of real;
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    function ii(x:real):integer;
    function jj(y:real):integer;
    function Mult_matr_vect(m:matrix;v:vector):vector;
    function Mult_matr(m1,m2:matrix):matrix;
    procedure Draw(m:matrix);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }

  end;
const
  D_plus:matrix=((1.1,0,0,0),
                 (0,1.1,0,0),
                 (0,0,1.1,0),
                 (0,0,0,1));
  D_minus:matrix=((0.9,0,0,0),
                  (0,0.9,0,0),
                  (0,0,0.9,0),
                  (0,0,0,1));
  cosp=0.9945;
  sinp=0.1045;
  Matr1:matrix=((1,0,0,0),
                (0,1,0,0),
                (0,0,1,0),
                (0,0,0,1));
  Rx:matrix=((1,0,0,0),
             (0,cosp,sinp,0),
             (0,-sinp,cosp,0),
             (0,0,0,1));
  Ry:matrix=((cosp,0,-sinp,0),
             (0,1,0,0),
             (sinp,0,cosp,0),
             (0,0,0,1));
  Rz:matrix=((cosp,sinp,0,0),
             (-sinp,cosp,0,0),
             (0,0,1,0),
             (0,0,0,1));
  PRO:matrix=((1,0,0,0),
              (0,1,0,0),
              (0.35,0.35,0,0),
              (0,0,0,1));
  e1:vector=(1,0,0,1);
  e2:vector=(0,1,0,1);
  e3:vector=(0,0,1,1);


var
  Form1: TForm1;
  x0:real=-4;
  x1:real=4;
  y0:real=-4;
  y1:real=4;
  mat:matrix;


implementation

{$R *.dfm}

function TForm1.Mult_matr_vect(m:matrix;v:vector):vector;
  var
    w:vector;
    k,l:integer;
    s:real;
begin
  for k:=1 to 4 do
  begin
    s:=0;
    for l:=1 to 4 do
      s:=s+v[l]*m[k,l];
    w[k]:=s;
  end;
  result:=w;
end;

function TForm1.ii(x:real):integer;
begin
  ii:=trunc((x-x0)/(x1-x0)*Form1.Image1.Width);
end;

function TForm1.jj(y:real):integer;
begin
  jj:=trunc((y1-y)/(y1-y0)*Form1.Image1.Height);
end;

function TForm1.Mult_matr(m1,m2:matrix):matrix;
  var
    k,l,n:integer;
    w:matrix;
    s:real;
begin
  for k:=1 to 4 do
  begin
    for l:=1 to 4 do
    begin
      s:=0;
      for n:=1 to 4 do
      s:=s+m1[k,n]*m2[n,l];
      w[k,l]:=s;
    end;
  end;
  result:=w;
end;

procedure TForm1.Draw(m:matrix);
  var
    a,b,c:vector;
    i,j,w,h,Ic,Jc:integer;
    t:real;

  procedure figur(c1,c2,c3,c4:real);
  begin
    c[1]:=c1;
    c[2]:=c2;
    c[3]:=c3;
    c[4]:=c4;
    a:=Mult_matr_vect(m,c);
    b:=Mult_matr_vect(PRO,a);
    i:=ii(b[1]);
    j:=jj(b[2]);
    Form1.Image1.Canvas.Pixels[i,j]:=clred;
  end;

  procedure koord(e:vector; ch:char);
  begin
    a:=Mult_matr_vect(m,e);
    b:=Mult_matr_vect(PRO,a);
    i:=ii(b[1]);
    j:=jj(b[2]);
    Form1.Image1.Canvas.MoveTo(Ic,Jc);
    Form1.Image1.Canvas.LineTo(i,j);
    Form1.Image1.Canvas.TextOut(i,j,ch);
  end;
begin
  w:=Form1.Image1.Width-1;
  h:=Form1.Image1.Height-1;
  Ic:=w div 2;
  Jc:=h div 2;
  Form1.Image1.Canvas.Rectangle(0,0,w,h);
  koord(e1,'X');
  koord(e2,'Y');
  koord(e3,'Z');
  t:=-1;
  while t<1 do
  begin
    figur(t,t*t,0,1);
    figur(t,t*t+0.25,0.5,1);
    figur(t,t*t+0.25,-0.5,1);
    figur(0,t*t,t,1);
    figur(0.5,t*t+0.25,t,1);
    figur(-0.5,t*t+0.25,t,1);
    figur(-1,t*t+1,t,1);
    figur(1,t*t+1,t,1);
    figur(t,t*t+1,-1,1);
    figur(t,t*t+1,1,1);
    t:=t+0.001;
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  mat:=Mult_matr(mat,Rx);
  Draw(mat);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  mat:=Mult_matr(mat,Ry);
  Draw(mat);
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  mat:=Mult_matr(mat,Rz);
  Draw(mat);
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
  mat:=Mult_matr(mat,D_plus);
  Draw(mat);
end;

procedure TForm1.BitBtn7Click(Sender: TObject);
begin
  mat:=Mult_matr(mat,D_minus);
  Draw(mat);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  image1.Width:=ClientWidth;
  image1.Height:=ClientHeight-50;
  Draw(Matr1);
  mat:=Matr1;
end;

end.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 18:12.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025