Текущий архив: 2004.12.19;
Скачать: CL | DM;

Вниз

Быстрый вывод Bitmap   Найти похожие ветки 

← →
REA   (2004-12-02 17:19) [0]

Как быстро-быстро кинуть Bitmap на экран без DirectX?
Bitmap приличного размера и нужно нечто вроде анимации.
Каким должен быть сам Bitmap для быстрого вывода?

---

← →
TButton ©   (2004-12-02 17:28) [1]

> Bitmap приличного размера

что вы подразумеваете под словом приличный?
как бы то ни было быстрее BitBlt вы не нарсуете этот битмап.
если прямо на экран (без формы)
Handle экрана (SrcDC) = GetDC(0);

---

← →
REA   (2004-12-02 17:50) [2]

>что вы подразумеваете под словом приличный
допустим 800x600

>как бы то ни было быстрее BitBlt вы не нарсуете этот битмап.
Да вроде как ее и использую. Bitmap создаю CreateCompatibleBitmap. Подготавливаю всю картину в памяти и вывожу целиком на форму. Мельтюхается что то.

---

← →
REA   (2004-12-02 18:02) [3]

Мне показалось, что мерцание вызвано тем, что вывод не синхронизирован с ходом луча монитора. Есть какая-либо возможность дождаться синхронизации?

---

← →
Style ©   (2004-12-02 20:36) [4]

Тока что проверял 4 картинки bmp. Мерцания не заметил ?


type
 TForm1 = class(TForm)
   Timer1: TTimer;
   procedure FormCreate(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
 public
   Bitmaps: array[1..4] of TBitmap;
   astep, apos:integer;
   {  Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i: integer;
begin
 for i := Low(Bitmaps) to High(Bitmaps) do
 begin
   Bitmaps[i] := TBitmap.Create;
   Bitmaps[i].LoadFromFile(ExtractFileDir(Application.ExeName) + "\" + IntToStr(i)+".bmp");
 end;
 apos := 1;
 astep := 1;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Canvas.Draw(0,0,Bitmaps[apos]);

 apos := apos + astep;
 if ( (apos = Low(Bitmaps)) or (apos = High(Bitmaps)) ) then
  astep := astep * -1;

end;

---

← →
REA   (2004-12-03 10:55) [5]

Задача пока несколько иначе выглядит. А именно передвинуть один bitmap допустим справа налево. Код такой:

 TForm1 = class(TForm)
   Timer1: TTimer;
   Image1: TImage;
   Procedure Timer1Timer(Sender: TObject);
   Procedure FormCreate(Sender: TObject);
 private
 public
   bmp: TBitmap;
   L, T: Integer;
 end;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
 bmp := TBitmap.Create;
 bmp.Handle := CreateCompatibleBitmap(Canvas.Handle, Width, Height);
 L := 1000;
 T := 100;
End;

Procedure TForm1.Timer1Timer(Sender: TObject);
Begin
 PatBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, WHITENESS); // в память
 bmp.Canvas.Draw(L, T, Image1.Picture.Graphic); // в память
 BitBlt(Canvas.Handle, 0, 0, bmp.Width, bmp.Height, bmp.Canvas.Handle, 0, 0, SRCCOPY); // результат на экран
 Dec(L, 10);
 If L < 0 Then L := 1000;
End;

---

← →
Style ©   (2004-12-03 20:36) [6]

Да уж, действительно что-то мерцает :(
Я даже попробовал засунуть все кадры анимации в память, т.е. сначала нарисовал все кадры и каждый TBitmap положил в TList и выводил по кадру... Все равно как-то мерцает...
Хотя потом поробовал сменить шаг, поставил 2 пикселя и вроде мерцание пропало.


unit fTest;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls;

type
 TForm1 = class(TForm)
   Image1: TImage;
   Timer1: TTimer;
   procedure FormCreate(Sender: TObject);
   procedure FormClick(Sender: TObject);
 private
   { Private declarations }
 public
  BmpList: TList;
  apos, astep: integer;
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
x,y: integer;
Bmp: TBitmap;
begin
  BmpList := TList.Create;

  y := 50;
  for i := 0 to 200 do
  begin
    Bmp := TBitmap.Create;
    Bmp.Handle := CreateCompatibleBitmap(Canvas.Handle,Width,Height);
    Bmp.Canvas.Brush.Color := clWhite;
    Bmp.Canvas.FillRect(Bmp.Canvas.ClipRect);
    x := 250 - (i*2);
    Bmp.Canvas.Draw(x,y,Image1.Picture.Bitmap);
    BmpList.Add(Bmp);
  end;

  apos := 0;
  astep := 1;

end;

procedure TForm1.FormClick(Sender: TObject);
begin
  while true do
  begin
   Application.ProcessMessages;
   BitBlt(Canvas.Handle,0,0,Width,Height,TBitmap(BmpList.Items[apos]).Canvas.Handle,0,0,SRCCOPY);
   Inc(apos,astep);
   if (apos <= 0) or (apos >= BmpList.Count-1) then astep := astep*-1;

   sleep(1);
  end;
end;

end.


---

Страницы: 1 вся ветка

Текущий архив: 2004.12.19;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.029 c