colorboxse.pas

FlexGraphics是一套创建矢量图形的VCL组件

unit ColorBoxSE;

interface

{$IFNDEF VER80}                { DELPHI 1.0     }
 {$IFNDEF VER90}               { DELPHI 2.0     }
  {$IFNDEF VER93}              { C++Builder 1.0 }
   {$IFNDEF VER100}            { DELPHI 3.0     }
    {$IFNDEF VER110}           { C++Builder 3.0 }
     {$IFNDEF VER120}          { DELPHI 4.0 }
      {$IFNDEF VER125}         { C++Builder 4.0 }
       {$IFNDEF VER130}        { DELPHI/C++Builder 5.0 }
         {$DEFINE DELPHI6_UP}
       {$ENDIF}
      {$ENDIF}
     {$ENDIF}
    {$ENDIF}
   {$ENDIF}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}

uses
  Windows, Classes, Controls, StdCtrls, Graphics, Dialogs, SysUtils, Messages;

const
  NoColorSelected = TColor($FF000000);

  {$IFNDEF DELPHI6_UP}
  StandardColorsCount = 16;

  clMoneyGreen = TColor($C0DCC0);
  clSkyBlue = TColor($F0CAA6);
  clCream = TColor($F0FBFF);
  clMedGray = TColor($A4A0A0);
  ExtendedColorsCount = 4;
  {$ENDIF}

type
  TFlexColorBoxStyles = (
    fcbStandardColors, // first sixteen RGBI colors
    fcbExtendedColors, // four additional reserved colors
    fcbSystemColors,   // system managed/defined colors
    fcbNoneColor,      // include clNone color, must be used with cbSystemColors
    fcbDefaultColor,   // include clDefault color, must be used with cbSystemColors
    fcbCustomColor,    // last color is customizable
    fcbPrettyNames     // instead of 'clColorNames' you get 'Color Names'
  );

  TFlexColorBoxStyle = set of TFlexColorBoxStyles;

const
  DefaultFlexColorBoxStyle = [
    fcbStandardColors, fcbExtendedColors, fcbNoneColor, fcbCustomColor,
    fcbPrettyNames ];

type
  TCustomColorBoxSE = class(TCustomComboBox)
  private
    FStyle: TFlexColorBoxStyle;
    FNeedToPopulate: Boolean;
    FListSelected: Boolean;
    FDefaultColor: TColor;
    FSelectedColor: TColor;
    FColorNames: array[TFlexColorBoxStyles] of string;
    function GetColor(Index: Integer): TColor;
    function GetColorName(Index: Integer): string;
    function GetColorValue: TColor;
    procedure SetColorValue(const AColor: TColor);
    procedure ColorCallBack(const AName: string);
    function ColorToName(const AColor: TColor): string;
    procedure SetDefaultColor(const Value: TColor);
    function GetColorType(Index: Integer): TFlexColorBoxStyles;
    function GetCustomColor: TColor;
    procedure SetCustomColor(const Value: TColor);
    procedure SetUserColorName(const Index: TFlexColorBoxStyles;
      const Value: string);
    function StoredUserColorName(const Index: TFlexColorBoxStyles): Boolean;
    function GetUserColorName(const Index: TFlexColorBoxStyles): string;
    {$IFNDEF DELPHI6_UP}
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    {$ENDIF}
  protected
    procedure CreateWnd; override;
    procedure CloseUp; {$IFDEF DELPHI6_UP} override; {$ELSE} virtual; {$ENDIF}
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    function PickCustomColor: Boolean; virtual;
    procedure PopulateList;
    procedure Select; {$IFDEF DELPHI6_UP} override; {$ELSE} virtual; {$ENDIF}
    procedure SetStyle(AStyle: TFlexColorBoxStyle); reintroduce;
  public
    constructor Create(AOwner: TComponent); override;
    property ColorType[Index: Integer]: TFlexColorBoxStyles read GetColorType;
    property Style: TFlexColorBoxStyle read FStyle write SetStyle
      default DefaultFlexColorBoxStyle;
    property Colors[Index: Integer]: TColor read GetColor;
    property ColorNames[Index: Integer]: string read GetColorName;
    property ColorValue: TColor read GetColorValue write SetColorValue default clBlack;
    property DefaultColor: TColor read FDefaultColor
      write SetDefaultColor default clBlack;
    property CustomColor: TColor read GetCustomColor write SetCustomColor;
    property CustomColorName: string index fcbCustomColor read GetUserColorName
      write SetUserColorName stored StoredUserColorName;
    property NoneColorName: string index fcbNoneColor read GetUserColorName
      write SetUserColorName stored StoredUserColorName;
    property DefaultColorName: string index fcbDefaultColor read GetUserColorName
      write SetUserColorName stored StoredUserColorName;
  end;

  TColorBoxSE = class(TCustomColorBoxSE)
  published
    {$IFDEF DELPHI6_UP}
    property AutoComplete;
    property AutoDropDown;
    {$ENDIF}
    property ColorValue;
    property DefaultColor;
    property CustomColor;
    property CustomColorName;
    property NoneColorName;
    property DefaultColorName;
    property Style;

    property Anchors;
    property BevelEdges;
    property BevelInner;
    property BevelKind;
    property BevelOuter;
    property BiDiMode;
    property Color;
    property Constraints;
    property Ctl3D;
    property DropDownCount;
    property Enabled;
    property Font;
    property ItemHeight;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDock;
    property OnStartDrag;
    {$IFDEF DELPHI6_UP}
    property OnCloseUp;
    property OnContextPopup;
    property OnSelect;
    {$ENDIF}
  end;

var
  CustomColors: TStringList;

implementation

resourcestring
  SFlexColorBoxCustomCaption = 'Other...';

  clNameBlack = 'Black';
  clNameMaroon = 'Maroon';
  clNameGreen = 'Green';
  clNameOlive = 'Olive';
  clNameNavy = 'Navy';
  clNamePurple = 'Purple';
  clNameTeal = 'Teal';
  clNameGray = 'Gray';
  clNameSilver = 'Silver';
  clNameRed = 'Red';
  clNameLime = 'Lime';
  clNameYellow = 'Yellow';
  clNameBlue = 'Blue';
  clNameFuchsia = 'Fuchsia';
  clNameAqua = 'Aqua';
  clNameWhite = 'White';
  clNameMoneyGreen = 'Money Green';
  clNameSkyBlue = 'Sky Blue';
  clNameCream = 'Cream';
  clNameMedGray = 'Medium Gray';
  clNameActiveBorder = 'Active Border';
  clNameActiveCaption = 'Active Caption';
  clNameAppWorkSpace = 'Application Workspace';
  clNameBackground = 'Background';
  clNameBtnFace = 'Button Face';
  clNameBtnHighlight = 'Button Highlight';
  clNameBtnShadow = 'Button Shadow';
  clNameBtnText = 'Button Text';
  clNameCaptionText = 'Caption Text';
  clNameDefault = 'Default';
  clNameGradientActiveCaption = 'Gradient Active Caption';
  clNameGradientInactiveCaption = 'Gradient Inactive Caption';
  clNameGrayText = 'Gray Text';
  clNameHighlight = 'Highlight Background';
  clNameHighlightText = 'Highlight Text';
  clNameInactiveBorder = 'Inactive Border';
  clNameInactiveCaption = 'Inactive Caption';
  clNameInactiveCaptionText = 'Inactive Caption Text';
  clNameInfoBk = 'Info Background';
  clNameInfoText = 'Info Text';
  clNameMenu = 'Menu Background';
  clNameMenuText = 'Menu Text';
  clNameNone = 'None';
  clNameScrollBar = 'Scroll Bar';
  clName3DDkShadow = '3D Dark Shadow';
  clName3DLight = '3D Light';
  clNameWindow = 'Window Background';
  clNameWindowFrame = 'Window Frame';
  clNameWindowText = 'Window Text';


const
  ColorToPretyName: array[0..46] of TIdentMapEntry = (
    (Value: clBlack; Name: clNameBlack),
    (Value: clMaroon; Name: clNameMaroon),
    (Value: clGreen; Name: clNameGreen),
    (Value: clOlive; Name: clNameOlive),
    (Value: clNavy; Name: clNameNavy),
    (Value: clPurple; Name: clNamePurple),
    (Value: clTeal; Name: clNameTeal),
    (Value: clGray; Name: clNameGray),
    (Value: clSilver; Name: clNameSilver),
    (Value: clRed; Name: clNameRed),
    (Value: clLime; Name: clNameLime),
    (Value: clYellow; Name: clNameYellow),
    (Value: clBlue; Name: clNameBlue),
    (Value: clFuchsia; Name: clNameFuchsia),
    (Value: clAqua; Name: clNameAqua),
    (Value: clWhite; Name: clNameWhite),
    (Value: clMoneyGreen; Name: clNameMoneyGreen),
    (Value: clSkyBlue; Name: clNameSkyBlue),
    (Value: clCream; Name: clNameCream),
    (Value: clMedGray; Name: clNameMedGray),

    (Value: clActiveBorder; Name: clNameActiveBorder),
    (Value: clActiveCaption; Name: clNameActiveCaption),
    (Value: clAppWorkSpace; Name: clNameAppWorkSpace),
    (Value: clBackground; Name: clNameBackground),
    (Value: clBtnFace; Name: clNameBtnFace),
    (Value: clBtnHighlight; Name: clNameBtnHighlight),
    (Value: clBtnShadow; Name: clNameBtnShadow),
    (Value: clBtnText; Name: clNameBtnText),
    (Value: clCaptionText; Name: clNameCaptionText),
    (Value: clDefault; Name: clNameDefault),
    (Value: clGrayText; Name: clNameGrayText),
    (Value: clHighlight; Name: clNameHighlight),
    (Value: clHighlightText; Name: clNameHighlightText),
    (Value: clInactiveBorder; Name: clNameInactiveBorder),
    (Value: clInactiveCaption; Name: clNameInactiveCaption),
    (Value: clInactiveCaptionText; Name: clNameInactiveCaptionText),
    (Value: clInfoBk; Name: clNameInfoBk),
    (Value: clInfoText; Name: clNameInfoText),
    (Value: clMenu; Name: clNameMenu),
    (Value: clMenuText; Name: clNameMenuText),
    (Value: clNone; Name: clNameNone),
    (Value: clScrollBar; Name: clNameScrollBar),
    (Value: cl3DDkShadow; Name: clName3DDkShadow),
    (Value: cl3DLight; Name: clName3DLight),
    (Value: clWindow; Name: clNameWindow),
    (Value: clWindowFrame; Name: clNameWindowFrame),
    (Value: clWindowText; Name: clNameWindowText) );

// TCustomColorBox ////////////////////////////////////////////////////////////

constructor TCustomColorBoxSE.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited Style := csOwnerDrawFixed;
  FStyle := DefaultFlexColorBoxStyle; 
  FSelectedColor := clBlack;
  FDefaultColor := clBlack;
  PopulateList;
end;

procedure TCustomColorBoxSE.CreateWnd;
begin
  inherited CreateWnd;
  if FNeedToPopulate then
    PopulateList;
end;

procedure TCustomColorBoxSE.Loaded;
begin
  inherited;
  ColorValue := FSelectedColor;
end;

{$IFNDEF DELPHI6_UP}
procedure TCustomColorBoxSE.CNCommand(var Message: TWMCommand);
begin
  case Message.NotifyCode of
    CBN_CLOSEUP:
      CloseUp;
    CBN_SELCHANGE:
      begin
        Text := Items[ItemIndex];
        Click;
        Select;
      end;
    else
      inherited;
  end;
end;
{$ENDIF}

procedure TCustomColorBoxSE.CloseUp;
begin
  {$IFDEF DELPHI6_UP}
  inherited CloseUp;
  {$ENDIF}
  FListSelected := True;
end;

procedure TCustomColorBoxSE.ColorCallBack(const AName: String);
var
  I, LStart: Integer;
  LColor: TColor;
  LName: string;
begin
  LColor := StringToColor(AName);
  if (LColor = clNone) or (LColor = clDefault) then exit;
  if fcbPrettyNames in Style then
  begin
    if not IntToIdent(LColor, LName, ColorToPretyName) then
    begin
      if Copy(AName, 1, 2) = 'cl' then
        LStart := 3
      else
        LStart := 1;
      LName := '';
      for I := LStart to Length(AName) do
      begin
        case AName[I] of
          'A'..'Z':
            if LName <> '' then
              LName := LName + ' ';
        end;
        LName := LName + AName[I];
      end;
    end;
  end
  else
    LName := AName;
  Items.AddObject(LName, TObject(LColor));
end;

function TCustomColorBoxSE.ColorToName(const AColor: TColor): string;
var
  AName: string;
  I, LStart: Integer;
begin
  AName := ColorToString(AColor);
  if fcbPrettyNames in Style then
  begin
    if not IntToIdent(AColor, Result, ColorToPretyName) then
    begin
      if Copy(AName, 1, 2) = 'cl' then
        LStart := 3