Распадание картинки

← →
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]

← →
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)

Смотря где&#133 у меня с плавностью напряг, т.е. она появляется, но когда на экране уже всё развалилось процентов на 80&#133 :(

← →
Knight © (2007-05-14 00:20) [26]

Мож лучше DelphiX заюзать?

> Мож лучше DelphiX заюзать?

Это в любом случае не лучше.

> Knight © (14.05.07 00:18) [25]
> > [19] DVM © (13.05.07 21:59)
>
> Смотря где… у меня с плавностью напряг, т.е. она появляется,
> но когда на экране уже всё развалилось процентов на 80…
> :(

Ну он, наверняка там реализовал задуманное не совсем хорошо.
У меня правда летает буквально при нулевой загрузке процессора на разрешении 1280*1024.

> Смотря где… у меня с плавностью напряг, т.е. она появляется,
> но когда на экране уже всё развалилось процентов на 80…
> :(

Может переменную с текущей картинкой не удаляешь. У меня тоже так было. Потом переменную в конце таймера стал очищать, все стало замечательно работать.

> Может переменную с текущей картинкой не удаляешь. У меня
> тоже так было

Так он твою программу запускал. Исходников то нет.

> [32] DVM © (14.05.07 13:55)

Во.. а чё-то ответ читаю и не въеду никак... причём тут таймеры и переменные, если прога автора ветки :))))

> [32] DVM © (14.05.07 13:55)
> [33] Knight © (14.05.07 14:04)

Исходник в самом начале ветки ;) Алгоритм, думаю, не изменился во второй версии с TFastDIB"ом.....)

> Алгоритм, думаю, не изменился во второй версии с TFastDIB"ом.
> ....)

я ему сказал же как делать. С тем что в начале общего не имеет.

> [34] {RASkov} © (14.05.07 14:35)

Ага.. я ещё качать исходники буду, потом компоненты ставить... Скачал, поглядел и будет :)))

> [36] Knight © (14.05.07 14:39)

:) Зачем качать, я так понимаю, там по ссылке - ехешник, а сам исходник в [0] ;) Я ж пошутил. :-)

> [35] DVM © (14.05.07 14:38)

Кроме [0] я не видел более, просто подумал, что основной алгоритм работы программы остался тот же.....

Распадание картинки Найти похожие ветки