paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mbColorLib: Fix ColorTree crashing at MouseClick

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5458 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2016-12-10 12:03:04 +00:00
parent 41feca985b
commit 2d62566fb7
1 changed files with 13 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
components/mbColorLib/mbColorTree.pas
View File

@ -59,9 +59,7 @@ type
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);
{$IFDEF FPC}
procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL;
{$ENDIF}
public
Colors: array of TmbColor;
@ -229,10 +227,15 @@ begin
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';
@ -259,7 +262,7 @@ end;
function TmbColorTree.CanChange(Node: TTreeNode): Boolean;
begin
Result := Node.HasChildren;
Result := Assigned(Node) and Node.HasChildren;
end;
procedure TmbColorTree.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
@ -351,7 +354,7 @@ end;
procedure TmbColorTree.DrawColorItem(R: TRect; Selected: boolean; Index: integer; itemText: string; Expanded: boolean);
var
SR, TR: TRect;
SR, TR: TRect;
begin
with Canvas do
begin
@ -555,12 +558,12 @@ end;
procedure TmbColorTree.AddColor(Name: string; Value: TColor; refresh: boolean = true);
var
l: integer;
L: integer;
begin
l := Length(Colors);
SetLength(Colors, l + 1);
Colors[l].name := Name;
Colors[l].value := Value;
L := Length(Colors);
SetLength(Colors, L + 1);
Colors[L].name := Name;
Colors[L].value := Value;
if refresh then
UpdateColors;
end;
@ -689,12 +692,4 @@ if PtInRect(ClientRect, Point(mx, my)) and ShowHint and not Dragging then
inherited;
end;
{$IFDEF FPC}
procedure TmbColorTree.WMHScroll(var Msg: TLMScroll);
begin
inherited;
//Invalidate;
end;
{$ENDIF}
end.