| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Распадание картинки [D7, WinXP]
Calibr © (2007-05-12 17:16:00)Хочу сделать такой эффект, распадание картинки на квадратики. Вот что у меня получилось.
http://janmihailprograms.narod.ru/Raspadanie.exe
Как это можно сделать более рационально. Чтоб это не висло. Вот код моего замысла.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TImages = record
aBmp : TImage;
Fall : Byte;//1 - вылет влево, 2 - вылет вправо,
//0 - стоит на месте
x, y : Integer;
end;
const
GridSize = 50;//Размер выпадающих кубиков
var
Form1 : TForm1;
Tablo : array of array of Byte;//0 - кубик на месте,
//1 - кубик вылетел
Images : array of array of TImages;
Kol : Integer;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
bmp : TBitmap;
i, j: Integer;
begin
DoubleBuffered := true;//Двойная буферизация вывода
//Считываем рисунок с рабочего стола
bmp := TBitmap.Create;
bmp.Width := Screen.Width;
bmp.Height := Screen.Height;
BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
GetDC(GetDesktopWindow), 0, 0, SRCCopy);
Image1.Picture.Bitmap := bmp;
bmp.Free;
Image1.Canvas.Pen.Color := clBlue;
Image1.Canvas.Brush.Color := clBlue;
//Рисуем сетку
(* i := 0;
repeat
Inc(i, GridSize);
Image1.Canvas.MoveTo(i, 0);
Image1.Canvas.LineTo(i, Screen.Height);
Image1.Canvas.MoveTo(0, i);
Image1.Canvas.LineTo(Screen.Width, i);
until i >= Screen.Width; *)
//Создаем массив Tablo
SetLength(Tablo, Screen.Width div GridSize + 1);
for i := 0 to length(Tablo) - 1 do
SetLength(Tablo[i], Screen.Height div GridSize + 1);
//Создаем массив aBmp
SetLength(Images, length(Tablo));
for i := 0 to length(Images) - 1 do
SetLength(Images[i], length(Tablo[0]));
//Заполняем массив aBmp
i := 0;
j := 0;
randomize;
repeat
Images[i, j].aBmp := TImage.Create(Self);
Images[i, j].aBmp.Parent := Self;
Images[i, j].aBmp.Left := i * Gridsize;
Images[i, j].aBmp.Top := j * GridSize;
Images[i, j].aBmp.Width := GridSize;
Images[i, j].aBmp.Height := GridSize;
BitBlt(Images[i, j].aBmp.Canvas.Handle, 0, 0, GridSize, GridSize,
Image1.Canvas.Handle, i * GridSize, j * GridSize, SRCCOPY);
Images[i, j].Fall := 0;
Images[i, j].x := 5;
Images[i, j].y := -10;
Inc(i);
if i = length(Tablo) then
begin
i := 0;
Inc(j);
end;
until j = length(Tablo[0]);
Timer1.Enabled := true;
end;
(* Таймер находит случайный квадратик *)
procedure TForm1.Timer1Timer(Sender: TObject);
label
Nach1;
var
i, j: Integer;
begin
kol := 0;
Nach1:
Randomize;
i := random(length(Images));
j := random(length(Images[0]));
if Images[i, j].Fall = 0 then
Images[i, j].Fall := random(2) + 1;
for j := 0 to length(Images[0]) - 1 do
for i := 0 to length(Images) - 1 do
if Images[i, j].Fall = 1 then
begin
if Images[i, j].aBmp.Top >= Screen.Height then
Continue;
Images[i, j].aBmp.BringToFront;
Images[i, j].aBmp.Left := Images[i, j].aBmp.Left - Images[i, j].x;
Images[i, j].aBmp.Top := Images[i, j].aBmp.Top + Images[i, j].y;
Inc(Images[i, j].y);
Image1.Canvas.Rectangle(i * GridSize, j * GridSize,
i * GridSize + GridSize + 1,
j * GridSize + GridSize + 1);
Inc(kol);
end
else if Images[i, j].Fall = 2 then
begin
if Images[i, j].aBmp.Top >= Screen.Height then
Continue;
Images[i, j].aBmp.BringToFront;
Images[i, j].aBmp.Left := Images[i, j].aBmp.Left + Images[i, j].x;
Images[i, j].aBmp.Top := Images[i, j].aBmp.Top + Images[i, j].y;
Inc(Images[i, j].y);
Image1.Canvas.Rectangle(i * GridSize, j * GridSize,
i * GridSize + GridSize + 1,
j * GridSize + GridSize + 1);
inc(kol);
end;
if kol = 0 then
application.Terminate;
end;
end.
{RASkov} (2007-05-14 14:49:00) [1]> [36] Knight © (14.05.07 14:39)
:) Зачем качать, я так понимаю, там по ссылке - ехешник, а сам исходник в [0] ;) Я ж пошутил. :-)
> [35] DVM © (14.05.07 14:38)
Кроме [0] я не видел более, просто подумал, что основной алгоритм работы программы остался тот же.....
Knight (2007-05-14 14:39:00) [2]> [34] {RASkov} © (14.05.07 14:35)
Ага.. я ещё качать исходники буду, потом компоненты ставить... Скачал, поглядел и будет :)))
DVM (2007-05-14 14:38:00) [3]
> Алгоритм, думаю, не изменился во второй версии с TFastDIB'ом.
> ....)
я ему сказал же как делать. С тем что в начале общего не имеет.
{RASkov} (2007-05-14 14:35:00) [4]> [32] DVM © (14.05.07 13:55)
> [33] Knight © (14.05.07 14:04)
Исходник в самом начале ветки ;) Алгоритм, думаю, не изменился во второй версии с TFastDIB'ом.....)
Knight (2007-05-14 14:04:00) [5]> [32] DVM © (14.05.07 13:55)
Во.. а чё-то ответ читаю и не въеду никак... причём тут таймеры и переменные, если прога автора ветки :))))
DVM (2007-05-14 13:55:00) [6]
> Может переменную с текущей картинкой не удаляешь. У меня
> тоже так было
Так он твою программу запускал. Исходников то нет.
Calibr (2007-05-14 13:39:00) [7]
> Смотря где… у меня с плавностью напряг, т.е. она появляется,
> но когда на экране уже всё развалилось процентов на 80…
> :(
Может переменную с текущей картинкой не удаляешь. У меня тоже так было. Потом переменную в конце таймера стал очищать, все стало замечательно работать.
DVM (2007-05-14 10:28:00) [8]
> Calibr ©
Кстати, при наличии более одного монитора - все действие разворачивается только на основном.
DVM (2007-05-14 10:26:00) [9]
> Knight © (14.05.07 00:18) [25]
> > [19] DVM © (13.05.07 21:59)
>
> Смотря где… у меня с плавностью напряг, т.е. она появляется,
> но когда на экране уже всё развалилось процентов на 80…
> :(
Ну он, наверняка там реализовал задуманное не совсем хорошо.
У меня правда летает буквально при нулевой загрузке процессора на разрешении 1280*1024.
Knight (2007-05-14 08:49:00) [10]> [27] homm © (14.05.07 00:35)
Значит алгоритм не оптимален... потому-как и более сложные вещи так не тормозят.
homm (2007-05-14 00:35:00) [11]> Мож лучше DelphiX заюзать?
Это в любом случае не лучше.
Knight (2007-05-14 00:20:00) [12]Мож лучше DelphiX заюзать?
Knight (2007-05-14 00:18:00) [13]> [19] DVM © (13.05.07 21:59)
Смотря где… у меня с плавностью напряг, т.е. она появляется, но когда на экране уже всё развалилось процентов на 80… :(
DVM (2007-05-13 22:17:00) [14]
> А чем отличается TBitmap от TFastDIB?
Намного более оптимальные алгоритмы обработки.
Вот тут кое-что: http://www.delphimaster.ru/articles/dib/
> Что если я сделал бы с TBitmap производительность бы уменьшилась?
Я не знаю, чего ты там в коде писал, но думаю именно в твоем случае не сильно.
Calibr (2007-05-13 22:10:00) [15]
> Ты, кстати, заметил - нагрузка на процессор почти нулевая.
Заметил!!! А чем отличается TBitmap от TFastDIB? Что если я сделал бы с TBitmap производительность бы уменьшилась?
DVM (2007-05-13 22:07:00) [16]
> А можно сделать, чтоб фон который сзади остается был не
> черным а каким-либо другим цветом или картинкой?
Можно, хоть огонь горящий там нарисовать.
Создавай два битмапа. Один с фоном, другой результирующий, который будет выводиться на экран. Сначала на результирующий копируй фоновой битмап, а сверху свои сегменты.
Ты, кстати, заметил - нагрузка на процессор почти нулевая.
homm (2007-05-13 22:06:00) [17]> А можно сделать
Я разрешаю.
Calibr (2007-05-13 22:01:00) [18]А можно сделать, чтоб фон который сзади остается был не черным а каким-либо другим цветом или картинкой?
DVM (2007-05-13 21:59:00) [19]
> Вот результат. Зацени.
Ну вот, очень даже хорошо. Быстро и гладко работает.
FastDIB оно вообще рулез. Сам использую и другим рекомендую.
Calibr (2007-05-13 21:36:00) [20]Спасибо тебе большое. Благодаря тебе у меня все получилось. Вот результат. Зацени.
http://JanMihailPrograms.narod.ru/Rassipanie.exe
| |
Страницы: 