paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 01:48:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented insert marks for TTreeView

Browse Source 
git-svn-id: trunk@4508 -
This commit is contained in:
mattias 2003-08-21 13:04:10 +00:00
parent 710904b03c
commit ce91561698
8 changed files with 264 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/codetools/fileprocs.pas
View File

@ -131,7 +131,9 @@ begin
end;
procedure CheckIfFileIsExecutable(const AFilename: string);
{$IFNDEF win32}
var AText: string;
{$ENDIF}
begin
// TProcess does not report, if a program can not be executed
// to get good error messages consider the OS

4
examples/easter/holyday.lpi
View File

@ -9,7 +9,7 @@
<SaveOnlyProjectUnits Value="True"/>
</Flags>
<MainUnit Value="0"/>
<ActiveEditorIndexAtStart Value="1"/>
<ActiveEditorIndexAtStart Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
<Title Value="holyday"/>
@ -26,7 +26,7 @@
<UsageCount Value="23"/>
</Unit0>
<Unit1>
<CursorPos X="14" Y="103"/>
<CursorPos X="11" Y="111"/>
<EditorIndex Value="0"/>
<Filename Value="main.pas"/>
<ComponentName Value="Form1"/>

23
lcl/comctrls.pp
View File

@ -1541,6 +1541,11 @@ type
TTreeViewOptions = set of TTreeViewOption;
TTreeViewExpandSignType = (tvestPlusMinus, tvestArrow);
TTreeViewInsertMarkType = (
tvimNone,
tvimAsFirstChild, // or as root
tvimAsNextSibling,
tvimAsPrevSibling);
TCustomTreeView = class(TCustomControl)
private
@ -1558,6 +1563,8 @@ type
FIndent: integer;
FImageChangeLink: TChangeLink;
FImages: TCustomImageList;
FInsertMarkNode: TTreeNode;
FInsertMarkType: TTreeViewInsertMarkType;
FLastDropTarget: TTreeNode;
FLastHorzScrollInfo: TScrollInfo;
FLastVertScrollInfo: TScrollInfo;
@ -1594,6 +1601,7 @@ type
FSelectedColor: TColor;
FSelectedNode: TTreeNode;
FSortType: TSortType;
FStartDragNode: TTreeNode;
FStateChangeLink: TChangeLink;
FStateImages: TCustomImageList;
FStates: TTreeViewStates;
@ -1644,6 +1652,8 @@ type
//procedure SetImageList(Value: HImageList; Flags: Integer);
procedure SetIndent(Value: Integer);
procedure SetImages(Value: TCustomImageList);
procedure SetInsertMarkNode(const AValue: TTreeNode);
procedure SetInsertMarkType(const AValue: TTreeViewInsertMarkType);
procedure SetKeepCollapsedNodes(Value: Boolean);
procedure SetReadOnly(Value: Boolean);
procedure SetRightClickSelect(Value: Boolean);
@ -1700,6 +1710,7 @@ type
function IsCustomDrawn(Target: TCustomDrawTarget;
Stage: TCustomDrawStage): Boolean;
function IsNodeVisible(ANode: TTreeNode): Boolean;
function IsInsertMarkVisible: boolean; virtual;
procedure Change(Node: TTreeNode); dynamic;
procedure Collapse(Node: TTreeNode); dynamic;
procedure CreateParams(var Params: TCreateParams); override;
@ -1786,6 +1797,10 @@ type
function CustomSort(SortProc: TTreeNodeCompare): Boolean;
function GetHitTestInfoAt(X, Y: Integer): THitTests;
function GetNodeAt(X, Y: Integer): TTreeNode;
procedure GetInsertMarkAt(X, Y: Integer; var AnInsertMarkNode: TTreeNode;
var AnInsertMarkType: TTreeViewInsertMarkType);
procedure SetInsertMark(var AnInsertMarkNode: TTreeNode;
var AnInsertMarkType: TTreeViewInsertMarkType);
function IsEditing: Boolean;
procedure BeginUpdate;
procedure EndUpdate;
@ -1807,6 +1822,8 @@ type
property DropTarget: TTreeNode read GetDropTarget write SetDropTarget;
property ExpandSignType: TTreeViewExpandSignType
read FExpandSignType write SetExpandSignType;
property InsertMarkNode: TTreeNode read FInsertMarkNode write SetInsertMarkNode;
property InsertMarkType: TTreeViewInsertMarkType read FInsertMarkType write SetInsertMarkType;
property KeepCollapsedNodes: boolean
read GetKeepCollapsedNodes write SetKeepCollapsedNodes;
property Options: TTreeViewOptions read FOptions write SetOptions;
@ -1818,6 +1835,9 @@ type
property TopItem: TTreeNode read GetTopItem write SetTopItem;
property TreeLineColor: TColor read FTreeLineColor write FTreeLineColor;
end;
{ TTreeView }
TTreeView = class(TCustomTreeView)
published
@ -2007,6 +2027,9 @@ end.
{ =============================================================================
$Log$
Revision 1.82 2003/08/21 13:04:10 mattias
implemented insert marks for TTreeView
Revision 1.81 2003/08/14 15:31:42 mattias
started TTabSheet and TPageControl

20
lcl/controls.pp
View File

@ -1237,7 +1237,7 @@ var
DragCapture : HWND;
DragControl : TControl;
DragFreeObject : Boolean;
DragObjectAutoFree : Boolean;
DragObject : TDragObject;
//DragSaveCursor : HCURSOR;
DragStartPos : TPoint;
@ -1318,11 +1318,11 @@ end;
{DragIntit}
Procedure DragInit(aDragObject : TDragObject; Immediate : Boolean;
Threshold : Integer);
Procedure DragInit(aDragObject: TDragObject; Immediate: Boolean;
Threshold: Integer);
Begin
DragObject := ADragObject;
DragObject.Dragtarget := nil;
DragObject.DragTarget := nil;
GetCursorPos(DragStartPos);
DragObject.DragPos := DragStartPos;
DragCapture := DragObject.Capture;
@ -1341,7 +1341,7 @@ begin
ok:=false;
try
DragObject := nil;
DragFreeObject := False;
DragObjectAutoFree := False;
if Control.fDragKind = dkDrag then
begin
Control.DoStartDrag(DragObject);
@ -1349,7 +1349,7 @@ begin
if DragObject = nil then
Begin
DragObject := TDragControlObject.Create(Control);
DragFreeObject := True;
DragObjectAutoFree := True;
End;
end;
DragInit(DragObject,Immediate,Threshold);
@ -1360,7 +1360,6 @@ begin
end;
end;
Procedure DragTo(P : TPoint);
Begin
Assert(False, 'Trace:********************************************');
@ -1424,8 +1423,8 @@ Begin
DragControl := nil;
end;
DragObject := nil;
if DragFreeObject then DragSave.Free;
DragFreeObject := False;
if DragObjectAutoFree then DragSave.Free;
DragObjectAutoFree := False;
end;
{------------------------------------------------------------------------------
@ -1636,6 +1635,9 @@ end.
{ =============================================================================
$Log$
Revision 1.141 2003/08/21 13:04:10 mattias
implemented insert marks for TTreeView
Revision 1.140 2003/08/14 15:31:42 mattias
started TTabSheet and TPageControl

27
lcl/include/control.inc
View File

@ -43,8 +43,8 @@ end;
Threshold: default -1, distance to move before dragging starts
Returns: Nothing
Starts the dragging of a control. If the Immidiate flag is set, dragging
starts immediate.
Starts the dragging of a control. If the Immediate flag is set, dragging
starts immediately.
------------------------------------------------------------------------------}
procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer);
var
@ -649,27 +649,23 @@ procedure TControl.DragCanceled;
begin
end;
{------------------------------------------------------------------------------
TControl.DoStartDrag
{------------------------------------------------------------------------------}
{ TControl.DoStartDrag
}
{------------------------------------------------------------------------------}
------------------------------------------------------------------------------}
procedure TControl.DoStartDrag(var DragObject: TDragObject);
begin
if Assigned(FOnStartDrag) then FOnStartDrag(Self, DragObject);
end;
{------------------------------------------------------------------------------}
{ TControl.DoStartDrag
}
{------------------------------------------------------------------------------}
Procedure TControl.DoEndDrag(Target: TObject; X,Y : Integer);
{------------------------------------------------------------------------------
TControl.DoEndDrag
------------------------------------------------------------------------------}
Procedure TControl.DoEndDrag(Target: TObject; X,Y: Integer);
Begin
if Assigned(FOnEndDrag) then FOnEndDrag(Self,Target,X,Y);
end;
{------------------------------------------------------------------------------
TControl.Perform
@ -2472,6 +2468,9 @@ end;
{ =============================================================================
$Log$
Revision 1.147 2003/08/21 13:04:10 mattias
implemented insert marks for TTreeView
Revision 1.146 2003/08/14 15:31:42 mattias
started TTabSheet and TPageControl

213
lcl/include/treeview.inc
View File

@ -1001,6 +1001,7 @@ procedure TTreeNode.Unbind;
// unbind from parent and neighbor siblings
var OldIndex, i: integer;
HigherNode: TTreeNode;
TheTreeView: TCustomTreeView;
begin
{$IFDEF TREEVIEW_DEBUG}
writeln('[TTreeNode.Unbind] Self=',HexStr(Cardinal(Self),8),' Self.Text=',Text);
@ -1010,11 +1011,14 @@ begin
Owner.ClearCache;
if FParent=nil then
Owner.MoveTopLvlNode(Owner.IndexOfTopLvlItem(Self),-1,Self);
if Owner.Owner<>nil then begin
Owner.Owner.FStates:=Owner.Owner.FStates+[tvsMaxRightNeedsUpdate,
TheTreeView:=Owner.Owner;
if TheTreeView<>nil then begin
TheTreeView.FStates:=TheTreeView.FStates+[tvsMaxRightNeedsUpdate,
tvsTopsNeedsUpdate,tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate];
if Owner.Owner.FLastDropTarget=Self then
Owner.Owner.FLastDropTarget:=nil;
if TheTreeView.FLastDropTarget=Self then
TheTreeView.FLastDropTarget:=nil;
if TheTreeView.FInsertMarkNode=Self then
TheTreeView.FInsertMarkNode:=nil;
end;
end;
UnbindFromMultiSelected;
@ -3260,6 +3264,76 @@ begin
end;}
end;
procedure TCustomTreeView.GetInsertMarkAt(X, Y: Integer;
var AnInsertMarkNode: TTreeNode; var AnInsertMarkType: TTreeViewInsertMarkType
);
var
ANode: TTreeNode;
NodeRect: TRect;
NodeMidY: integer;
begin
ANode:=GetNodeAtY(Y);
if ANode<>nil then begin
AnInsertMarkNode:=ANode;
if (X>AnInsertMarkNode.DisplayExpandSignRight) then
// insert as first child of pointed node
AnInsertMarkType:=tvimAsFirstChild
else begin
NodeRect:=ANode.DisplayRect(false);
NodeMidY:=(NodeRect.Top+NodeRect.Bottom) div 2;
if Y>=NodeMidY then begin
if ANode.Expanded and ANode.HasChildren then begin
// insert as first child of pointed node
AnInsertMarkType:=tvimAsFirstChild;
end else begin
// insert as next sibling of pointed node
AnInsertMarkType:=tvimAsNextSibling;
end;
end else begin
AnInsertMarkType:=tvimAsPrevSibling;
end;
end;
end else begin
// insert behind all nodes
ANode:=Items.GetLastExpandedSubNode;
if ANode<>nil then begin
AnInsertMarkNode:=ANode;
if X>AnInsertMarkNode.DisplayExpandSignRight then
// insert as first child of last visible node
AnInsertMarkType:=tvimAsFirstChild
else
// insert as next sibling of last visible node
AnInsertMarkType:=tvimAsNextSibling;
end else begin
// insert as new root
AnInsertMarkNode:=nil;
AnInsertMarkType:=tvimAsFirstChild;
end;
end;
// normalize
if (AnInsertMarkType=tvimAsPrevSibling) and (AnInsertMarkNode<>nil) then begin
if (AnInsertMarkNode.GetPrevSibling<>nil) then begin
if (AnInsertMarkNode.GetPrevSibling.Expanded=false)
and (AnInsertMarkNode.GetPrevSibling.IsVisible) then begin
AnInsertMarkNode:=AnInsertMarkNode.GetPrevSibling;
AnInsertMarkType:=tvimAsNextSibling;
end;
end else if (AnInsertMarkNode.Parent<>nil)
and (AnInsertMarkNode.IsVisible) then begin
AnInsertMarkNode:=AnInsertMarkNode.Parent;
AnInsertMarkType:=tvimAsFirstChild;
end;
end;
end;
procedure TCustomTreeView.SetInsertMark(var AnInsertMarkNode: TTreeNode;
var AnInsertMarkType: TTreeViewInsertMarkType);
begin
InsertMarkNode:=AnInsertMarkNode;
InsertMarkType:=AnInsertMarkType;
end;
function TCustomTreeView.GetHitTestInfoAt(X, Y: Integer): THitTests;
//var HitTest: TTVHitTestInfo;
var Node: TTreeNode;
@ -3927,6 +4001,12 @@ begin
inherited WndProc(Message);
end;
function TCustomTreeView.IsInsertMarkVisible: boolean;
begin
Result:=(FInsertMarkType<>tvimNone) and (FInsertMarkNode<>nil)
and (FInsertMarkNode.IsVisible);
end;
procedure TCustomTreeView.DoStartDrag(var DragObject: TDragObject);
{var
ImageHandle: HImageList;
@ -4005,6 +4085,7 @@ var
a,HalfBorderWidth:integer;
SpaceRect, DrawRect: TRect;
Node: TTreeNode;
InsertMarkRect: TRect;
begin
if [tvsUpdating,tvsPainting]*FStates<>[] then exit;
Include(FStates,tvsPainting);
@ -4026,6 +4107,14 @@ begin
//write('[TCustomTreeView.DoPaint] B Node=',HexStr(Cardinal(Node),8));
//if Node<>nil then writeln(' Node.Text=',Node.Text) else writeln('');
end;
// draw insert mark for new root node
if (InsertMarkType=tvimAsFirstChild)
and (Items.Count=0) then begin
Pen.Color:=FTreeLineColor;
Brush.Color:=FSelectedColor;
InsertMarkRect:=Rect(0,0,ClientWidth,2);
Rectangle(InsertMarkRect);
end;
// draw unused space below nodes
SpaceRect:=Rect(BorderWidth,BorderWidth,
(ClientWidth-ScrollBarWidth)-BorderWidth,
@ -4098,14 +4187,17 @@ var
Canvas.MoveTo(CurMid,VertMid);
Canvas.LineTo(Result+Indent,VertMid);
end;
if CurNode.GetNextSibling<>nil then begin
if (CurNode.GetNextSibling<>nil) then begin
// draw vertical line to next brother
Canvas.MoveTo(CurMid,NodeRect.Top);
Canvas.LineTo(CurMid,NodeRect.Bottom);
end else if CurNode=Node then begin
// draw vertical line from top to horizontal line
Canvas.MoveTo(CurMid,NodeRect.Top);
Canvas.LineTo(CurMid,VertMid);
if ((InsertMarkNode=Node) and (InsertMarkType=tvimAsNextSibling)) then
Canvas.LineTo(CurMid,NodeRect.Bottom-1)
else
Canvas.LineTo(CurMid,VertMid);
end;
end;
inc(Result,Indent);
@ -4162,7 +4254,84 @@ var
end;
end;
end;
procedure DrawInsertMark;
var
InsertMarkRect: TRect;
x: Integer;
begin
case InsertMarkType of
tvimAsFirstChild:
if InsertMarkNode=Node then begin
// draw insert mark for new first child
with Canvas do begin
// draw virtual tree line
Pen.Color:=TreeLineColor;
Pen.Style:=psDot;
x:=Node.DisplayExpandSignRight+Indent div 2;
MoveTo(x,NodeRect.Bottom-3);
LineTo(x,NodeRect.Bottom-2);
x:=Node.DisplayExpandSignRight+Indent;
LineTo(x,NodeRect.Bottom-2);
Pen.Style:=psSolid;
// draw virtual rectangle
Pen.Color:=TreeLineColor;
Brush.Color:=FSelectedColor;
InsertMarkRect:=Rect(x,NodeRect.Bottom-3,
NodeRect.Right,NodeRect.Bottom-1);
Rectangle(InsertMarkRect);
end;
end;
tvimAsPrevSibling:
if InsertMarkNode=Node then begin
// draw insert mark for new previous sibling
with Canvas do begin
// draw virtual tree line
Pen.Color:=TreeLineColor;
Pen.Style:=psDot;
x:=Node.DisplayExpandSignLeft+Indent div 2;
MoveTo(x,NodeRect.Top+1);
x:=Node.DisplayExpandSignRight;
LineTo(x,NodeRect.Top+1);
Pen.Style:=psSolid;
// draw virtual rectangle
Pen.Color:=TreeLineColor;
Brush.Color:=FSelectedColor;
InsertMarkRect:=Rect(x,NodeRect.Top,
NodeRect.Right,NodeRect.Top+2);
Rectangle(InsertMarkRect);
end;
end;
tvimAsNextSibling:
if InsertMarkNode=Node then begin
// draw insert mark for new next sibling
with Canvas do begin
// draw virtual tree line
Pen.Color:=TreeLineColor;
Pen.Style:=psDot;
x:=Node.DisplayExpandSignLeft+Indent div 2;
MoveTo(x,NodeRect.Bottom-3);
LineTo(x,NodeRect.Bottom-2);
x:=Node.DisplayExpandSignRight;
LineTo(x,NodeRect.Bottom-2);
Pen.Style:=psSolid;
// draw virtual rectangle
Pen.Color:=TreeLineColor;
Brush.Color:=FSelectedColor;
InsertMarkRect:=Rect(x,NodeRect.Bottom-3,
NodeRect.Right,NodeRect.Bottom-1);
Rectangle(InsertMarkRect);
end;
end;
end;
end;
var x, ImgIndex: integer;
CurBackgroundColor, OldFontColor: TColor;
@ -4248,6 +4417,8 @@ begin
MoveTo(NodeRect.Left,NodeRect.Bottom-1);
LineTo(NodeRect.Right,NodeRect.Bottom-1);
end;
// draw insert mark
DrawInsertMark;
end;
if Assigned(OnCustomDrawItem) or Assigned(FOnAdvancedCustomDrawItem) then
begin
@ -4435,8 +4606,10 @@ begin
bStartDrag := true;
end;
end;
if (bStartDrag) then
if (bStartDrag) then begin
FStartDragNode:=CursorNode;
Include(fStates, tvsWaitForDragging);
end;
if Button=mbMiddle then begin
// insert primary selection text
@ -4452,6 +4625,9 @@ begin
if (Abs(fMouseDownX - X) >= GetSystemMetrics(SM_CXDRAG))
or (Abs(fMouseDownY - Y) >= GetSystemMetrics(SM_CYDRAG))
then begin
{$IFDEF VerboseDrag}
writeln('TCustomTreeView.MouseMove A Begindrag ',Name,':',ClassName,' ');
{$ENDIF}
Exclude(fStates, tvsWaitForDragging);
BeginDrag(false);
end;
@ -4502,6 +4678,29 @@ begin
Invalidate;
end;
procedure TCustomTreeView.SetInsertMarkNode(const AValue: TTreeNode);
var
InvalidateNeeded: Boolean;
begin
if FInsertMarkNode=AValue then exit;
InvalidateNeeded:=IsInsertMarkVisible;
FInsertMarkNode:=AValue;
InvalidateNeeded:=InvalidateNeeded or IsInsertMarkVisible;
if InvalidateNeeded then Invalidate;
end;
procedure TCustomTreeView.SetInsertMarkType(
const AValue: TTreeViewInsertMarkType);
var
InvalidateNeeded: Boolean;
begin
if FInsertMarkType=AValue then exit;
InvalidateNeeded:=IsInsertMarkVisible;
FInsertMarkType:=AValue;
InvalidateNeeded:=InvalidateNeeded or IsInsertMarkVisible;
if InvalidateNeeded then Invalidate;
end;
procedure TCustomTreeView.SetStateImages(Value: TCustomImageList);
begin
if FStateImages=Value then exit;

4
lcl/include/wincontrol.inc
View File

@ -776,7 +776,6 @@ function TWinControl.GetClientRect: TRect;
end;
var
//r: TRect;
InterfaceWidth, InterfaceHeight: integer;
begin
if not HandleAllocated then begin
@ -2948,6 +2947,9 @@ end;
{ =============================================================================
$Log$
Revision 1.160 2003/08/21 13:04:10 mattias
implemented insert marks for TTreeView
Revision 1.159 2003/08/12 16:12:42 mattias
reduced output

5
lcl/interfaces/win32/win32winapi.inc
View File

@ -1462,7 +1462,7 @@ begin
dec(LeftTop.X,2);
ReleaseDC(ParentHandle, DC);
end;
end;
end;
end;
Left:=LeftTop.X;
Top:=LeftTop.Y;
@ -2419,6 +2419,9 @@ end;
{ =============================================================================
$Log$
Revision 1.55 2003/08/21 13:04:10 mattias
implemented insert marks for TTreeView
Revision 1.54 2003/08/21 06:52:47 mattias
size fixes from Karl