Форум: "Основная";
Текущий архив: 2005.08.28;
Скачать: [xml.tar.bz2];
ВнизNode.CustomSort Найти похожие ветки
← →
Андрей Молчанов (2005-08-05 18:25) [0]Здравствуйте!
Надо отсортировать дочерние элементы TTreeNode.
Вызываю Node.CustomSort(@ListSortFunc, 0);
function ListSortFunc(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
begin
Result := SmallInt( NewShellFolder.CompareIDs(Result, PShellItem(Node1.Data).FullID, PShellItem(Node2.Data).FullID) );
end;
Выдает ошибку. Что делать?
← →
Digitman © (2005-08-05 18:28) [1]как минимум - убрать stdcall
← →
Андрей Молчанов (2005-08-05 18:32) [2]Не помогает :(
← →
Андрей Молчанов (2005-08-05 18:33) [3]Если надо - могу привести исходник модуля.
← →
Андрей Молчанов (2005-08-05 18:43) [4]
unit VListView;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ToolWin, ShlObj, ImgList, Menus;
type
PShellItem = ^TShellItem;
TShellItem = record
FullID, ID: PItemIDList;
DisplayName, Path: string;
end;
TForm1 = class(TForm)
CheckTree: TTreeView;
ImageList1: TImageList;
procedure FormCreate(Sender: TObject);
procedure Form1Close(Sender: TObject; var Action: TCloseAction);
procedure CheckTreeExpanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
private
FIDesktopFolder: IShellFolder;
RootPIDL: PItemIDList;
procedure AddChildrens(Node: TTreeNode);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ShellAPI, ActiveX, ComObj, CommCtrl;
procedure DisposePIDL(ID: PItemIDList);
var
Malloc: IMalloc;
begin
if ID = nil then Exit;
OLECheck(SHGetMalloc(Malloc));
Malloc.Free(ID);
end;
function ConcatPIDLs(IDList1, IDList2: PItemIDList): PItemIDList;
function NextPIDL(IDList: PItemIDList): PItemIDList;
begin
Result := IDList;
Inc(PChar(Result), IDList^.mkid.cb);
end;
function GetPIDLSize(IDList: PItemIDList): Integer;
begin
Result := 0;
if Assigned(IDList) then
begin
Result := SizeOf(IDList^.mkid.cb);
while IDList^.mkid.cb <> 0 do
begin
Result := Result + IDList^.mkid.cb;
IDList := NextPIDL(IDList);
end;
end;
end;
function CreatePIDL(Size: Integer): PItemIDList;
var
Malloc: IMalloc;
HR: HResult;
begin
Result := nil;
HR := SHGetMalloc(Malloc);
if Failed(HR) then
Exit;
try
Result := Malloc.Alloc(Size);
if Assigned(Result) then
FillChar(Result^, Size, 0);
finally
end;
end;
var
cb1, cb2: Integer;
begin
if Assigned(IDList1) then
cb1 := GetPIDLSize(IDList1) - SizeOf(IDList1^.mkid.cb)
else
cb1 := 0;
cb2 := GetPIDLSize(IDList2);
Result := CreatePIDL(cb1 + cb2);
if Assigned(Result) then
begin
if Assigned(IDList1) then
CopyMemory(Result, IDList1, cb1);
CopyMemory(PChar(Result) + cb1, IDList2, cb2);
end;
end;
function GetDisplayName(ShellFolder: IShellFolder; PIDL: PItemIDList;
ForParsing: Boolean): string;
var
StrRet: TStrRet;
P: PChar;
Flags: Integer;
begin
Result := "";
if ForParsing then
Flags := SHGDN_FORPARSING
else
Flags := SHGDN_NORMAL;
ShellFolder.GetDisplayNameOf(PIDL, Flags, StrRet);
case StrRet.uType of
STRRET_CSTR:
SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
STRRET_OFFSET:
begin
P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
end;
STRRET_WSTR:
Result := StrRet.pOleStr;
end;
end;
function GetShellImage(PIDL: PItemIDList; Open: Boolean): Integer;
var
FileInfo: TSHFileInfo;
Flags: Integer;
begin
FillChar(FileInfo, SizeOf(FileInfo), #0);
Flags := SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_ICON or SHGFI_SMALLICON;
if Open then Flags := Flags or SHGFI_OPENICON;
SHGetFileInfo(PChar(PIDL),
0,
FileInfo,
SizeOf(FileInfo),
Flags);
Result := FileInfo.iIcon;
end;
function IsFolder(ShellFolder: IShellFolder; ID: PItemIDList): Boolean;
var
Flags: UINT;
begin
Flags := SFGAO_FOLDER;
ShellFolder.GetAttributesOf(1, ID, Flags);
Result := SFGAO_FOLDER and Flags <> 0;
end;
function IsFileSystem(ShellFolder: IShellFolder; ID: PItemIDList): Boolean;
var
Flags: UINT;
begin
Flags := SFGAO_FILESYSTEM or SFGAO_FILESYSANCESTOR;
ShellFolder.GetAttributesOf(1, ID, Flags);
Result := (SFGAO_FILESYSTEM or SFGAO_FILESYSANCESTOR) and Flags <> 0;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
FileInfo: TSHFileInfo;
ImageListHandle: THandle;
begin
OLECheck(SHGetDesktopFolder(FIDesktopFolder));
ImageListHandle := SHGetFileInfo("C:\",
0,
FileInfo,
SizeOf(FileInfo),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
ImageList1.Handle := ImageListHandle;
OLECheck(
SHGetSpecialFolderLocation(
Application.Handle,
CSIDL_NETWORK,
RootPIDL)
);
AddChildrens(CheckTree.Items[0].Item[2]);
end;
procedure TForm1.AddChildrens(Node: TTreeNode);
var
NewShellFolder: IShellFolder;
function ListSortFunc(Node1, Node2: TTreeNode; Data: Longint): Integer;
begin
Result := SmallInt( NewShellFolder.CompareIDs(Result, PShellItem(Node1.Data).FullID, PShellItem(Node2.Data).FullID) );
end;
var
ID: PItemIDList;
EnumList: IEnumIDList;
NumIDs: LongWord;
SaveCursor: TCursor;
ShellItem: PShellItem;
ChildNode: TTreeNode;
begin
if Assigned(Node.Data) then OLECheck(FIDesktopFolder.BindToObject(PShellItem(Node.Data)^.FullID, nil, IID_IShellFolder, Pointer(NewShellFolder)) )
else OLECheck(FIDesktopFolder.BindToObject(RootPIDL, nil, IID_IShellFolder, Pointer(NewShellFolder)) );
SaveCursor := Screen.Cursor;
CheckTree.Items.BeginUpdate;
try
Screen.Cursor := crHourglass;
OleCheck( NewShellFolder.EnumObjects(Application.Handle, SHCONTF_NONFOLDERS or SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN, EnumList) );
Node.DeleteChildren;
while EnumList.Next(1, ID, NumIDs) = S_OK do begin
if not IsFileSystem(NewShellFolder, ID) then Continue;
New(ShellItem);
ShellItem^.ID := ID;
if Assigned(Node.Data) then
ShellItem^.FullID := ConcatPIDLs(PShellItem(Node.Data)^.FullID, ID)
else
ShellItem^.FullID := ConcatPIDLs(RootPIDL, ID);
ShellItem^.DisplayName := GetDisplayName(NewShellFolder, ID, False);
ShellItem^.Path := GetDisplayName(NewShellFolder, ID, True);
ChildNode := CheckTree.Items.AddChildObject(Node, ShellItem^.DisplayName, ShellItem);
ChildNode.HasChildren := True;
ChildNode.StateIndex := SmallInt(ShellItem^.Path <> "");
ChildNode.ImageIndex := GetShellImage(ShellItem^.FullID, False);
ChildNode.SelectedIndex := GetShellImage(ShellItem^.FullID, True);
end;
finally
Node.CustomSort(@ListSortFunc, 0);
CheckTree.Items.EndUpdate;
Screen.Cursor := SaveCursor;
end;
end;
procedure TForm1.Form1Close(Sender: TObject; var Action: TCloseAction);
var
I: Integer;
begin
{ for I := 0 to FIDList.Count-1 do
begin
DisposePIDL(ShellItem(I).ID);
Dispose(ShellItem(I));
end;
FIDList.Clear;}
end;
procedure TForm1.CheckTreeExpanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
begin
if Assigned(Node.Data) then
AddChildrens(Node);
end;
end.
← →
begin...end © (2005-08-05 18:45) [5]> Digitman © (05.08.05 18:28) [1]
Это почему же?
← →
Андрей Молчанов (2005-08-05 19:28) [6]Ну пожалуйста, помогите...
← →
Андрей Молчанов (2005-08-05 19:59) [7]Все, разобрался сам.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2005.08.28;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.06 c