Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 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)

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


 
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.047 c
15-1178698333
Kerk
2007-05-09 12:12
2007.06.03
Ищу единомышленников...


2-1179156321
Ski1
2007-05-14 19:25
2007.06.03
как типу PAnsiChar присвоить тип String


2-1179193956
delphino
2007-05-15 05:52
2007.06.03
Как разделить права доступа к компонентам?


1-1176043931
mr.sokolOFF
2007-04-08 18:52
2007.06.03
Косольные Приложения


2-1179142023
ыавпып
2007-05-14 15:27
2007.06.03
String





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский