Een eenvoudige kleurenkiezer

Klik hier om het hele project te downloaden.

Inleiding

Delphi kent al een component met een dialogform voor kleurenkeuze.
Maar vaak is het handig om hiervoor een component te hebben dat op een eigen dialogform kan worden geplaatst.
Dit artikel beschrijft zo'n simpel componentje, dat gemakkelijk kan worden toegevoegd aan complexe dialog forms.

Hoe de kleurenkiezer eruitziet

    8 color mode, horizontaal, square = 20*20 pixels
    64 color mode, horizontaal, square = 20*20 pixels
    512 color mode, horizontaal, square = 10*10 pixels

Ancestor Class

The ancestor class is van het type TGraphicControl, dat ook de ancestor is van de Tpaintbox.
Een davColorBox is eigenlijk een veranderde paintbox.

Component eigenschappen

    - 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 .............levert de geselecteerde kleur

OnSelect is afkomstig van een Mouse_Up event.

Component Application


Na een mouse_up event wordt de kleur doorgegeven met een OnSelect event.
    procedure Tform1.selcolor(sender : TObject; color : LongInt);
    begin
    //.............color is the selected color
    end;

Opmerkingen

De width en height eigenschappen van het component worden herberekend
afhankelijk van de colordepth en de Csquare waarden.

Binnen het component wordt een kleur aangegeven met een getal van 0 t/m 511
in het geval van 512 color mode.
Uit dit getal wordt de positie van het kleurenvierkantje in de rechthoek berekend.
Ook wordt uit dit getal de 32 bits (Windows) kleur berekend.

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

Dit Delphi-7 project bestaat uit
    - form1,unit1: exerciser met controls om de component properties in te stellen
    - unit: dav7colorpicker : bevat de code van het component
Het component wordt geregistreerd in "system", maar dat is zo te veranderen.