cxshellcontrols.pas
来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,033 行 · 第 1/5 页
PAS
2,033 行
Handled := True;
if ANode.Parent = nil then
Exit;
FContextPopupItemProducer := TcxShellTreeItemProducer(ANode.Parent.Data);
FContextPopupItemProducer.OnDestroy := ContextPopupItemProducerDestroyHandler;
FContextPopupItemProducer.LockRead;
try
CreateChangeNotification(ANode);
AItem := FContextPopupItemProducer.Items[ANode.Index];
FIsChangeNotificationCreationLocked := True;
if AItem.pidl <> nil then
begin
AItemPIDLList := TList.Create;
try
AItemPIDLList.Add(GetPidlCopy(AItem.pidl));
cxShellCommon.DisplayContextMenu(Handle, FContextPopupItemProducer.ShellFolder,
AItemPIDLList, ClientToScreen(MousePos));
finally
DisposePidl(AItemPIDLList[0]);
AItemPIDLList.Free;
end;
end;
finally
if FContextPopupItemProducer <> nil then
FContextPopupItemProducer.UnlockRead;
end;
finally
FIsChangeNotificationCreationLocked := False;
if FContextPopupItemProducer <> nil then
begin
FContextPopupItemProducer.OnDestroy := nil;
FContextPopupItemProducer := nil;
end;
end;
end;
function TcxCustomInnerShellTreeView.DragEnter(const dataObj: IDataObject;
grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
New: Boolean;
begin
DraggedObject := IcxDataObject(dataObj);
GetDropTarget(new, pt);
dwEffect := DragDropSettings.DefaultDropEffectAPI;
if CurrentDropTarget = nil then
begin
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
end
else
Result := CurrentDropTarget.DragEnter(dataObj, grfKeyState, pt, dwEffect)
end;
function TcxCustomInnerShellTreeView.DragLeave: HResult;
begin
DraggedObject := nil;
Result := TryReleaseDropTarget;
end;
function TcxCustomInnerShellTreeView.IDropTargetDragOver(grfKeyState: Integer; pt: TPoint;
var dwEffect: Integer): HResult;
var
New: Boolean;
begin
GetDropTarget(new, pt);
if CurrentDropTarget = nil then
begin
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
end
else
begin
if New then
Result := CurrentDropTarget.DragEnter(DraggedObject, grfKeyState, pt, dwEffect)
else
Result := S_OK;
if Succeeded(Result) then
Result := CurrentDropTarget.DragOver(grfKeyState, pt, dwEffect);
end;
end;
function TcxCustomInnerShellTreeView.Drop(const dataObj: IDataObject;
grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
New: Boolean;
begin
GetDropTarget(new, pt);
if CurrentDropTarget = nil then
begin
dwEffect := DROPEFFECT_NONE;
Result := S_OK;
end
else
begin
if New then
Result := CurrentDropTarget.DragEnter(dataObj, grfKeyState, pt, dwEffect)
else
Result := S_OK;
if Succeeded(Result) then
Result := CurrentDropTarget.Drop(dataObj, grfKeyState, pt, dwEffect);
end;
PostMessage(Handle, DSM_SHELLCHANGENOTIFY, WPARAM(PrevTargetNode.Data), 0);
TryReleaseDropTarget;
end;
procedure TcxCustomInnerShellTreeView.DsmNotifyAddItem(var Message: TMessage);
var
Node, NewNode: TTreeNode;
ItemProducer: TcxShellTreeItemProducer;
tempShellItem: TcxShellItemInfo;
begin
Node := TTreeNode(Message.LParam);
ItemProducer := TcxShellTreeItemProducer(Node.Data);
ItemProducer.LockRead;
try
tempShellItem := ItemProducer.Items[Message.WParam];
NewNode := Items.AddChild(Node, tempShellItem.Name);
NewNode.Data := TcxShellTreeItemProducer.Create(Self);
NewNode.ImageIndex := tempShellItem.IconIndex;
NewNode.SelectedIndex := tempShellItem.OpenIconIndex;
NewNode.HasChildren := tempShellItem.HasSubfolder;
finally
ItemProducer.UnlockRead;
end;
end;
procedure TcxCustomInnerShellTreeView.DsmNotifyRemoveItem(
var Message: TMessage);
var
Node: TTreeNode;
begin
Node := TTreeNode(Message.LParam);
if Message.WParam < Node.Count then
Node.Item[Message.WParam].Delete;
end;
procedure TcxCustomInnerShellTreeView.DsmNotifyUpdateContents(
var Message: TMessage);
begin
if not (csLoading in ComponentState) then
UpdateNode(nil, False);
end;
procedure TcxCustomInnerShellTreeView.DsmNotifyUpdateItem(
var Message: TMessage);
function GetChildNode(ANode: TTreeNode; AIndex: Integer): TTreeNode;
begin
Result := ANode.getFirstChild;
while (Result <> nil) and (AIndex > 0) do
begin
Result := ANode.GetNextChild(Result);
Dec(AIndex);
end;
end;
var
AItem: TcxShellItemInfo;
AItemProducer: TcxShellTreeItemProducer;
ANode, ATempNode: TTreeNode;
begin
ANode := TTreeNode(Message.LParam);
if ANode.getFirstChild = nil then
Exit;
ATempNode := GetChildNode(ANode, Message.WParam);
if ATempNode = nil then
Exit;
AItemProducer := TcxShellTreeItemProducer(ANode.Data);
AItemProducer.LockRead;
try
AItem := AItemProducer.Items[Message.WParam];
ATempNode.ImageIndex := AItem.IconIndex;
ATempNode.SelectedIndex := AItem.OpenIconIndex;
ATempNode.Text := AItem.Name;
ATempNode.HasChildren := AItem.HasSubfolder;
ATempNode.Cut := AItem.IsGhosted;
ATempNode.OverlayIndex := GetShellItemOverlayIndex(AItem);
finally
AItemProducer.UnlockRead;
end;
end;
procedure TcxCustomInnerShellTreeView.DsmSetCount(var Message: TMessage);
var
Node: TTreeNode;
ItemProducer: TcxShellTreeItemProducer;
i: Integer;
NewNode: TTreeNode;
tempShellItem: TcxShellItemInfo;
begin
Node := TTreeNode(Message.LParam);
if Message.WParam = 0 then
begin
Node.DeleteChildren;
Node.HasChildren := False;
Exit;
end;
ItemProducer := TcxShellTreeItemProducer(Node.Data);
ItemProducer.LockRead;
try
Items.BeginUpdate;
try
for i := 0 to ItemProducer.Items.Count-1 do
begin
tempShellItem := ItemProducer.Items[i];
if not tempShellItem.Updated then
ItemProducer.FetchRequest(i, False);
NewNode := Items.AddChild(Node, tempShellItem.Name);
NewNode.Data := TcxShellTreeItemProducer.Create(Self);
NewNode.ImageIndex := tempShellItem.IconIndex;
NewNode.SelectedIndex := tempShellItem.OpenIconIndex;
NewNode.HasChildren := tempShellItem.HasSubfolder;
NewNode.Cut := tempShellItem.IsGhosted;
NewNode.OverlayIndex := GetShellItemOverlayIndex(tempShellItem);
end;
finally
Items.EndUpdate;
end;
if Node.GetFirstChild = nil then
Node.HasChildren := False;
finally
ItemProducer.UnlockRead;
end;
end;
procedure TcxCustomInnerShellTreeView.DsmShellChangeNotify(
var Message: TMessage);
begin
Sleep(100);
if not TcxShellTreeItemProducer(Message.WParam).CheckUpdates then
UpdateNode(PrevTargetNode, False);
end;
procedure TcxCustomInnerShellTreeView.Edit(const Item: TTVItem);
var
AItemInfo: TcxShellItemInfo;
AItemProducer: TcxShellTreeItemProducer;
ANode: TTreeNode;
APIDL: PItemIDList;
APrevNodeText: string;
begin
ANode := GetNodeFromItem(Item);
APrevNodeText := '';
if ANode <> nil then
APrevNodeText := ANode.Text;
inherited Edit(Item);
if (Item.pszText = nil) or (ANode = nil) or (ANode.Parent = nil) then
Exit;
AItemProducer := TcxShellTreeItemProducer(ANode.Parent.Data);
AItemInfo := AItemProducer.Items[ANode.Index];
RemoveChangeNotification;
if AItemProducer.ShellFolder.SetNameOf(Handle, AItemInfo.pidl, PWideChar(WideString(ANode.Text)),
SHGDN_INFOLDER or SHGDN_FORPARSING, APIDL) = S_OK then
try
AItemInfo.SetNewPidl(AItemProducer.ShellFolder, AItemProducer.FolderPidl, APIDL);
finally
DisposePidl(APIDL);
end
else
ANode.Text := APrevNodeText;
end;
procedure TcxCustomInnerShellTreeView.GetDropTarget(out New: Boolean;pt:TPoint);
var
Node: TTreeNode;
cpt: TPoint;
ItemProducer: TcxShellTreeItemProducer;
tempDropTarget: IcxDropTarget;
tempShellItem: TcxShellItemInfo;
tempPidl: PItemIDList;
Res: HRESULT;
tempShellFolder: IShellFolder;
begin
cpt := ScreenToClient(pt);
Node := GetNodeAt(cpt.X, cpt.Y);
if Node = nil then
begin
TryReleaseDropTarget;
Exit;
end;
if (Node = PrevTargetNode) and (CurrentDropTarget <> nil) then
begin
New := False;
Exit;
end;
TryReleaseDropTarget;
New := True;
if Node.Parent = nil then
begin // Root object selected
ItemProducer := TcxShellTreeItemProducer(Node.Data);
if ItemProducer.ShellFolder = nil then
Exit;
Res:=ItemProducer.ShellFolder.CreateViewObject(Handle, IDropTarget, tempDropTarget);
if Failed(Res) then
Exit;
end
else
begin // Non-root object selected
ItemProducer := TcxShellTreeItemProducer(Node.Parent.Data);
tempShellItem := ItemProducer.Items[Node.Index];
tempPidl := GetPidlCopy(tempShellItem.pidl);
try
if tempShellItem.IsFolder then
begin
if Failed(ItemProducer.ShellFolder.BindToObject(tempPidl, nil, IID_IShellFolder, tempShellFolder)) then
Exit;
if Failed(tempShellFolder.CreateViewObject(Handle, IDropTarget, tempDropTarget)) then
Exit;
end
else
begin
Res := ItemProducer.ShellFolder.GetUIObjectOf(Handle, 1, tempPidl, IDropTarget, nil, tempDropTarget);
if Failed(Res) then
Exit;
end;
finally
DisposePidl(tempPidl);
end;
end;
PrevTargetNode := Node;
CurrentDropTarget := tempDropTarget;
end;
procedure TcxCustomInnerShellTreeView.ContextPopupItemProducerDestroyHandler(
Sender: TObject);
begin
FContextPopupItemProducer.UnlockRead;
FContextPopupItemProducer.OnDestroy := nil;
FContextPopupItemProducer := nil;
end;
function TcxCustomInnerShellTreeView.GetFolder(AIndex: Integer): TcxShellFolder;
var
ANode: TTreeNode;
begin
ANode := Items[AIndex];
if ANode.Parent = nil then
Result := Root.Folder
else
Result := TcxShellItemInfo(TcxShellTreeItemProducer(ANode.Parent.Data).Items[ANode.Index]).Folder;
end;
function TcxCustomInnerShellTreeView.GetFolderCount: Integer;
begin
Result := Items.Count;
end;
function TcxCustomInnerShellTreeView.GetNodeFromItem(
const Item: TTVItem): TTreeNode;
begin
Result := nil;
if Items <> nil then
with Item do
if (state and TVIF_PARAM) <> 0 then
Result := Pointer(lParam)
else
Result := Items.GetNode(hItem);
end;
procedure TcxCustomInnerShellTreeView.RestoreTreeState;
procedure RestoreExpandedNodes;
procedure ExpandNode(APIDL: PItemIDList);
var
ANode: TTreeNode;
begin
if Root.ShellFolder = nil then
Root.CheckRoot;
if APIDL = nil then
APIDL := Root.Pidl;
ANode := GetNodeByPIDL(APIDL);
if ANode <> nil then
ANode.Expand(False);
end;
procedure DestroyExpandedNodeList;
var
I: Integer;
begin
if FStateData.ExpandedNodeList = nil then
Exit;
for I := 0 to FStateData.ExpandedNodeList.Count - 1 do
DisposePidl(PItemIDList(FStateData.ExpandedNodeList[I]));
FreeAndNil(FStateData.ExpandedNodeList);
end;
var
I: Integer;
begin
try
for I := 0 to FStateData.ExpandedNodeList.Count - 1 do
ExpandNode(PItemIDList(FStateData.ExpandedNodeList[I]));
finally
DestroyExpandedNodeList;
end;
end;
procedure RestoreTopItemIndex;
begin
if (FStateData.TopItemIndex >= 0) and (FStateData.TopItemIndex < Items.Count) then
TopItem :
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?