Часовой пояс: UTC + 3 часа




Начать новую тему Новая тема / Ответить на тему Ответить  Сообщений: 8 
  Пред. тема | След. тема 
В случае проблем с отображением форума, отключите блокировщик рекламы
Автор Сообщение
 

Заблокирован
Заблокирован
Статус: Не в сети
Регистрация: 02.11.2003
Откуда: Россия,Москва
Завтра курсач сдавать помогите.Вот исходник проги.Там крутится квардрат(приближение-удаление)Подскажите какие координаты ввести для получения стола??
Заранее спасибо!!

unit Main;

interface

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

type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
procedure FormActivate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
x0,y0:integer;
move:boolean;
rec: TRect;
implementation
{$R *.DFM}
Const
Focus : word = 1000;
MaxPoints = 8 {8-19};

Type
TMain = array[1..MaxPoints] of record
X, Y, Z : double;
Sd : array[1..3] of byte;
end;

Const
Points : TMain =(
(X : -10; Y: -10; Z: -10; Sd:(2,4,8)), // 1
(X : -10; Y: -10; Z: 10; Sd:(0,3,7)), // 2
(X : 10; Y: -10; Z: 10; Sd:(6,4,0)), // 3
(X : 10; Y: -10; Z: -10; Sd:(5,0,0)), // 4
(X : 10; Y: 10; Z: -10; Sd:(6,8,0)), // 5
(X : 10; Y: 10; Z: 10; Sd:(7,0,0)), // 6
(X : -10; Y: 10; Z: 10; Sd:(8,0,0)), // 7
(X : -10; Y: 10; Z: -10; Sd:(0,0,0)){,} // 8
{(X : 10; Y: 10; Z: 10; Sd:(8,0,0)),
(X : -10; Y: -10; Z: 10; Sd:(8,0,0)),
(X : 10; Y: -10; Z: -10; Sd:(8,0,0)),
(X : 10; Y: -10; Z: -10; Sd:(6,4,0)),
(X : -10; Y: -10; Z: 10; Sd:(6,4,0)),
(X : -10; Y: 10; Z: 10; Sd:(0,3,7)),
(X : -10; Y: 10; Z: 10; Sd:(5,0,0)),
(X : 10; Y: -10; Z: 10; Sd:(5,0,0)),
(X : -10; Y: -10; Z: -10; Sd:(5,0,0)),
(X : 10; Y: 10; Z: 10; Sd:(0,0,0)), // !!!!!!!!!!!
(X : 10; Y: 10; Z: 10; Sd:(0,0,0))}); // !!!!!!!!!!!;
N: integer = 30;
Var
Lines : array[1..1000] of record X1,Y1,X2,Y2 : integer; end;
LinesCount : integer;
dxy,dxz,dyz : double;
sxy,sxz,syz : double;

procedure XYZ(X,Y,Z : double; Var X2,Y2 : double);
begin
X2:=Round(X*Focus/100+(Form1.PaintBox1.Width div 2));
Y2:=Round(Y*Focus/100+(Form1.PaintBox1.Height div 2));
end;

procedure Pw(var X,Y : double; Al : double);
Var
X2, Y2 : double;
sina, cosa : double;
begin
if Al=0 then Exit;
sina :=sin(Al); cosa:=cos(Al);
X2:=(X*cosa-Y*Sina-pi);
Y2:=(X*Sina+Y*Cosa-pi);
X:=X2; Y:=Y2;
end;

procedure Draw;
Var
J, I, C : integer;
TT : TMain;
begin
TT:=Points;
for I:=1 to MaxPoints do begin
Pw(TT[i].X, TT[i].Y, dxy);
Pw(TT[i].X, TT[i].Z, dxz);
Pw(TT[i].Y, TT[i].Z, dyz);
XYZ(TT[i].X, TT[i].Y, TT[i].Z, TT[i].X, TT[i].Y);
end;

LinesCount:=0;
for I:=1 to MaxPoints do
for j:=1 to 3 do if TT[i].Sd[J]<>0 then begin
C:=TT[i].Sd[j];
inc(LinesCount);
with Lines[LinesCount] do begin
X1:=round(TT[i].X); Y1:=round(TT[i].Y);
X2:=round(TT[C].X); Y2:=round(TT[C].Y);
end;
end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
Paintbox1.Canvas.pen.Color:=cllime;
Paintbox1.Canvas.pen.Width:=1;
dxy:=10; dxz:=100; dyz:=1000;
sxy:=0.02;
sxz:=0.02;
syz:=0.02;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var i : integer;
begin
Draw;
PaintBox1.canvas.FillRect(PaintBox1.canvas.ClipRect);
with PaintBox1.canvas do
for i:=1 to LinesCount do begin
MoveTo(Lines[i].X1, Lines[i].Y1);
LineTo(Lines[i].X2, Lines[i].Y2);
Label2.Caption:='XY='+FloatToStr(dxy);
Label3.Caption:='XZ='+FloatToStr(dxz);
Label4.Caption:='YZ='+FloatToStr(dyz);
Label5.Caption:='Focus='+inttostr(Focus);
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
dxy:=dxy+sxy;
dxz:=dxz+sxz;
dyz:=dyz+syz;
PaintBox1.Repaint;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key='1' then begin
dxy:=dxy-0.05;
PaintBox1.Repaint;
end;
if key='3' then begin
dxy:=dxy+0.05;
PaintBox1.Repaint;
end;
if key='4' then begin
dxz:=dxz-0.05;
PaintBox1.Repaint;
end;
if key='6' then begin
dxz:=dxz+0.05;
PaintBox1.Repaint;
end;
if key='2' then begin
dyz:=dyz+0.05;
PaintBox1.Repaint;
end;
if key='8' then begin
dyz:=dyz-0.05;
PaintBox1.Repaint;
end;
if key='7' then begin
Focus:=Focus-n;
Label1.Caption:='N='+ inttostr(n);
PaintBox1.Repaint;
end;
if key='9' then begin
Focus:=Focus+n;
Label1.Caption:='N='+inttostr(n);
PaintBox1.Repaint;
end;
if key='5' then begin
Focus:=1000;
DXY:=10;
DXZ:=100;
DYZ:=1000;
sxy:=0.02;
Label9.Caption:='Speed=0,02';
Timer1.Enabled:=False;
N:=30;
Label1.Caption:='N=30';
Label6.Caption:='Random Rotate=False';
Paintbox1.Left:=54;
Paintbox1.Top:=39;
Paintbox1.Repaint;
Label7.Caption:='Position=' + inttostr(Paintbox1.Left) + ',' + inttostr(Paintbox1.Top);
end;

if (key='w') or (key='W') or (key='ц') or (key='Ц') then begin
Paintbox1.Top:=Paintbox1.Top-n;
Label7.Caption:='Position=' + inttostr(Paintbox1.Left) + ',' + inttostr(Paintbox1.Top);
end;

if (key='a') or (key='A') or (key='ф') or (key='Ф') then begin
Paintbox1.Left:=Paintbox1.Left-n;
Label7.Caption:='Position=' + inttostr(Paintbox1.Left) + ',' + inttostr(Paintbox1.Top);
end;

if (key='d') or (key='D') or (key='в') or (key='В') then begin
Paintbox1.Left:=Paintbox1.Left+n;
Label7.Caption:='Position=' + inttostr(Paintbox1.Left) + ',' + inttostr(Paintbox1.Top);
end;

if (key='s') or (key='S') or (key='ы') or (key='Ы') then begin
Paintbox1.Top:=Paintbox1.Top+n;
Label7.Caption:='Position=' + inttostr(Paintbox1.Left) + ',' + inttostr(Paintbox1.Top);
end;

end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Height:=Screen.Height;
Width:=Screen.Width;
Paintbox1.Height:=Screen.Height;
Paintbox1.Width:=Screen.Width;
Showcursor(False);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=vk_Escape then Application.Terminate;

if key=vk_Left then begin
sxy:=sxy - 0.01;
Label9.Caption:='Speed=' + floattostr(sxy);
end;
if key=vk_right then begin
sxy:=sxy + 0.01;
Label9.Caption:='Speed=' + floattostr(sxy);
end;

if key=vk_F1 then begin
Application.MessageBox(
' Created by PaPa_CaRLO аля Михаил и San40 аля Александр Кутаков' + #13 +
'---------------------------------------------------------------------------------------' + #13 +
' Управление: ' + #13 +
'---------------------------------------------------------------------------------------' + #13 +
'>Доп. 4, 6 - Вращать куб по оси X' + #13 +
'>Доп. 2, 8 - Вращать куб по оси Y' + #13 +
'>Доп. 1, 3 - Вращать куб по оси Z' + #13 +
'>Доп. 7 - Удалить куб' + #13 +
'>Доп. 7 - Удалить куб' + #13 +
'>Доп. 5 - Вернуть стандартные значения' + #13 +
'>Пробел - Автоматически вращать куб' + #13 +
'>A, D - Изменить положение куба по оси X' + #13 +
'>W, S - Изменить положение куба по оси Y' + #13 +
'>Стрелка вверх - Увеличить значение N на 1' + #13 +
'>Стрелка вниз - Уменшить значение N на 1' + #13 +
'>Стрелка влево - Уменшить значение Speed на 0,01' + #13 +
'>Стрелка вправо - Увеличить значение Speed на 0,01' + #13 +
'>Escape - Выход из программы' + #13 +
'>F1 - Помощь',
' <<<Информация>>>',
MB_OK or MB_ICONINFORMATION or MB_DEFBUTTON3);
end;

if key=vk_Up then begin
n:=n+1;
Label1.Caption:='N='+inttostr(n);
end;
if key=vk_Down then begin
n:=n-1;
Label1.Caption:='N='+inttostr(n);
end;

if key=vk_space then begin
Timer1.Enabled:=not Timer1.Enabled;
if timer1.Enabled=true then
Label6.Caption:='Random Rotate=True' else
Label6.Caption:='Random Rotate=False'
end;

end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
move:=true;
x0:=x;
y0:=y;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if move then begin
PaintBox1.Left:=PaintBox1.Left+x-x0;
PaintBox1.Top:=PaintBox1.Top+y-y0;
Label7.Caption:='Position=' + inttostr(Paintbox1.Left) + ',' + inttostr(Paintbox1.Top);
end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
move:=false;
end;

end.

_________________
Ego potissimus. Если кто не понял - его проблемы... Правда - и я не допёр... Хотя догадываюсь.Типа на Латыне что то.....



Партнер
 

Member
Статус: Не в сети
Регистрация: 13.04.2004
Откуда: Москва
PaPa_CaRLO
не понял вопрос - какого стола?


 

Заблокирован
Заблокирован
Статус: Не в сети
Регистрация: 02.11.2003
Откуда: Россия,Москва
Нужен что бы столик крутился.Объект обычный СТОЛ!!!4 ножки что бы было.А не квадрат.

_________________
Ego potissimus. Если кто не понял - его проблемы... Правда - и я не допёр... Хотя догадываюсь.Типа на Латыне что то.....


 

Member
Статус: Не в сети
Регистрация: 13.04.2004
Откуда: Москва
PaPa_CaRLO
Держи:
Код:
{$R *.DFM}
Const
MaxPoints = 36{8-19};

Type
TMain = array[1..MaxPoints] of record
X, Y, Z : double;
Sd : array[1..3] of byte;
end;

Const
Points : TMain =(
(X : -30; Y: 25; Z: -20; Sd:(2,4,5)), // 1
(X : -30; Y: 25; Z: 20; Sd:(0,3,6)), // 2
(X : 30; Y: 25; Z: 20; Sd:(7,4,0)), // 3
(X : 30; Y: 25; Z: -20; Sd:(8,0,0)), // 4

(X : -30; Y: 15; Z: -20; Sd:(6,12,8)), // 5
(X : -30; Y: 15; Z: 20; Sd:(7,0,0)), // 6
(X : 30; Y: 15; Z: 20; Sd:(8,0,0)), // 7
(X : 30; Y: 15; Z: -20; Sd:(0,0,0)), // 8

(X : -30; Y: 15; Z: -17; Sd:(10,13,0)), // 9
(X : -27; Y: 15; Z: -17; Sd:(11,14,0)), // 10
(X : -27; Y: 15; Z: -20; Sd:(15,0,0)), // 11

(X : -30; Y: -25; Z: -20; Sd:(13,15,0)), // 12
(X : -30; Y: -25; Z: -17; Sd:(14,0,0)), // 13
(X : -27; Y: -25; Z: -17; Sd:(15,0,0)), // 14
(X : -27; Y: -25; Z: -20; Sd:(0,0,0)), // 15

(X : -27; Y: 15; Z: 20; Sd:(17,20,0)), // 16
(X : -27; Y: 15; Z: 17; Sd:(18,21,0)), // 17
(X : -30; Y: 15; Z: 17; Sd:(22,0,0)), // 18

(X : -30; Y: -25; Z: 20; Sd:(20,22,6)), // 19
(X : -27; Y: -25; Z: 20; Sd:(21,0,0)), // 20
(X : -27; Y: -25; Z: 17; Sd:(22,0,0)), // 21
(X : -30; Y: -25; Z: 17; Sd:(0,0,0)), // 22

(X : 27; Y: 15; Z: 20; Sd:(25,26,0)), // 23
(X : 30; Y: 15; Z: 17; Sd:(25,28,0)), // 24
(X : 27; Y: 15; Z: 17; Sd:(29,0,0)), // 25

(X : 27; Y: -25; Z: 20; Sd:(27,29,0)), // 26
(X : 30; Y: -25; Z: 20; Sd:(28,7,0)), // 27
(X : 30; Y: -25; Z: 17; Sd:(29,0,0)), // 28
(X : 27; Y: -25; Z: 17; Sd:(0,0,0)), // 29

(X : 27; Y: 15; Z: -20; Sd:(31,33,0)), // 30
(X : 27; Y: 15; Z: -17; Sd:(32,34,0)), // 31
(X : 30; Y: 15; Z: -17; Sd:(35,0,0)), // 32

(X : 27; Y: -25; Z: -20; Sd:(34,36,0)), // 33
(X : 27; Y: -25; Z: -17; Sd:(35,0,0)), // 34
(X : 30; Y: -25; Z: -17; Sd:(36,0,0)), // 35
(X : 30; Y: -25; Z: -20; Sd:(8,0,0))) // 36


В :grob: я видел этот стол...


 

Member
Статус: Не в сети
Регистрация: 28.03.2003
Откуда: Челябинск
А есть ли в Делфи 7 аналог модуля Graph, который был в Turbo Pascal?
Если есть то как его врубить, описать и как пользоваться?

_________________
СПАРТАК - ЧЕМПИОН!!! Forever!!!


 

Member
Статус: Не в сети
Регистрация: 30.01.2004
Откуда: Пенза
Цитата:
А есть ли в Делфи 7 аналог модуля Graph, который был в Turbo Pascal?
Если есть то как его врубить, описать и как пользоваться?

Я не видел Turbo Pascal, но в дельфях есть компонент TChart для вывода всяких графиков и диаграмм, а также к вашим услугам GDI (GDI+ в win xp), а также DirectX и Direct3D :)

_________________
Abit AI-7/P4-2.26@3.4/Zalman7000A-Cu/1Gb Transcend PC3200/Leadtek GF 6800 (CPU400/DDR860)/Samsung 193P
Member #155 of http://www.ISDEF.org


 

Advanced member
Статус: Не в сети
Регистрация: 09.06.2003
Откуда: USSR
Xaker Ты не путай ДОС и Windows, последний уже графика и чегото еще ему не надо.
Для того чтобы рисовать ты должен просто работать с обьектом TCanvas, Такой есть почти у всех визуальных компонентов. А уже использя его ты можеш и линии рисовать и картинки лепить, короче всю работу с графикой. TCanvas это просто оболочка для выхова GDI функция самой Windows. Советую почитать хелпец :)


 

Заблокирован
Заблокирован
Статус: Не в сети
Регистрация: 02.11.2003
Откуда: Россия,Москва
Профи помогите теперь еще разок плиз сообразить.Вот исходник проги там крутится вертится стол.А какие координаты ввести для получения СТУЛ-а???

_________________
Ego potissimus. Если кто не понял - его проблемы... Правда - и я не допёр... Хотя догадываюсь.Типа на Латыне что то.....


Показать сообщения за:  Поле сортировки  
Начать новую тему Новая тема / Ответить на тему Ответить  Сообщений: 8 
-

Часовой пояс: UTC + 3 часа


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 19


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group
Русская поддержка phpBB | Kolobok smiles © Aiwan