unit8.pas

(Delphi) Universal dib codes. Usign DIB palettes, dib bitmaps and more

unit Unit8;

interface

uses
  Graphics, Forms, ExtCtrls, Controls, Classes, UniDIB, SysUtils, ComCtrls;

{$DEFINE SequentialAccess}

type
  TForm8 = class(TForm)
    Image1: TImage;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
  private
    UDIB:TUniDIB;
    X:Integer;
    AddS:Integer;
    LP:TLogPalette256;
    StartTime:TDateTime;
    Redraws:Integer;
    procedure DoIdle (Sender: TObject; var Done: Boolean);
  end;

var
  Form8: TForm8;

implementation

{$R *.DFM}

procedure TForm8.FormCreate(Sender: TObject);
var A,B:Integer;
begin
  UDIB:=TUniDIB.Create (Image1.Width,Image1.Height,8,SBU_NONE);
  For A:=0 to 255 do
  begin
    LP.palEntry[A].peRed:=A;
    LP.palEntry[A].peGreen:=0;
    LP.palEntry[A].peBlue:=0;
  end;
  UDIB.SetPalette (LP);
  X:=0;
  AddS:=+1;
  Redraws:=0;
  StartTime:=Now;
  Application.OnIdle:=DoIdle;
  Image1.Canvas.Brush.Style:=bsClear;
end;

procedure TForm8.DoIdle (Sender: TObject; var Done: Boolean);
var A,B,C:Integer;
    R:Real;
begin
  X:=X+AddS;
  If (X=255) OR (X=0) then
    AddS:=-AddS;
  For A:=0 to Image1.Height-1 do
  begin
{$IFDEF SequentialAccess}
    UDIB.Seek (0,A);
    C:=255-abs(255-(A+X));
    For B:=0 to Image1.Width-1 do
      UDIB.SetSeqPixel (C);
{$ELSE}
    C:=255-abs(255-(A+X));
    For B:=0 to Image1.Width-1 do
      UDIB.SetPixel (B,A,C);
{$ENDIF}
  end;
  UDIB.DIBtoScreen (Image1.Canvas.Handle);
  Image1.Canvas.TextOut (5,5,'Please send me e-mail what do you');
  Image1.Canvas.TextOut (5,20,'think about this ''component'':');
  Image1.Canvas.TextOut (5,40,'[e-mail]');
  Image1.Repaint;
  Inc (Redraws);
  R:=(Now-StartTime)/0.000011574;
  If R<>0 then
    StatusBar1.SimpleText:='Frames per second : '+IntToStr (Round(Redraws/R))
  else
    StatusBar1.SimpleText:='Frames per second : ?';
  Done:=False;
end;

end.