Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Распадание картинки [D7, WinXP]


Страницы:   1 2

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.

Calibr   (2007-05-13 18:02:00) [21]

Понял. Получилось!

DVM   (2007-05-13 17:58:00) [22]

Размеры то задай и цветность: SetSize

Calibr   (2007-05-13 17:50:00) [23]

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:00) [24]

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 16:51:00) [25]

Спасибо DVM!!!

DVM   (2007-05-13 16:42:00) [26]

http://sourceforge.net/projects/tfastdib

Calibr   (2007-05-13 16:34:00) [27]

Не подскажете ссылку, где можно скачать TFastDIB. Сколько искал везде мертвые ссылки.

DVM   (2007-05-13 15:56:00) [28]


> Что такое TFastDIB?

Несложная библиотека для быстрой работы с графикой на Delphi и с исходниками.

Zagaevskiy   (2007-05-13 13:23:00) [29]

> Calibr ©   (13.05.07 11:55) [8]
А действительно, что есть TFastDIB?

Calibr   (2007-05-13 11:55:00) [30]

Что такое TFastDIB?

Calibr   (2007-05-12 18:37:00) [31]

Спасибо. Попробую сделать!!!

DVM   (2007-05-12 17:52:00) [32]


> А как?Намекни хотябы.

Ну вариант такой:

1) Делаем скриншот рабочего стола.
2) По размерам скриншота вычисляем нужное количество сегментов.
3) Создаем массив, в котором содержится информация о сегментах - их оригинальное положение в оригинальном скриншоте и новое положение.
4) Запускаем таймер на нужную частоту кадров.
5) При срабатывании таймера вычисляем новые координаты координаты сегментов и заносим их в массив. Создаем битмап в памяти, равный размеру скриншота. Пробегаемся по массиву и в соответствии с координатами в оном копируем куски картинки из скриншота в этот новый битмап. Далее копируем весь битмап на экран. Копируем с пом BitBlt.
Данный подход может обеспечить чут ли не сотню FPS, особенно если вместо TBitmap использовать TFastDIB.

antonn   (2007-05-12 17:45:00) [33]


> Как я его, на канву выводить чтоли буду?

ага

Calibr   (2007-05-12 17:42:00) [34]

А как?Намекни хотябы. А TBitmap - это же тип. Как я его, на канву выводить чтоли буду?

DVM   (2007-05-12 17:36:00) [35]


> Calibr

А зачем тебе эта туча TImage. Достаточно же обычных TBitmap. В циклы хотя бы Application.ProcessMessages вставь.

Но подход вообще в корне неправильный. Не так надо.

Calibr   (2007-05-12 17:27:00) [36]

Ну этот цикл больше негде реализовать, если не в основном потоке.

DVM   (2007-05-12 17:24:00) [37]


> Чтоб это не висло.

Не делать в основном потоке длительных циклов.

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо