перерисовка битмапа по таймеру

[hunter03]

Добрый день!
есть такая проблемка:
по таймеру создаю битмап, отображаю его в image, ставлю имтервал например 100, т.е. частота обновления 10 раз в секунду, но отрисовует очень медленно...вот код, который написал:

procedure TForm1.Timer1Timer(Sender: TObject);
const ind=324*256*3;
var bmp:TBitmap;
    Frame:array[0..ind]of Integer ;
    i,index,row,col,j:Integer;
    mass:Integer;
    pixcount,height:Integer;
    fullpix,Thread:Integer;
    rgbcolor,currcount:Integer;
begin
    Inc(count); if count = 256 then count:=0;
  bmp:=TBitmap.Create;

  bmp.Width:=324;
  bmp.Height:=256;

  pixcount:=324*256;
  // bmp.PixelFormat:=pf8bit;
  for mass:=0 to pixcount do begin
  Frame[mass]:=160;
  end;

  for height:=0 to 256 do begin
  fullpix:= (height+1)*324;
  i:=height*324;
  for index:=i to fullpix do begin
  Frame[index]:=height;
  end;end;

  bmp.Width:=324;
  bmp.Height:=256;

  for row:=0 to 324 do begin
  for col:=0 to 256 do begin
  rgbcolor:=Frame[col*324+row]+count;
     //if rgbcolor<0 then rgbcolor:=255;
     //if rgbcolor>255 then rgbcolor:=0;
  bmp.Canvas.Pixels[row,col]:=RGB(rgbcolor,rgbcolor,rgbcolor);
        //Frame[row*256+col];
  end;
  end;
  //Form1.Image1.Repaint;
  Form1.Image1.Picture.Assign(bmp);
  //form1.Canvas.Assign(bmp);
    bmp.FreeImage;





 end;

как можно ускорить работу???

[hunter03]

пробовал сделать с использованием потоков, так по идее должно быть быстрее...
но ничего не отображается...

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, ShellApi,
  Dialogs, SyncObjs, ExtCtrls, StdCtrls, Buttons,  directshow9, ActiveX, Jpeg, WinInet, IniFiles;

type
  TNewThread = class(TThread)
  private
       Rez : Integer;
  protected
    procedure Execute; override;
  public
    procedure Sync;
    constructor Create(CreateSuspended: Boolean);
  end;

var
   Form1: TForm1;
   count,currcount,Thread:Integer;
   CS:Tcriticalsection;
   work:Boolean;  bmp:TBitmap;
implementation

{$R *.dfm}
constructor TNewThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
end;

procedure TNewThread.Execute;
 const ind=324*256*3;
var
    Frame:array[0..ind]of Integer ;
    i,index,row,col,j:Integer;
    mass:Integer;
    pixcount,height:Integer;
    fullpix:Integer;
    rgbcolor,currcount:Integer;
begin
   while work do begin
  CS.Enter;
  Inc(count);
  if count<256 then currcount:=count else work:=False;
  cs.Leave;
  if work then begin
  bmp:=TBitmap.Create;
  pixcount:=324*256;
  for mass:=0 to pixcount do begin
  Frame[mass]:=160;
  end;
  for height:=0 to 256 do begin
  fullpix:= (height+1)*324;
  i:=height*324;
  for index:=i to fullpix do begin
  Frame[index]:=height;
  end;end;

  bmp.Width:=324;
  bmp.Height:=256;

  for row:=0 to 324 do begin
  for col:=0 to 256 do begin
  rgbcolor:=Frame[col*324+row]+currcount;
     //if rgbcolor<0 then rgbcolor:=255;
     //if rgbcolor>255 then rgbcolor:=0;
  bmp.Canvas.Pixels[row,col]:=RGB(rgbcolor,rgbcolor,rgbcolor);
        //Frame[row*256+col];
  end;
  end;
  //Form1.Image1.Repaint;
 // Form1.Image1.Picture.Assign(bmp);
  //form1.Canvas.Assign(bmp);
  //  bmp.FreeImage;
  rez:=1;

Synchronize(Sync);

  end;

 end;

 dec(Thread);
 if Thread=0 then ShowMessage('OK');

  end;

  procedure TNewThread.Sync;
begin
   Form1.Image1.Repaint;
   Form1.Image1.Picture.Assign(bmp);
   bmp.FreeImage;



end;


procedure TForm1.FormCreate(Sender: TObject);
begin
count:=-1; work:=True;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);

begin
//Timer1.Enabled:=True;
for Thread:=1 to 10 do begin
TNewThread.Create(false);
end;
end;

посмотрите код пожалуйста, может я что то не дописал...?

[phomm]

Свойство Pixels - не для быстрой работы )
Используйте TBitmap.ScanLine
поищите на форуме примеры работы с ним, вот например мой
http://programmersforum.ru/showpost....&postcount=628
Также негоже по таймеру создавать объект (Вы его кстати не уничтожаете, freeimage - неправильно, надо просто free), проще хранить такой битмап как поле формы, создать и уничтожить один раз.
Более того, канвас поддерживает буфферизацию в своей GDI-сути, и не задействовать её - лишняя нагрузка на проц, надо на каждом шаге менять только то, что требуется, остальное не трогать, как именно это сделать - уже работа программиста (хотя у Вас похоже нет возможностей к такой оптимизации, каждый шаг вся картинка меняется, насколько я вник в код)

ПС. Потоки не дают ускорения почти ни в чём на такой задаче, тем более если процессор не многоядерный.
А вообще от такого кода хочется биться в печали, стиль вообще и идентация в частности - хромают, куча магических цифр - которые просто просятся быть константами, по уму ещё должно быть разделение логики обновления данных (таймера) и прорисовки, сами команды прорисовки должны лежать в onpaint формы если рисовать на канве формы, а в таймере только invalidate вызывать надо.

[hunter03]

да, каждый раз картинка должна полностью меняться...как оптимизировать...не представляю...единственная , по моему, возможность - потоки...но я ,видимо, что то не так сделал...не работает второй код.

[hunter03]

Ну потоки ,наверно, да...не много выиграть можно...

Используйте TBitmap.ScanLine

это гораздо ускорит работу?
у Вас в примере довольно быстро обновлялась графика.

[hunter03]

кстати, нашел следующий код:
[CODE]type
{Used for pointer math under Win16}
PPtrRec = ^TPtrRec;
TPtrRec = record
Lo: Word;
Hi: Word;
end;
{$ENDIF}

{Used for huge pointer math}
function GetBigPointer(lp: pointer; Offset: Longint): Pointer;
begin
{$IFDEF WIN32}
GetBigPointer := @PByteArray(lp)^[Offset];
{$ELSE}
Offset := Offset + TPtrRec(lp).Lo;
GetBigPointer := Ptr(TPtrRec(lp).Hi + TPtrRec(Offset).Hi *
SelectorInc,
TPtrRec(Offset).Lo);
{$ENDIF}
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hPixelBuffer : THandle; {Handle to the pixel buffer}
lpPixelBuffer : pointer; {pointer to the pixel buffer}
lpPalBuffer : PLogPalette; {The palette buffer}
lpBitmapInfo : PBitmapInfo; {The bitmap info header}
BitmapInfoSize : longint; {Size of the bitmap info header}
BitmapSize : longint; {Size of the pixel array}
PaletteSize : integer; {Size of the palette buffer}
i : longint; {loop variable}
j : longint; {loop variable}
OldPal : hPalette; {temp palette}
hPal : hPalette; {handle to our palette}
hBm : hBitmap; {handle to our bitmap}
Bm : TBitmap; {temporary TBitmap}
Dc : hdc; {used to convert the DOB to a DDB}
IsPaletteDevice : bool;
cross:HBITMAP;
Dcc,M: HWnd;
begin
Application.ProcessMessages;
{If range checking is on - turn it off for now}
{we will remember if range checking was on by defining}
{a define called CKRANGE if range checking is on.}
{We do this to access array members past the arrays}
{defined index range without causing a range check}
{error at runtime. To satisfy the compiler, we must}
{also access the indexes with a variable. ie: if we}
{have an array defined as a: array[0..0] of byte,}
{and an integer i, we can now access a[3] by setting}
{i := 3; and then accessing a[i] without error}
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}

{Lets check to see if this is a palette device - if so, then}
{we must do palette handling for a successful operation.}
{Get the screen's dc to use since memory dc's are not reliable}
dc := GetDc(0);
IsPaletteDevice :=
GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE;
{Give back the screen dc}
dc := ReleaseDc(0, dc);

{Ðàçìåð èíôîðìàöèè î ðèñóíêå äîëæåí ðàâíÿòüñÿ ðàçìåðó BitmapInfo}
{ïëþñ ðàçìåð òàáëèöû öâåòîâ, ìèíóñ îäíà òàáëèöà}
{òàê êàê îíà óæå îáúÿâëåíà â TBitmapInfo}
BitmapInfoSize := sizeof(TBitmapInfo) + (sizeof(TRGBQUAD) * 255);

{The bitmap size must be the width of the bitmap rounded}
{up to the nearest 32 bit boundary}
BitmapSize := (sizeof(byte) * 256) * 256;

{Ðàçìåð ïàëèòðû äîëæåí ðàâíÿòüñÿ ðàçìåðó TLogPalette}
{ïëþñ êîëè÷åñòâî ÿ÷ååê öâåòîâîé ïàëèòðû - 1, òàê êàê}
{îäíà ïàëèòðà óæå îáúÿâëåíà â TLogPalette}
if IsPaletteDevice then
PaletteSize := sizeof(TLogPalette) + (sizeof(TPaletteEntry) * 255);

{Âûäåëÿåì ïàìÿòü ïîä BitmapInfo, PixelBuffer, è Palette}
GetMem(lpBitmapInfo, BitmapInfoSize);
hPixelBuffer := GlobalAlloc(GHND, BitmapSize);
lpPixelBuffer := GlobalLock(hPixelBuffer);

if IsPaletteDevice then
GetMem(lpPalBuffer, PaletteSize);

{Çàïîëíÿåì íóëÿìè BitmapInfo, PixelBuffer, è Palette}
FillChar(lpBitmapInfo^, BitmapInfoSize, #0);
FillChar(lpPixelBuffer^, BitmapSize, #0);
if IsPaletteDevice then
FillChar(lpPalBuffer^,PaletteSize, #0);

{Çàïîëíÿåì ñòðóêòóðó BitmapInfo}
lpBitmapInfo^.bmiHeader.biSize := sizeof(TBitmapInfoHeader);
lpBitmapInfo^.bmiHeader.biWidth := 256;
lpBitmapInfo^.bmiHeader.biHeight := 256;
lpBitmapInfo^.bmiHeader.biPlanes := 1;
lpBitmapInfo^.bmiHeader.biBitCount := 8;
lpBitmapInfo^.bmiHeader.biCompressi on := BI_RGB;
lpBitmapInfo^.bmiHeader.biSizeImage := BitmapSize;
lpBitmapInfo^.bmiHeader.biXPelsPerM eter := 0;
lpBitmapInfo^.bmiHeader.biYPelsPerM eter := 0;
lpBitmapInfo^.bmiHeader.biClrUsed := 256;
lpBitmapInfo^.bmiHeader.biClrImport ant := 256;

{Çàïîëíÿåì òàáëèöó öâåòîâ BitmapInfo îòòåíêàìè ñåðîãî: îò ÷¸ðíîãî äî áåëîãî}
for i := 0 to 255 do
begin
lpBitmapInfo^.bmiColors[i].rgbRed := i;
lpBitmapInfo^.bmiColors[i].rgbGreen := i;
lpBitmapInfo^.bmiColors[i].rgbBlue := i;
end;

cross := CreateBitmap(256,256,1,8,lpBitmapIn fo);
{cross:=LoadImage(GetModuleHandle(n il),'cross4.bmp',IMAGE_BITMAP,0,0,L R_LOADFROMFILE);
//a?ocei aeoiai
}
DC:=GetDC(Form1.Handle);//aa?ai eiioaeno oi?iu
M:=CreateCompatibleDC(DC);//nicaaai a?aiaiiue eiioaeno
SelectObject(M,cross);//i?eiaiyai e iaio iao aeoiai
GetObject(cross,sizeof(lpBitmapInfo ),@lpBitmapInfo^.bmiHeader);//aa?ai aaiiua aeoiaiaf
BitBlt(DC,324, 256,256,256,M,0,0,SRCCOPY);//?enoai aeoiai ia eiioaenoa oi?iu(eniieucoy oe?eio e aunioo)
DeleteDC(M);//noe?aai a?aiaiiue eiioaeno

end;
пытаюсь это так отобразить на форме...но ничего....

[Человек_Борща]

Найти и копирнуть код - мало, надо ещё мозги включать и головой подумать Код - всего-то пример реализации быстрого рисования. Отличайте примеры от готового кода.

Возьмите на вооружение библиотеку Graphics32 Там возможностей по-больше будет да и по-шустрей с графикой работает, в частности есть 2d и 3d.
Не говоря уже про 32хбитный Bitmap и Canvas, ну и пара десятков оптимизаций изображения.

Так же посмотрите JclGraphics модуль из Jedi Code Library

[phomm]

омг.. я бы назвал это дерьмом винапишного мамонта. (и лично я бы не использовал никогда) Ну, может в обёртке такое допустимо, но явно не так монолитно.
Ну, винапи это конечно не полный отстой, но зачем использовать ритуальную шаманскую магию, когда можно (пусть и с небольшим импактом) задействовать современные синхрофазотроны.

Если так ратуете за скорость обработки пихелей на проце, то сразу берите FastDIB библиотечку (гуглим), там пихели гоняются посредством асм-команд на фпу, и задачи уровня видюхи летают на проце.

Но я повторюсь, GDI и дельфи-обёртки поверх него чрезвычайно годный инструмент для определённого круга задач, например: http://programmersforum.ru/showpost....&postcount=169 хотя там сканлайн почти не используется (ну, в паре мест), вся производительность и работа с графикой достигаются практически только канвасом и совсем немного gdi-винапишками (типа bitblt stretchblt)

Ну, и следите, пожалуйста, за тегом CODE

ПС. sizeof(byte) - в юмор. (ну инт или чар ещё меняются, и код может учитывать их, но байт и ворд - не верю что поменяются, ну а если они вдруг поменяются, то окружающий их код уже точно будет бактериями на дереве эволюции технологий программирования).

[Slym]

http://www.programmersforum.ru/showt...=242122&page=2