pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

mbColorLib: Delphi support removed. Change version number to 2.1 (standard even/odd numbering scheme).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5549 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-20 15:41:10 +00:00
parent 8e3f2972ae
commit f00577f5f4
30 changed files with 4038 additions and 5806 deletions
Download Patch File Download Diff File Expand all files Collapse all files

414
components/mbColorLib/mbColorTree.pas
View File

@ -1,29 +1,15 @@
unit mbColorTree;
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$MODE DELPHI}
interface
{$I mxs.inc}
uses
{$IFDEF FPC}
LCLIntf, LCLType,
{$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;
LCLIntf, LCLType, SysUtils, Classes, Controls, ComCtrls, Graphics, Themes,
GraphUtil, ImgList, Forms,
HTMLColors, RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils;
type
{$IFNDEF DELPHI_6_UP}
TScrollDirection = (sdLeft, sdRight, sdUp, sdDown);
{$ENDIF}
TmbColor = record
Name: string;
Value: TColor;
@ -46,30 +32,28 @@ type
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);
procedure DrawColorItem(R: TRect; Selected: boolean; AIndex: Integer;
AItemText: String; Expanded: boolean); dynamic;
procedure DrawInfoItem(R: TRect; Index: integer); dynamic;
function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
public
Colors: array of TmbColor;
constructor Create(AOwner: TComponent); override;
procedure UpdateColors;
procedure AddColor(AName: string; AValue: TColor; ARefresh: boolean = true);
procedure ClearColors;
function ColorCount: integer;
procedure DeleteColor(AIndex: integer; ARefresh: boolean = true);
procedure DeleteColorByName(AName: string; All: boolean);
procedure DeleteColorByValue(AValue: TColor; All: boolean);
procedure InsertColor(AIndex: integer; AName: string; AValue: TColor);
function ColorCount: integer;
procedure UpdateColors;
published
property InfoLabelText: string read FInfoLabel write SetInfoLabel;
property InfoDisplay1: string read FInfo1 write SetInfo1;
@ -77,20 +61,8 @@ type
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;
@ -99,10 +71,6 @@ type
property Enabled;
property Font;
property Indent;
{$IFDEF DELPHI_7_UP}
property MultiSelect;
property MultiSelectStyle;
{$ENDIF}
property ParentColor default False;
property ParentFont;
property ParentShowHint;
@ -119,10 +87,6 @@ type
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;
@ -160,52 +124,12 @@ 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;
@ -221,64 +145,65 @@ begin
FInfo2 := 'HEX: #%hex';
end;
procedure TmbColorTree.UpdateColors;
procedure TmbColorTree.AddColor(AName: string; AValue: TColor;
ARefresh: boolean = true);
var
L: integer;
begin
L := Length(Colors);
SetLength(Colors, L + 1);
Colors[L].Name := AName;
Colors[L].Value := AValue;
if ARefresh then
UpdateColors;
end;
procedure TmbColorTree.ClearColors;
begin
SetLength(Colors, 0);
UpdateColors;
end;
procedure TmbColorTree.CMHintShow(var Message: TCMHintShow);
var
Handled: boolean;
i: integer;
n: TTreeNode;
begin
Items.Clear;
for i := 0 to Length(Colors) - 1 do
if PtInRect(ClientRect, Point(mx, my)) and ShowHint and not Dragging then
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
n := GetNodeAt(mx, my);
if n <> nil then
begin
if selected.Expanded then
Selected.Collapse(false)
if not n.HasChildren then
i := n.Parent.Index
else
Selected.Expand(false);
Invalidate;
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;
procedure TmbColorTree.MouseMove(Shift: TShiftState; X, Y: Integer);
var
r: TRect;
function TmbColorTree.ColorCount: integer;
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;
Result := Length(Colors);
end;
function TmbColorTree.CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
@ -292,6 +217,23 @@ begin
DrawInfoItem(Node.DisplayRect(false), node.Parent.Index);
end;
procedure TmbColorTree.DeleteColorByValue(AValue: TColor; All: boolean);
var
i: integer;
begin
for i := Length(Colors) - 1 downto 0 do
if Colors[i].Value = AValue then
begin
DeleteColor(i, false);
if not All then
begin
UpdateColors;
Exit;
end;
end;
UpdateColors;
end;
procedure TmbColorTree.DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint;
sel: boolean);
var
@ -324,8 +266,10 @@ begin
end;
end;
procedure TmbColorTree.DrawColorItem(R: TRect; Selected: boolean; Index: integer;
itemText: string; Expanded: boolean);
procedure TmbColorTree.DrawColorItem(R: TRect; Selected: boolean; AIndex: integer;
AItemText: string; Expanded: boolean);
const
FLAGS = DT_LEFT or DT_NOCLIP or DT_END_ELLIPSIS;
var
SR, TR: TRect;
begin
@ -343,27 +287,26 @@ begin
//swatches
SR := Rect(R.Left + 6, R.Top + 6, R.Left + 42, R.Top + 42);
Brush.Color := Self.Colors[Index].value;
Brush.Color := Self.Colors[AIndex].value;
if Selected then
begin
{$IFDEF DELPHI_7_UP}
if ThemeServices.ThemesEnabled then
begin
ThemeServices.DrawElement(Canvas.Handle, ThemeServices.GetElementDetails(teEditTextNormal), SR);
ThemeServices.DrawElement(Canvas.Handle,
ThemeServices.GetElementDetails(teEditTextNormal), SR);
InflateRect(SR, -2, -2);
Brush.Color := Blend(Self.Colors[Index].value, clBlack, 80);
Brush.Color := Blend(Self.Colors[AIndex].value, clBlack, 80);
FillRect(SR);
InflateRect(SR, -1, -1);
Brush.Color := Blend(Self.Colors[Index].value, clBlack, 90);
Brush.Color := Blend(Self.Colors[AIndex].value, clBlack, 90);
FillRect(SR);
InflateRect(SR, -1, -1);
Brush.Color := Self.Colors[Index].value;
Brush.Color := Self.Colors[AIndex].value;
FillRect(SR);
end
else
//windows 9x
begin
{$ENDIF}
Pen.Color := clBackground;
Brush.Color := clWindow;
Rectangle(SR);
@ -371,45 +314,39 @@ begin
FillRect(SR);
InflateRect(SR, 1, 1);
InflateRect(SR, -2, -2);
Brush.Color := Blend(Self.Colors[Index].value, clBlack, 75);
Brush.Color := Blend(Self.Colors[AIndex].value, clBlack, 75);
FillRect(SR);
InflateRect(SR, -1, -1);
Brush.Color := Blend(Self.Colors[Index].value, clBlack, 87);
Brush.Color := Blend(Self.Colors[AIndex].value, clBlack, 87);
FillRect(SR);
InflateRect(SR, -1, -1);
Brush.Color := Self.Colors[Index].value;
Brush.Color := Self.Colors[AIndex].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;
Brush.Color := Self.Colors[AIndex].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;
Brush.Color := Self.Colors[AIndex].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];
@ -425,10 +362,10 @@ begin
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);
TR := Rect(R.Left + 48, R.Top + (48 - TextHeight(AItemText)) div 2, R.Right - 15, R.Bottom);
if Assigned(FDraw) then FDraw(Self, AIndex, Canvas.Font, AItemText, Selected);
SetBkMode(Canvas.Handle, TRANSPARENT);
DrawText(Canvas.Handle, PChar(itemText), Length(itemText), TR, DT_LEFT or DT_NOCLIP or DT_END_ELLIPSIS);
DrawText(Canvas.Handle, PChar(AItemText), Length(AItemText), TR, FLAGS);
SetBkMode(Canvas.Handle, OPAQUE);
if R.Right > 60 then
begin
@ -496,11 +433,78 @@ begin
end;
end;
function TmbColorTree.IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean;
procedure TmbColorTree.InsertColor(AIndex: integer; AName: string; AValue: TColor);
var
i: integer;
begin
if AIndex > Length(Colors) - 1 then
raise Exception.Create(Format('List index out of bounds (%d)', [AIndex]));
SetLength(Colors, Length(Colors) + 1);
for i := Length(Colors) - 1 downto AIndex do
Colors[i] := Colors[i-1];
Colors[AIndex].Name := AName;
Colors[AIndex].Value := AValue;
UpdateColors;
end;
function TmbColorTree.IsCustomDrawn(Target: TCustomDrawTarget;
Stage: TCustomDrawStage): Boolean;
begin
Result := true;
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;
procedure TmbColorTree.SetInfoLabel(Value: string);
begin
if FInfoLabel <> Value then
@ -528,30 +532,6 @@ begin
end;
end;
procedure TmbColorTree.AddColor(AName: string; AValue: TColor;
ARefresh: boolean = true);
var
L: integer;
begin
L := Length(Colors);
SetLength(Colors, L + 1);
Colors[L].Name := AName;
Colors[L].Value := AValue;
if ARefresh then
UpdateColors;
end;
procedure TmbColorTree.ClearColors;
begin
SetLength(Colors, 0);
UpdateColors;
end;
function TmbColorTree.ColorCount: integer;
begin
Result := Length(Colors);
end;
procedure TmbColorTree.DeleteColor(AIndex: integer; ARefresh: boolean = true);
var
i: integer;
@ -586,75 +566,17 @@ begin
UpdateColors;
end;
procedure TmbColorTree.DeleteColorByValue(AValue: TColor; All: boolean);
procedure TmbColorTree.UpdateColors;
var
i: integer;
begin
for i := Length(Colors) - 1 downto 0 do
if Colors[i].Value = AValue then
begin
DeleteColor(i, false);
if not All then
begin
UpdateColors;
Exit;
end;
end;
UpdateColors;
end;
procedure TmbColorTree.InsertColor(AIndex: integer; AName: string; AValue: TColor);
var
i: integer;
begin
if AIndex > Length(Colors) - 1 then
raise Exception.Create(Format('List index out of bounds (%d)', [AIndex]));
SetLength(Colors, Length(Colors) + 1);
for i := Length(Colors) - 1 downto AIndex do
Colors[i] := Colors[i-1];
Colors[AIndex].Name := AName;
Colors[AIndex].Value := AValue;
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
Items.Clear;
for i := 0 to Length(Colors) - 1 do
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;
n := Items.Add(TopItem, Colors[i].name);
Items.AddChild(n, '');
end;
inherited;
end;
end.