Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.10.2015, 21:23   #1
Alecksandra12
Пользователь
 
Регистрация: 05.10.2015
Сообщений: 18
По умолчанию Анимацию выполнить с помощью копирования из вторичной поверхности.

Анимацию объкта выполнить с помощью копирования из вторичной поверхности в Delphi.
Препод сказал что это можно сделать с помощью Tbitmat, но я никак не соображу как это сделать вот код помогите кто-нибудь.


Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type T3DPoint=record
             x,y,z:integer;
             end;

var
  Form1: TForm1;
  w: array [1..8] of T3DPoint =    //мировые (world) координаты вершин
(
  (X: -50; Y: -50; Z: -100),
  (X:  50; Y: -50; Z: -100),
  (X:  50; Y:  50; Z: -100),
  (X: -50; Y:  50; Z: -100),
  (X: -50; Y: -50; Z:  50),
  (X:  50; Y: -50; Z:  50),
  (X:  50; Y:  50; Z:  50),
  (X: -50; Y:  50; Z:  50)
);
  v:array[1..8] of T3DPoint;    //видовые (view) координаты вершин
  s: array [1..8] of TPoint; //экранные (screen) координаты вершин
teta,phi:double;
d,ro:integer;
buf: TBitmat;
blink_buf: TBitmap; //поверхность для фона
implementation

{$R *.dfm}
procedure Line(a,b:TPoint);
begin
with Form1.Canvas do
 begin
  moveto(a.x,a.y);
  lineto(b.x,b.y);
 end;
end;
procedure ViewTransformation;
var i:integer;
begin
for i := 1 to 8 Do
begin
v[i].x := Round(w[i].x*(-sin(teta)) + w[i].y*(cos(teta)))+ Form1.ClientWidth div 2;
v[i].y := Round(w[i].x*(-cos(phi) * cos(teta)) - w[i].y*( cos(phi) * sin(teta)) + w[i].z*(sin(phi))) + Form1.ClientHeight div 2;
v[i].z:= Round(w[i].x*(-sin(phi) * cos(teta)) - w[i].y*(sin(phi)*sin(teta)) - w[i].z*(cos(phi))+Ro);
//Перспективное преобразование
s[i].x:= 320 + Round(d*(v[i].x/v[i].z));
s[i].y:= 320 + Round(d*(v[i].y/v[i].z));
end;
end;
procedure DrawParallelepiped;
begin
Line(s[1],s[2]);
Line(s[2],s[3]);
Line(s[3],s[4]);
Line(s[4],s[1]);
Line(s[5],s[6]);
Line(s[6],s[7]);
Line(s[7],s[8]);
Line(s[8],s[5]);
Line(s[1],s[5]);
Line(s[2],s[6]);
Line(s[3],s[7]);
Line(s[4],s[8]);
end;
//активируем
procedure TForm1.FormCreate(Sender: TObject);
begin
teta:=pi/6;
phi:=pi/3;
ViewTransformation;
keypreview:=true;//разрешим форме реагиолвать на нажатие клавиш
d:=200;
ro:=500;
end;
//рисуем
procedure TForm1.FormPaint(Sender: TObject);
begin
DrawParallelepiped;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
case key of//клавиши стрелка влево и вправо
VK_Left:teta:=teta+pi/10; //поворот против часовой стрелки
VK_Right:teta:=teta-pi/10; //по часовой стрелке
VK_Up:phi:=phi-pi/10;
VK_Down:phi:=phi+pi/10;
end;
ViewTransformation;
Repaint
end;

end.

Последний раз редактировалось Stilet; 18.10.2015 в 07:43.
Alecksandra12 вне форума Ответить с цитированием
Старый 18.10.2015, 02:02   #2
ResourceSpace
Форумчанин
 
Аватар для ResourceSpace
 
Регистрация: 30.06.2015
Сообщений: 353
По умолчанию

Какая любопытная штука)
Так а что именно надо сделать-то? Какую анимацию, чего?
Термин "вторичной поверхности" какой-то странный, поясните?
ResourceSpace вне форума Ответить с цитированием
Старый 18.10.2015, 07:51   #3
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Цитата:
Термин "вторичной поверхности" какой-то странный, поясните?
Препод имел ввиду буффер в виде некой канвы, на которой сначала происходит размещение объектов, а уже потом вся канва рисуется на экране. Принцип двойной буфферизации.
Alecksandra12, я угадал? Если да, то опиши перменку типа TCanvas. Глобально. Создай ее объект в событии создания формы, и задай размеры:
Код:
var canv:TCanvas;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
canv:=TCanvas.Create; canv.Width:=Width; Canv.Height:=Height;
teta:=pi/6;
...
перепиши:
Код:
procedure Line(a,b:TPoint);
begin
with canv do
 begin
  moveto(a.x,a.y);
  lineto(b.x,b.y);
 end;
end;
И
Код:
procedure DrawParallelepiped;
begin
Line(s[1],s[2]);
...
Line(s[4],s[8]);

Form1.Canvas.CopyRect(ClientRect,canv,ClientRect);
end;
Про CopyRect почитай в хелпе, я могу ошибаться на счет его параметров. Уточни.

Идея ясна?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 18.10.2015, 11:24   #4
Alecksandra12
Пользователь
 
Регистрация: 05.10.2015
Сообщений: 18
По умолчанию

Я поискала в инете в книгах нашла методичку и в ней вот какой описан код
Удаление старого объекта с экрана
Для повышения скорости создания изображения часто используется следующая технология –
объект помещается в память, а затем копируется в нужное место экрана.
Этот процесс можно разбить на следующие этапы:
1. закрашивание картинкой фона первой поверхности в памяти
2. отрисовка изображения в памяти поверх фона
3. копирование изображения из памяти на экран
4. вычисление новых координат объектов
5. снова п. 1
Нам потребуются две вспомогательных поверхности – одна для быстрого закрашивания фоном
(будет хранить в себе фон изображения), а в другой мы будем создавать движение нашего куба.
Для представления этих поверхностей в Delphi удобно воспользоваться переменными типа
TBitmap, которые хранят в себе изображения. Изменять эти изображения можно с помощью
свойства TBitmap Canvas, которое имеет те же функции, что и Canvas формы.
Объявим эти переменные в разделе var:
Код:
buf: TBitmap;
blink_buf: TBitmap; //поверхность для фона
Но для того чтобы использовать эти переменные одного их объявления недостаточно, нужно ещѐ
проинициализировать их:
Код:
buf:= TBitmap.Create;
buf.Width := Form1.ClientWidth; //зададим ширину и высоту
buf.Height := Form1.ClientHeight;
blink_buf := TBitmap.Create;
blink_buf.LoadFromFile('delphi.bmp'); //фоновый рисунок – должен
находиться в одном каталоге с проектом
blink_buf.Width := Form1.ClientWidth;
blink_buf.Height := Form1.ClientHeight;
После того как мы создали переменные этого типа, под них выделилась память, поэтому перед
выходом из программы эту память нужно освободить. Это удобно сделать в процедуре FormDestroy:
Код:
procedure TForm1.FormDestroy(Sender: TObject);
begin
 buf.Free;
 blink_buf.Free;
end;
Закрашивание картинкой фона первой поверхности в памяти
Для копирования изображений между холстами воспользуемся командой Draw:
Код:
buf.Canvas.Draw(0 ,0, blink_buf); //скопировали в buf начиная с точки
0,0 изображение из blink_buf.
Отрисовка изображения в памяти поверх фона
Теперь мы должны рисовать не на форме, а в памяти, следовательно процедура Line измениться
следующим образом:
Код:
procedure Line( ptFrom, ptTo:TPoint);
begin
 buf.Canvas.moveto(ptFrom.x,ptFrom.y);
 buf.canvas.lineto(ptTo.x,ptTo.y);
end;
Копирование изображения из памяти на экран
Производится аналогично копированию из blink_buf:
Код:
Form1.Canvas.Draw(0, 0, buf);
Вот только не соображу как это в мой код вставить может поможете?

Последний раз редактировалось Аватар; 18.10.2015 в 11:33.
Alecksandra12 вне форума Ответить с цитированием
Старый 18.10.2015, 11:47   #5
Alecksandra12
Пользователь
 
Регистрация: 05.10.2015
Сообщений: 18
По умолчанию

Так все получилось вроде. Всем спасибо за помощь!.
Alecksandra12 вне форума Ответить с цитированием
Старый 18.10.2015, 13:02   #6
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Вот прицепилась ты к этим битмапам... Canvas - и больше ничего лишнего не надо.
Впрочем сие есть твое выбор.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 18.10.2015, 13:30   #7
Alecksandra12
Пользователь
 
Регистрация: 05.10.2015
Сообщений: 18
По умолчанию

Просто препод сказал нужно через битмап я и делаю. По другому я ему уже сдавала не принимает...

Кстате не подскажите вот .exe вроде все правильно сделала, но что-то где видно все таки не так потому что ничего не рисует.
Вот екзешник и задание.

Построить перспективную проекцию модели трехмерного изображения.
(Прямоугольный параллелепипед (в основании прямоугольник и боковые ребра
перпендикулярны основанию)
2) Получить перспективную проекцию трехмерного объекта.
3) Предусмотреть возможность смены ракурса.
4) Анимацию выполнить с помощью копирования из вторичной поверхности
Вложения
Тип файла: rar Лаб.раб. №4.rar (164.9 Кб, 8 просмотров)
Alecksandra12 вне форума Ответить с цитированием
Старый 18.10.2015, 15:56   #8
ResourceSpace
Форумчанин
 
Аватар для ResourceSpace
 
Регистрация: 30.06.2015
Сообщений: 353
По умолчанию

Сомневаюсь что тут имелась ввиду двойная буферизация... Да и в VCL для неё достаточно свойство чекнуть.
Ну если допустим, тогда причём тут "анимация"? Мне кажется 4-й пункт как-то плохо сформулирован.
ResourceSpace вне форума Ответить с цитированием
Старый 18.10.2015, 16:36   #9
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Цитата:
Да и в VCL для неё достаточно свойство чекнуть.
Ну пути препода неисповедимы
Цитата:
Мне кажется 4-й пункт как-то плохо сформулирован.
А ты как хотел? )
Только плохой постановкой задачи ВУЗы могут прокормить свой персонал посредством взяток. Се Ля Ви, елки-моталки
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 20.10.2015, 13:43   #10
phomm
personality
Старожил
 
Аватар для phomm
 
Регистрация: 28.04.2009
Сообщений: 2,899
По умолчанию

Взял на себя смелость перекроить. У Вас была ошибка в нерисовании буфера на канву формы, я когда её попрвил, увидел что там тоже всяких косяков полно, вроде нечистки буфера, непонятная загрузка из файла одноцветного рисунка (если надо вернуть, то там несложно так-то), искуственное ограничение области рисования размером этого рисунка и неудобный код работы с кнопками, я его перецепил на таймер.
В общем, переделал немало, но оригинал угадать можно
Вложения
Тип файла: zip Лаб.раб. №4_fixed.zip (207.5 Кб, 7 просмотров)
phomm вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как в SQL-запросе выполнить выполнить условие? Dux БД в Delphi 6 08.01.2015 17:52
триангуляция 2d поверхности GiletiAnna Помощь студентам 0 18.04.2013 06:24
3D поверхности Lost_Angel C++ Builder 1 29.03.2012 01:19
Макрос для копирования значений из нескольких файлов в один общий с определенным условием копирования zenner Microsoft Office Excel 0 21.03.2011 14:48
Закрытие вторичной USERFORM - глюк VBE Aent Microsoft Office Excel 9 08.08.2010 00:08