ezcolorpicker.pas

很管用的GIS控件

unit EzColorPicker;

// This unit contains a special speed button which can be used to let the user select
// a specific color. The control does not use the standard Windows color dialog, but
// a popup window very similar to the one in Office97, which has been improved a lot
// to support the task of picking one color out of millions. Included is also the
// ability to pick one of the predefined system colors (e.g. clBtnFace).
// Note: The layout is somewhat optimized to look pretty with the predefined box size
//       of 18 pixels (the size of one little button in the predefined color area) and
//       the number of color comb levels. It is easily possible to change this, but
//       if you want to do so then you have probably to make some additional
//       changes to the overall layout.
//
// (BCB check by Josue Andrade Gomes [e-mail])
//
// (c) 1999, written by Dipl. Ing. Mike Lischke ([e-mail])
// All rights reserved. 
// Portions copyright by Borland. The implementation of the speed button has been
// taken from Delphi sources.
//
// 22-JUN-99 ml: a few improvements for the overall layout (mainly indicator rectangle
//               does now draw in four different styles and considers the layout
//               property of the button (changed to version 1.2, BCB compliance is
//               now proved by Josue Andrade Gomes)
// 18-JUN-99 ml: message redirection bug removed (caused an AV under some circumstances)
//               and accelerator key handling bug removed (wrong flag for EndSelection)
//               (changed to version 1.1)
// 16-JUN-99 ml: initial release
//
// Notes from EzSoft Engineering: Named changed to TEzColorBox to avoid incompatibility
// issues with previous version of EzGIS/EzCAD
// Changed the behaviour to adapt to support Transparent definition for
// a color and a TColorDialog is used in order to support wide range/standard of color selection

{$I EZ_FLAG.PAS}
interface

uses Windows, Messages, SysUtils, Classes, Controls, Forms, Graphics, StdCtrls,
     ExtCtrls, CommCtrl, Dialogs, EzBase;

const // constants used in OnHint and internally to indicate a specific cell
      NoneColorCell = -3;
      CustomCell = -2;
      NoCell = -1;

type
  TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
  TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive);
  TButtonStyle = (bsAutoDetect, bsWin31, bsNew);
  TNumGlyphs = 1..4;

  TIndicatorBorder = (ibNone, ibFlat, ibSunken, ibRaised);

  THintEvent = procedure(Sender: TObject; Cell: Integer; var Hint: String) of object;
  TDropChangingEvent = procedure(Sender: TObject; var Allowed: Boolean) of object;

  { name changed for avoid compatibility problems }
  TEzColorBox = class(TCustomControl)
  private
    FGroupIndex: Integer;
    FGlyph: Pointer;
    FDown: Boolean;
    FDragging: Boolean;
    FAllowAllUp: Boolean;
    FLayout: TButtonLayout;
    FSpacing: Integer;
    FMargin: Integer;
    FFlat: Boolean;
    FMouseInControl: Boolean;
    FTransparent: Boolean;
    FIndicatorBorder: TIndicatorBorder;

    FDropDownArrowColor: TColor;
    FDropDownWidth: Integer;
    FDropDownZone: Boolean;
    FDroppedDown: Boolean;
    FSelectionColor: TColor;
    FState: TButtonState;
    FColorPopup: TWinControl;
    FPopupWnd: HWND;

    FOnChange,
    FOnNoneColorSelect,
    FOnDropChanged: TNotifyEvent;
    FOnDropChanging: TDropChangingEvent;
    FOnHint: THintEvent;
    procedure GlyphChanged(Sender: TObject);
    procedure UpdateExclusive;
    function GetGlyph: TBitmap;
    procedure SetDropDownArrowColor(Value: TColor);
    procedure SetDropDownWidth(Value: integer);
    procedure SetGlyph(Value: TBitmap);
    function GetNumGlyphs: TNumGlyphs;
    procedure SetNumGlyphs(Value: TNumGlyphs);
    procedure SetDown(Value: Boolean);
    procedure SetFlat(Value: Boolean);
    procedure SetAllowAllUp(Value: Boolean);
    procedure SetGroupIndex(Value: Integer);
    procedure SetLayout(Value: TButtonLayout);
    procedure SetSpacing(Value: Integer);
    procedure SetMargin(Value: Integer);
    procedure UpdateTracking;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;

    procedure DrawButtonSeperatorUp(Canvas: TCanvas);
    procedure DrawButtonSeperatorDown(Canvas: TCanvas);
    procedure DrawTriangle(Canvas: TCanvas; Top, Left, Width: Integer);
    procedure SetDroppedDown(const Value: Boolean);
    procedure SetSelectionColor(const Value: TColor);
    procedure PopupWndProc(var Msg: TMessage);
    function GetCustomText: String;
    procedure SetCustomText(const Value: String);
    function GetNoneColorText: String;
    procedure SetNoneColorText(const Value: String);
    procedure SetShowSystemColors(const Value: Boolean);
    function GetShowSystemColors: Boolean;
    procedure SetTransparent(const Value: Boolean);
    procedure SetIndicatorBorder(const Value: TIndicatorBorder);
    function GetPopupSpacing: Integer;
    procedure SetPopupSpacing(const Value: Integer);
    function GetAbout: TEzAbout;
    procedure SetAbout(const Value: TEzAbout);
  protected
    procedure DoNoneColorEvent; virtual;
    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Click; override;

    property DroppedDown: Boolean read FDroppedDown write SetDroppedDown;
    { only for compatibility with TEzColorBox}
    property Selected: TColor read FSelectionColor write SetSelectionColor;
  published

    Property About: TEzAbout read GetAbout write SetAbout;
    property TabOrder;
    property TabStop;
    property Action;
    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
    property Anchors;
    property BiDiMode;
    property Caption;
    property Constraints;
    property CustomText: String read GetCustomText write SetCustomText;
    property NoneColorText: String read GetNoneColorText write SetNoneColorText;
    property Down: Boolean read FDown write SetDown default False;
    property DropDownArrowColor: TColor read FDropDownArrowColor write SetDropDownArrowColor default clBlack;
    property DropDownWidth: integer read FDropDownWidth write SetDropDownWidth default 15;
    property Enabled;
    property Flat: Boolean read FFlat write SetFlat default False;
    property Font;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property IndicatorBorder: TIndicatorBorder read FIndicatorBorder write SetIndicatorBorder default ibFlat;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
    property ParentBiDiMode;
    property ParentFont;
    property ParentShowHint;
    property PopupSpacing: Integer read GetPopupSpacing write SetPopupSpacing;
    property SelectionColor: TColor read FSelectionColor write SetSelectionColor default clBlack;
    property ShowHint;
    property ShowSystemColors: Boolean read GetShowSystemColors write SetShowSystemColors;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property Transparent: Boolean read FTransparent write SetTransparent default True;
    property Visible;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClick;
    property OnDblClick;
    property OnNoneColorSelect: TNotifyEvent read FOnNoneColorSelect write FOnNoneColorSelect;
    property OnDropChanged: TNotifyEvent read FOnDropChanged write FOnDropChanged;
    property OnDropChanging: TDropChangingEvent read FOnDropChanging write FOnDropChanging;
    property OnHint: THintEvent read FOnHint write FOnHint;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnEnter;
    Property OnExit;
  end;

//procedure Register;

//-----------------------------------------------------------------------------

implementation

uses
  ImgList, EzConsts;

const DRAW_BUTTON_UP = 8208;
      DRAW_BUTTON_DOWN = 8720;

type TColorEntry = record
       Name: PChar;
       case Boolean of
         True: (R, G, B, reserved: Byte);
         False: (Color: COLORREF);
     end;

const DefaultColorCount = 40;
      // these colors are the same as used in Office 97/2000
      DefaultColors : array[0..DefaultColorCount - 1] of TColorEntry = (
        (Name: 'Black'; Color: $000000),
        (Name: 'Brown'; Color: $003399),
        (Name: 'Olive Green'; Color: $003333),
        (Name: 'Dark Green'; Color: $003300),
        (Name: 'Dark Teal'; Color: $663300),
        (Name: 'Dark blue'; Color: $800000),
        (Name: 'Indigo'; Color: $993333),
        (Name: 'Gray-80%'; Color: $333333),

        (Name: 'Dark Red'; Color: $000080),
        (Name: 'Orange'; Color: $0066FF),
        (Name: 'Dark Yellow'; Color: $008080),
        (Name: 'Green'; Color: $008000),
        (Name: 'Teal'; Color: $808000),
        (Name: 'Blue'; Color: $FF0000),
        (Name: 'Blue-Gray'; Color: $996666),
        (Name: 'Gray-50%'; Color: $808080),

        (Name: 'Red'; Color: $0000FF),
        (Name: 'Light Orange'; Color: $0099FF),
        (Name: 'Lime'; Color: $00CC99),
        (Name: 'Sea Green'; Color: $669933),
        (Name: 'Aqua'; Color: $CCCC33),
        (Name: 'Light Blue'; Color: $FF6633),
        (Name: 'Violet'; Color: $800080),
        (Name: 'Grey-40%'; Color: $969696),

        (Name: 'Pink'; Color: $FF00FF),
        (Name: 'Gold'; Color: $00CCFF),
        (Name: 'Yellow'; Color: $00FFFF),
        (Name: 'Bright Green'; Color: $00FF00),
        (Name: 'Turquoise'; Color: $FFFF00),
        (Name: 'Sky Blue'; Color: $FFCC00),
        (Name: 'Plum'; Color: $663399),
        (Name: 'Gray-25%'; Color: $C0C0C0),

        (Name: 'Rose'; Color: $CC99FF),
        (Name: 'Tan'; Color: $99CCFF),
        (Name: 'Light Yellow'; Color: $99FFFF),
        (Name: 'Light Green'; Color: $CCFFCC),
        (Name: 'Light Turquoise'; Color: $FFFFCC),
        (Name: 'Pale Blue'; Color: $FFCC99),
        (Name: 'Lavender'; Color: $FF99CC),
        (Name: 'White'; Color: $FFFFFF)
      );

      SysColorCount = 25;
      SysColors : array[0..SysColorCount - 1] of TColorEntry = (
        (Name: 'Scroll bar'; Color: COLORREF(clScrollBar)),
        (Name: 'Background'; Color: COLORREF(clBackground)),
        (Name: 'Active caption'; Color: COLORREF(clActiveCaption)),
        (Name: 'Inactive caption'; Color: COLORREF(clInactiveCaption)),
        (Name: 'Menu'; Color: COLORREF(clMenu)),
        (Name: 'Window'; Color: COLORREF(clWindow)),
        (Name: 'Window frame'; Color: COLORREF(clWindowFrame)),
        (Name: 'Menu text'; Color: COLORREF(clMenuText)),
        (Name: 'Window text'; Color: COLORREF(clWindowText)),
        (Name: 'Caption text'; Color: COLORREF(clCaptionText)),
        (Name: 'Active border'; Color: COLORREF(clActiveBorder)),
        (Name: 'Inactive border'; Color: COLORREF(clInactiveBorder)),
        (Name: 'Application workspace'; Color: COLORREF(clAppWorkSpace)),
        (Name: 'Highlight'; Color: COLORREF(clHighlight)),
        (Name: 'Highlight text'; Color: COLORREF(clHighlightText)),
        (Name: 'Button face'; Color: COLORREF(clBtnFace)),
        (Name: 'Button shadow'; Color: COLORREF(clBtnShadow)),
        (Name: 'Gray text'; Color: COLORREF(clGrayText)),
        (Name: 'Button text'; Color: COLORREF(clBtnText)),
        (Name: 'Inactive caption text'; Color: COLORREF(clInactiveCaptionText)),
        (Name: 'Button highlight'; Color: COLORREF(clBtnHighlight)),
        (Name: '3D dark shadow'; Color: COLORREF(cl3DDkShadow)),
        (Name: '3D light'; Color: COLORREF(cl3DLight)),
        (Name: 'Info text'; Color: COLORREF(clInfoText)),
        (Name: 'Info background'; Color: COLORREF(clInfoBk))
      );

type
  TGlyphList = class(TImageList)
  private
    FUsed: TBits;
    FCount: Integer;
    function AllocateIndex: Integer;
  public
    constructor CreateSize(AWidth, AHeight: Integer);
    destructor Destroy; override;

    function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
    procedure Delete(Index: Integer);
    property Count: Integer read FCount;
  end;

  TGlyphCache = class
  private
    FGlyphLists: TList;
  public
    constructor Create;
    destructor Destroy; override;

    function GetList(AWidth, AHeight: Integer): TGlyphList;
    procedure ReturnList(List: TGlyphList);
    function Empty: Boolean;
  end;

  TButtonGlyph = class
  private
    FOriginal: TBitmap;
    FGlyphList: TGlyphList;
    FIndexes: array[TButtonState] of Integer;
    FTransparentColor: TColor;
    FNumGlyphs: TNumGlyphs;
    FOnChange: TNotifyEvent;
    procedure GlyphChanged(Sender: TObject);
    procedure SetGlyph(Value: TBitmap);
    procedure SetNumGlyphs(Value: TNumGlyphs);
    procedure Invalidate;
    function CreateButtonGlyph(State: TButtonState): Integer;
    procedure DrawButtonGlyph(Canvas: TCanvas; const GlyphPos: TPoint;
      State: TButtonState; Transparent: Boolean);
    procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
      TextBounds: TRect; State: TButtonState; BiDiFlags: Longint);
    procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
      const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
      Margin, Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
      const DropDownWidth: Integer; BiDiFlags: Longint);
  public
    constructor Create;
    destructor Destroy; override;

    function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
      const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
      State: TButtonState; Transparent: Boolean;
      const DropDownWidth: Integer; BiDiFlags: Longint): TRect;

    property Glyph: TBitmap read FOriginal write SetGlyph;
    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TFloatPoint = record
    X, Y: Extended;
  end;

  TRGB = record
    Red, Green, Blue: Single;
  end;

  TSelectionMode = (smNone, smColor, smBW, smRamp);
  
  TColorPopup = class(TWinControl)
  private
    FNoneColorText,
    FCustomText: String;
    FCurrentColor: TCOlor;
    FCanvas: TCanvas;
    FMargin,
    FSpacing,
    FColumnCount,
    FRowCount,
    FSysRowCount,
    FBoxSize: Integer;
    FSelectedIndex,
    FHoverIndex: Integer;
    FWindowRect,
    FCustomTextRect,
    FNoneColorTextRect,
    FCustomColorRect: TRect;
    FShowSysColors: Boolean;