unit mbColorTree;

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}

interface

{$I mxs.inc}

uses
  {$IFDEF FPC}
  LCLIntf, LCLType, LMessages,
  {$ELSE}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes, Controls, ComCtrls, Graphics,
  {$IFDEF DELPHI_7_UP} Themes, {$ENDIF} {$IFDEF DELPHI_6_UP}GraphUtil,{$ENDIF}
  ImgList, HTMLColors, RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils,
  Forms;

type
  {$IFNDEF DELPHI_6_UP}
  TScrollDirection = (sdLeft, sdRight, sdUp, sdDown);
  {$ENDIF}

  TmbColor = record
   name: string;
   value: TColor;
  end;

  TDrawCaptionEvent = procedure (Sender: TObject; AIndex: integer; AFont: TFont; var AText: string; Selected: boolean) of object;
  TDrawLabelEvent = procedure (Sender: TObject; AIndex: integer; AFont: TFont; var AText: string) of object;
  TGetHintEvent = procedure (AIndex: integer; var AHint: string; var Handled: boolean) of object;

  TmbColorTree = class(TCustomTreeView)
  private
   dummy: TCustomImageList;
   FInfo1, FInfo2: string;
   FInfoLabel: string;
   FDraw: TDrawCaptionEvent;
   FDraw1, FDraw2, FDraw3: TDrawLabelEvent;
   mx, my: integer;
   FGetHint: TGetHintEvent;
   FOnStartDrag: TStartDragEvent;
   FOnEndDrag: TEndDragEvent;
   procedure SetInfo1(Value: string);
   procedure SetInfo2(Value: string);
   procedure SetInfoLabel(Value: string);

  protected
   procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
   procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
      Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; override;
   function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; {$IFDEF DELPHI_7_UP}override;{$ENDIF}
   procedure DrawColorItem(R: TRect; Selected: boolean; Index: integer; itemText: string; Expanded: boolean); dynamic;
   procedure DrawInfoItem(R: TRect; Index: integer); dynamic;
   procedure DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean);

  public
   Colors: array of TmbColor;

   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;

   procedure UpdateColors;
   procedure AddColor(Name: string; Value: TColor; refresh: boolean = true);
   procedure ClearColors;
   procedure DeleteColor(Index: integer; refresh: boolean = true);
   procedure DeleteColorByName(Name: string; All: boolean);
   procedure DeleteColorByValue(Value: TColor; All: boolean);
   procedure InsertColor(Index: integer; Name: string; Value: TColor);
   function ColorCount: integer;
  published
   property InfoLabelText: string read FInfoLabel write SetInfoLabel;
   property InfoDisplay1: string read FInfo1 write SetInfo1;
   property InfoDisplay2: string read FInfo2 write SetInfo2;
   property Align;
   property Anchors;
   property AutoExpand;
   {$IFDEF DELPHI}
   property BevelEdges;
   property BevelInner;
   property BevelOuter;
   property BevelKind default bkNone;
   property BevelWidth;
   {$ENDIF}
   property BorderStyle;
   property BorderWidth;
   {$IFDEF DELPHI}
   property ChangeDelay;
   property Ctl3D;
   property ParentCtl3D;
   {$ENDIF}
   property Constraints;
   property Color;
   property DragKind;
   property DragCursor;
   property DragMode;
   property Enabled;
   property Font;
   property Indent;
   {$IFDEF DELPHI_7_UP}
   property MultiSelect;
   property MultiSelectStyle;
   {$ENDIF}
   property ParentColor default False;
   property ParentFont;
   property ParentShowHint;
   property PopupMenu;
   property RightClickSelect;
   property ShowHint;
   property SortType;
   property TabOrder;
   property TabStop default True;
   property ToolTips;
   property Visible;

   property OnGetHint: TGetHintEvent read FGetHint write FGetHint;
   property OnDrawCaption: TDrawCaptionEvent read FDraw write FDraw;
   property OnDrawInfoLabel: TDrawLabelEvent read FDraw1 write FDraw1;
   property OnDrawInfoDisplay1: TDrawLabelEvent read FDraw2 write FDraw2;
   property OnDrawInfoDisplay2: TDrawLabelEvent read FDraw3 write FDraw3;
   {$IFDEF DELPHI_7_UP}
   property OnAddition;
   property OnCreateNodeClass;
   {$ENDIF}
   property OnAdvancedCustomDraw;
   property OnAdvancedCustomDrawItem;
   property OnChange;
   property OnChanging;
   property OnClick;
   property OnCollapsed;
   property OnCollapsing;
   property OnCompare;
   property OnContextPopup;
   property OnCustomDraw;
   property OnCustomDrawItem;
   property OnDblClick;
   property OnDeletion;
   property OnDragDrop;
   property OnDragOver;
   property OnEndDock;
   property OnEndDrag: TEndDragEvent read FOnEndDrag write FOnEndDrag;
   property OnEnter;
   property OnExit;
   property OnExpanding;
   property OnExpanded;
   property OnKeyDown;
   property OnKeyPress;
   property OnKeyUp;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnStartDock;
   property OnStartDrag: TStartDragEvent read FOnStartDrag write FOnStartDrag;
   property Items;
  end;

implementation

uses
  PalUtils, mbUtils;

//taken from GraphUtil, only for Delphi 5
{$IFNDEF DELPHI_6_UP}

procedure DrawArrow(ACanvas: TCanvas; Direction: TScrollDirection;
  Location: TPoint; Size: Integer);
const
  ArrowPts: array[TScrollDirection, 0..2] of TPoint =
    (((X:1; Y:0), (X:0; Y:1), (X:1; Y:2)),
     ((X:0; Y:0), (X:1; Y:1), (X:0; Y:2)),
     ((X:0; Y:1), (X:1; Y:0), (X:2; Y:1)),
     ((X:0; Y:0), (X:1; Y:1), (X:2; Y:0)));
var
  I: Integer;
  Pts: array[0..2] of TPoint;
  OldWidth: Integer;
  OldColor: TColor;
begin
  if ACanvas = nil then exit;
  OldColor := ACanvas.Brush.Color;
  ACanvas.Brush.Color := ACanvas.Pen.Color;
  Move(ArrowPts[Direction], Pts, SizeOf(Pts));
  for I := 0 to 2 do
    Pts[I] := Point(Pts[I].x * Size + Location.X, Pts[I].y * Size + Location.Y);
  with ACanvas do
  begin
    OldWidth := Pen.Width;
    Pen.Width := 1;
    Polygon(Pts);
    Pen.Width := OldWidth;
    Brush.Color := OldColor;
  end;
end;

{$ENDIF}

{  TmbColorTree  }

constructor TmbColorTree.Create(AOwner: TComponent);
begin
 inherited;
 ControlStyle := ControlStyle + [csDisplayDragImage];
 MaxHue := 360;
 MaxSat := 255;
 MaxLum := 255;
 ReadOnly := true;
 ShowButtons := false;
 ShowLines := false;
 ShowRoot := true;
 RowSelect := true;
 HotTrack := false;
 SetLength(Colors, 0);
 Images := TImageList.Create(Self);
 Images.Width := 48;
 Images.Height := 48;
 {
 dummy := TCustomImageList.Create(Self);
 dummy.Width := 48;
 dummy.Height := 48;
 Images := dummy;
 }
 FInfoLabel := 'Color Values:';
 FInfo1 := 'RGB: %r.%g.%b';
 FInfo2 := 'HEX: #%hex';
end;

destructor TmbColorTree.Destroy;
begin
 dummy.Free;
 inherited;
end;

procedure TmbColorTree.UpdateColors;
var
 i: integer;
 n: TTreeNode;
begin
 Items.Clear;
 for i := 0 to Length(Colors) - 1 do
  begin
   n := Items.Add(TopItem, Colors[i].name);
   Items.AddChild(n, '');
  end;
end;

procedure TmbColorTree.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 r: TRect;
begin
 inherited;
 if (ssShift in Shift) or (ssCtrl in Shift) then Exit;
 if Selected <> nil then
  r := Selected.DisplayRect(false)
 else
  Exit;
 if (x > r.Right - 15) and (x < r.Right - 3) and (y > r.Top + 13) and (y < r.Top + 30) then
  if (Selected.HasChildren) and PtInRect(r, Point(x, y)) then
   begin
    if selected.Expanded then
     Selected.Collapse(false)
    else
     Selected.Expand(false);
    Invalidate;
   end;
end;

procedure TmbColorTree.MouseMove(Shift: TShiftState; X, Y: Integer);
var
 r: TRect;
begin
 inherited;
 mx := x;
 my := y;
 if GetNodeAt(x, y) <> nil then
  r := GetNodeAt(x, y).DisplayRect(false)
 else
  begin
   Cursor := crDefault;
   Exit;
  end;

 if (x > r.Right - 15) and (x < r.Right - 3) and (y > r.Top + 13) and (y < r.Top + 30) then
  begin
   if (GetNodeAt(x, y).HasChildren) and PtInRect(r, Point(x, y)) then
    Cursor := crHandPoint
   else
    Cursor := crDefault;
  end
 else
  Cursor := crDefault;
end;

function TmbColorTree.CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
  Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean;
begin
  Result := true;
  if Length(Colors) = 0 then Exit;
  if Node.HasChildren then
    DrawColorItem(Node.DisplayRect(false), cdsSelected in State, node.Index, node.Text, node.Expanded)
  else
    DrawInfoItem(Node.DisplayRect(false), node.Parent.Index);
end;

procedure TmbColorTree.DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean);
var
 b: TBitmap;
begin
 b := TBitmap.Create;
 try
  b.Height := 12;
  b.Width := 12;
  if Sel then
   begin
    b.Canvas.Brush.Color := clHighlight;
    b.Canvas.Pen.Color := clHighlightText;
   end
  else
   begin
    b.Canvas.Brush.Color := clFuchsia;
    b.Canvas.Pen.Color := clWindowText;
    b.Transparent := true;
    b.TransparentColor := clFuchsia;
   end;
  b.Canvas.FillRect(B.Canvas.ClipRect);
  case dir of
   sdDown: DrawArrow(b.Canvas, dir, Point(2, 3), 3);
   sdRight: DrawArrow(b.Canvas, dir, Point(1, 2), 3);
  end;
  c.Draw(p.x, p.y, b);
 finally
  b.Free;
 end;
end;

procedure TmbColorTree.DrawColorItem(R: TRect; Selected: boolean; Index: integer; itemText: string; Expanded: boolean);
var
  SR, TR: TRect;
begin
  with Canvas do
  begin
    //background
    Pen.Color := clWindow;
    if Selected then
      Brush.Color := clHighlight
    else
      Brush.Color := Color;
    FillRect(R);
    MoveTo(R.Left, R.Bottom - 1);
    LineTo(R.Right, R.Bottom - 1);

    //swatches
    SR := Rect(R.Left + 6, R.Top + 6, R.Left + 42, R.Top + 42);
    Brush.Color := Self.Colors[Index].value;
    if Selected then
    begin
      {$IFDEF DELPHI_7_UP}
      if ThemeServices.ThemesEnabled then
      begin
        ThemeServices.DrawElement(Canvas.Handle, ThemeServices.GetElementDetails(teEditTextNormal), SR);
        InflateRect(SR, -2, -2);
        Brush.Color := Blend(Self.Colors[Index].value, clBlack, 80);
        FillRect(SR);
        InflateRect(SR, -1, -1);
        Brush.Color := Blend(Self.Colors[Index].value, clBlack, 90);
        FillRect(SR);
        InflateRect(SR, -1, -1);
        Brush.Color := Self.Colors[Index].value;
        FillRect(SR);
      end
      else
      //windows 9x
      begin
      {$ENDIF}
        Pen.Color := clBackground;
        Brush.Color := clWindow;
        Rectangle(SR);
        InflateRect(SR, -1, -1);
        FillRect(SR);
        InflateRect(SR, 1, 1);
        InflateRect(SR, -2, -2);
        Brush.Color := Blend(Self.Colors[Index].value, clBlack, 75);
        FillRect(SR);
        InflateRect(SR, -1, -1);
        Brush.Color := Blend(Self.Colors[Index].value, clBlack, 87);
        FillRect(SR);
        InflateRect(SR, -1, -1);
        Brush.Color := Self.Colors[Index].value;
        FillRect(SR);
      {$IFDEF DELPHI_7_UP}
      end;
     {$ENDIF}
    end
    else
    //not selected
    begin
      //windows XP
      {$IFDEF DELPHI_7_UP}
      if ThemeServices.ThemesEnabled then
      begin
        ThemeServices.DrawElement(Canvas.Handle, ThemeServices.GetElementDetails(teEditTextNormal), SR);
        InflateRect(SR, -2, -2);
        Brush.Color := Self.Colors[Index].value;
        FillRect(SR);
      end
      else
      //windows 9x
      begin
     {$ENDIF}
        DrawEdge(Canvas.Handle, SR, BDR_SUNKENOUTER, BF_RECT);
        InflateRect(SR, -2, -2);
        Brush.Color := Self.Colors[Index].value;
        Pen.Color := clBlack;
        Rectangle(SR);
        InflateRect(SR, -1, -1);
        FillRect(SR);
        InflateRect(SR, 1, 1);
       {$IFDEF DELPHI_7_UP}
      end;
       {$ENDIF}
    end;
    //names
    Font.Style := [fsBold];
    if Selected then
    begin
      //Brush.Color := clHighlightText;
      Pen.Color := clHighlightText;
      Font.Color := clHighlightText;
    end
    else
    begin
      //Brush.Color := clWindowText;
      Pen.Color := clWindowText;
      Font.Color := clWindowText;
    end;
    TR := Rect(R.Left + 48, R.Top + (48 - TextHeight(itemText)) div 2, R.Right - 15, R.Bottom);
    if Assigned(FDraw) then FDraw(Self, Index, Canvas.Font, itemText, Selected);
    SetBkMode(Canvas.Handle, TRANSPARENT);
    DrawText(Canvas.Handle, PChar(itemText), Length(itemText), TR, DT_LEFT or DT_NOCLIP or DT_END_ELLIPSIS);
    SetBkMode(Canvas.Handle, OPAQUE);
    if R.Right > 60 then
    begin
      if Expanded then
        DoArrow(Canvas, sdDown, Point(R.Right - 13, R.Top + 20), selected)
      else
        DoArrow(Canvas, sdRight, Point(R.Right - 10, R.Top + 18), selected);
    end;
  end;
end;

procedure TmbColorTree.DrawInfoItem(R: TRect; Index: integer);
const
  FLAGS = DT_LEFT or DT_END_ELLIPSIS or DT_NOCLIP;
  DELTA = 2;
var
 b: TBitmap;
 BR, TR: TRect;
 i, fx: integer;
 s: string;
 h: Integer;
begin
 b := TBitmap.Create;
 try
  b.Width := R.Right - R.Left;
  b.Height := R.Bottom - R.Top;
  BR := b.Canvas.ClipRect;
  with b.Canvas do
   begin
    Canvas.Font.Assign(Self.Font);
    Brush.Color := Blend(clBtnFace, clWindow, 30);
    FillRect(BR);
    BR := Rect(BR.Left + 42, BR.Top, BR.Right, BR.Bottom);
    Brush.Color := clWindow;
    FillRect(BR);
    Inc(BR.Left, 6);
    Font.Style := [];
    Font.Size := 7;

    s := FInfoLabel;
    h := TextHeight(s);
    TR := Rect(BR.Left, BR.Top{ + 2}, BR.Right, BR.Top + {2 + }h + DELTA);
    if Assigned(FDraw1) then FDraw1(Self, Index, Canvas.Font, s);
    DrawText(b.Canvas.Handle, PChar(s), Length(s), TR, FLAGS);

    DrawHorDottedLine(b.Canvas, BR.Left, BR.Right, TR.Bottom + DELTA, clGray);

    s := FormatHint(FInfo1, Self.Colors[Index].value);
    TR.Top := TR.Bottom + 2 * DELTA;
    TR.Bottom := TR.Top + h + DELTA;
    if Assigned(FDraw2) then FDraw2(Self, Index, Canvas.Font, s);
    DrawText(b.Canvas.Handle, PChar(s), Length(s), TR, FLAGS);

    DrawHorDottedLine(b.Canvas, BR.LEft, BR.Right, TR.Bottom + DELTA, clGray);

    s := FormatHint(FInfo2, Self.Colors[Index].value);
    TR.Top := TR.Bottom + 2 * DELTA;
    TR.Bottom := TR.Top + h + DELTA;
    if Assigned(FDraw3) then FDraw3(Self, Index, Canvas.Font, s);
    DrawText(b.Canvas.Handle, PChar(s), Length(s), TR, FLAGS);
   end;

  Canvas.Draw(R.Left, R.Top, b);
 finally
  b.Free;
 end;
end;

function TmbColorTree.IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean;
begin
 Result := true;
end;

procedure TmbColorTree.SetInfoLabel(Value: string);
begin
 if FInfoLabel <> Value then
  begin
   FInfoLabel := Value;
   Invalidate;
  end;
end;

procedure TmbColorTree.SetInfo1(Value: string);
begin
 if FInfo1 <> Value then
  begin
   FInfo1 := Value;
   Invalidate;
  end;
end;

procedure TmbColorTree.SetInfo2(Value: string);
begin
 if FInfo2 <> Value then
  begin
   FInfo2 := Value;
   Invalidate;
  end;
end;

procedure TmbColorTree.AddColor(Name: string; Value: TColor; refresh: boolean = true);
var
 L: integer;
begin
 L := Length(Colors);
 SetLength(Colors, L + 1);
 Colors[L].name := Name;
 Colors[L].value := Value;
 if refresh then
  UpdateColors;
end;

procedure TmbColorTree.ClearColors;
begin
 SetLength(Colors, 0);
 UpdateColors;
end;

function TmbColorTree.ColorCount: integer;
begin
 Result := Length(Colors);
end;

procedure TmbColorTree.DeleteColor(Index: integer; refresh: boolean = true);
var
 i: integer;
begin
 if Length(Colors) = 0 then
  begin
   raise Exception.Create('There''s nothing to delete! The length of the array is 0.');
   Exit;
  end;

 if Index > Length(Colors) - 1 then
  begin
   raise Exception.Create(Format('List index out of bounds (%d)', [Index]));
   Exit;
  end;

 for i := Index to Length(Colors) - 2 do
  Colors[i] := Colors[i+1];
 SetLength(Colors, Length(Colors) - 1);
 if refresh then
  UpdateColors;
end;

procedure TmbColorTree.DeleteColorByName(Name: string; All: boolean);
var
 i: integer;
begin
 for i := Length(Colors) - 1 downto 0 do
  if SameText(Colors[i].name, Name) then
   begin
    DeleteColor(i, false);
    if not All then
     begin
      UpdateColors;
      Exit;
     end;
   end;
 UpdateColors;
end;

procedure TmbColorTree.DeleteColorByValue(Value: TColor; All: boolean);
var
 i: integer;
begin
 for i := Length(Colors) - 1 downto 0 do
  if Colors[i].Value = Value then
   begin
    DeleteColor(i, false);
    if not All then
     begin
      UpdateColors;
      Exit;
     end;
   end;
 UpdateColors;
end;

procedure TmbColorTree.InsertColor(Index: integer; Name: string; Value: TColor);
var
 i: integer;
begin
 if Index > Length(Colors) - 1 then
  begin
   raise Exception.Create(Format('List index out of bounds (%d)', [Index]));
   Exit;
  end;

 SetLength(Colors, Length(Colors) + 1);
 for i := Length(Colors) - 1 downto Index do
  Colors[i] := Colors[i-1];

 Colors[Index].Name := Name;
 Colors[Index].Value := Value;

 UpdateColors;
end;

procedure TmbColorTree.CMHintShow(var Message: TCMHintShow);
var
 Handled: boolean;
 i: integer;
 n: TTreeNode;
begin
if PtInRect(ClientRect, Point(mx, my)) and ShowHint and not Dragging then
 begin
  n := GetNodeAt(mx, my);
  if n <> nil then
   begin
    if not n.HasChildren then
     i := n.Parent.Index
    else
     i := n.Index;
    with TCMHintShow(Message) do
     if not ShowHint then
      Message.Result := 1
     else
      with HintInfo^ do
       begin
        Result := 0;
        ReshowTimeout := 2000;
        HideTimeout := 1000;
        Handled := false;
        if Assigned(FGetHint) then FGetHint(i, HintStr, Handled);
        if Handled then
         HintStr := FormatHint(HintStr, Colors[i].Value)
        else
         HintStr := Colors[i].Name;
       end;
   end;
 end;
 inherited;
end;

end.