a simple Component for Color Selection


Introduction

The Delphi programming environment already contains a dialog form for color selection.
In some cases however, a simple component, not a pop-up form, for the selection of colors is needed.

This article describes such a simple component, which may also be integrated in complex, home built, dialog forms.
The component source code is listed and the complete project may be downloaded.

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

The ancestor class is the TGraphicControl component, which is also the ancestor of the Tpaintbox component.
Basically, the davColorBox is a modified paintbox.

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

OnSelect is derived from the Mouse_Up event.

Component Application


When a mouse_up event occurs on the davColorBox component,
an OnSelect event is received.
    procedure Tform1.selcolor(sender : TObject; color : LongInt);
    begin
    //.............color is the selected color
    end;

Remarks

The width and height properties are recalculated by the component,
depending on the colordepth and Csquare values selected.

Within the component, a color is represented by a sequential number in the range 0 .. 511
in the case of 512 color mode.
From this number, the position in the rectangle is calculated for display.
Also the 32 bit Windows color is calculated from this value.
This 32 bit, true color, value is returned at the Onselect event.

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

This Delphi-7 project consists of
    - form1,unit1: exerciser with controls to change component properties
    - unit dav7colorpicker : unit that holds the component source code
Note: here, the component is registered in the IDE's "system" package.

Click [ here ] to download the complete project.