an ArrayButton component


Introduction
Arrays are an efficient way to organize large amounts of similar data.
A graphic-user-interface uses many buttons with similar characteristics to start processes
or select modes of operation.
So, why not organize buttons as arrays?
This article describes a Delphi ArrayButton Component, which arranges buttons in a rectangle of columns and rows.

Characteristics
The component can have a maximum of 48 buttons [0..47] which may be organized
as a single row, single column or any combination of rows and columns.
All buttons have the same width and height.

Properties:

btnHeightthe height of each button in pixels
btnwidththe width of each button in pixels
borderthe border around the total panel in pixels
btnEdgethe width of the line around each button, 1 or 2
btnSpacingthe spacing in pixels between the buttons
btnShapebs3D(sharp corners) or bsFlat(rounded corners)


Button Behaviour
A button can have the status:

stFlatnot activated, in rest
stDownpressed by mousebutton or by program command
stHImousepointer moving over button
stHiddenbutton not shown


In addition, a button can operate in the following modes:

omMomstDown when pressed down by mousebutton,
return to stFlat when mousebutton is released.
omPressstDown when pressed by mousebutton.
omTogglestDown when pressed down by mousebutton,
released to stFlat by 2nd mousebutton press


Each button is assigned to a group, 0..15. In a group only one button
can have the status stDown.
So, pressing a button releases any stDown button with the same groep number.

Responsibilities
The component takes care of:
- painting edges and background colors
- generating events when the status of a button changes

The application programmer should:
- paint the foreground image or caption according to button status

Colors
The property "color" is the color of the border and spacing between the buttons.
Five colors in an array[bcInactBG..bcLO] of longInt are used to indicate the status
of a button.

bcInactBGbackground color of inactive (flat) button
bcActiveBGbackground color of active (pressed) button
bcFlatEdge color of flat button
bcHIEdge color when mousepointer over button
bcLOEdge color of pressed down button


How they look
(foreground not painted)

default colors, border = 10, button spacing = 5
edge = 2, shape = bs3D
after command: btnShape := bsFlat
button 4 is pressed down
after command: PColorTable := @ct, where
const ct : array[0..4] of LongInt =($ffff,$ff00ff,$d0,$ff00,$ff0000)
after command: border := 2; btnSpacing := 1;
btnShape := bs3D; (default colors)

Events

onBtnChangegenerated when status of button changes
onBtnPaintgenerated when foreground of button needs to be painted
onEntergenerated when component is entered
onLeavegenerated when mousepointer leaves component


On receiving an onBtnChange or onBtnPaint event along with the button number
and the button status, the application should request the rectangle by the
method function GetBtnRect(btnNr);
It is the responsability of the application programmer not to paint over the
button edges.

Click on download (lightning) icon at the top of the page to download the complete Delphi-7 project.

Application

An application has been build, with the sole purpose to demonstrate some arraybuttons.
It only is a skeleton where the user may select an action from a menubutton, select a penwidth or color.

Below is the main form with menubuttons load..roundrect at the top of the page.
On the left side are the property buttons which open dialog forms.
Below is the penwidth dialog form.
Below is the colormixer dialog, which is made of 3 arraybuttons.

Click [ here] to load the program.

Click [ here] to load the Delphi-7 demo project.

Below is the complete source code of the component.

The complete ArrayButton Component

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.