unit davArrayBtn;
{
  aug.8 2004: corrected column/row problem when using max number of buttons
  
 columns and rows of buttons, 0..47 maximal, for menu's and controls
 common properties:
 - button width,height
 - button edge 1..2 , borderwidth
 - shape: - flat, corners rounded
          - raised, 3D, sharp corners
 - colortable for alternate colors of edges/background         
 per button:
 - button belongs to group 0..15
   only -1- button of a group can be down at the time
 - button operating mode
   - mom : released on mouse-up
   - press : user press down, released by other button
   - toggle: additional user 2 ND press Up action

 - button status:
   - hidden
   - flat    (inactive)
   - down    (activated)

 component:
 - paints edges and backgrounds
 - triggers onBtnPaint event if button foreground needs painting
 - triggers onBtnChange event when button pressed or released

 application:
 - paints foreground when triggered by event
 - responds to button pressed/released, Enter/Leave

 controlbyte per Button:
 bit 0..3 : group code 0..15
 bit 4,5 : action : 00:mom  01:press  10:toggle
 bit 6,7 : status : 00:hidden  01:flat  10:down 
}

interface

uses windows,extctrls,controls,classes,graphics,messages;

const davmaxBtn = 48;//buttons 0..47; btn 48 = no button

type TBtnShape = (bsFlat,bs3D);
     TBtnStatus = (stHidden,stFlat,stDown,stHI);
     TBtnOpmode = (omMom,omPress,omToggle);
     TBtnColorIndex = (bcInactBG,bcActiveBG,bcFlat,bcHI,bcLO);
     TBtnChangeProc = procedure(sender : TObject; BtnNr : byte;
                      status : TBtnStatus; button : TmouseButton) of object;
     TBtnPaintProc = procedure(sender : TObject; BtnNr : byte;
                               status : TBtnStatus) of object;
     TColorTable = array[bcInactBG..bcLO] of LongInt;
     TPColorTable = ^TColorTable;

     TDavArrayBtn = class(TGraphicControl)
     private
      FonBtnchange : TBtnChangeProc;
      FonBtnPaint : TBtnPaintProc;
      FonEnter : TNotifyEvent;
      FonLeave : TNotifyEvent;
      FHiBtn : byte;            //mouse over this button
      Frows : byte;             //rows
      Fcolumns : byte;          //columns
      FbtnWidth : byte;         //button width
      FbtnHeight : byte;        //button height
      FBtnEdge : byte;          //button edge
      FBtnSpacing : byte;       //space between buttons
      FBorder : byte;           //border
      FBtnShape : TBtnShape;    //rounded flat, 3D
      FPcolorTable : TPColorTable;
      FBtnControl : array[0..davmaxBtn] of byte;
      FNextRelease : byte;
      procedure setRows(n : byte);
      procedure setColumns(n : byte);
      procedure setBtnWidth(n : byte);
      procedure setBtnHeight(n : byte);
      procedure setBtnshape(bs : TBtnShape);
      procedure setBorder(b : byte);
      procedure setSpacing(b : byte);
      procedure setBtnEdge(edge : byte);
      procedure repaintBtns;
      procedure fixdimensions;
      procedure BtnPaint(BtnNr : byte; bst : TBtnStatus);
      procedure CMmouseLeave(var message : Tmessage); message CM_MOUSELEAVE;
      procedure CMmouseEnter(var message : Tmessage); message CM_MOUSEENTER;
      procedure InitBtns;
      procedure SetBtnStatus(BtnNr : byte; status : TBtnStatus);
      function GetBtnGroup(BtnNr : byte) : byte;
      function GetBtnOpMode(BtnNr : byte) : TBtnOpMode;
     protected
      procedure paint; override;
      procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                          X, Y: Integer); override;
      procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer); override;
      procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
      procedure AssignColorTable(p : TPcolorTable);
      procedure TestReleaseBtn(downBtn : byte);
     public
      constructor Create(AOwner: TComponent); override;
      function GetBtnRect(btnNr : byte) : TRect;
      function GetBtnStatus(btnNr : byte) : TBtnStatus;
      procedure setBtnOpmode(BtnNr : byte; opMode: TBtnOpmode);
      procedure BtnHide(btnNr : byte);
      procedure BtnShow(btnNr : byte);
      procedure BtnDown(btnNr : byte);
      procedure BtnRelease(btnNr : byte);
      procedure setBtnGroup(btnNr,group : byte);
      property canvas;
      property PColorTable : TPColorTable read FPColorTable
               write AssignColorTable;
     published
      property Border : byte read FBorder write setBorder default 10;
      property BtnHeight : byte read FBtnHeight write setBtnHeight default 20;
      property BtnSpacing : byte read FBtnSpacing write setSpacing default 5;
      property BtnShape : TBtnShape read FBtnShape write setBtnShape default bs3D;
      property BtnWidth : byte read FBtnWidth write setbtnwidth default 30;
      property BtnEdge : byte read FBtnEdge write SetBtnEdge default 1;
      property Color;
      property Columns : byte read Fcolumns write setcolumns default 2;
      property Enabled;
      property Font;
      property onBtnChange : TBtnChangeProc read FonBtnChange write FonBtnChange;
      property onBtnPaint : TBtnPaintProc read FonBtnPaint write FonBtnPaint;
      property OnEnter : TNotifyEvent read FOnEnter write FOnEnter;
      property OnLeave : TNotifyEvent read FonLeave write FOnLeave;
      property Rows : byte read Frows write setRows default 2;
      property Visible;
     end;

procedure Register;

implementation

const defaultColors : TColorTable =
      ($c0c0c0,$f0f0f0,$808080,$ffffff,$202020);

procedure Register;
begin
 RegisterComponents('system',[TdavArrayBtn]);
end;

procedure TdavArrayBtn.SetBtnOpMode(BtnNr : byte; Opmode : TBtnOpMode);
var cb : byte;
begin
 cb := FBtnControl[BtnNr] and $cf;
 FBtnControl[BtnNr] := cb or (byte(OpMode) shl 4);
end;

function TdavArrayBtn.GetBtnOpMode(BtnNr : byte) : TbtnOpMode;
begin
 result := TBtnOpMode((FBtnControl[BtnNr] shr 4) and $3);
end;

procedure TdavArrayBtn.setBtnStatus(BtnNr : byte; status : TBtnStatus);
var bc : byte;
begin
 bc := FBtnControl[BtnNr] and $3f;
 FBtnControl[BtnNr] := bc or (byte(status) shl 6);
end;

function TdavArrayBtn.GetBtnGroup(BtnNr : byte) : byte;
begin
 result := FBtnControl[BtnNr] and $f;
end;

procedure TdavArrayBtn.setBtnGroup(btnNr,group : byte);
//add button to group
var bc : byte;
begin
 bc := FBtnControl[BtnNr] and $f0;
 FBtnControl[BtnNr] := bc or group;
end;

procedure TdavArrayBtn.initBtns;
//alle buttons group -0-, press
var i,top : byte;
    control : byte;
begin
 top := FRows*Fcolumns-1;
 control := (byte(stFlat) shl 6) or (byte(omPress) shl 4);
 for i := 0 to davmaxBtn do
  if i <= top then FBtnControl[i] := control
   else FBtnControl[i] := 0;
end;

function TdavarrayBtn.GetBtnStatus(btnNr : byte) : TBtnStatus;
begin
 result := TBtnStatus((FBtnControl[btnNr] shr 6) and $3);
end;

procedure TdavArrayBtn.BtnHide(btnNr : byte);
//hide button
begin
 if GetBtnStatus(btnNr) <> stHidden then
  begin
   SetBtnStatus(btnNr,stHidden);
   if FHiBtn = btnNr then FHiBtn := davmaxBtn;
   BtnPaint(btnNr,stHidden);
  end;
end;

procedure TdavarrayBtn.BtnShow(btnNr : byte);
//show a hidden button, set flat
begin
 if GetBtnStatus(btnNr) = stHidden then
  begin
   SetBtnStatus(btnNr,stFlat);
   BtnPaint(BtnNr,stFlat);
  end;
end;

procedure TdavArrayBtn.BtnRelease(btnNr : byte);
//set button from DOWN to Flat
begin
 if GetBtnStatus(btnNr) = stDown then
  begin
   SetBtnStatus(btnNr,stFlat);
   BtnPaint(btnNr,stFlat);
  end;
end;

procedure TdavArrayBtn.BtnDown(btnNr : byte);
begin
 if GetBtnStatus(btnNr) = stFlat then
  begin
   SetBtnStatus(btnNr,stDown);
   BtnPaint(btnNr,stDown);
   TestReleaseBtn(btnNr);//to release other buttons
  end;
end;

procedure TdavArrayBtn.TestReleaseBtn(downBtn : byte);
//downBtn was pressed down, test to release buttons of same group
var groupNr,i : byte;
begin
 groupNr := GetBtnGroup(downBtn);
 for i := 0 to Frows*Fcolumns-1 do
  if (i <> downBtn) and (GetBtnGroup(i) = groupNr)
                    and (GetBtnStatus(i)  = stDown) then
   begin
    SetBtnStatus(i,stFlat);
    btnPaint(i,stFlat);
   end;
end;

procedure TdavArrayBtn.BtnPaint(btnNr : byte; bst : TBtnStatus);
//if button hidden: erase
var r : Trect;
    radius : byte;
    k1,k2 : LongInt;
    i : byte;
begin
 r := GetBtnRect(btnNr);
 with canvas do
  begin
   pen.Width := 1;
   brush.style := bssolid;
    case bst of
     stHidden  : begin
                  brush.color := color;
                  brush.style := bsSolid;
                  fillrect(r);
                  exit;
                 end;
     stFlat    : begin
                  brush.color := PColorTable^[bcInactBG];
                  k1 := PColorTable^[bcFlat]; k2 := k1;
                 end;
     stHI      : begin
                  brush.color := PColorTable^[bcInactBG];
                  k1 := PColorTable^[bcHI]; k2 := PColorTable^[bcLO];
                 end;
     stDown    : begin
                  brush.color := PColorTable^[bcActiveBG];
                  k1 := PColorTable^[bcLO]; k2 := PColorTable^[bcHI];
                 end;
    end;//case
    if FBtnShape = bsFlat then    //vlak,ronde hoeken
     begin
      radius := FBtnHeight div 2;
      if radius > 40 then radius := 40;
      if radius < 10 then radius := 10;
      pen.Width := FbtnEdge;
      pen.color := k1;
      roundrect(r.left+1,r.top+1,r.right,r.bottom,radius,radius);
     end
    else
     begin
      fillrect(r);
      for i := 0 to FbtnEdge-1 do
       begin
        pen.color := k1;
        moveto(r.right-1-i,r.top+i);
        lineto(r.left+i,r.top+i);
        lineto(r.left+i,r.bottom-1-i);
        pen.color := k2;
        lineto(r.right-1-i,r.bottom-1-i);
        lineto(r.right-1-i,r.top+i);
       end;//for
     end;//else
  end;//with canvas
  if not (csDesigning in componentstate) and assigned(onBtnPaint) then
   onBtnPaint(self,btnNr,bst);
end;

procedure TdavArrayBtn.RepaintBtns;
//na initialiseren hele paintbox
var i : byte;
begin
 for i := 0 to FRows*Fcolumns-1 do BtnPaint(i,GetBtnStatus(i));
end;

procedure TdavArrayBtn.FixDimensions;
//adjust width,height na verandering van knop of spacing
//generates onPaint event
begin
 if FRows = 0 then FRows := 1;
 if FColumns = 0 then FColumns := 1;
 width := FColumns*(FBtnWidth + FBtnSpacing) - FBtnSpacing + 2*Fborder;
 height := FRows*(FBtnHeight + FBtnspacing) - FBtnSpacing + 2*Fborder;
end;

constructor TdavArrayBtn.Create(AOwner: TComponent);
begin
 inherited create(Aowner);
 canvas.font := font;
 FHiBtn := davmaxBtn;//=off
 FBtnShape := bs3D;
 FbtnEdge := 1;
 FPColorTable := @defaultColors;
 Frows := 2;
 Fcolumns := 2;
 InitBtns;
 FbtnWidth := 40;
 FbtnHeight := 30;
 FBtnSpacing := 5;
 FBorder := 10;
 fixDimensions;//set width , height
end;

procedure TdavArrayBtn.AssignColorTable(p : TPcolorTable);
begin
 FPcolorTable := p;
 invalidate;
end;

procedure TdavArrayBtn.MouseDown(Button: TMouseButton; Shift: TShiftState;
                    X, Y: Integer);
var status : TBtnStatus;
begin
 FNextRelease := davmaxBtn;
 if (FHiBtn = davmaxBtn) then exit; //no button selected
//----
 status := GetBtnstatus(FHIbtn);
 if status = stFlat then
  begin
   SetBtnStatus(FHIbtn,stDown);
   BtnPaint(FHIbtn,stDown);
   TestReleaseBtn(FHIbtn);
   if assigned(FonBtnChange) and (not (csDesigning in componentstate)) then
    onBtnChange(self,FHiBtn,stDown,button);
  end;
 case GetBtnOpMode(FHIbtn) of
  omMom    : FNextRelease := FHIbtn;
  omToggle : if status = stDown then FNextrelease := FHIbtn;
 end;//case
end;

procedure TdavArrayBtn.MouseUp(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer);
begin
 if FNextRelease <> davmaxBtn then
  begin
   SetBtnStatus(FNextRelease,stFlat);
   BtnPaint(FNextRelease,stFlat);
   if (not (csDesigning in componentstate)) and assigned(FonBtnChange) then
      onBtnChange(self,FNextRelease,stFlat,button);
  end;
end;

procedure TdavArrayBtn.MouseMove(Shift: TShiftState; X, Y: Integer);
var dx,maxX,maxY,dy : integer;
    button : byte;
    px,py : integer;
    status : TBtnStatus;
begin
 x := x - FBorder; y := y - FBorder;
 dx := FBtnSpacing + FBtnWidth;
 dy := FBtnSpacing + FBtnHeight;
 maxX := FColumns * dx; maxY := FRows * dy;
 px := x mod dx; py := y mod dy;
 if (x < maxX) and (y < maxY) and
    (px > FBtnEdge) and (px < dx-FBtnEdge-FBtnSpacing) and
    (py > FBtnEdge) and (py < dy-FBtnEdge-FBtnSpacing) then
  begin
   button := x div dx + FColumns*(y div dy);
  end
 else button := davmaxBtn;
 status := GetBtnStatus(button);
 if (status = stHidden) then button := davmaxBtn;
 if button = FHiBtn then exit;//if no change

//---process Btn change
 if button <> davmaxBtn then cursor := crhandpoint
  else cursor := crArrow;

 if (FHIbtn <> davmaxBtn) and (GetBtnStatus(FHIbtn) <> stDown) then
     BtnPaint(FHIbtn,stFlat);//remove HI edge
 if (button <> davmaxBtn) and (GetBtnStatus(button) <> stDown) then
     BtnPaint(button,stHI);//paint HI
 FHIbtn := button;    
end;

procedure TdavarrayBtn.Paint;
//teken de paintbox
//teken alle buttons
var i : byte;
    k1,k2 : LongInt;
begin
 FHiBtn := davmaxBtn;
  with canvas do
   begin
    brush.color := color;
    pen.Width := 1;
    pen.color := PcolorTable^[bcFlat];
    fillrect(rect(0,0,width,height));
    if FBorder > 0 then
     begin
      if FBtnShape = bs3D then
       begin
        k1 := PcolorTable^[bcHI]; k2 := PcolorTable^[bcFlat];
       end
      else begin
            k1 := Pcolortable^[bcFlat]; k2 := k1;
           end;
      pen.color := k1;
      moveto(width-1,0);
      lineto(0,0); lineto(0,height-1);
      pen.color := k2;
      lineto(width-1,height-1); lineto(width-1,0);
    end;//if border
   end;//with
 for i := 0 to FColumns*Frows-1 do
  if GetBtnStatus(i) <> stHidden then Btnpaint(i,GetBtnStatus(i));
end;

function TdavArrayBtn.GetBtnRect(btnNr : byte) : TRect;
//geef rectangle waarin button getekend moet worden
var x,y : integer;
begin
 x := btnNr mod Fcolumns;
 y := btnNr div FColumns;
 with result do
  begin
   left := Fborder + (FBtnWidth + FBtnspacing)*x;
   right := left + FBtnWidth;
   top := Fborder + (FBtnHeight + FBtnspacing)*y;
   bottom := top + FbtnHeight;
  end;
end;

procedure TdavArrayBtn.setRows(n : byte);
begin
 if n = 0 then n := 1;
 if n > davmaxBtn then n := davmaxBtn;
 if n * Fcolumns > davMaxBtn then Fcolumns := 1;
 Frows := n;
 initBtns;
 FixDimensions;
end;

procedure TdavArrayBtn.setColumns(n : byte);
begin
 if n = 0 then n := 1;
 if n > davMaxBtn then n := davMaxbtn;
 if n * Frows > davMaxBtn then Frows := 1;
 Fcolumns := n;
 initBtns;
 FixDimensions;
end;

procedure TdavArrayBtn.setBtnWidth(n : byte);
begin
 if n < 10 then n := 10;
 FBtnWidth := n;
 FixDimensions;
end;

procedure TdavarrayBtn.setBtnHeight(n : byte);
begin
 if n < 10 then n := 10;
 FBtnHeight := n;
 FixDimensions;
end;

procedure TdavArrayBtn.setBtnShape(bs : TBtnShape);
begin
 FBtnShape := bs;
 invalidate;
end;

procedure TdavArrayBtn.setBtnEdge(edge : byte);
begin
 if edge = 0 then edge := 1
  else if edge > 2 then edge := 2;
 FBtnEdge := edge;
 repaintBtns;
end;

procedure TdavArrayBtn.setBorder(b : byte);
begin
 Fborder := b;
 FixDimensions;
end;

procedure TdavarrayBtn.setSpacing(b : byte);
begin
 FBtnSpacing := b;
 FixDimensions;
end;

procedure TdavArrayBtn.CMmouseLeave(var message : Tmessage);
begin
 if (FHiBtn <> davmaxbtn) then
  begin
   if GetBtnStatus(FHIbtn) <> stDown then BtnPaint(FHIbtn,stFlat);
   FHIbtn := davMaxBtn;
  end;
 if not (csDesigning in componentstate) and assigned(FOnLeave) then
    onLeave(self);
end;

procedure TdavarrayBtn.CMmouseEnter(var message : Tmessage);
begin
 if not (csDesigning in componentstate) and assigned(FOnLeave) then
    onEnter(self);
end;

end.