diff --git a/.gitattributes b/.gitattributes index 0c5b14e36e..98df23d0ac 100644 --- a/.gitattributes +++ b/.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 diff --git a/lcl/alllclunits.pp b/lcl/alllclunits.pp index 614e075f34..6b1899d27f 100644 --- a/lcl/alllclunits.pp +++ b/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 diff --git a/lcl/colorbox.pas b/lcl/colorbox.pas new file mode 100644 index 0000000000..fa5b4ad574 --- /dev/null +++ b/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. diff --git a/lcl/graphics.pp b/lcl/graphics.pp index da9b12dba0..0d1d0d5556 100644 --- a/lcl/graphics.pp +++ b/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 diff --git a/packager/packagesystem.pas b/packager/packagesystem.pas index b79b6affda..88b562d794 100644 --- a/packager/packagesystem.pas +++ b/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 diff --git a/packager/registerlcl.pas b/packager/registerlcl.pas index 3f3616d365..450311d7a8 100644 --- a/packager/registerlcl.pas +++ b/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.