paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-27 01:27:23 +01:00
Code Issues Packages Projects Releases Wiki Activity

MG: started TTreeView dragging

Browse Source 
git-svn-id: trunk@3308 -
This commit is contained in:
lazarus 2002-09-09 19:04:01 +00:00
parent 42c2244602
commit b385b12038
2 changed files with 75 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lcl/comctrls.pp
View File

@ -932,7 +932,7 @@ type
function GetHasChildren: Boolean; function GetHasChildren: Boolean;
function GetCount: Integer; function GetCount: Integer;
function GetCut: boolean; function GetCut: boolean;
//function GetDropTarget: Boolean; function GetDropTarget: Boolean;
function GetExpanded: Boolean; function GetExpanded: Boolean;
function GetFocused: Boolean; function GetFocused: Boolean;
function GetHeight: integer; function GetHeight: integer;
@ -953,7 +953,7 @@ type
procedure ReadDelphiData(Stream: TStream; Info: PDelphiNodeInfo); procedure ReadDelphiData(Stream: TStream; Info: PDelphiNodeInfo);
procedure SetCut(AValue: Boolean); procedure SetCut(AValue: Boolean);
procedure SetData(AValue: Pointer); procedure SetData(AValue: Pointer);
//procedure SetDropTarget(Value: Boolean); procedure SetDropTarget(AValue: Boolean);
procedure SetExpanded(AValue: Boolean); procedure SetExpanded(AValue: Boolean);
procedure SetFocused(AValue: Boolean); procedure SetFocused(AValue: Boolean);
procedure SetHasChildren(AValue: Boolean); procedure SetHasChildren(AValue: Boolean);
@ -1023,7 +1023,7 @@ type
property Data: Pointer read FData write SetData; property Data: Pointer read FData write SetData;
property Deleting: Boolean read FDeleting; property Deleting: Boolean read FDeleting;
property Focused: Boolean read GetFocused write SetFocused; property Focused: Boolean read GetFocused write SetFocused;
//property DropTarget: Boolean read GetDropTarget write SetDropTarget; property DropTarget: Boolean read GetDropTarget write SetDropTarget;
property Expanded: Boolean read GetExpanded write SetExpanded; property Expanded: Boolean read GetExpanded write SetExpanded;
property Handle: THandle read GetHandle; property Handle: THandle read GetHandle;
property HasChildren: Boolean read GetHasChildren write SetHasChildren; property HasChildren: Boolean read GetHasChildren write SetHasChildren;
@ -1174,8 +1174,7 @@ type
tvoRowSelect, tvoRowSelect,
tvoKeepCollapsedNodes, tvoKeepCollapsedNodes,
tvoShowSeparators, tvoShowSeparators,
tvoAllowMultiselect, tvoAllowMultiselect
tvoAutoItemHeight
); );
TTreeViewOptions = set of TTreeViewOption; TTreeViewOptions = set of TTreeViewOption;
@ -1245,14 +1244,14 @@ type
//procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; //procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
//procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED; //procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
//procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; //procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
//procedure CMDrag(var Message: TCMDrag); message CM_DRAG; procedure CMDrag(var AMessage: TCMDrag); message CM_DRAG;
//procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY; //procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure EditWndProc(var Message: TLMessage); procedure EditWndProc(var Message: TLMessage);
//procedure DoDragOver(Source: TDragObject; X, Y: Integer; CanDrop: Boolean); procedure DoDragOver(Source: TDragObject; X, Y: Integer; CanDrop: Boolean);
function GetAutoExpand: boolean; function GetAutoExpand: boolean;
function GetBottomItem: TTreeNode; function GetBottomItem: TTreeNode;
function GetChangeDelay: Integer; function GetChangeDelay: Integer;
//function GetDropTarget: TTreeNode; function GetDropTarget: TTreeNode;
function GetHideSelection: boolean; function GetHideSelection: boolean;
function GetHotTrack: boolean; function GetHotTrack: boolean;
function GetKeepCollapsedNodes: boolean; function GetKeepCollapsedNodes: boolean;
@ -1276,7 +1275,7 @@ type
procedure SetChangeDelay(Value: Integer); procedure SetChangeDelay(Value: Integer);
procedure SetDefaultItemHeight(Value: integer); procedure SetDefaultItemHeight(Value: integer);
procedure SetExpandSignType(Value: TTreeViewExpandSignType); procedure SetExpandSignType(Value: TTreeViewExpandSignType);
//procedure SetDropTarget(Value: TTreeNode); procedure SetDropTarget(Value: TTreeNode);
procedure SetHideSelection(Value: Boolean); procedure SetHideSelection(Value: Boolean);
procedure SetHotTrack(Value: Boolean); procedure SetHotTrack(Value: Boolean);
//procedure SetImageList(Value: HImageList; Flags: Integer); //procedure SetImageList(Value: HImageList; Flags: Integer);
@ -1310,8 +1309,8 @@ type
procedure UpdateScrollbars; procedure UpdateScrollbars;
procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL; procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL;
procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL; procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL;
procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN; procedure WMLButtonDown(var AMessage: TLMLButtonDown); message LM_LBUTTONDOWN;
procedure WMNotify(var Message: TLMNotify); message LM_NOTIFY; procedure WMNotify(var AMessage: TLMNotify); message LM_NOTIFY;
procedure WMSize(var Msg: TLMSize); message LM_SIZE; procedure WMSize(var Msg: TLMSize); message LM_SIZE;
//procedure WMContextMenu(var Message: TLMContextMenu); message LM_CONTEXTMENU; //procedure WMContextMenu(var Message: TLMContextMenu); message LM_CONTEXTMENU;
//procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; //procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
@ -1340,7 +1339,7 @@ type
procedure EndEditing; procedure EndEditing;
procedure EnsureNodeIsVisible(ANode: TTreeNode); procedure EnsureNodeIsVisible(ANode: TTreeNode);
procedure Expand(Node: TTreeNode); dynamic; procedure Expand(Node: TTreeNode); dynamic;
//function GetDragImages: TDragImageList; override; function GetDragImages: TDragImageList; //override;
procedure GetImageIndex(Node: TTreeNode); virtual; procedure GetImageIndex(Node: TTreeNode); virtual;
function GetMaxLvl: integer; function GetMaxLvl: integer;
function GetMaxScrollLeft: integer; function GetMaxScrollLeft: integer;
@ -1433,7 +1432,7 @@ type
property BorderWidth; property BorderWidth;
property BottomItem: TTreeNode read GetBottomItem write SetBottomItem; property BottomItem: TTreeNode read GetBottomItem write SetBottomItem;
property Canvas: TCanvas read FCanvas; property Canvas: TCanvas read FCanvas;
//property DropTarget: TTreeNode read GetDropTarget write SetDropTarget; property DropTarget: TTreeNode read GetDropTarget write SetDropTarget;
property DefaultItemHeight: integer property DefaultItemHeight: integer
read FDefItemHeight write SetDefaultItemHeight; read FDefItemHeight write SetDefaultItemHeight;
property ExpandSignType: TTreeViewExpandSignType property ExpandSignType: TTreeViewExpandSignType
@ -1462,7 +1461,7 @@ type
property ChangeDelay; property ChangeDelay;
property Color; property Color;
property Ctl3D; property Ctl3D;
//property Constraints; property Constraints;
property DefaultItemHeight; property DefaultItemHeight;
property DragKind; property DragKind;
property DragCursor; property DragCursor;
@ -1656,6 +1655,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.41 2002/09/09 19:04:01 lazarus
MG: started TTreeView dragging
Revision 1.40 2002/09/09 17:41:18 lazarus Revision 1.40 2002/09/09 17:41:18 lazarus
MG: added multiselection to TTreeView MG: added multiselection to TTreeView

118
lcl/include/treeview.inc
View File

@ -510,16 +510,26 @@ begin
TreeView_SetItem(Handle, Item);} TreeView_SetItem(Handle, Item);}
end; end;
{function TTreeNode.GetDropTarget: Boolean; function TTreeNode.GetDropTarget: Boolean;
begin begin
Result := GetState(nsDropHilited); Result := GetState(nsDropHilited);
end;} end;
{procedure TTreeNode.SetDropTarget(Value: Boolean); procedure TTreeNode.SetDropTarget(AValue: Boolean);
begin begin
if Value then TreeView_SelectDropTarget(Handle, ItemId) if AValue=GetDropTarget then exit;
else if DropTarget then TreeView_SelectDropTarget(Handle, nil); if AValue then begin
end;} Include(FStates,nsDropHilited);
if TreeView<>nil then
TreeView.FLastDropTarget:=Self;
end else begin
Exclude(FStates,nsDropHilited);
if TreeView<>nil then
TreeView.FLastDropTarget:=nil;
end;
{if Value then TreeView_SelectDropTarget(Handle, ItemId)
else if DropTarget then TreeView_SelectDropTarget(Handle, nil);}
end;
function TTreeNode.GetHasChildren: Boolean; function TTreeNode.GetHasChildren: Boolean;
begin begin
@ -869,6 +879,8 @@ begin
if Owner.Owner<>nil then begin if Owner.Owner<>nil then begin
Owner.Owner.FStates:=Owner.Owner.FStates+[tvsMaxRightNeedsUpdate, Owner.Owner.FStates:=Owner.Owner.FStates+[tvsMaxRightNeedsUpdate,
tvsTopsNeedsUpdate,tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate]; tvsTopsNeedsUpdate,tvsTopItemNeedsUpdate,tvsBottomItemNeedsUpdate];
if Owner.Owner.FLastDropTarget=Self then
Owner.Owner.FLastDropTarget:=nil;
end; end;
end; end;
UnbindFromMultiSelected; UnbindFromMultiSelected;
@ -3374,15 +3386,17 @@ begin
Result := FChangeTimer.Interval; Result := FChangeTimer.Interval;
end; end;
{function TCustomTreeView.GetDropTarget: TTreeNode; function TCustomTreeView.GetDropTarget: TTreeNode;
begin begin
if HandleAllocated then if HandleAllocated then
begin begin
Result := Items.GetNode(TreeView_GetDropHilite(Handle)); //Result := Items.GetNode(TreeView_GetDropHilite(Handle));
if Result = nil then Result := FLastDropTarget; //if Result = nil then Result := FLastDropTarget;
Result := FLastDropTarget;
end end
else Result := nil; else
end;} Result := nil;
end;
function TCustomTreeView.GetHideSelection: boolean; function TCustomTreeView.GetHideSelection: boolean;
begin begin
@ -3414,12 +3428,14 @@ begin
Result:=(tvoRowSelect in FOptions); Result:=(tvoRowSelect in FOptions);
end; end;
{procedure TCustomTreeView.SetDropTarget(Value: TTreeNode); procedure TCustomTreeView.SetDropTarget(Value: TTreeNode);
begin begin
if HandleAllocated then if HandleAllocated then
if Value <> nil then Value.DropTarget := True if Value <> nil then
else TreeView_SelectDropTarget(Handle, nil); Value.DropTarget := True;
end;} {else
TreeView_SelectDropTarget(Handle, nil);}
end;
{function TCustomTreeView.GetNodeFromItem(const Item: TTVItem): TTreeNode; {function TCustomTreeView.GetNodeFromItem(const Item: TTVItem): TTreeNode;
begin begin
@ -3672,14 +3688,14 @@ begin
end; end;
end;} end;}
{function TCustomTreeView.GetDragImages: TDragImageList; function TCustomTreeView.GetDragImages: TDragImageList;
begin begin
if FDragImage.Count > 0 then if FDragImage.Count > 0 then
Result := FDragImage Result := FDragImage
else else
Result := nil; Result := nil;
end; end;
}
procedure TCustomTreeView.WndProc(var Message: TLMessage); procedure TCustomTreeView.WndProc(var Message: TLMessage);
begin begin
if not (csDesigning in ComponentState) if not (csDesigning in ComponentState)
@ -3732,14 +3748,15 @@ begin
FLastDropTarget := nil; FLastDropTarget := nil;
end; end;
{procedure TCustomTreeView.CMDrag(var Message: TCMDrag); procedure TCustomTreeView.CMDrag(var AMessage: TCMDrag);
begin begin
inherited; inherited CMDrag(AMessage);
with Message, DragRec^ do writeln('TCustomTreeView.CMDrag ',ord(AMessage.DragMessage));
with AMessage, DragRec^ do
case DragMessage of case DragMessage of
dmDragMove: dmDragMove:
with ScreenToClient(Pos) do with ScreenToClient(Pos) do
DoDragOver(Source, X, Y, Message.Result <> 0); DoDragOver(Source, X, Y, AMessage.Result <> 0);
dmDragLeave: dmDragLeave:
begin begin
TDragObject(Source).HideDragImage; TDragObject(Source).HideDragImage;
@ -3749,23 +3766,24 @@ begin
end; end;
dmDragDrop: FLastDropTarget := nil; dmDragDrop: FLastDropTarget := nil;
end; end;
end;} end;
{procedure TCustomTreeView.DoDragOver(Source: TDragObject; X, Y: Integer; procedure TCustomTreeView.DoDragOver(Source: TDragObject; X, Y: Integer;
CanDrop: Boolean); CanDrop: Boolean);
var var
Node: TTreeNode; Node: TTreeNode;
begin begin
Node := GetNodeAt(X, Y); Node := GetNodeAt(X, Y);
if (Node <> nil) and writeln('TCustomTreeView.DoDragOver ',Node<>nil,' ',Node <> DropTarget,' ',Node = FLastDropTarget);
((Node <> DropTarget) or (Node = FLastDropTarget)) then if (Node <> nil)
and ((Node <> DropTarget) or (Node = FLastDropTarget)) then
begin begin
FLastDropTarget := nil; FLastDropTarget := nil;
TDragObject(Source).HideDragImage; TDragObject(Source).HideDragImage;
Node.DropTarget := True; Node.DropTarget := True;
TDragObject(Source).ShowDragImage; TDragObject(Source).ShowDragImage;
end; end;
end;} end;
procedure TCustomTreeView.DoPaint; procedure TCustomTreeView.DoPaint;
var var
@ -4181,22 +4199,16 @@ begin
end else begin end else begin
Items.ClearMultiSelection; Items.ClearMultiSelection;
CursorNode.MultiSelected:=true; CursorNode.MultiSelected:=true;
writeln('AAA1 ',CursorNode.MultiSelected);
end; end;
end; end;
bStartDrag := true; bStartDrag := true;
end; end;
end; end;
if (Button = mbLeft) and bStartDrag then if (bStartDrag) then
Include(fStates, tvsWaitForDragging) Include(fStates, tvsWaitForDragging);
else begin if Button=mbMiddle then begin
if ([tvsDblClicked,tvsTripleClicked,tvsQuadClicked]*fStates)<>[] then // insert primary selection text
begin
if Button=mbMiddle then begin
// insert primary selection text
end;
end;
end; end;
end; end;
//LCLLinux.SetFocus(Handle); //LCLLinux.SetFocus(Handle);
@ -4205,20 +4217,13 @@ end;
procedure TCustomTreeView.MouseMove(Shift: TShiftState; X, Y: Integer); procedure TCustomTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
begin begin
inherited MouseMove(Shift, x, y); inherited MouseMove(Shift, x, y);
if (X>=ClientWidth-ScrollBarWidth) or (Y>=(ClientHeight-ScrollBarWidth)) then if {MouseCapture and} (tvsWaitForDragging in fStates) then begin
begin
// workaround vs scrollbar clientrect bug in lcl
exit;
end;
if MouseCapture and (tvsWaitForDragging in fStates) then begin
if (Abs(fMouseDownX - X) >= GetSystemMetrics(SM_CXDRAG)) if (Abs(fMouseDownX - X) >= GetSystemMetrics(SM_CXDRAG))
or (Abs(fMouseDownY - Y) >= GetSystemMetrics(SM_CYDRAG)) or (Abs(fMouseDownY - Y) >= GetSystemMetrics(SM_CYDRAG))
then begin then begin
Exclude(fStates, tvsWaitForDragging); Exclude(fStates, tvsWaitForDragging);
//BeginDrag(false); BeginDrag(false);
end; end;
end else if (ssLeft in Shift) and MouseCapture then begin
end; end;
end; end;
@ -4226,22 +4231,17 @@ procedure TCustomTreeView.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); X, Y: Integer);
begin begin
inherited MouseUp(Button, Shift, X, Y); inherited MouseUp(Button, Shift, X, Y);
if (X>=ClientWidth-ScrollBarWidth) or (Y>=(ClientHeight-ScrollBarWidth)) then
begin
exit;
end;
if (Button = mbRight) and (Shift = [ssRight]) and Assigned(PopupMenu) then if (Button = mbRight) and (Shift = [ssRight]) and Assigned(PopupMenu) then
exit; exit;
MouseCapture := False; MouseCapture := False;
if fStates * [tvsDblClicked, tvsWaitForDragging] = [tvsWaitForDragging] then Exclude(fStates, tvsWaitForDragging);
begin
Exclude(fStates, tvsWaitForDragging);
end;
if (Button=mbLeft) if (Button=mbLeft)
and (fStates * [tvsDblClicked, tvsWaitForDragging] = []) then begin and (fStates * [tvsDblClicked, tvsTripleClicked, tvsQuadClicked,
tvsWaitForDragging] = [])
then begin
//AquirePrimarySelection; //AquirePrimarySelection;
end; end;
Exclude(fStates, tvsDblClicked); fStates:=fStates-[tvsDblClicked,tvsTripleClicked,tvsQuadClicked];
end; end;
procedure TCustomTreeView.Notification(AComponent: TComponent; procedure TCustomTreeView.Notification(AComponent: TComponent;
@ -4383,7 +4383,7 @@ begin
end; end;
end; end;
procedure TCustomTreeView.WMLButtonDown(var Message: TLMLButtonDown); procedure TCustomTreeView.WMLButtonDown(var AMessage: TLMLButtonDown);
var var
Node: TTreeNode; Node: TTreeNode;
MousePos: TPoint; MousePos: TPoint;
@ -4401,7 +4401,7 @@ begin
Perform(LM_LBUTTONUP, 0, MakeLong(X, Y)); Perform(LM_LBUTTONUP, 0, MakeLong(X, Y));
end end
else begin else begin
Node := GetNodeAt(Message.XPos, Message.YPos); Node := GetNodeAt(AMessage.XPos, AMessage.YPos);
if Node <> nil then if Node <> nil then
begin begin
Node.Focused := True; Node.Focused := True;
@ -4415,7 +4415,7 @@ begin
end; end;
end; end;
procedure TCustomTreeView.WMNotify(var Message: TLMNotify); procedure TCustomTreeView.WMNotify(var AMessage: TLMNotify);
{var {var
Node: TTreeNode; Node: TTreeNode;
MaxTextLen: Integer; MaxTextLen: Integer;