a simple Component for Color Selection

Introduction

How the component looks

8 color mode, horizontal, square = 20*20 pixels

64 color mode, horizontal, square = 20*20 pixels

512 color mode, horizontal, square = 10*10 pixels

Ancestor Class

Component Properties

- direction
- cbHor .............horizontal orientation
- cbVert ............ vertical orientation
- colorDepth
- cb8 .............1 bit per color, 8 selectable colors
- cb64............2 bits per color, 64 selectable colors
- cb512..........3 bits per color, 512 selectable colors
- border
- 0 .. 10 ............number of pixels of edges
- borderlight
- 32 bit integer ..............color of top and left edges
- borderdark
- 32 bit integer ...............color of bottom and right edges
-csquare
- byte, value 5 .. 40..........edge length of each colored square in rectangle

Component Methods

- create

Component Events

- onSelect .............provides selected color

Component Application

procedure Tform1.selcolor(sender : TObject; color : LongInt);
begin
//.............color is the selected color
end;

Remarks

Source Code

unit davColorBox;
{color picker component

 supply rectangle with selectable colors

 properties:

 - direction : cbHor, cbVert for horizontal or vertical orientation
 - colordepth : cb8, cb64 , cb512 for amount of colors
 - Csquare : 5 .. 40, edge of each colored square
 - border : 0 .. 10 , the width of the border
 - borderlight : color of left and top of border
 - borderdark : color of bottom and right side of border

 methods:

 - create

 events:

 - OnSelect : mouse-up over a color supplies selected color 
}


interface

uses windows,controls,classes;

type TcolorDepth = (cb8,cb64,cb512);
     Tcolorboxdir = (cbHor,cbVert);
     TColorSelect = procedure(sender : TObject; color : LongInt) of object;
     TColorSquare = record
                     x1 : integer;
                     y1 : integer;
                  color : LongInt;
                    end;

     TdavColorBox = class(TGraphicControl)
     private
       FColorDepth : TColorDepth;
       FDirection  : Tcolorboxdir;
       FColor      : LongInt;
       FOnSelect   : TColorSelect;
       Fx          : Integer;
       Fy          : integer;
       FBorderwidth: byte;
       FBorderlight: LongInt;
       FBorderdark : LongInt;
       FCsquare : byte;
       procedure setDirection(cbDir : TcolorBoxdir);
       procedure setColorDepth(cbDepth : TColorDepth);
       procedure setDimensions;
       function number2color(w : word) : TColorSquare;
     protected
       procedure paint; override;
       procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
                         X, Y: Integer); override;
       procedure setSquare(edge : byte);
       procedure setBorderwidth(w : byte);
       procedure setBorderlight(c : longInt);
       procedure setBorderdark(c : longInt);
       procedure select(sender : TObject; selcolor : LongInt);
     public
      constructor create(AOwner:TComponent); override;
     published
       property OnSelect : TcolorSelect read FOnSelect write FOnSelect;
       property direction: TColorboxdir read FDirection write setDirection default cbHor;
       property colordepth: Tcolordepth read Fcolordepth write setcolordepth default cb512;
       property Csquare : byte read FCsquare write setSquare default 10;
       property border : byte read Fborderwidth write setborderwidth default 2;
       property borderlight : longInt read Fborderlight write setborderLight default $ffffff;
       property borderdark  : LongInt read Fborderdark write setBorderdark default $0;
       property visible;
       property enabled;
  end;

procedure Register;

implementation

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

procedure TdavColorBox.setDimensions;
const dimlist : array[cb8..cb512] of byte = (2,4,8);
var xx,yy : integer;
begin
 yy := dimlist[FcolorDepth]*FCsquare;
 xx := yy * dimlist[FColorDepth] + 2*border + 1;
 yy := yy + 2*border + 1;
 if Fdirection = cbHor then
  begin
   width := xx; height := yy;
  end
  else
   begin
    height := xx; width := yy;
   end;
end;

constructor TdavColorBox.create(AOwner: TComponent);
begin
 inherited create(Aowner);
 FCSquare := 10;
 FBorderwidth := 4;
 FColorDepth := cb512;
 FDirection := cbHor;
 FBorderLight := $ffffff;
 FBorderdark := $0;
 FColor := $0;
 setdimensions;
end;

procedure TdavColorBox.setdirection(cbdir : Tcolorboxdir);
begin
 Fdirection := cbdir;
 setdimensions;
end;

procedure TdavColorbox.setColorDepth(cbdepth : TColorDepth);
begin
 FColorDepth := cbdepth;
 setSquare(FCSquare);
 setdimensions;
end;

function TdavColorBox.number2color(w : word) : TColorSquare;
var r,g,b : byte;
begin
 case ColorDepth of
       cb8   : begin
                r := w and $1;
                g := (w shr 1) and 1;
                b := (w shr 2) and $1;
                result.x1 := border + (r + 2*g) * FCSquare;
                result.y1 := border + b * FCSquare;
                if r > 0 then r := $ff;
                if g > 0 then g := $ff;
                if b > 0 then b := $ff;
               end;
       cb64  : begin
                r := (w and $3);
                g := (w shr 2) and $3;
                b := (w shr 4) and $3;
                result.x1 := border + (r + 4*g) * FCSquare;
                result.y1 := border + b * FCSquare;
                r := r shl 6;
                g := g shl 6;
                b := b shl 6;
                if r > 0 then r := r + $3f;
                if g > 0 then g := g + $3f;
                if b > 0 then b := b + $3f;
               end;
       cb512 : begin
                r := (w and $7);
                g := (w shr 3) and $7;
                b := (w shr 6) and $7;
                result.x1 := border + (r + 8*g) * FCSquare;
                result.y1 := border + b * FCSquare;
                r := r shl 5;
                g := g shl 5;
                b := b shl 5;
                if r > 0 then r := r + $1f;
                if g > 0 then g := g + $1f;
                if b > 0 then b := b + $1f;
               end;
      end;//case
 result.color := RGB(r,g,b);
end;

procedure TdavColorBox.Paint;
const Cmaxcolor : array[cb8..cb512] of word = (7,63,511);
var h,i,x1,y1 : integer;
    cs : TColorSquare;
begin
 with self do
  with canvas do
   begin
    pen.color := $0;
    pen.width := 1;
    for i := 0 to border-1 do                  //borderpaint
     begin
      pen.color := Fborderlight;
      moveto(width-1-i,i);
      lineto(i,i);
      lineto(i,height-1-i);
      pen.color := FborderDark;
      lineto(width-1-i,height-1-i);
      lineto(width-1-i,i);
     end;
//--
    for i := 0 to Cmaxcolor[FColorDepth] do
     begin
      cs := number2color(i);
      if FDirection = cbVert then     //trade x,y positions for vertical
       begin
        h := cs.x1; cs.x1 := cs.y1; cs.y1 := h;
       end;
      brush.color := cs.color;
      fillrect(rect(cs.x1,cs.y1,cs.x1+FCSquare,cs.y1+FCSquare));
     end;//for i
//--     
    pen.color := $0;
    for i := 0 to ((width-2*border) div FCSquare) do //sep. lines
     begin
      x1 := border + i * FCSquare;
      moveto(x1,border);
      lineto(x1,height - border);
     end;
    for i := 0 to ((height-2*border) div FCSquare) do
     begin
      y1 := border+ i * FCSquare;
      moveto(border,y1);
      lineto(width-border,y1);
     end;
   end;
end;

procedure TdavColorBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
                          X, Y: Integer);
var h,v,temp : byte;
    colornumber : word;
begin
 if (x > Fborderwidth) and (x < width-Fborderwidth-1)
    and (y > Fborderwidth) and (y < height-Fborderwidth-1) then
  begin
   h := (x - Fborderwidth) div FCsquare;
   v := (y - Fborderwidth) div FCSquare;
  end
 else exit;
//--
 if FDirection = cbVert then
  begin
   temp := h; h := v; v:= temp;
  end;
 case FColorDepth of
  cb8 : colornumber := h + v * 4;
  cb64 : colornumber := h + v * 16;
  cb512 : colornumber := h + v * 64;
 end;
 Fcolor := number2color(colornumber).color;
 if assigned(FOnSelect) then FonSelect(self,FColor);
end;

procedure TdavColorBox.Select(sender : TObject; selcolor : LongInt);
begin
 if assigned(FOnSelect) then FonSelect(self,Fcolor);
end;

procedure TDavColorBox.setSquare(edge : byte);
begin
 case FColorDepth of
  cb8   : if edge > 40 then edge := 40;
  cb64  : if edge > 20 then edge := 20;
  cb512 : if edge > 10 then edge := 10;
 end;
 if edge < 5 then edge := 5; 
 FCSquare := edge;
 setdimensions;
end;

procedure TdavColorBox.setBorderwidth(w : byte);
begin
 if w > 10 then w := 10;
 FBorderwidth := w;
 setdimensions;
end;

procedure TdavColorBox.setBorderlight(c : longInt);
begin
 FBorderlight := c;
 paint;
end;

procedure TdavColorBox.setBorderdark(c : longInt);
begin
 FBorderdark := c;
 paint;
end;

end.

Project source code

- form1,unit1: exerciser with controls to change component properties
- unit dav7colorpicker : unit that holds the component source code