Форум: "Начинающим";
Текущий архив: 2007.06.03;
Скачать: [xml.tar.bz2];
ВнизРаспадание картинки Найти похожие ветки
← →
Calibr © (2007-05-12 17:16) [0]Хочу сделать такой эффект, распадание картинки на квадратики. Вот что у меня получилось.
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.
← →
DVM © (2007-05-12 17:24) [1]
> Чтоб это не висло.
Не делать в основном потоке длительных циклов.
← →
Calibr © (2007-05-12 17:27) [2]Ну этот цикл больше негде реализовать, если не в основном потоке.
← →
DVM © (2007-05-12 17:36) [3]
> Calibr
А зачем тебе эта туча TImage. Достаточно же обычных TBitmap. В циклы хотя бы Application.ProcessMessages вставь.
Но подход вообще в корне неправильный. Не так надо.
← →
Calibr © (2007-05-12 17:42) [4]А как?Намекни хотябы. А TBitmap - это же тип. Как я его, на канву выводить чтоли буду?
← →
antonn © (2007-05-12 17:45) [5]
> Как я его, на канву выводить чтоли буду?
ага
← →
DVM © (2007-05-12 17:52) [6]
> А как?Намекни хотябы.
Ну вариант такой:
1) Делаем скриншот рабочего стола.
2) По размерам скриншота вычисляем нужное количество сегментов.
3) Создаем массив, в котором содержится информация о сегментах - их оригинальное положение в оригинальном скриншоте и новое положение.
4) Запускаем таймер на нужную частоту кадров.
5) При срабатывании таймера вычисляем новые координаты координаты сегментов и заносим их в массив. Создаем битмап в памяти, равный размеру скриншота. Пробегаемся по массиву и в соответствии с координатами в оном копируем куски картинки из скриншота в этот новый битмап. Далее копируем весь битмап на экран. Копируем с пом BitBlt.
Данный подход может обеспечить чут ли не сотню FPS, особенно если вместо TBitmap использовать TFastDIB.
← →
Calibr © (2007-05-12 18:37) [7]Спасибо. Попробую сделать!!!
← →
Calibr © (2007-05-13 11:55) [8]Что такое TFastDIB?
← →
Zagaevskiy © (2007-05-13 13:23) [9]> Calibr © (13.05.07 11:55) [8]
А действительно, что есть TFastDIB?
← →
DVM © (2007-05-13 15:56) [10]
> Что такое TFastDIB?
Несложная библиотека для быстрой работы с графикой на Delphi и с исходниками.
← →
Calibr © (2007-05-13 16:34) [11]Не подскажете ссылку, где можно скачать TFastDIB. Сколько искал везде мертвые ссылки.
← →
DVM © (2007-05-13 16:42) [12]http://sourceforge.net/projects/tfastdib
← →
Calibr © (2007-05-13 16:51) [13]Спасибо DVM!!!
← →
Calibr © (2007-05-13 17:50) [14]a: TFastDIB
...
a := TFastDIB.Create;
BitBlt(a.hDC, 0, 0, bDesktop.Width, bDesktop.Height,
GetDC(GetDesktopWindow), 0, 0, SRCCOPY);
a.saveToFile("C:\1.bmp")
Файл пустой, и не открывается вообще. В чем проблема??
← →
Calibr © (2007-05-13 17:50) [15]a: TFastDIB
...
a := TFastDIB.Create;
BitBlt(a.hDC, 0, 0, bDesktop.Width, bDesktop.Height,
GetDC(GetDesktopWindow), 0, 0, SRCCOPY);
a.saveToFile("C:\1.bmp")
Файл пустой, и не открывается вообще. В чем проблема??
← →
DVM © (2007-05-13 17:58) [16]Размеры то задай и цветность: SetSize
← →
Calibr © (2007-05-13 18:02) [17]Понял. Получилось!
← →
Calibr © (2007-05-13 21:36) [18]Спасибо тебе большое. Благодаря тебе у меня все получилось. Вот результат. Зацени.
http://JanMihailPrograms.narod.ru/Rassipanie.exe
← →
DVM © (2007-05-13 21:59) [19]
> Вот результат. Зацени.
Ну вот, очень даже хорошо. Быстро и гладко работает.
FastDIB оно вообще рулез. Сам использую и другим рекомендую.
← →
Calibr © (2007-05-13 22:01) [20]А можно сделать, чтоб фон который сзади остается был не черным а каким-либо другим цветом или картинкой?
← →
homm © (2007-05-13 22:06) [21]> А можно сделать
Я разрешаю.
← →
DVM © (2007-05-13 22:07) [22]
> А можно сделать, чтоб фон который сзади остается был не
> черным а каким-либо другим цветом или картинкой?
Можно, хоть огонь горящий там нарисовать.
Создавай два битмапа. Один с фоном, другой результирующий, который будет выводиться на экран. Сначала на результирующий копируй фоновой битмап, а сверху свои сегменты.
Ты, кстати, заметил - нагрузка на процессор почти нулевая.
← →
Calibr © (2007-05-13 22:10) [23]
> Ты, кстати, заметил - нагрузка на процессор почти нулевая.
Заметил!!! А чем отличается TBitmap от TFastDIB? Что если я сделал бы с TBitmap производительность бы уменьшилась?
← →
DVM © (2007-05-13 22:17) [24]
> А чем отличается TBitmap от TFastDIB?
Намного более оптимальные алгоритмы обработки.
Вот тут кое-что: http://www.delphimaster.ru/articles/dib/
> Что если я сделал бы с TBitmap производительность бы уменьшилась?
Я не знаю, чего ты там в коде писал, но думаю именно в твоем случае не сильно.
← →
Knight © (2007-05-14 00:18) [25]> [19] DVM © (13.05.07 21:59)
Смотря где… у меня с плавностью напряг, т.е. она появляется, но когда на экране уже всё развалилось процентов на 80… :(
← →
Knight © (2007-05-14 00:20) [26]Мож лучше DelphiX заюзать?
← →
homm © (2007-05-14 00:35) [27]> Мож лучше DelphiX заюзать?
Это в любом случае не лучше.
← →
Knight © (2007-05-14 08:49) [28]> [27] homm © (14.05.07 00:35)
Значит алгоритм не оптимален... потому-как и более сложные вещи так не тормозят.
← →
DVM © (2007-05-14 10:26) [29]
> Knight © (14.05.07 00:18) [25]
> > [19] DVM © (13.05.07 21:59)
>
> Смотря где… у меня с плавностью напряг, т.е. она появляется,
> но когда на экране уже всё развалилось процентов на 80…
> :(
Ну он, наверняка там реализовал задуманное не совсем хорошо.
У меня правда летает буквально при нулевой загрузке процессора на разрешении 1280*1024.
← →
DVM © (2007-05-14 10:28) [30]
> Calibr ©
Кстати, при наличии более одного монитора - все действие разворачивается только на основном.
← →
Calibr © (2007-05-14 13:39) [31]
> Смотря где… у меня с плавностью напряг, т.е. она появляется,
> но когда на экране уже всё развалилось процентов на 80…
> :(
Может переменную с текущей картинкой не удаляешь. У меня тоже так было. Потом переменную в конце таймера стал очищать, все стало замечательно работать.
← →
DVM © (2007-05-14 13:55) [32]
> Может переменную с текущей картинкой не удаляешь. У меня
> тоже так было
Так он твою программу запускал. Исходников то нет.
← →
Knight © (2007-05-14 14:04) [33]> [32] DVM © (14.05.07 13:55)
Во.. а чё-то ответ читаю и не въеду никак... причём тут таймеры и переменные, если прога автора ветки :))))
← →
{RASkov} © (2007-05-14 14:35) [34]> [32] DVM © (14.05.07 13:55)
> [33] Knight © (14.05.07 14:04)
Исходник в самом начале ветки ;) Алгоритм, думаю, не изменился во второй версии с TFastDIB"ом.....)
← →
DVM © (2007-05-14 14:38) [35]
> Алгоритм, думаю, не изменился во второй версии с TFastDIB"ом.
> ....)
я ему сказал же как делать. С тем что в начале общего не имеет.
← →
Knight © (2007-05-14 14:39) [36]> [34] {RASkov} © (14.05.07 14:35)
Ага.. я ещё качать исходники буду, потом компоненты ставить... Скачал, поглядел и будет :)))
← →
{RASkov} © (2007-05-14 14:49) [37]> [36] Knight © (14.05.07 14:39)
:) Зачем качать, я так понимаю, там по ссылке - ехешник, а сам исходник в [0] ;) Я ж пошутил. :-)
> [35] DVM © (14.05.07 14:38)
Кроме [0] я не видел более, просто подумал, что основной алгоритм работы программы остался тот же.....
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2007.06.03;
Скачать: [xml.tar.bz2];
Память: 0.55 MB
Время: 0.05 c