dibdemo.pas

Delphi Dib usage components. These ise a dib-paintbox... u can use them. :>)

unit DIBdemo;

interface

uses
  { Borland }
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
  Forms, StdCtrls, Dialogs, Controls, Spin, ExtCtrls,
  { Mine }
  DIBSurf, DIBpbox;

type
  TDIBDemoForm = class(TForm)
    Panel1: TPanel;
    ColoursBtn: TButton;
    syscols: TCheckBox;
    GroupBox1: TGroupBox;
    cycle: TCheckBox;
    SpinEdit1: TSpinEdit;
    Label3: TLabel;
    speedbar: TScrollBar;
    Label4: TLabel;
    PaletteBtn: TButton;
    ClearBtn: TButton;
    dpb: TDIBPaintBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Timer1: TTimer;
    RadioGroup1: TRadioGroup;
    procedure PaletteBtnClick(Sender: TObject);
    procedure PolygonBtnClick(Sender: TObject);
    procedure ColoursBtnClick(Sender: TObject);
    procedure SinusoidBtnClick(Sender: TObject);
    procedure LinesBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ClearBtnClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure cycleClick(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure dpbPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    App_Palette  : TPalette;
//    DIBsurface   : TDIBSurface;
    Original_pal : hPalette;
    win_size     : TPoint;

    procedure clear_surface;
    procedure IdleAction(Sender: TObject; var Done: Boolean);
    function  GetPalette : HPalette; override;
  end;

var
  DIBDemoForm : TDIBDemoForm;

implementation

{$R *.DFM}
uses Paldlg;

const
   mShowColors = 1;
   mLines      = 2;
   mPolygon    = 3;
   mSinusoid   = 4;
   Msg : integer = 0;

function ColorBitDepth:integer;
var
   aDC : HDC;
begin
     aDC := GetDC(0);
     try
        Result := GetDeviceCaps(aDC,BITSPIXEL);
     finally
        ReleaseDC(0,aDC);
     end;
end;

procedure TDIBDemoForm.FormCreate(Sender: TObject);
begin
  GroupBox1.Enabled := (ColorBitDepth = 8) ; // Only available in 256 colors
  App_Palette := TPalette.Create;
  App_Palette.LoadFromFile(Palette_dir+'green.pal');
  Original_pal := SelectPalette(canvas.handle,dpb.DIBsurface.Palette.Handle,false);
  Application.OnIdle := IdleAction;
end;

procedure TDIBDemoForm.FormDestroy(Sender: TObject);
begin
  SelectPalette(canvas.handle,Original_pal,false);
end;

procedure TDIBDemoForm.clear_surface;
begin
  dpb.DIBsurface.Clear;
  repaint;
end;

{ // didn't realize Delphi provided this for me ! - tut tut }
function TDIBDemoForm.GetPalette : HPalette;
begin
  if dpb.DIBSurface<>nil then
      result := dpb.DIBsurface.Palette.Handle
  else
      result := inherited GetPalette;
end;

{**************************************************************}
procedure TDIBDemoForm.PaletteBtnClick(Sender: TObject);
begin
  Application.CreateForm(TPalette_dlg, Palette_dlg);
  with Palette_dlg do
  try
    if ShowModal=mrok then
    begin
      App_Palette.LoadFromFile(FileName);
      dpb.DIBSurface.SetPalette(App_Palette.LogPalette);
      SelectPalette(canvas.handle,dpb.DIBSurface.Palette.Handle,false);
      RealizePalette(canvas.handle);
      repaint;
    end
  finally
    Release;
  end;
end;

{ just a quickie to save time with 4 pointed polygons for demo }
procedure set_polygon_vertices(var poly:array of TPoint; x1,y1,x2,y2,x3,y3,x4,y4:word);
var lp1 : word;
begin                  { the order of clockwise/anticlockwise is important }
  poly[0].x:=x1; poly[0].y:=y1;
  poly[1].x:=x2; poly[1].y:=y2;
  poly[2].x:=x3; poly[2].y:=y3;
  poly[3].x:=x4; poly[3].y:=y4;
  { use anticlockwise coordinates }
end;

procedure TDIBDemoForm.PolygonBtnClick(Sender: TObject);
var newpoly : array[1..4] of TPoint;
begin
  set_polygon_vertices(newpoly,5,300,250,270,300,100,100,150);
  dpb.DIBsurface.FillPolygon(newpoly,random(236)+10);
  dpb.Paint;//Dibsurface.SurfaceToScreen(canvas.handle);
end;

procedure TDIBDemoForm.ColoursBtnClick(Sender: TObject);
var
   lp1 : integer;
begin
  Msg := mShowColors;
{
  if syscols.checked then
  for lp1:=0 to (dpb.Dibsurface.Height)-1 do
    dpb.Dibsurface.DrawHorizontalLine(0,(dpb.Dibsurface.Width),lp1,lp1)
  else
  for lp1:=0 to dpb.Dibsurface.Height-1 do
    dpb.Dibsurface.DrawHorizontalLine(0,(dpb.Dibsurface.Width),lp1,(lp1 mod (dpb.Dibsurface.Palette.nColors))+10);
  //Dibsurface.SurfaceToScreen(canvas.handle);
}
  dpb.Paint;
end;

procedure TDIBDemoForm.SinusoidBtnClick(Sender: TObject);
var lp1,lp2,col : integer;
    val         : double;
begin
  for lp1:=0 to dpb.DIBsurface.width-1 do begin
    for lp2:=0 to dpb.DIBsurface.Height-1 do begin
      val := sin(2*pi*lp1/(dpb.DIBsurface.Width))*sin(2*pi*lp2/(dpb.DIBsurface.height));
      { val is -1->+1 }
      val := ((val+1)/2)*(dpb.DIBsurface.Palette.nColors-1) +10;   { 10 -> 236 }
      col := round(val);
      dpb.DIBsurface.Pixel[lp1,lp2] :=col;
    end;
  end;
  dpb.Paint;//Dibsurface.SurfaceToScreen(canvas.handle);
end;

procedure TDIBDemoForm.LinesBtnClick(Sender: TObject);
var lp1,x1,y1,x2,y2,c : integer;
begin
    with dpb do
    begin
      x1 := Width div 2;
      y1 := Height div 2;
      for lp1:=0 to 360 do
      begin
        x2 := x1 + round(100*cos(2*pi*lp1/360));
        y2 := y1 + round(100*sin(2*pi*lp1/360));
        c  := round((lp1/360)*(DIBsurface.Palette.nColors-1))+10;
        DIBsurface.DrawLine(x1,y1,x2,y2,c);
      end;
      paint;
    end;
end;

procedure TDIBDemoForm.IdleAction(Sender: TObject; var Done: Boolean);
var
    adc        : HDC;
    temp,delay : integer;
    anim_pal   : array[0..255] of TPaletteEntry;
begin
  if not cycle.checked then
  begin
       done:=true;
       exit;
  end;
  temp:=SpinEdit1.value;   // cycle ??? step forwards/backwards
  if temp>App_Palette.nColors then
     temp:=App_Palette.nColors;

  GetPaletteEntries(App_Palette.Handle,10,App_Palette.nColors,anim_pal[10]);
  if temp>0 then
  begin    // forward cycling
    animatepalette(App_Palette.Handle,10,App_Palette.nColors-temp,@anim_pal[10+temp]);
    animatepalette(App_Palette.Handle,10+App_Palette.nColors-temp,temp,@anim_pal[10]);
  end
  else
  begin
    temp:=-temp; // reverse cycling
    animatepalette(App_Palette.Handle,10+temp,App_Palette.nColors-temp,@anim_pal[10]);
    animatepalette(App_Palette.Handle,10,temp,@anim_pal[10+App_Palette.nColors-temp]);
  end;
  adc := canvas.handle;
  SelectPalette(adc,App_Palette.Handle,false);
  RealizePalette(adc);
  done:=false;
  for delay := 0 to speedbar.position*100 do begin
    temp := round(delay*1.0);
    // rough delay because my Pentium pro is very fast and timers are too slow
  end;
end;

procedure TDIBDemoForm.ClearBtnClick(Sender: TObject);
begin
     Clear_Surface;
end;

procedure TDIBDemoForm.Timer1Timer(Sender: TObject);
var
    adc        : HDC;
    temp,delay : integer;
    anim_pal   : array[0..255] of TPaletteEntry;
begin
  temp:=SpinEdit1.value;   // cycle ??? step forwards/backwards
  if temp>App_Palette.nColors then
     temp:=App_Palette.nColors;

  GetPaletteEntries(App_Palette.Handle,10,App_Palette.nColors,anim_pal[10]);
  if temp>0 then
  begin    // forward cycling
    animatepalette(App_Palette.Handle,10,App_Palette.nColors-temp,@anim_pal[10+temp]);
    animatepalette(App_Palette.Handle,10+App_Palette.nColors-temp,temp,@anim_pal[10]);
  end
  else
  begin
    temp:=-temp; // reverse cycling
    animatepalette(App_Palette.Handle,10+temp,App_Palette.nColors-temp,@anim_pal[10]);
    animatepalette(App_Palette.Handle,10,temp,@anim_pal[10+App_Palette.nColors-temp]);
  end;
  adc := canvas.handle;
  SelectPalette(adc,App_Palette.Handle,false);
  RealizePalette(adc);
  for delay := 0 to speedbar.position*100 do begin
    temp := round(delay*1.0);
    // rough delay because my Pentium pro is very fast and timers are too slow
  end;
end;

procedure TDIBDemoForm.cycleClick(Sender: TObject);
begin
     Timer1.Enabled := TCheckBox(Sender).Checked;
end;

procedure TDIBDemoForm.RadioGroup1Click(Sender: TObject);
begin
     if TRadioGroup(Sender).ItemIndex = 0 then
     begin
          Application.OnIdle := IdleAction;
          Timer1.OnTimer := nil;
     end
     else
     begin
          Application.OnIdle := nil;
          Timer1.OnTimer := Timer1Timer;
     end;
end;

procedure TDIBDemoForm.dpbPaint(Sender: TObject);
var
   lp1 : integer;
begin
     with TDIBPaintBox(Sender) do
     case Msg of
        mShowColors :
            if syscols.checked then
               for lp1:=0 to Dibsurface.Height-1 do
                 Dibsurface.DrawHorizontalLine(0,(Dibsurface.Width),lp1,lp1)
            else
               for lp1:=0 to Dibsurface.Height-1 do
                 Dibsurface.DrawHorizontalLine(0,(Dibsurface.Width),lp1,(lp1 mod (Dibsurface.Palette.nColors))+10);
     {
     else
         Dibsurface.Clear;
     }
     end;
     Msg := 0;
end;

initialization
end.