added ColorBox (from Darius) to LCL

git-svn-id: trunk@7375 -

.gitattributes

@@ -1331,6 +1331,7 @@ lcl/chart.pp svneol=native#text/pascal
 lcl/checklst.pas svneol=native#text/pascal
 lcl/clipbrd.pp svneol=native#text/pascal
 lcl/clistbox.pp svneol=native#text/pascal
+lcl/colorbox.pas svneol=native#text/pascal
 lcl/comctrls.pp svneol=native#text/pascal
 lcl/commctrl.pp svneol=native#text/pascal
 lcl/controls.pp svneol=native#text/pascal

lcl/alllclunits.pp

@@ -46,7 +46,7 @@ uses
   Comctrls, Graphics, StdCtrls, Arrow, Controls, ImgList, Menus, Toolwin,
   Dialogs, Messages, Clistbox, ActnList, Grids, MaskEdit,
   Printers, PostScriptPrinter, PostScriptCanvas, CheckLst, PairSplitter,
-  ExtDlgs, DBCtrls, DBGrids, DBActns, EditBtn, ExtGraphics,
+  ExtDlgs, DBCtrls, DBGrids, DBActns, EditBtn, ExtGraphics, ColorBox,
   PropertyStorage, IniPropStorage, XMLPropStorage, Chart, LDockTree,
   // widgetset skeleton
   WSActnList, WSArrow, WSButtons, WSCalendar,
@@ -68,6 +68,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.28  2005/07/19 08:31:21  vincents
+  added ColorBox (from Darius) to LCL
+
   Revision 1.27  2005/07/16 00:08:26  marc
   * Reimplemented ZOrder
   + Added IDE option to move a control one forward/back

lcl/colorbox.pas

@@ -0,0 +1,273 @@
+{
+  TColorBox is component that displays colors in a combobox
+
+  Copyright (C) 2005 Darius Blaszijk
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.LCL, included in this distribution,                 *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+}
+
+unit ColorBox;
+
+{$mode objfpc}
+{$H+}
+
+interface
+
+uses
+  LResources, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls;
+
+type
+  TColorPalette = (cpDefault, cpFull);
+
+  TColorBox = class(TCustomComboBox)
+  private
+    FPalette: TColorPalette;
+    function GetSelection: TColor;
+    procedure SetSelection(Value: TColor);
+
+    procedure SetPalette(Value: TColorPalette);
+  protected
+    procedure SetStyle(Value: TComboBoxStyle); override;
+    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure SetColorList;
+    property Selection: TColor read GetSelection write SetSelection;
+    property Palette: TColorPalette read FPalette write SetPalette;
+  published
+    property Color;
+    property Ctl3D;
+    property DragMode;
+    property DragCursor;
+    property DropDownCount;
+    property Enabled;
+    property Font;
+    property ItemHeight;
+    property Items;
+    property MaxLength;
+    property ParentColor;
+    property ParentCtl3D;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowHint;
+    property Sorted;
+    property TabOrder;
+    property TabStop;
+    property Text;
+    property Visible;
+    property OnChange;
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnDrawItem;
+    property OnDropDown;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMeasureItem;
+    property OnStartDrag;
+  end;
+
+procedure Register;
+
+implementation
+
+// The following colors match the predefined Delphi Colors
+// as defined in Graphics.pp
+const
+  ColorDefault: array[0..20] of Integer =
+  ( clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,
+    clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clLtGray,
+    clDkGray, clWhite, clCream, clNone, clDefault);
+
+{------------------------------------------------------------------------------}
+procedure Register;
+begin
+  RegisterComponents('Additional', [TColorBox]);
+end;
+{------------------------------------------------------------------------------
+  Method:   TCanvas.Create
+  Params:   AOwner
+  Returns:  Nothing
+
+  Use Create to create an instance of TColorBox and initialize all properties
+  and variables.
+
+ ------------------------------------------------------------------------------}
+constructor TColorBox.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  FPalette := cpDefault;
+
+  SetColorList;
+
+  Style := csOwnerDrawFixed;
+end;
+{------------------------------------------------------------------------------
+  Method:   TCanvas.GetSelection
+  Params:   None
+  Returns:  TColor
+
+  Use GetSelection to convert the item selcted into a system color.
+
+ ------------------------------------------------------------------------------}
+function TColorBox.GetSelection: TColor;
+begin
+  Result := 0;
+  if ItemIndex >= 0 then
+    if not IdentToColor(Items[ItemIndex], LongInt(Result)) then
+      Result := 0;
+end;
+{------------------------------------------------------------------------------
+  Method:   TCanvas.SetSelection
+  Params:   Value
+  Returns:  Nothing
+
+  Use SetSelection to set the item in the ColorBox when appointed a color
+  from code.
+
+ ------------------------------------------------------------------------------}
+procedure TColorBox.SetSelection(Value: TColor);
+var
+  c: integer;
+  i: Longint;
+begin
+  ItemIndex := -1;
+
+  for c := 0 to Pred(Items.Count) do
+    if IdentToColor(Items[c], i) then
+      if i = Value then
+        ItemIndex := c;
+end;
+{------------------------------------------------------------------------------
+  Method:   TCanvas.SetPalette
+  Params:   Value
+  Returns:  Nothing
+
+  Use SetPalette to determine wether to reset the colorlist in the ColorBox
+  based on the type of palette.
+
+ ------------------------------------------------------------------------------}
+procedure TColorBox.SetPalette(Value: TColorPalette);
+begin
+  if Value <> FPalette then
+  begin
+    FPalette := Value;
+    SetColorList;
+  end;
+end;
+{------------------------------------------------------------------------------
+  Method:   TCanvas.SetStyle
+  Params:   Value
+  Returns:  Nothing
+
+  Use SetStyle to prevent the style to be changed to anything else than
+  csOwnerDrawFixed.
+
+ ------------------------------------------------------------------------------}
+procedure TColorBox.SetStyle(Value: TComboBoxStyle);
+begin
+  inherited SetStyle(csOwnerDrawFixed);
+end;
+{------------------------------------------------------------------------------
+  Method:   TCanvas.DrawItem
+  Params:   Index, Rect, State
+  Returns:  Nothing
+
+  Use DrawItem to customdraw an item in the ColorBox. A color preview is drawn
+  and the item rectangle is made smaller and given to the inherited method to
+  draw the corresponding text. The Brush color and Pen color where changed and
+  reset to theire original values.
+
+ ------------------------------------------------------------------------------}
+procedure TColorBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
+var
+  r: TRect;
+  ItemColor: TColor;
+  BrushColor: TColor;
+  PenColor: TColor;
+begin
+  if Index<0 then
+    exit;
+  r.top := Rect.top + 3;
+  r.bottom := Rect.bottom - 3;
+  r.left := Rect.left + 3;
+  r.right := r.left + 14;
+  with Canvas do begin
+    FillRect(Rect);
+
+    BrushColor := Brush.Color;
+    PenColor := Pen.Color;
+
+    if IdentToColor(Items[Index], LongInt(ItemColor)) then
+      Brush.Color := ItemColor;
+      
+    Pen.Color := clBlack;
+
+    Rectangle(r);
+
+    Brush.Color := BrushColor;
+    Pen.Color := PenColor;
+  end;
+  r := Rect;
+  r.left := r.left + 20;
+  
+  inherited DrawItem(Index, r, State);
+end;
+{------------------------------------------------------------------------------
+  Method:   TCanvas.SetColorList
+  Params:   None
+  Returns:  Nothing
+
+  Use SetColorList to fill the itemlist in the ColorBox with the right color
+  entries. Based on the value of the Palette property.
+
+ ------------------------------------------------------------------------------}
+procedure TColorBox.SetColorList;
+var
+  c: Longint;
+  s: ANSIString;
+  m: TIdentMapEntry;
+begin
+  with Items do
+  begin
+    Clear;
+
+    //add palettes as desired
+    case Palette of
+      cpFull : begin
+                 c := 0;
+                 while IdentEntry(c, m) do
+                 begin
+                   Add(m.Name);
+                   Inc(c);
+                 end;
+               end;
+      else
+      begin
+        for c := 0 to High(ColorDefault) do
+          if ColorToIdent(ColorDefault[c], s) then Add(s);
+      end;
+    end;
+  end;
+end;
+{------------------------------------------------------------------------------}
+end.

lcl/graphics.pp

@@ -1376,6 +1376,7 @@ type
   // Color / Identifier mapping
   TGetColorStringProc = procedure(const s:ansistring) of object;
 
+function IdentEntry(Entry: Longint; var MapEntry: TIdentMapEntry): boolean;
 function ColorToIdent(Color: Longint; var Ident: String): Boolean;
 function IdentToColor(const Ident: string; var Color: Longint): Boolean;
 function SysColorToSysColorIndex(Color: TColor): integer;
@@ -1628,6 +1629,16 @@ const
     (Value: clActiveHighlightedText; Name: 'clActiveHighlightedText')
     );
 
+function IdentEntry(Entry: Longint; var MapEntry: TIdentMapEntry): boolean;
+begin
+  Result := False;
+  if (Entry >= 0) and (Entry <= High(Colors)) then
+  begin
+    MapEntry := Colors[Entry];
+    Result := True;
+  end;
+end;
+
 function ColorToIdent(Color: Longint; var Ident: String): Boolean;
 begin
   Result := IntToIdent(Color, Ident, Colors);
@@ -1951,6 +1962,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.178  2005/07/19 08:31:21  vincents
+  added ColorBox (from Darius) to LCL
+
   Revision 1.177  2005/07/18 09:29:11  mattias
   Added TProtableAnyMapGraphic and fixed loading .ico on BIG_ENDIAN systems  from Colin Western
 

packager/packagesystem.pas

@@ -954,6 +954,7 @@ begin
     AddFile('xmlpropstorage.pas','XMLPropStorage',pftUnit,[pffHasRegisterProc],cpBase);
     AddFile('inipropstorage.pas','IniPropStorage',pftUnit,[pffHasRegisterProc],cpBase);
     AddFile('chart.pp','Chart',pftUnit,[pffHasRegisterProc],cpBase);
+    AddFile('colorbox.pas','ColorBox',pftUnit,[pffHasRegisterProc],cpBase);
     // increase priority by one, so that the LCL components are inserted to the
     // left in the palette
     for i:=0 to FileCount-1 do

packager/registerlcl.pas

@@ -42,7 +42,7 @@ uses
   Menus, Buttons, StdCtrls, ExtCtrls, ComCtrls, Forms, Grids, Controls,
   Dialogs, Spin, Arrow, Calendar, MaskEdit, CheckLst, PairSplitter, ExtDlgs,
   StdActns, DBCtrls, DBGrids, DBActns, EditBtn, ActnList, FileCtrl,
-  XMLPropStorage, IniPropStorage, Graphics, Chart;
+  XMLPropStorage, IniPropStorage, Graphics, Chart, ColorBox;
   
 procedure Register;
 
@@ -77,6 +77,7 @@ begin
   RegisterUnit('XMLPropStorage',@XMLPropStorage.Register);
   RegisterUnit('IniPropStorage',@IniPropStorage.Register);
   RegisterUnit('Chart',@Chart.Register);
+  RegisterUnit('ColorBox',@ColorBox.Register);
 end;
 
 end.