jvqfullcolorctrls.pas

East make Tray Icon in delphi

    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp; 
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp; 
    property OnResize;
    property OnStartDrag;
  end;

  TJvFullColorSpaceFormat = (cfName, cfShortName, cfBoth);

  TJvFullColorSpaceFormatEvent = procedure(Sender: TObject; AColorSpace: TJvColorSpace;
    out ACaption: string) of object;

  TJvFullColorSpaceCombo = class(TJvExCustomComboBox)
  private
    FAllowVariable: Boolean;
    FItemFormat: TJvFullColorSpaceFormat;
    FOnFormatItem: TJvFullColorSpaceFormatEvent;
    function GetColorSpace: TJvColorSpace;
    procedure SetAllowVariable(const Value: Boolean);
    procedure SetColorSpace(const Value: TJvColorSpace);
    procedure SetColorSpaceID(const Value: TJvFullColorSpaceID);
    function GetColorSpaceID: TJvFullColorSpaceID;
    procedure SetItemFormat(const Value: TJvFullColorSpaceFormat);
  protected
    procedure CreateWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
    property SelectedSpace: TJvColorSpace read GetColorSpace write SetColorSpace;
    procedure MakeList; virtual;
  published
    property AllowVariable: Boolean read FAllowVariable write SetAllowVariable default True;
    property ColorSpaceID: TJvFullColorSpaceID read GetColorSpaceID write SetColorSpaceID default csRGB;
    property ItemFormat: TJvFullColorSpaceFormat read FItemFormat write SetItemFormat default cfBoth;
    property OnFormatItem: TJvFullColorSpaceFormatEvent read FOnFormatItem write FOnFormatItem; 
    property Anchors;
    property Color;
    property Constraints;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ItemHeight;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick; 
    property OnCloseUp; 
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem; 
    property OnSelect; 
    property OnStartDrag;
  end;

  TJvFullColorAxisConfigFormat = (afShort, afIndent, afComplete);

  TJvFullColorAxisFormatEvent = procedure(Sender: TObject; AAxisConfig: TJvFullColorAxisConfig;
    out ACaption: string) of object;

  TJvFullColorAxisCombo = class(TJvExCustomComboBox)
  private
    FItemFormat: TJvFullColorAxisConfigFormat;
    FColorID: TJvFullColorSpaceID;
    procedure SetItemFormat(const Value: TJvFullColorAxisConfigFormat);
    procedure SetSelected(const Value: TJvFullColorAxisConfig);
    procedure SetColorID(const Value: TJvFullColorSpaceID);
    function GetSelected: TJvFullColorAxisConfig;
  protected
    procedure MakeList; virtual;
    procedure CreateWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ItemFormat: TJvFullColorAxisConfigFormat read FItemFormat write SetItemFormat default afComplete;
    property Selected: TJvFullColorAxisConfig read GetSelected write SetSelected;
    property ColorID: TJvFullColorSpaceID read FColorID write SetColorID default csRGB; 
    property Anchors;
    property Color;
    property Constraints;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ItemHeight;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick; 
    property OnCloseUp; 
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem; 
    property OnSelect; 
    property OnStartDrag;
  end;

  TJvFullColorArray = array [0..MaxListSize - 1] of TJvFullColor;
  PJvFullColorArray = ^TJvFullColorArray;

  TJvFullColorListOperation = (foAllChanged, foDeleted, foAdded, foChanged);

  TJvFullColorListEvent = procedure(Sender: TObject; Index: Integer;
    Operation: TJvFullColorListOperation) of object;

  EJvFullColorListError = class(Exception);

  TJvFullColorList = class(TPersistent)
  private
    FCapacity: Integer;
    FCount: Integer;
    FList: PJvFullColorArray;
    FOnChange: TJvFullColorListEvent;
    FUpdateCount: Integer;
    FAllocBy: Integer;
    procedure SetCapacity(const Value: Integer);
    procedure SetCount(const Value: Integer);
    procedure SetAllocBy(const Value: Integer);
  protected
    procedure Grow;
    function GetItem(Index: Integer): TJvFullColor;
    procedure SetItem(Index: Integer; const Value: TJvFullColor);
    procedure DefineProperties(Filer: TFiler); override;
    procedure WriteItems(Writer: TWriter);
    procedure ReadItems(Reader: TReader);
    procedure Change(AIndex: Integer; AOperation: TJvFullColorListOperation);
  public
    constructor Create;
    destructor Destroy; override;
    function Add(AColor: TJvFullColor): Integer;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    function Remove(AColor: TJvFullColor): Integer;
    procedure Delete(Index: Integer);
    procedure Exchange(Index1, Index2: Integer);
    procedure Insert(Index: Integer; AColor: TJvFullColor);
    function IndexOf(AColor: TJvFullColor): Integer;
    procedure DeleteRedundant;
    procedure BeginUpdate;
    procedure EndUpdate;
    property AllocBy: Integer read FAllocBy write SetAllocBy;
    property Items[Index: Integer]: TJvFullColor read GetItem write SetItem; default;
    property List: PJvFullColorArray read FList;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount write SetCount;
    property UpdateCount: Integer read FUpdateCount;
    property OnChange: TJvFullColorListEvent read FOnChange write FOnChange;
  end;

  TJvFullColorEdge = (feRaised, feLowered, feFlat); 
 
  TJvFormatHintEvent = procedure(Sender: TObject; HintColor: TJvFullColor;
    var HintText: widestring) of object; 


  
  TJvFullColorGroup = class(TJvCustomPanel) 
  private
    FItems: TJvFullColorList;
    FColCount: Integer;
    FEdge: TJvFullColorEdge;
    FSelectedEdge: TJvFullColorEdge;
    FMouseEdge: TJvFullColorEdge;
    FSquareSize: Integer;
    FMouseIndex: Integer;
    FSelectedIndex: Integer;
    FBrush: TBrush;
    FOnChange: TNotifyEvent;
    FOnFormatHint: TJvFormatHintEvent;
    procedure SetItems(const Value: TJvFullColorList);
    procedure SetColCount(const Value: Integer);
    function GetRowCount: Integer;
    procedure SetEdge(const Value: TJvFullColorEdge);
    procedure SetMouseEdge(const Value: TJvFullColorEdge);
    procedure SetSelectedEdge(const Value: TJvFullColorEdge);
    procedure SetSquareSize(const Value: Integer);
    function GetSelected: TJvFullColor;
    procedure SetSelected(const Value: TJvFullColor);
    procedure SetSelectedIndex(const Value: Integer);
    procedure SetBrush(const Value: TBrush);
    procedure WMMouseLeave(var Msg: TWMMouse); message WM_MOUSELEAVE;
    procedure CMHintShow(var Msg: TMessage); message CM_HINTSHOW;
  protected
    procedure Paint; override;
    procedure ItemsChange(Sender: TObject; Index: Integer;
      Operation: TJvFullColorListOperation);
    procedure BrushChange(Sender: TObject);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure CalcRects(out XPos, YPos, XInc, YInc: Integer);
    procedure InvalidateIndex(AIndex: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property MouseIndex: Integer read FMouseIndex;
    property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex;
    property Selected: TJvFullColor read GetSelected write SetSelected;
    property RowCount: Integer read GetRowCount;
  published
    property Items: TJvFullColorList read FItems write SetItems;
    property ColCount: Integer read FColCount write SetColCount default 4;
    property Edge: TJvFullColorEdge read FEdge write SetEdge default feRaised;
    property SelectedEdge: TJvFullColorEdge read FSelectedEdge write SetSelectedEdge default feLowered;
    property MouseEdge: TJvFullColorEdge read FMouseEdge write SetMouseEdge default feRaised;
    property SquareSize: Integer read FSquareSize write SetSquareSize default 6;
    property Brush: TBrush read FBrush write SetBrush;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnFormatHint: TJvFormatHintEvent read FOnFormatHint write FOnFormatHint;
    property Align;
    property Anchors;
    property BevelInner;
    property BevelOuter; 
    property BevelWidth; 
    property BorderStyle; 
    property BorderWidth;
    property Color;
    property Constraints;
    property Hint;
    property ParentShowHint;
    property ParentColor;
    property ShowHint;
    property Visible;
  end;

function GetIndexAxis(AxisConfig: TJvFullColorAxisConfig; AxisID: TJvAxisIndex): TJvAxisIndex;
function GetIndexAxisX(AxisConfig: TJvFullColorAxisConfig): TJvAxisIndex;
function GetIndexAxisY(AxisConfig: TJvFullColorAxisConfig): TJvAxisIndex;
function GetIndexAxisZ(AxisConfig: TJvFullColorAxisConfig): TJvAxisIndex;
function ColorSpaceToString(AColorSpace: TJvColorSpace;
  ItemFormat: TJvFullColorSpaceFormat): string;
function AxisConfigToString(AxisConfig: TJvFullColorAxisConfig;
  ItemFormat: TJvFullColorAxisConfigFormat; AColorSpace: TJvColorSpace): string;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF HAS_UNIT_RTLCONSTS}
  RTLConsts,
  {$ELSE}
  QConsts,
  {$ENDIF HAS_UNIT_RTLCONSTS}
  Math, TypInfo, QForms, 
  JvQResources, JvQConsts;

type
  TJvFullColorAxisConfigs = array [TJvAxisIndex] of TJvAxisIndex;

const
  TabAxisConfigs: array [TJvFullColorAxisConfig] of TJvFullColorAxisConfigs =
   ((axIndex0, axIndex1, axIndex2),
    (axIndex0, axIndex2, axIndex1),
    (axIndex1, axIndex0, axIndex2),
    (axIndex2, axIndex0, axIndex1),
    (axIndex1, axIndex2, axIndex0),
    (axIndex2, axIndex1, axIndex0));

function ColorSpaceToString(AColorSpace: TJvColorSpace; ItemFormat: TJvFullColorSpaceFormat): string;
begin
  case ItemFormat of
    cfName:
      Result := AColorSpace.Name;
    cfShortName:
      Result := AColorSpace.ShortName;
  else
    Result := Format('%s (%s)', [AColorSpace.Name, AColorSpace.ShortName]);
  end;
end;

function AxisConfigToString(AxisConfig: TJvFullColorAxisConfig;
  ItemFormat: TJvFullColorAxisConfigFormat; AColorSpace: TJvColorSpace): string;
var
  Str: string;
  AxisConfigs: TJvFullColorAxisConfigs;
begin
  Str := GetEnumName(TypeInfo(TJvFullColorAxisConfig), Ord(AxisConfig));
  case ItemFormat of
    afShort:
      Result := Copy(Str, 3, Length(Str) - 2);
    afIndent:
      Result := Str;
  else
    AxisConfigs := TabAxisConfigs[AxisConfig];
    Result := Format('[%s] = %s ; [%s] = %s ; [%s] = %s',
      [Str[3], AColorSpace.AxisName[axIndex0], Str[4],
      AColorSpace.AxisName[axIndex1], Str[5], AColorSpace.AxisName[axIndex2]]);
  end;
end;

function GetIndexAxis(AxisConfig: TJvFullColorAxisConfig; AxisID: TJvAxisIndex): TJvAxisIndex;
begin
  Result := TabAxisConfigs[AxisConfig][AxisID];
end;

function GetIndexAxisX(AxisConfig: TJvFullColorAxisConfig): TJvAxisIndex;
begin
  Result := TabAxisConfigs[AxisConfig][axIndex0];
end;

function GetIndexAxisY(AxisConfig: TJvFullColorAxisConfig): TJvAxisIndex;
begin
  Result := TabAxisConfigs[AxisConfig][axIndex1];
end;

function GetIndexAxisZ(AxisConfig: TJvFullColorAxisConfig): TJvAxisIndex;
begin
  Result := TabAxisConfigs[AxisConfig][axIndex2];
end;

//=== { TJvColorComponent } ==================================================

constructor TJvFullColorComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBuffer := TBitmap.Create;
  FBuffer.PixelFormat := pf32Bit;
  FAutoMouse := True;
  FAxisConfig := acXYZ;

  FFullColor := fclRGBWhite;

  TabStop := True;

  ControlStyle := [csSetCaption, csOpaque];
end;

destructor TJvFullColorComponent.Destroy;
begin
  FBuffer.Free;
  inherited Destroy;
end;

procedure TJvFullColorComponent.SetBounds(ALeft, ATop, AWidth,
  AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  CalcSize;
end;

procedure TJvFullColorComponent.CalcSize;
begin
  WantDrawBuffer := True;
end;

procedure TJvFullColorComponent.DrawBuffer;
begin
  Invalidate;
end;

procedure TJvFullColorComponent.Paint;
begin
  if WantDrawBuffer then
    DrawBuffer;
  WantDrawBuffer := False;
  inherited Paint;
end;

procedure TJvFullColorComponent.DrawFocus;
begin
  if Focused and not (csDesigning in ComponentState) then
    with Canvas do
    begin
      Pen.Color := Color;
      Brush.Color := Color;
      DrawFocusRect(ClientRect);