pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases 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
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 DrawColorItem(R: TRect; Selected: boolean; Index: integer; itemText: string; Expanded: boolean); dynamic;
procedure DrawInfoItem(R: TRect; Index: integer); dynamic; procedure DrawInfoItem(R: TRect; Index: integer); dynamic;
procedure DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean); procedure DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean);
{$IFDEF FPC}
procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL;
{$ENDIF}
public public
Colors: array of TmbColor; Colors: array of TmbColor;
@ -229,10 +227,15 @@ begin
RowSelect := true; RowSelect := true;
HotTrack := false; HotTrack := false;
SetLength(Colors, 0); SetLength(Colors, 0);
Images := TImageList.Create(Self);
Images.Width := 48;
Images.Height := 48;
{
dummy := TCustomImageList.Create(Self); dummy := TCustomImageList.Create(Self);
dummy.Width := 48; dummy.Width := 48;
dummy.Height := 48; dummy.Height := 48;
Images := dummy; Images := dummy;
}
FInfoLabel := 'Color Values:'; FInfoLabel := 'Color Values:';
FInfo1 := 'RGB: %r.%g.%b'; FInfo1 := 'RGB: %r.%g.%b';
FInfo2 := 'HEX: #%hex'; FInfo2 := 'HEX: #%hex';
@ -259,7 +262,7 @@ end;
function TmbColorTree.CanChange(Node: TTreeNode): Boolean; function TmbColorTree.CanChange(Node: TTreeNode): Boolean;
begin begin
Result := Node.HasChildren; Result := Assigned(Node) and Node.HasChildren;
end; end;
procedure TmbColorTree.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 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); procedure TmbColorTree.DrawColorItem(R: TRect; Selected: boolean; Index: integer; itemText: string; Expanded: boolean);
var var
SR, TR: TRect; SR, TR: TRect;
begin begin
with Canvas do with Canvas do
begin begin
@ -555,12 +558,12 @@ end;
procedure TmbColorTree.AddColor(Name: string; Value: TColor; refresh: boolean = true); procedure TmbColorTree.AddColor(Name: string; Value: TColor; refresh: boolean = true);
var var
l: integer; L: integer;
begin begin
l := Length(Colors); L := Length(Colors);
SetLength(Colors, l + 1); SetLength(Colors, L + 1);
Colors[l].name := Name; Colors[L].name := Name;
Colors[l].value := Value; Colors[L].value := Value;
if refresh then if refresh then
UpdateColors; UpdateColors;
end; end;
@ -689,12 +692,4 @@ if PtInRect(ClientRect, Point(mx, my)) and ShowHint and not Dragging then
inherited; inherited;
end; end;
{$IFDEF FPC}
procedure TmbColorTree.WMHScroll(var Msg: TLMScroll);
begin
inherited;
//Invalidate;
end;
{$ENDIF}
end. end.