Текущий архив: 2005.08.28;
Скачать: CL | DM;

Вниз

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;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.027 c