fccolorcombo.pas

一套及时通讯的原码

unit fcColorCombo;
{
//
// Components : TfcColorCombo
//
// Copyright (c) 2001 by Woll2Woll Software
//
// Changes:
// 3/19/99 -PYW- Rect is already correct now, so do not use GetIconIndent
//               when colorcombo is not in a grid and not focused.
// 3/25/99 -PYW- Exit if Combo is being destroyed to handle recordviewpanel support.
// 4/13/99 -PYW- Added Shift Select Support.
// 4/13/99 -PYW- Make sure events are set before adding all of the colors
// 3/7/00 - Use clGrayText for disabled color
// 4/19/00  PYW In certain cases Listbox can be nil.  Let CreateWnd create the listbox and update the color.
// 10/13/2000 - PYW - Check for Null to initialize to blank.
// 10/13/2000 - PYW - Make sure this paints correctly when it doesn't have the focus or in certain highlight cases.
// 3/1/2002-Added new function to handle painting in a TDBCtrlGrid
}

{//**************************************************
// Ideas: Add event to display different name when displaying list.
// Ideas: Code to add Standard 255 Colors exists add another option for it?
// Ideas: Add ColorDialog Standard Colors option?
//9/27/2001- Respect value storing for csPaintcopy - Allows to paint correctly in grid
//10/1/2001- Exposed OnMouseEnter and OnMouseLeave to be consistent with InfoPower.
//10/1/2001- Exposed OnContextPopup.
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus,
  fccombo,fccommon,dbctrls,db,grids, fcframe;

{$i fcIfDef.pas}

const
  ColorRectMargin = 2;

type
  TfcOwnerDrawState = (odsChecked, odsComboBoxEdit, odsDefault, odsDisabled, odsFocus, odsGrayed, odsSelected);
  TfcOwnerDrawStates = set of TfcOwnerDrawState;

  TfcSortByOption = (csoNone, csoByRGB, csoByIntensity, csoByName);

  TfcColorListBoxOption = (ccoShowSystemColors, ccoShowColorNone, ccoShowCustomColors, ccoShowStandardColors,
      ccoShowColorNames, ccoShowGreyScale, ccoGroupSystemColors);
  TfcColorListBoxOptions = set of TfcColorListBoxOption;

  TfcColorDialogOption = (cdoEnabled, cdoPreventFullOpen,
                          cdoFullOpen, cdoSolidColor, cdoAnyColor);
  TfcColorDialogOptions = set of TfcColorDialogOption;

  TfcColorDialogEvent = procedure(Sender: TObject; Dialog: TColorDialog) of object;
  TfcCloseColorDialogEvent = procedure(Sender: TObject; Dialog: TColorDialog; MResult: TModalResult; var Accept: Boolean) of object;
//  TfcCloseColorComboEvent = procedure(Sender: TObject; Accept: Boolean) of object;
  TfcAddNewColorEvent = procedure(Sender: TObject; AColor:TColor; var AColorName:String;
     var Accept: Boolean) of object;

  TfcOnFilterColorEvent = procedure(Sender: TObject; AColor:TColor; AColorName:String;
     var Accept: Boolean) of object;

  TfcColorListFiller = class
  private
    FOptions:TfcColorListBoxOptions;
    FList:TStringList;
  public
    procedure ColorCallbackProc(const s: String);
    procedure FillColorList(var AList:TStringList;AOptions:TfcColorListBoxOptions;NoneString:String);
  end;

  TfcCustomColorCombo = class;

  TfcCustomColorList = class(TCustomListBox)
  private
    { Private declarations }
    FAlignment: TLeftRight;
    FColorAlignment: TLeftRight;
    FColorWidth: Integer;
    FOptions: TfcColorListBoxOptions;
    FCustomColors: TStringList;
    FHighlightColor: TColor;
    FHighlightTextColor: TColor;
    FAllColors: TStringList;
    FSelectedColor: TColor;
    FOldSelectedColor: TColor;
    FSortByOption : TfcSortByOption;
    FTempColors: TStringList;
    FGreyScaleIncrement: Integer;
    FNoneString : String;
    FOnAddNewColor: TfcAddNewColorEvent;
    FOnFilterColor: TfcOnFilterColorEvent;
    FPrevItem : Integer;
    FLastPoint: TPoint;
    FCloseOnUp: Boolean;
    ItemIDMap: TList;
    FClickedInControl: Boolean;
    FIgnoreMouseScroll: Boolean;
    FListBoxUpdated: boolean;
    FColorMargin: Integer;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure SetAlignment(Value: TLeftRight);
    procedure SetColorAlignment(Value: TLeftRight);
    procedure SetOptions(Value: TfcColorListBoxOptions);
    procedure SetColorWidth(Value: Integer);
    procedure SetColorMargin(Value: Integer);
    procedure SetSelectedColor(Value: TColor);
    procedure SetNoneString(Value: String);
    procedure SetGreyScaleIncrement(Value: Integer);
    procedure SetSortBy(Value: TfcSortByOption);
    procedure SetCustomColors(Value: TStringList);
    function GetSelectedColor: TColor;
    function GetEditRectHeight: Integer;
//    procedure ListChange(Sender: TObject);
    {$Warnings Off}
    function GetItemIndex: integer;
    Procedure SetItemIndex(Value: integer);
    function GetHighlightColor: TColor;
    {$Warnings On}
    function GetHighlightTextColor: TColor;
//    function MapItemID(val: integer): integer;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    { Protected declarations }
    function AddToAllColors(AName:String;AValue:String): Boolean; virtual;
    procedure Click; override;
    procedure CreateWnd; override;
    procedure CustomColorsChangeEvent(Sender: TObject); virtual;
    function HasDuplicateNames(var dup:String): Boolean; virtual;
    procedure Loaded; override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
    Patch: Variant;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure InitColorList; virtual;
    procedure SortList; virtual;
    procedure UpdateItems; virtual;
    procedure DoDrawItem(ACanvas:TCanvas; Index, CWidth, CHeight:Integer; Rect: TRect;
       State: TOwnerDrawState;  Text:String; AColor:TColor); virtual;
    function ColorFromIndex(Index: Integer):TColor; virtual;
    property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
    property OldSelectedColor: TColor read FOldSelectedColor write FOldSelectedColor;
    property AllColors: TStringList read FAllColors;
    property Alignment: TLeftRight read FAlignment write SetAlignment default taLeftJustify;
    property ColorAlignment: TLeftRight read FColorAlignment write SetColorAlignment default taLeftJustify;
    property ColorMargin: Integer read FColorMargin write SetColorMargin default 2;
    property ColorWidth: Integer read FColorWidth write SetColorWidth;
    property CustomColors: TStringList read FCustomColors write SetCustomColors;
    property GreyScaleIncrement: Integer read FGreyScaleIncrement write SetGreyScaleIncrement default 15;
    property HighlightColor: TColor read FHighlightColor write FHighlightColor;
    property HighlightTextColor: TColor read FHighlightTextColor write FHighlightTextColor;
    property ItemIndex read GetItemIndex write SetItemIndex;
    property NoneString: String read FNoneString write SetNoneString;
    property Options: TfcColorListBoxOptions read FOptions write SetOptions;
    property SortBy: TfcSortByOption read FSortByOption write SetSortBy default csoNone;
    property OnAddNewColor: TfcAddNewColorEvent read FOnAddNewColor write FOnAddNewColor;
    property OnFilterColor: TfcOnFilterColorEvent read FOnFilterColor write FOnFilterColor;
    { Published declarations }
  end;

  TfcColorList = class(TfcCustomColorList)
  published
    {$ifdef fcDelphi4Up}
    property Anchors;
    property Constraints;
    {$endif}
    property Align;
    property Alignment;
    property BorderStyle;
    property Color;
    property ColorAlignment;
    property ColorMargin;
    property ColorWidth;
    property Columns;
    property Ctl3D;
    property CustomColors;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ExtendedSelect;     //4/13/99 - PYW - Added Shift Select Support.
    property Font;
    property GreyScaleIncrement;
    property ImeMode;
    property ImeName;
    property IntegralHeight;
    property MultiSelect;
    property NoneString;
    property Options;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property SelectedColor;   //3/2/99 - Added SelectedColor and removed ItemIndex.
    property SortBy;
    property OnAddNewColor;
    property OnFilterColor;
    property OnClick;
    {$ifdef fcDelphi5Up}
    property OnContextPopup;
    {$endif}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property ParentColor;
    property ShowHint;
    property TabOrder;
    property Visible;
    property ItemHeight;
  end;

  TfcColorListOptions = class(TPersistent)
  private
     FCombo:TfcCustomColorCombo;
     FColor:TColor;
     FColorWidth: Integer;
     FFont: TFont;
     FGreyScaleIncrement: Integer;
     FIntegralHeight:Boolean;
     FItemHeight:Integer;
     FOptions: TfcColorListBoxOptions;
     FSortByOption : TfcSortByOption;
     FNoneString : String;

     procedure SetColor(Value: TColor);
     procedure SetColorWidth(Value: Integer);
     procedure SetFont(Value: TFont);
     procedure SetGreyScaleIncrement(Value: Integer);
     procedure SetIntegralHeight(Value: Boolean);
     procedure SetItemHeight(Value: Integer);
     procedure SetNoneString(Value: String);
     procedure SetSortBy(Value: TfcSortByOption);
     function StoreNoneString: boolean;
  protected
     procedure SetOptions(Value: TfcColorListBoxOptions);
  published
     constructor Create(AOwner: TfcCustomColorCombo);
     destructor Destroy; override;
     property Color: TColor read FColor write SetColor default clWindow;
     property ColorWidth: Integer read FColorWidth write SetColorWidth default 0;
     property Font: TFont read FFont write SetFont;
     property GreyScaleIncrement: Integer read FGreyScaleIncrement write SetGreyScaleIncrement default 10;
     property IntegralHeight: Boolean read FIntegralHeight write SetIntegralHeight default True;
     property ItemHeight: Integer read FItemHeight write SetItemHeight default 16;
     property NoneString: String read FNoneString write SetNoneString stored StoreNoneString;
     property Options : TfcColorListBoxOptions read FOptions write SetOptions default [ccoShowStandardColors, ccoShowColorNames];
     property SortBy: TfcSortByOption read FSortByOption write SetSortBy default csoNone;
  end;

  TfcColorComboDataType = (ccdColorName,ccdColor);   //Maybe add ccdColorHex?

  TfcCustomColorCombo = class(TfcCustomCombo)
  private
    FAlignment: TLeftRight;
//    FAlignmentVertical: TfcAlignVertical;
    FAutoDropDown: boolean;
    InAutoDropDown: boolean;
    FColorAlignment: TLeftRight;
    FColorDialog: TColorDialog;
    FShowMatchText: Boolean;

    FCustomColors: TStringList;

//    FDataType: TfcColorComboDataType;

    FListbox: TfcColorList;
    FSelectedColor: TColor;
    FDropDownWidth: integer;
    FColorListOptions: TfcColorListOptions;

    FOnDrawItem: TDrawItemEvent;
    FOnInitColorDialog: TfcColorDialogEvent;
    FOnCloseColorDialog: TfcCloseColorDialogEvent;
    FColorDialogOptions: TfcColorDialogOptions;
    FItemIndex: Integer;
    SkipDataChange: Boolean;
    SkipTextChange: Boolean;
    SkipDropDown:Boolean;
//    FOnCloseUp: TNotifyEvent;
    FCloseOnUp: Boolean;
    FOriginalIndex: Integer;
    FOriginalSelectedColor: TColor;
    FSelectedItemIndex: Integer;
    FOnAddNewColor: TfcAddNewColorEvent;
    FOnFilterColor: TfcOnFilterColorEvent;
    SetModifiedInChangeEvent: boolean;

    procedure SetAlignment(Value: TLeftRight);
//    procedure SetAlignmentVertical(Value: TfcAlignVertical);
    procedure SetColorAlignment(Value: TLeftRight);
    procedure SetCustomColors(Value: TStringList);
    procedure SetItemIndex(Value: integer);
    procedure SetSelectedColor(Value: TColor);

    procedure CustomColorsChangeEvent(Sender: TObject);
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ListMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; {handle tab}
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    function GetSelectedColorString: string;
    procedure SetSelectedColorString(Value: string);
    procedure UpdateSelectedColor;
    function GetEffectiveAlignment: TLeftRight;
protected
    procedure Change; override; // 7/31/00
    procedure AddNewColorEvent(Sender: TObject; AColor:TColor;
      var AColorName:String;  var Accept: Boolean); virtual;
    procedure OnFilterColorEvent(Sender: TObject; AColor:TColor;
      AColorName:String;  var Accept: Boolean); virtual;

    function GetComboColor(Index:Integer): TColor; virtual;
    function GetComboDataType:TfcColorComboDataType; virtual;
    function GetComboDisplayText(Value:integer): String; virtual;
    function GetTextRect(ARect:TRect;Highlight:Boolean): TRect; virtual;
    procedure ListBoxNeeded; virtual;
    procedure PaintToCanvas(ACanvas: TCanvas; Rect: TRect; Highlight, GridPaint: Boolean;
      Text: string); override;
    procedure Paint; override;

    procedure CreateWnd; override;
    procedure DataChange(Sender: TObject); override;
    Function Editable: boolean; override;
    function EditCanModify: Boolean; override;
    function GetDropDownControl: TWinControl; override;
    function GetDropDownContainer: TWinControl; override;
    function GetItemCount: Integer; override;
    function GetItemSize: TSize; override;
//    procedure HandleDropDownKeys(var Key: Word; Shift: TShiftState); override;
    procedure HideCaret; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    function GetIndentLeft(Rect: TRect): Integer; virtual;
    function GetRightIndent(Rect:TRect): Integer; override;
    function GetTopIndent: Integer; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    Procedure DrawColorRect(ACanvas:TCanvas;Rect:TRect;CurColor:TColor;Highlight:Boolean); virtual;
    procedure SetComboText(Value:String); virtual;

    procedure SetEditRect; override;
    procedure ShowCaret; override;
    procedure UpdateData(Sender: TObject); override;
    procedure WndProc(var Message: TMessage); override;
    property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure SelectAll; override;
    procedure CloseUp(Accept: Boolean); override;
    function ColorString(s: string): string;
    function IsCustomColor(s: string): Boolean;