5d7f9b43bf
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5452 8e941d3f-bd1b-0410-a28a-d453659cc2b4
687 lines
17 KiB
ObjectPascal
687 lines
17 KiB
ObjectPascal
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
|
|
function CanChange(Node: TTreeNode): Boolean; override;
|
|
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;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
{$IFDEF FPC}
|
|
{$R mbColorTree.dcr}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
PalUtils;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('mbColor Lib', [TmbColorTree]);
|
|
end;
|
|
|
|
//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);
|
|
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;
|
|
|
|
function TmbColorTree.CanChange(Node: TTreeNode): Boolean;
|
|
begin
|
|
Result := Node.HasChildren;
|
|
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 := clBtnFace;
|
|
b.Canvas.Pen.Color := clWindowText;
|
|
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 := clBtnFace;
|
|
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;
|
|
end
|
|
else
|
|
begin
|
|
Brush.Color := clWindowText;
|
|
Pen.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);
|
|
DrawText(Canvas.Handle, PChar(itemText), Length(itemText), TR, DT_LEFT or DT_NOCLIP or DT_END_ELLIPSIS);
|
|
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);
|
|
var
|
|
b: TBitmap;
|
|
BR, TR: TRect;
|
|
i, fx: integer;
|
|
s: string;
|
|
begin
|
|
b := TBitmap.Create;
|
|
try
|
|
b.Width := R.Right - R.Left;
|
|
b.Height := R.Bottom - R.Top;
|
|
BR := b.Canvas.ClipRect;
|
|
b.Canvas.Font.Assign(Font);
|
|
with b.Canvas do
|
|
begin
|
|
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;
|
|
TR := Rect(BR.Left, BR.Top + 2, BR.Right, BR.Top + 12);
|
|
if Assigned(FDraw1) then FDraw1(Self, Index, Canvas.Font, s);
|
|
DrawText(b.Canvas.Handle, PChar(s), Length(s), TR, DT_LEFT or DT_END_ELLIPSIS or DT_NOCLIP);
|
|
|
|
fX := BR.Left;
|
|
for i := 0 to (BR.Right - 2 - BR.Left) div 2 do
|
|
begin
|
|
Pixels[fX, BR.Top + 4 + TextHeight(s)] := clGray;
|
|
fX := fX + 2;
|
|
end;
|
|
|
|
s := FormatHint(FInfo1, Self.Colors[Index].value);
|
|
TR := Rect(BR.Left, BR.Top + (BR.Bottom - BR.Top) div 3 + 2, BR.Right, BR.Top + 12);
|
|
if Assigned(FDraw2) then FDraw2(Self, Index, Canvas.Font, s);
|
|
DrawText(b.Canvas.Handle, PChar(s), Length(s), TR, DT_LEFT or DT_END_ELLIPSIS or DT_NOCLIP);
|
|
|
|
fX := BR.Left;
|
|
for i := 0 to (BR.Right - 2 - BR.Left) div 2 do
|
|
begin
|
|
Pixels[fX, BR.Top + (BR.Bottom - BR.Top) div 3 + 4 + TextHeight(s)] := clGray;
|
|
fX := fX + 2;
|
|
end;
|
|
|
|
s := FormatHint(FInfo2, Self.Colors[Index].value);
|
|
TR := Rect(BR.Left, BR.Top + 2*((BR.Bottom - BR.Top) div 3) + 2, BR.Right, BR.Top + 12);
|
|
if Assigned(FDraw3) then FDraw3(Self, Index, Canvas.Font, s);
|
|
DrawText(b.Canvas.Handle, PChar(s), Length(s), TR, DT_LEFT or DT_END_ELLIPSIS or DT_NOCLIP);
|
|
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.
|