mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 01:38:01 +02:00
932 lines
28 KiB
ObjectPascal
932 lines
28 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.txt, 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, LCLStrConsts;
|
|
|
|
type
|
|
{ TCustomColorBox }
|
|
|
|
TCustomColorBox = class;
|
|
TColorBoxStyles = (cbStandardColors, // 16 standard colors (look at graphics.pp)
|
|
cbExtendedColors, // 4 extended colors (look at graphics.pp)
|
|
cbSystemColors, // system colors (look at graphics.pp)
|
|
cbIncludeNone, // include clNone
|
|
cbIncludeDefault, // include clDefault
|
|
cbCustomColor, // first color is customizable
|
|
cbPrettyNames, // use good looking color names - like Red for clRed
|
|
cbCustomColors); // call OnGetColors after all other colors processing
|
|
TColorBoxStyle = set of TColorBoxStyles;
|
|
TGetColorsEvent = procedure(Sender: TCustomColorBox; Items: TStrings) of object;
|
|
|
|
TCustomColorBox = class(TCustomComboBox)
|
|
private
|
|
FDefaultColorColor: TColor;
|
|
FNoneColorColor: TColor;
|
|
FOnGetColors: TGetColorsEvent;
|
|
FStyle: TColorBoxStyle;
|
|
FSelected: TColor;
|
|
function GetColor(Index : Integer): TColor;
|
|
function GetColorName(Index: Integer): string;
|
|
function GetSelected: TColor;
|
|
procedure SetDefaultColorColor(const AValue: TColor);
|
|
procedure SetNoneColorColor(const AValue: TColor);
|
|
procedure SetSelected(Value: TColor);
|
|
procedure SetStyle(const AValue: TColorBoxStyle); reintroduce;
|
|
procedure ColorProc(const s: AnsiString);
|
|
protected
|
|
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
|
|
procedure SetColorList;
|
|
procedure Loaded; override;
|
|
procedure InitializeWnd; override;
|
|
procedure DoGetColors; virtual;
|
|
procedure Change; override;
|
|
function PickCustomColor: Boolean; virtual;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
|
|
property Style: TColorBoxStyle read FStyle write SetStyle
|
|
default [cbStandardColors, cbExtendedColors, cbSystemColors];
|
|
property Colors[Index: Integer]: TColor read GetColor;
|
|
property ColorNames[Index: Integer]: string read GetColorName;
|
|
property Selected: TColor read GetSelected write SetSelected default clBlack;
|
|
property DefaultColorColor: TColor read FDefaultColorColor write SetDefaultColorColor default clBlack;
|
|
property NoneColorColor: TColor read FNoneColorColor write SetNoneColorColor default clBlack;
|
|
property OnGetColors: TGetColorsEvent read FOnGetColors write FOnGetColors;
|
|
end;
|
|
|
|
{ TColorBox }
|
|
|
|
TColorBox = class(TCustomColorBox)
|
|
published
|
|
property DefaultColorColor;
|
|
property NoneColorColor;
|
|
property Selected;
|
|
property Style;
|
|
property OnGetColors;
|
|
|
|
property Align;
|
|
property Anchors;
|
|
property ArrowKeysTraverseList;
|
|
property AutoComplete;
|
|
property AutoCompleteText;
|
|
property AutoDropDown;
|
|
property AutoSelect;
|
|
property AutoSize;
|
|
property BidiMode;
|
|
property BorderSpacing;
|
|
property Color;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property DropDownCount;
|
|
property Enabled;
|
|
property Font;
|
|
property ItemHeight;
|
|
property ItemWidth;
|
|
property OnChange;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnCloseUp;
|
|
property OnContextPopup;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnDropDown;
|
|
property OnEditingDone;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnStartDrag;
|
|
property OnSelect;
|
|
property OnUTF8KeyPress;
|
|
property ParentBidiMode;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
end;
|
|
|
|
{ TCustomColorListBox }
|
|
|
|
TCustomColorListBox = class;
|
|
TLBGetColorsEvent = procedure(Sender: TCustomColorListBox; Items: TStrings) of object;
|
|
|
|
TCustomColorListBox = class(TCustomListBox)
|
|
private
|
|
FDefaultColorColor: TColor;
|
|
FNoneColorColor: TColor;
|
|
FOnGetColors: TLBGetColorsEvent;
|
|
FSelected: TColor;
|
|
FStyle: TColorBoxStyle;
|
|
function GetColor(Index : Integer): TColor;
|
|
function GetColorName(Index: Integer): string;
|
|
function GetSelected: TColor;
|
|
procedure SetDefaultColorColor(const AValue: TColor);
|
|
procedure SetNoneColorColor(const AValue: TColor);
|
|
procedure SetSelected(Value: TColor);
|
|
procedure SetStyle(const AValue: TColorBoxStyle); reintroduce;
|
|
procedure ColorProc(const s: AnsiString);
|
|
protected
|
|
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
|
|
procedure SetColorList;
|
|
procedure Loaded; override;
|
|
procedure InitializeWnd; override;
|
|
procedure DoGetColors; virtual;
|
|
procedure DoSelectionChange(User: Boolean); override;
|
|
function PickCustomColor: Boolean; virtual;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
|
|
property Style: TColorBoxStyle read FStyle write SetStyle
|
|
default [cbStandardColors, cbExtendedColors, cbSystemColors];
|
|
property Colors[Index: Integer]: TColor read GetColor;
|
|
property ColorNames[Index: Integer]: string read GetColorName;
|
|
property Selected: TColor read GetSelected write SetSelected default clBlack;
|
|
property DefaultColorColor: TColor read FDefaultColorColor write SetDefaultColorColor default clBlack;
|
|
property NoneColorColor: TColor read FNoneColorColor write SetNoneColorColor default clBlack;
|
|
property OnGetColors: TLBGetColorsEvent read FOnGetColors write FOnGetColors;
|
|
end;
|
|
|
|
{ TColorListBox }
|
|
|
|
TColorListBox = class(TCustomColorListBox)
|
|
published
|
|
property DefaultColorColor;
|
|
property NoneColorColor;
|
|
property Selected;
|
|
property Style;
|
|
property OnGetColors;
|
|
|
|
property Align;
|
|
property Anchors;
|
|
property BidiMode;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property ClickOnSelChange;
|
|
property Color;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property ExtendedSelect;
|
|
property Enabled;
|
|
property Font;
|
|
property IntegralHeight;
|
|
property ItemHeight;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEnter;
|
|
property OnEndDrag;
|
|
property OnExit;
|
|
property OnKeyPress;
|
|
property OnKeyDown;
|
|
property OnKeyUp;
|
|
property OnMouseMove;
|
|
property OnMouseDown;
|
|
property OnMouseUp;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnSelectionChange;
|
|
property OnShowHint;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
property ParentBidiMode;
|
|
property ParentColor;
|
|
property ParentShowHint;
|
|
property ParentFont;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property TopIndex;
|
|
property Visible;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Additional', [TColorBox, TColorListBox]);
|
|
end;
|
|
|
|
function GetPrettyColorName(ColorName: String): String;
|
|
|
|
function FindInMap(ColorName: String; out NewColorName: String): Boolean;
|
|
var
|
|
Color: TColor;
|
|
begin
|
|
Result := IdentToColor(ColorName, Color);
|
|
if Result then
|
|
begin
|
|
{ workaround for a bug in fpc 2.2.2 }
|
|
if Color=clScrollBar then
|
|
NewColorName := rsScrollBarColorCaption
|
|
else
|
|
case Color of
|
|
clBlack : NewColorName := rsBlackColorCaption;
|
|
clMaroon : NewColorName := rsMaroonColorCaption;
|
|
clGreen : NewColorName := rsGreenColorCaption;
|
|
clOlive : NewColorName := rsOliveColorCaption;
|
|
clNavy : NewColorName := rsNavyColorCaption;
|
|
clPurple : NewColorName := rsPurpleColorCaption;
|
|
clTeal : NewColorName := rsTealColorCaption;
|
|
clGray : NewColorName := rsGrayColorCaption;
|
|
clSilver : NewColorName := rsSilverColorCaption;
|
|
clRed : NewColorName := rsRedColorCaption;
|
|
clLime : NewColorName := rsLimeColorCaption;
|
|
clYellow : NewColorName := rsYellowColorCaption;
|
|
clBlue : NewColorName := rsBlueColorCaption;
|
|
clFuchsia : NewColorName := rsFuchsiaColorCaption;
|
|
clAqua : NewColorName := rsAquaColorCaption;
|
|
clWhite : NewColorName := rsWhiteColorCaption;
|
|
clMoneyGreen : NewColorName := rsMoneyGreenColorCaption;
|
|
clSkyBlue : NewColorName := rsSkyBlueColorCaption;
|
|
clCream : NewColorName := rsCreamColorCaption;
|
|
clMedGray : NewColorName := rsMedGrayColorCaption;
|
|
clNone : NewColorName := rsNoneColorCaption;
|
|
clDefault : NewColorName := rsDefaultColorCaption;
|
|
clBackground : NewColorName := rsBackgroundColorCaption;
|
|
clActiveCaption : NewColorName := rsActiveCaptionColorCaption;
|
|
clInactiveCaption : NewColorName := rsInactiveCaptionColorCaption;
|
|
clMenu : NewColorName := rsMenuColorCaption;
|
|
clWindow : NewColorName := rsWindowColorCaption;
|
|
clWindowFrame : NewColorName := rsWindowFrameColorCaption;
|
|
clMenuText : NewColorName := rsMenuTextColorCaption;
|
|
clWindowText : NewColorName := rsWindowTextColorCaption;
|
|
clCaptionText : NewColorName := rsCaptionTextColorCaption;
|
|
clActiveBorder : NewColorName := rsActiveBorderColorCaption;
|
|
clInactiveBorder : NewColorName := rsInactiveBorderColorCaption;
|
|
clAppWorkspace : NewColorName := rsAppWorkspaceColorCaption;
|
|
clHighlight : NewColorName := rsHighlightColorCaption;
|
|
clHighlightText : NewColorName := rsHighlightTextColorCaption;
|
|
clBtnFace : NewColorName := rsBtnFaceColorCaption;
|
|
clBtnShadow : NewColorName := rsBtnShadowColorCaption;
|
|
clGrayText : NewColorName := rsGrayTextColorCaption;
|
|
clBtnText : NewColorName := rsBtnTextColorCaption;
|
|
clInactiveCaptionText : NewColorName := rsInactiveCaptionText;
|
|
clBtnHighlight : NewColorName := rsBtnHighlightColorCaption;
|
|
cl3DDkShadow : NewColorName := rs3DDkShadowColorCaption;
|
|
cl3DLight : NewColorName := rs3DLightColorCaption;
|
|
clInfoText : NewColorName := rsInfoTextColorCaption;
|
|
clInfoBk : NewColorName := rsInfoBkColorCaption;
|
|
clHotLight : NewColorName := rsHotLightColorCaption;
|
|
clGradientActiveCaption : NewColorName := rsGradientActiveCaptionColorCaption;
|
|
clGradientInactiveCaption : NewColorName := rsGradientInactiveCaptionColorCaption;
|
|
clMenuHighlight : NewColorName := rsMenuHighlightColorCaption;
|
|
clMenuBar : NewColorName := rsMenuBarColorCaption;
|
|
clForm : NewColorName := rsFormColorCaption;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
// check in color map
|
|
if not FindInMap(ColorName, Result) then
|
|
begin
|
|
Result := ColorName;
|
|
if Copy(Result, 1, 2) = 'cl' then
|
|
Delete(Result, 1, 2);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCustomColorBox.Create
|
|
Params: AOwner
|
|
Returns: Nothing
|
|
|
|
Use Create to create an instance of TCustomColorBox and initialize all properties
|
|
and variables.
|
|
|
|
------------------------------------------------------------------------------}
|
|
constructor TCustomColorBox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
inherited Style := csOwnerDrawFixed;
|
|
inherited ReadOnly := True;
|
|
|
|
FStyle := [cbStandardColors, cbExtendedColors, cbSystemColors];
|
|
FNoneColorColor := clBlack;
|
|
FDefaultColorColor := clBlack;
|
|
FSelected := clBlack;
|
|
|
|
SetColorList;
|
|
end;
|
|
{------------------------------------------------------------------------------
|
|
Method: TCustomColorBox.GetSelected
|
|
Params: None
|
|
Returns: TColor
|
|
|
|
Use GetSelected to convert the item selected into a system color.
|
|
|
|
------------------------------------------------------------------------------}
|
|
function TCustomColorBox.GetSelected: TColor;
|
|
begin
|
|
if HandleAllocated then
|
|
begin
|
|
if ItemIndex <> -1 then
|
|
Result := Colors[ItemIndex]
|
|
else
|
|
Result := FSelected;
|
|
end
|
|
else
|
|
Result := FSelected;
|
|
end;
|
|
|
|
procedure TCustomColorBox.SetDefaultColorColor(const AValue: TColor);
|
|
begin
|
|
if FDefaultColorColor <> AValue then
|
|
begin
|
|
FDefaultColorColor := AValue;
|
|
invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomColorBox.SetNoneColorColor(const AValue: TColor);
|
|
begin
|
|
if FNoneColorColor <> AValue then
|
|
begin
|
|
FNoneColorColor := AValue;
|
|
invalidate;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCustomColorBox.GetColor
|
|
Params: Index
|
|
Returns: Color at position Index
|
|
|
|
Used as read procedure from Colors property.
|
|
|
|
------------------------------------------------------------------------------}
|
|
|
|
function TCustomColorBox.GetColor(Index : Integer): TColor;
|
|
begin
|
|
Result := PtrInt(Items.Objects[Index])
|
|
end;
|
|
|
|
function TCustomColorBox.GetColorName(Index: Integer): string;
|
|
begin
|
|
Result := Items[Index];
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCustomColorBox.SetSelected
|
|
Params: Value
|
|
Returns: Nothing
|
|
|
|
Use SetSelected to set the item in the ColorBox when appointed a color
|
|
from code.
|
|
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomColorBox.SetSelected(Value: TColor);
|
|
var
|
|
c: integer;
|
|
begin
|
|
if HandleAllocated then
|
|
begin
|
|
FSelected := Value;
|
|
for c := Ord(cbCustomColor in Style) to Items.Count - 1 do
|
|
begin
|
|
if Colors[c] = Value then
|
|
begin
|
|
ItemIndex := c;
|
|
Exit;
|
|
end;
|
|
end;
|
|
if cbCustomColor in Style then
|
|
begin
|
|
Items.Objects[0] := TObject(PtrInt(Value));
|
|
ItemIndex := 0;
|
|
invalidate;
|
|
end
|
|
else
|
|
ItemIndex := -1;
|
|
end
|
|
else
|
|
FSelected := Value;
|
|
end;
|
|
|
|
procedure TCustomColorBox.SetStyle(const AValue: TColorBoxStyle);
|
|
begin
|
|
if FStyle <> AValue then
|
|
begin
|
|
FStyle := AValue;
|
|
SetColorList;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomColorBox.ColorProc(const s: AnsiString);
|
|
var
|
|
AColor: TColor;
|
|
Index: Integer;
|
|
ColorCaption: String;
|
|
begin
|
|
if IdentToColor(s, AColor) then
|
|
begin
|
|
if AColor = clWhite then
|
|
AColor := AColor;
|
|
// check clDefault
|
|
if not (cbIncludeDefault in Style) and (AColor = clDefault) then
|
|
Exit;
|
|
// check clNone
|
|
if not (cbIncludeNone in Style) and (AColor = clNone) then
|
|
Exit;
|
|
// check System colors
|
|
if not (cbSystemColors in Style) and ((AColor and SYS_COLOR_BASE) <> 0) then
|
|
Exit;
|
|
// check Standard, Extended colors
|
|
if ([cbStandardColors, cbExtendedColors] * Style <> [cbStandardColors, cbExtendedColors]) and
|
|
ColorIndex(AColor, Index) then
|
|
begin
|
|
if not (cbStandardColors in Style) and (Index < StandardColorsCount) then
|
|
Exit;
|
|
if not (cbExtendedColors in Style) and (Index < StandardColorsCount + ExtendedColorCount) then
|
|
Exit;
|
|
end;
|
|
|
|
if cbPrettyNames in Style then
|
|
ColorCaption := GetPrettyColorName(s)
|
|
else
|
|
ColorCaption := s;
|
|
|
|
Items.AddObject(ColorCaption, TObject(PtrInt(AColor)));
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCustomColorBox.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 TCustomColorBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
|
var
|
|
r: TRect;
|
|
BrushColor, PenColor, NewColor: TColor;
|
|
begin
|
|
if Index = -1 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;
|
|
|
|
NewColor := Self.Colors[Index];
|
|
|
|
if NewColor = clNone then
|
|
NewColor := NoneColorColor
|
|
else
|
|
if NewColor = clDefault then
|
|
NewColor := DefaultColorColor;
|
|
|
|
Brush.Color := NewColor;
|
|
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: TCustomColorBox.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 TCustomColorBox.SetColorList;
|
|
var
|
|
OldSelected: Integer;
|
|
begin
|
|
// we need to wait while we finish loading since we depend on style and OnGetColors event
|
|
if (csLoading in ComponentState) then
|
|
Exit;
|
|
|
|
OldSelected := FSelected;
|
|
with Items do
|
|
begin
|
|
Clear;
|
|
if cbCustomColor in Style then
|
|
Items.AddObject(rsCustomColorCaption, TObject(PtrInt(clBlack)));
|
|
GetColorValues(@ColorProc);
|
|
if (cbCustomColors in Style) then
|
|
DoGetColors;
|
|
end;
|
|
Selected := OldSelected;
|
|
end;
|
|
|
|
procedure TCustomColorBox.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
SetColorList;
|
|
end;
|
|
|
|
procedure TCustomColorBox.InitializeWnd;
|
|
begin
|
|
inherited InitializeWnd;
|
|
Selected := FSelected;
|
|
end;
|
|
|
|
procedure TCustomColorBox.DoGetColors;
|
|
begin
|
|
if Assigned(OnGetColors) then
|
|
OnGetColors(Self, Items)
|
|
end;
|
|
|
|
procedure TCustomColorBox.Change;
|
|
begin
|
|
if (cbCustomColor in Style) and (ItemIndex = 0) then // custom color has been selected
|
|
PickCustomColor;
|
|
if ItemIndex <> -1 then
|
|
FSelected := Colors[ItemIndex];
|
|
inherited Change;
|
|
end;
|
|
|
|
function TCustomColorBox.PickCustomColor: Boolean;
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
with TColorDialog.Create(Self) do
|
|
begin
|
|
Color := Colors[0];
|
|
Result := Execute;
|
|
if Result then
|
|
begin
|
|
Items.Objects[0] := TObject(PtrInt(Color));
|
|
invalidate;
|
|
end;
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{------------------------------------------------------------------------------
|
|
Method: TCustomColorListBox.Create
|
|
Params: AOwner
|
|
Returns: Nothing
|
|
|
|
Use Create to create an instance of TCustomColorListBox and initialize all properties
|
|
and variables.
|
|
|
|
------------------------------------------------------------------------------}
|
|
constructor TCustomColorListBox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
inherited Style := lbOwnerDrawFixed;
|
|
|
|
FStyle := [cbStandardColors, cbExtendedColors, cbSystemColors];
|
|
FNoneColorColor := clBlack;
|
|
FDefaultColorColor := clBlack;
|
|
FSelected := clBlack;
|
|
|
|
SetColorList;
|
|
end;
|
|
{------------------------------------------------------------------------------
|
|
Method: TCustomColorListBox.GetSelected
|
|
Params: None
|
|
Returns: TColor
|
|
|
|
Use GetSelected to convert the item selected into a system color.
|
|
|
|
------------------------------------------------------------------------------}
|
|
function TCustomColorListBox.GetSelected: TColor;
|
|
begin
|
|
if HandleAllocated then
|
|
begin
|
|
if ItemIndex <> -1 then
|
|
Result := Colors[ItemIndex]
|
|
else
|
|
Result := FSelected
|
|
end
|
|
else
|
|
Result := FSelected;
|
|
end;
|
|
|
|
procedure TCustomColorListBox.SetDefaultColorColor(const AValue: TColor);
|
|
begin
|
|
if FDefaultColorColor <> AValue then
|
|
begin
|
|
FDefaultColorColor := AValue;
|
|
invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomColorListBox.SetNoneColorColor(const AValue: TColor);
|
|
begin
|
|
if FNoneColorColor <> AValue then
|
|
begin
|
|
FNoneColorColor := AValue;
|
|
invalidate;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCustomColorListBox.GetColor
|
|
Params: Index
|
|
Returns: Color at position Index
|
|
|
|
Used as read procedure from Colors property.
|
|
|
|
------------------------------------------------------------------------------}
|
|
function TCustomColorListBox.GetColor(Index : Integer): TColor;
|
|
begin
|
|
Result := PtrInt(Items.Objects[Index]);
|
|
end;
|
|
|
|
function TCustomColorListBox.GetColorName(Index: Integer): string;
|
|
begin
|
|
Result := Items[Index];
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCustomColorListBox.SetSelected
|
|
Params: Value
|
|
Returns: Nothing
|
|
|
|
Use SetSelected to set the item in the ColorListBox when appointed a color
|
|
from code.
|
|
|
|
------------------------------------------------------------------------------}
|
|
procedure TCustomColorListBox.SetSelected(Value: TColor);
|
|
var
|
|
c: integer;
|
|
begin
|
|
if HandleAllocated then
|
|
begin
|
|
FSelected := Value;
|
|
for c := Ord(cbCustomColor in Style) to Items.Count - 1 do
|
|
begin
|
|
if Colors[c] = Value then
|
|
begin
|
|
ItemIndex := c;
|
|
Exit;
|
|
end;
|
|
end;
|
|
if cbCustomColor in Style then
|
|
begin
|
|
Items.Objects[0] := TObject(PtrInt(Value));
|
|
ItemIndex := 0;
|
|
invalidate;
|
|
end
|
|
else
|
|
ItemIndex := -1;
|
|
end
|
|
else
|
|
FSelected := Value;
|
|
end;
|
|
|
|
procedure TCustomColorListBox.SetStyle(const AValue: TColorBoxStyle);
|
|
begin
|
|
if FStyle <> AValue then
|
|
begin
|
|
FStyle := AValue;
|
|
SetColorList;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomColorListBox.ColorProc(const s: AnsiString);
|
|
var
|
|
AColor: TColor;
|
|
Index: Integer;
|
|
ColorCaption: String;
|
|
begin
|
|
if IdentToColor(s, AColor) then
|
|
begin
|
|
// check clDefault
|
|
if not (cbIncludeDefault in Style) and (AColor = clDefault) then
|
|
Exit;
|
|
// check clNone
|
|
if not (cbIncludeNone in Style) and (AColor = clNone) then
|
|
Exit;
|
|
// check System colors
|
|
if not (cbSystemColors in Style) and ((AColor and SYS_COLOR_BASE) <> 0) then
|
|
Exit;
|
|
// check Standard, Extended colors
|
|
if ([cbStandardColors, cbExtendedColors] * Style <> [cbStandardColors, cbExtendedColors]) and
|
|
ColorIndex(AColor, Index) then
|
|
begin
|
|
if not (cbStandardColors in Style) and (Index < StandardColorsCount) then
|
|
Exit;
|
|
if not (cbExtendedColors in Style) and (Index < StandardColorsCount + ExtendedColorCount) then
|
|
Exit;
|
|
end;
|
|
|
|
if cbPrettyNames in Style then
|
|
ColorCaption := GetPrettyColorName(s)
|
|
else
|
|
ColorCaption := s;
|
|
|
|
Items.AddObject(ColorCaption, TObject(PtrInt(AColor)));
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
Method: TCustomColorListBox.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 TCustomColorListBox.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
|
var
|
|
r: TRect;
|
|
BrushColor, PenColor, NewColor: 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;
|
|
|
|
NewColor := Self.Colors[Index];
|
|
|
|
if NewColor = clNone then
|
|
NewColor := NoneColorColor
|
|
else
|
|
if NewColor = clDefault then
|
|
NewColor := DefaultColorColor;
|
|
|
|
Brush.Color := NewColor;
|
|
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: TCustomColorListBox.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 TCustomColorListBox.SetColorList;
|
|
var
|
|
OldSelected: Integer;
|
|
begin
|
|
// we need to wait while we finish loading since we depend on style and OnGetColors event
|
|
if (csLoading in ComponentState) then
|
|
Exit;
|
|
|
|
OldSelected := FSelected;
|
|
with Items do
|
|
begin
|
|
Clear;
|
|
if cbCustomColor in Style then
|
|
Items.AddObject(rsCustomColorCaption, TObject(PtrInt(clBlack)));
|
|
GetColorValues(@ColorProc);
|
|
if (cbCustomColors in Style) then
|
|
DoGetColors;
|
|
end;
|
|
Selected := OldSelected;
|
|
end;
|
|
|
|
procedure TCustomColorListBox.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
SetColorList;
|
|
end;
|
|
|
|
procedure TCustomColorListBox.InitializeWnd;
|
|
begin
|
|
inherited InitializeWnd;
|
|
Selected := FSelected;
|
|
end;
|
|
|
|
procedure TCustomColorListBox.DoGetColors;
|
|
begin
|
|
if Assigned(OnGetColors) then
|
|
OnGetColors(Self, Items)
|
|
end;
|
|
|
|
procedure TCustomColorListBox.DoSelectionChange(User: Boolean);
|
|
begin
|
|
if User then
|
|
begin
|
|
if (cbCustomColor in Style) and (ItemIndex = 0) then // custom color has been selected
|
|
PickCustomColor;
|
|
if ItemIndex <> -1 then
|
|
FSelected := Colors[ItemIndex];
|
|
end;
|
|
inherited DoSelectionChange(User);
|
|
end;
|
|
|
|
function TCustomColorListBox.PickCustomColor: Boolean;
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
begin
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
|
|
with TColorDialog.Create(Self) do
|
|
begin
|
|
Color := Colors[0];
|
|
Result := Execute;
|
|
if Result then
|
|
begin
|
|
Items.Objects[0] := TObject(PtrInt(Color));
|
|
invalidate;
|
|
end;
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
end.
|