unit24.pas

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

unit Unit24;
{TUniDIB Example}

interface

uses
  Forms,UniDIB, SysUtils,Graphics,
  ComCtrls, Controls, Classes, ExtCtrls;
  
{$DEFINE SequentialAccess}

const C_BPP = 16; {only 16 or 24 !}

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

var
  Form24: TForm24;

implementation

{$R *.DFM}

procedure TForm24.FormCreate(Sender: TObject);
begin
  UDIB:=TUniDIB.Create (Image1.Width,Image1.Height,C_BPP,SBU_NONE);
  X:=0;
  AddS:=+1;
  Redraws:=0;
  StartTime:=Now;
  Application.OnIdle:=DoIdle;
  Image1.Canvas.Brush.Style:=bsClear;
end;

procedure TForm24.DoIdle (Sender: TObject; var Done: Boolean);
var A,B:Integer;
    R:Real;
begin
  X:=X+AddS;
  If (X=51) OR (X=0) then
    AddS:=-AddS;
  For A:=0 to Image1.Height-1 do
{$IFDEF SequentialAccess}
  begin
    UDIB.Seek (0,A);
    For B:=0 to Image1.Width-1 do
    begin
      If C_BPP=16 then
        UDIB.SetSeqPixel (((A     AND $F8) SHL 13) OR
                           ((B     AND $F8) SHL 5) OR
                           (((X*5) AND $F8) SHR 3))
      else {=> C_BBP=24}
        UDIB.SetSeqPixel (((A AND $FF) SHL 16) OR
                           ((B AND $FF) SHL 8) OR
                           ((X*5) AND $FF));
    end;
  end;
{$ELSE}
    For B:=0 to Image1.Width-1 do
    begin
      If C_BPP=16 then
        UDIB.SetPixel (B,A,((A     AND $F8) SHL 13) OR
                           ((B     AND $F8) SHL 5) OR
                           (((X*5) AND $F8) SHR 3))
      else {=> C_BBP=24}
        UDIB.SetPixel (B,A,((A AND $FF) SHL 16) OR
                           ((B AND $FF) SHL 8) OR
                           ((X*5) AND $FF));
    end;
{$ENDIF}
  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]');
  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 : ?';
  Image1.Repaint;
  Done:=False;
end;

end.