mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-17 22:49:31 +02:00
569 lines
16 KiB
ObjectPascal
569 lines
16 KiB
ObjectPascal
{
|
|
TColorBox is component that displays colors in a combobox
|
|
TColorListBox is component that displays colors in a listbox
|
|
|
|
Copyright (C) 2005 Darius Blaszijk
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL, 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, LCLProc, LCLType, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls;
|
|
|
|
type
|
|
TColorPalette = (cpDefault, cpFull);
|
|
|
|
{ TColorBox }
|
|
|
|
TColorBox = class(TCustomComboBox)
|
|
private
|
|
FPalette: TColorPalette;
|
|
function GetColor(Index : Integer): TColor;
|
|
function GetSelected: TColor;
|
|
procedure SetSelected(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 Colors[Index : Integer] : TColor Read GetColor;
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property ArrowKeysTraverseList;
|
|
property AutoComplete;
|
|
property AutoCompleteText;
|
|
property AutoDropDown;
|
|
property AutoSize;
|
|
property BorderSpacing;
|
|
property Color;
|
|
property Ctl3D;
|
|
property DragMode;
|
|
property DragCursor;
|
|
property DropDownCount;
|
|
property Enabled;
|
|
property Font;
|
|
property ItemHeight;
|
|
property ItemIndex;
|
|
property Items;
|
|
property ItemWidth;
|
|
property MaxLength;
|
|
property Palette: TColorPalette read FPalette write SetPalette;
|
|
property ParentColor;
|
|
property ParentCtl3D;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property Selected: TColor read GetSelected write SetSelected;
|
|
property ShowHint;
|
|
property Sorted;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Text;
|
|
property Visible;
|
|
property OnChange;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnCloseUp;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnDrawItem;
|
|
property OnDropDown;
|
|
property OnEditingDone;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMeasureItem;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnStartDrag;
|
|
property OnSelect;
|
|
end;
|
|
|
|
{ TColorListBox }
|
|
|
|
TColorListBox = class(TCustomListBox)
|
|
private
|
|
FPalette: TColorPalette;
|
|
function GetColor(Index : Integer): TColor;
|
|
function GetSelected: TColor;
|
|
procedure SetSelected(Value: TColor);
|
|
procedure SetPalette(Value: TColorPalette);
|
|
protected
|
|
procedure SetStyle(Value: TListBoxStyle); override;
|
|
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure SetColorList;
|
|
property Colors[Index : Integer] : TColor Read GetColor;
|
|
property Selected: TColor read GetSelected write SetSelected;
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property ClickOnSelChange;
|
|
property Color;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property ExtendedSelect;
|
|
property Font;
|
|
property IntegralHeight;
|
|
property ItemHeight;
|
|
property Items;
|
|
property MultiSelect;
|
|
property Palette: TColorPalette read FPalette write SetPalette;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property Sorted;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property TopIndex;
|
|
property Visible;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnDrawItem;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnSelectionChange;
|
|
property OnShowHint;
|
|
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, TColorListBox]);
|
|
end;
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorBox.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: TColorBox.GetSelected
|
|
Params: None
|
|
Returns: TColor
|
|
|
|
Use GetSelected to convert the item selected into a system color.
|
|
|
|
------------------------------------------------------------------------------}
|
|
function TColorBox.GetSelected: TColor;
|
|
begin
|
|
Result := 0;
|
|
if ItemIndex >= 0 then
|
|
Result := StringToColor(Items[ItemIndex]);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorBox.GetColor
|
|
Params: Index
|
|
Returns: Color at position Index
|
|
|
|
Used as read procedure from Colors property.
|
|
|
|
------------------------------------------------------------------------------}
|
|
|
|
function TColorBox.GetColor(Index : Integer): TColor;
|
|
begin
|
|
if not IdentToColor(Items[Index], Result) then
|
|
Result := clNone;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorBox.SetSelected
|
|
Params: Value
|
|
Returns: Nothing
|
|
|
|
Use SetSelected to set the item in the ColorBox when appointed a color
|
|
from code.
|
|
|
|
------------------------------------------------------------------------------}
|
|
procedure TColorBox.SetSelected(Value: TColor);
|
|
var
|
|
c: integer;
|
|
selColor: TColor;
|
|
begin
|
|
ItemIndex := -1;
|
|
for c := 0 to Pred(Items.Count) do
|
|
begin
|
|
selColor := StringToColor(Items[c]);
|
|
if selColor = Value then
|
|
ItemIndex := c;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorBox.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: TColorBox.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: TColorBox.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 their original values.
|
|
|
|
------------------------------------------------------------------------------}
|
|
procedure TColorBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
|
var
|
|
r: TRect;
|
|
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;
|
|
Exclude(State,odPainted);
|
|
with Canvas do begin
|
|
FillRect(Rect);
|
|
|
|
BrushColor := Brush.Color;
|
|
PenColor := Pen.Color;
|
|
|
|
Brush.Color := StringToColor(Items[Index]);
|
|
|
|
Pen.Color := clBlack;
|
|
|
|
Rectangle(r);
|
|
|
|
Brush.Color := BrushColor;
|
|
Pen.Color := PenColor;
|
|
end;
|
|
r := Rect;
|
|
r.left := r.left + 20;
|
|
|
|
//DebugLn('TColorBox.DrawItem ',dbgs(Index),' ',dbgs(r),' ',dbgs(odPainted in State),' ',dbgs(Assigned(OndrawItem)));
|
|
inherited DrawItem(Index, r, State);
|
|
end;
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorBox.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;
|
|
{------------------------------------------------------------------------------}
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorListBox.Create
|
|
Params: AOwner
|
|
Returns: Nothing
|
|
|
|
Use Create to create an instance of TColorListBox and initialize all properties
|
|
and variables.
|
|
|
|
------------------------------------------------------------------------------}
|
|
constructor TColorListBox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FPalette := cpDefault;
|
|
|
|
SetColorList;
|
|
|
|
Style := lbOwnerDrawFixed;
|
|
end;
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorListBox.GetSelected
|
|
Params: None
|
|
Returns: TColor
|
|
|
|
Use GetSelected to convert the item selected into a system color.
|
|
|
|
------------------------------------------------------------------------------}
|
|
function TColorListBox.GetSelected: TColor;
|
|
begin
|
|
Result := 0;
|
|
if ItemIndex >= 0 then
|
|
if not IdentToColor(Items[ItemIndex], LongInt(Result)) then
|
|
Result := 0;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorListBox.GetColor
|
|
Params: Index
|
|
Returns: Color at position Index
|
|
|
|
Used as read procedure from Colors property.
|
|
|
|
------------------------------------------------------------------------------}
|
|
function TColorListBox.GetColor(Index : Integer): TColor;
|
|
begin
|
|
if Not IdentToColor(Items[Index],Result) then
|
|
Result:=clNone;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorListBox.SetSelected
|
|
Params: Value
|
|
Returns: Nothing
|
|
|
|
Use SetSelected to set the item in the ColorListBox when appointed a color
|
|
from code.
|
|
|
|
------------------------------------------------------------------------------}
|
|
procedure TColorListBox.SetSelected(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: TColorListBox.SetPalette
|
|
Params: Value
|
|
Returns: Nothing
|
|
|
|
Use SetPalette to determine wether to reset the colorlist in the ColorListBox
|
|
based on the type of palette.
|
|
|
|
------------------------------------------------------------------------------}
|
|
procedure TColorListBox.SetPalette(Value: TColorPalette);
|
|
begin
|
|
if Value <> FPalette then
|
|
begin
|
|
FPalette := Value;
|
|
SetColorList;
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorListBox.SetStyle
|
|
Params: Value
|
|
Returns: Nothing
|
|
|
|
Use SetStyle to prevent the style to be changed to anything else than
|
|
lbOwnerDrawFixed.
|
|
|
|
------------------------------------------------------------------------------}
|
|
procedure TColorListBox.SetStyle(Value: TListBoxStyle);
|
|
begin
|
|
inherited SetStyle(lbOwnerDrawFixed);
|
|
end;
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorListBox.DrawItem
|
|
Params: Index, Rect, State
|
|
Returns: Nothing
|
|
|
|
Use DrawItem to customdraw an item in the ColorListBox. 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 their original values.
|
|
|
|
------------------------------------------------------------------------------}
|
|
procedure TColorListBox.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;
|
|
Exclude(State,odPainted);
|
|
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;
|
|
|
|
//DebugLn('TColorListBox.DrawItem ',dbgs(Index),' ',dbgs(r),' ',dbgs(odPainted in State),' ',dbgs(Assigned(OndrawItem)));
|
|
inherited DrawItem(Index, r, State);
|
|
end;
|
|
{------------------------------------------------------------------------------
|
|
Method: TColorListBox.SetColorList
|
|
Params: None
|
|
Returns: Nothing
|
|
|
|
Use SetColorList to fill the itemlist in the ColorListBox with the right color
|
|
entries. Based on the value of the Palette property.
|
|
|
|
------------------------------------------------------------------------------}
|
|
procedure TColorListBox.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.
|