贴一个支持同时处理多种语言的 Favorites Tree 控件,问一个百思不得其解的问题(200分)

  • 主题发起人 主题发起人 940801
  • 开始时间 开始时间
9

940801

Unregistered / Unconfirmed
GUEST, unregistred user!
//********************************************************
//
// GFavoritesTree
// By 940801,l940801@yahoo.com
//
//********************************************************

unit GFavoritesTrees;

interface

uses
Windows, Messages, Classes, Forms, SysUtils, ComCtrls, Commctrl, ShellAPI, IniFiles,
Registry, Controls, SHDocVw, ComObj;

type
TGFavoriteType = (gftFolder, gftUrl, gftUnknown);

TGFavorite = Class
private
FParent: TGFavorite;
FFavoriteType: TGFavoriteType;

FFileName: string;
FDisplayName: string;
FCanDelete: Boolean;
FCanRename: Boolean;

FUrl: string;
function GetPath: string;
function GetFullFileName: string;
function GetUrl: string;
procedure SetUrl(Value: string);
protected
public
constructor Create(APathName: string); overload;
constructor Create(AParent: TGFavorite; FindFileData: TSearchRec); overload;
destructor Destroy; override;

function ComparePos(GFavorite1, GFavorite2: TGFavorite): SmallInt;
function Rename(const NewName: string): Boolean;
function Delete: Boolean;
procedure ShowProperty;

property Url: string read FUrl write SetUrl;
property FileName: string read FFileName;
property FullFileName: string read GetFullFileName;
property Path: string read GetPath;
property DisplayName: string read FDisplayName;
property Parent: TGFavorite read FParent;
property FavoriteType: TGFavoriteType read FFavoriteType;
property CanDelete: Boolean read FCanDelete;
property CanRename: Boolean read FCanRename;
end;

TAddFavoriteEvent = procedure(Sender: TObject; AFavorite: TGFavorite;
var CanAdd: Boolean) of object;

TUrlClickEvent = procedure (Sender: TObject; Url: string) of object;

TCustomGFavoritesTree = Class(TCustomTreeView)
private
FUpdating, FLoadingRoot: Boolean;
FRootCaption: string;
FOnAddFavorite: TAddFavoriteEvent;
FOnUrlClick: TUrlClickEvent;
FShowUrlHint: Boolean;

FCanImportExport: Boolean;

function GetFavorites(Index: integer): TGFavorite;
procedure SetRootCaption(Value: string);
procedure CreateRoot;
function GetShellImage(FileName: string; Open: Boolean): Integer;
function GetSelectedFavorite: TGFavorite;
function GetIEVersion: Extended;
procedure SetShowUrlHint(Value: Boolean);
protected
procedure Loaded; override;
procedure DBLClick; override;
procedure Delete(Node: TTreeNode); override;
procedure Edit(const Item: TTVItem); override;

procedure ClearItems;
procedure InitNode(NewNode: TTreeNode; ParentNode: TTreeNode; FindFileData: TSearchRec);
procedure PopulateNode(Node: TTreeNode);
function CanExpand(Node: TTreeNode): Boolean; override;
procedure WndProc(var Msg: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

procedure RefreshRoot;
procedure DeleteNode(Node: TTreeNode);
procedure EditNode(Node: TTreeNode);
procedure OrganizeFavorites;
procedure ExportFavorites;
procedure ImportFavorites;

property Favorites[Index: Integer]: TGFavorite read GetFavorites; default;
property RootCaption: string read FRootCaption write SetRootCaption;
property SelectedFavorite: TGFavorite read GetSelectedFavorite;
property ShowUrlHint: Boolean read FShowUrlHint write SetShowUrlHint;

property OnUrlClick: TUrlClickEvent read FOnUrlClick write FOnUrlClick;
property OnAddFavorite: TAddFavoriteEvent read FOnAddFavorite write FOnAddFavorite;
property CanImportExport: Boolean read FCanImportExport write FCanImportExport;
end;

TGFavoritesTree = Class(TCustomGFavoritesTree)
published
property RootCaption;
property SelectedFavorite;
property OnUrlClick;
property OnAddFavorite;
property ShowUrlHint;
property CanImportExport;

property Align;
property Anchors;
property AutoExpand;
property BiDiMode;
property BorderStyle;
property BorderWidth;
property ChangeDelay;
property Color;
property Ctl3D;
property Constraints;
property DragKind;
property DragCursor;
property DragMode;
property Enabled;
property Font;
// property HideSelection;
// property HotTrack;
// property Images;
property Indent;
property ParentBiDiMode;
property ParentColor default False;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
// property RightClickSelect;
// property RowSelect;
// property ShowButtons;
property ShowHint;
// property ShowLines;
// property ShowRoot;
// property SortType;
// property StateImages;
property TabOrder;
property TabStop default True;
// property ToolTips;
property Visible;
property OnAdvancedCustomDraw;
property OnAdvancedCustomDrawItem;
property OnChange;
property OnChanging;
property OnClick;
property OnCollapsed;
property OnCollapsing;
property OnCompare;
property OnContextPopup;
property OnCustomDraw;
property OnCustomDrawItem;
property OnDblClick;
property OnDeletion;
property OnDragDrop;
property OnDragOver;
property OnEdited;
property OnEditing;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnExpanding;
property OnExpanded;
// property OnGetImageIndex;
// property OnGetSelectedIndex;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property Items;
end;

procedure Register;

const
CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';

implementation

procedure Register;
begin
RegisterComponents('Grape', [TGFavoritesTree]);
end;

{ TGFavoritesTreeNode }

constructor TGFavorite.Create(APathName: string);
begin
inherited Create;
FParent:= nil;
FFileName:= ExtractFileName(APathName);

FDisplayName:= ExtractFilePath(APathName);
FDisplayName:= Copy(FDisplayname, 1, Length(FDisplayName) - 1);
FCanDelete:= False;
FCanRename:= False;

if DirectoryExists(APathName) then
FFavoriteType:= gftFolder
else
FFavoriteType:= gftUnknown;
end;

constructor TGFavorite.Create(AParent: TGFavorite; FindFileData: TSearchRec);
begin
inherited Create;
FParent:= AParent;
FDisplayName:= ChangeFileExt(FindFileData.Name, '');
FCanDelete:= True;
FCanRename:= True;

if FindFileData.Attr = faDirectory then
FFavoriteType:= gftFolder
else
FFavoriteType:= gftUnknown;

FFileName:= FindFileData.FindData.cAlternateFileName;
if FFileName = '' then FFileName:= FindFileData.Name;

if (FFavoriteType = gftUnknown) and SameText(ExtractFileExt(FFileName), '.url') then
begin
FUrl:= GetUrl;
if FUrl <> '' then
FFavoriteType:= gftUrl
end;
end;

destructor TGFavorite.Destroy;
begin
inherited;
end;

function TGFavorite.GetPath: string;
begin
if FParent <> nil then
Result:= FParent.FullFileName
else
Result:= FDisplayName;
end;

function TGFavorite.GetFullFileName: string;
begin
Result:= Path + '/' + FFileName;
end;

function TGFavorite.GetUrl: string;
begin
Result:= '';
with TIniFile.Create(FullFileName) do
try
Result:= ReadString('InternetShortcut', 'URL', '');
finally
Free;
end;
end;

procedure TGFavorite.SetUrl(Value: string);
begin
FUrl:= Value;
with TIniFile.Create(FullFileName) do
try
WriteString('InternetShortcut', 'URL', Value);
finally
Free;
end;
end;

function TGFavorite.ComparePos(GFavorite1, GFavorite2: TGFavorite): SmallInt;
begin
if GFavorite1.FavoriteType = GFavorite2.FavoriteType then
Result:= CompareText(GFavorite1.FileName, GFavorite2.FileName)
else if GFavorite1.FavoriteType = gftFolder then
Result:= -1
else
Result:= 1;
end;

function TGFavorite.Rename(const NewName: string): boolean;
var
lpFileOp: TSHFileOpStruct;
pOldName: Array [0..MAX_PATH + 1] of Char;
pNewName: Array [0..MAX_PATH + 1] of Char;
TempStr: string;
begin
TempStr:= FullFileName;
FillChar(pOldName, MAX_PATH + 1, #0);
StrPCopy(pOldName, TempStr);

TempStr:= GetPath + '/' + NewName;
if (FavoriteType = gftUrl) and not SameText(ExtractFileExt(TempStr), '.url') then
TempStr:= TempStr + '.url';
FillChar(pNewName, MAX_PATH + 1, #0);
StrPCopy(pNewName, TempStr);

with lpFileOp do
begin
Wnd:= Application.Handle;
wFunc:= FO_RENAME;
pFrom:= pOldName;
pTo:= pNewName;
fFlags:= FOF_ALLOWUNDO + FOF_RENAMEONCOLLISION;
end;
Result:= SHFileOperation(lpFileOp) = 0;
if Result then FFileName:= NewName;
end;

function TGFavorite.Delete: Boolean;
var
lpFileOp: TSHFileOpStruct;
pFileName: Array [0..MAX_PATH + 1] of Char;
TempStr: string;
begin
TempStr:= FullFileName;
FillChar(pFileName, MAX_PATH + 1, #0);
StrPCopy(pFileName, TempStr);

with lpFileOp do
begin
Wnd:= Application.Handle;
wFunc:= FO_DELETE;
pFrom:= pFileName;
pTo:= nil;
fFlags:= FOF_ALLOWUNDO + FOF_SILENT + FOF_NOCONFIRMATION;
end;
Result:= (SHFileOperation(lpFileOp) = 0) and not lpFileOp.fAnyOperationsAborted;
end;

procedure TGFavorite.ShowProperty;
begin
end;

{ TCustomGFavoritesTree }

constructor TCustomGFavoritesTree.Create(AOwner: TComponent);
begin
inherited;
HotTrack:= True;
RowSelect:= True;
ToolTips:= True;
ShowLines:= False;
ShowButtons:= False;
ShowRoot:= False;
RightClickSelect:= True;
HideSelection:= False;
FRootCaption:= 'Favorites';
FUpdating:= False;
FLoadingRoot:= False;
FShowUrlHint:= True;
ShowHint:= True;
FCanImportExport:= GetIEVersion > 5.0;
end;

destructor TCustomGFavoritesTree.Destroy;
begin
ClearItems;
inherited;
end;

procedure TCustomGFavoritesTree.ClearItems;
var
I: Integer;
begin
for I:= 0 to Items.Count - 1 do
begin
if Items.Data <> nil then
TGFavorite(Items.Data).Free;
Items.Data:= nil;
end;
Items.Clear;
end;

procedure TCustomGFavoritesTree.Loaded;
var
FileInfo: TSHFileInfo;
TempImages: Integer;
begin
inherited Loaded;
if (csDesigning in ComponentState) then Exit;
TempImages:= SHGetFileInfo('C:/',
0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
SendMessage(Handle, TVM_SETIMAGELIST, TVSIL_NORMAL, TempImages);
CreateRoot;
end;

function TreeSortFunc(Node1, Node2: TTreeNode; lParam: Integer): Integer; stdcall;
begin
Result:= TGFavorite(Node1.Data).Parent.ComparePos(TGFavorite(Node1.Data), TGFavorite(Node2.Data));
end;

procedure TCustomGFavoritesTree.InitNode(NewNode: TTreeNode; ParentNode: TTreeNode; FindFileData: TSearchRec);
var
CanAdd: Boolean;
begin
NewNode.Data:= TGFavorite.Create(TGFavorite(ParentNode.Data), FindFileData);
with TGFavorite(NewNode.Data) do
begin
if FavoriteType = gftUnknown then
NewNode.Delete
else
begin
NewNode.Text:= DisplayName;
NewNode.ImageIndex:= GetShellImage(FullFileName, False);
NewNode.SelectedIndex:= GetShellImage(FullFileName, True);
if NewNode.SelectedIndex = 0 then NewNode.SelectedIndex:= NewNode.ImageIndex;
if FavoriteType = gftFolder then NewNode.HasChildren:= True
else NewNode.HasChildren:= False;
end;
end;

CanAdd:= True;
if Assigned(FOnAddFavorite) then FOnAddFavorite(Self, TGFavorite(NewNode.Data), CanAdd);
if not CanAdd then NewNode.Delete;
end;

procedure TCustomGFavoritesTree.PopulateNode(Node: TTreeNode);
var
NewNode: TTreeNode;
SaveCursor: TCursor;
SR : TSearchRec;
Found: Integer;
begin
if TGFavorite(Node.Data^).FavoriteType <> gftFolder then Exit;
SaveCursor:= Screen.Cursor;
Screen.Cursor:= crHourglass;
Items.BeginUpdate;
try
Found:= FindFirst(TGFavorite(Node.Data).FullFileName + '/*.*', faDirectory + faArchive, SR);
while Found = 0 do
begin
if (SR.Name <> '.') and (SR.Name <> '..') then
begin
NewNode:= Items.AddChild(Node, '');
InitNode(NewNode, Node, SR);
end;

Found:= FindNext(SR);
end;
FindClose(SR);

Node.CustomSort(@TreeSortFunc, 0);
finally
Items.EndUpdate;
Screen.Cursor:= SaveCursor;
end;
end;

procedure TCustomGFavoritesTree.CreateRoot;
var
FavoritesParh: string;
Buf: Array [0..MAX_PATH] of Char;

RootNode: TTreeNode;
begin
with TRegistry.Create do
try
RootKey:= HKEY_CURRENT_USER;
if OpenKey('/Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders', False) then
begin
FavoritesParh:= ReadString('Favorites');
ExpandEnvironmentStrings(PChar(FavoritesParh), Buf, MAX_PATH);
FavoritesParh:= Buf;
end;
finally
Free;
end;

Items.BeginUpdate;
try
if Items.Count > 0 then
ClearItems;
RootNode:= Items.Add(nil, '');
with RootNode do
begin
Data:= TGFavorite.Create(FavoritesParh);

Text:= FRootCaption;

RootNode.ImageIndex:= GetShellImage(FavoritesParh, False);
RootNode.SelectedIndex:= GetShellImage(FavoritesParh, True);
RootNode.HasChildren:= True;
end;
RootNode.Expand(False);
Selected:= RootNode;
finally
Items.EndUpdate;
end;
end;

function TCustomGFavoritesTree.CanExpand(Node: TTreeNode): Boolean;
begin
Result:= True;
if (csDesigning in ComponentState) and (Node.Level > 0) then Exit;
if Assigned(OnExpanding) then OnExpanding(Self, Node, Result);
if Result and (TGFavorite(Node.Data).FavoriteType = gftFolder) and (Node.Count = 0) then
PopulateNode(Node);
Node.HasChildren:= Node.Count > 0;
end;

procedure TCustomGFavoritesTree.Edit(const Item: TTVItem);
var
S: string;
Node: TTreeNode;
begin
with Item do
if pszText <> nil then
begin
S:= pszText;
Node:= Items.GetNode(Item.hItem);
if Assigned(OnEdited) then OnEdited(Self, Node, S);
if Node <> nil then
if Node.AbsoluteIndex = 0 then
SetRootCaption(S)
else
if TGFavorite(Node.Data).Rename(S) then Node.Text:= S
end;
end;

procedure TCustomGFavoritesTree.Delete(Node: TTreeNode);
begin
if Assigned(Node.Data) then
begin
TGFavorite(Node.Data).Free;
Node.Data:= nil;
end;
inherited Delete(Node);
end;

function TCustomGFavoritesTree.GetFavorites(Index: integer): TGFavorite;
begin
Result:= TGFavorite(Items[Index].Data);
end;

function TCustomGFavoritesTree.GetSelectedFavorite: TGFavorite;
begin
Result:= nil;
if Selected <> nil then
Result:= TGFavorite(Selected.Data)
end;

function TCustomGFavoritesTree.GetShellImage(FileName: string; Open: Boolean): Integer;
var
FileInfo: TSHFileInfo;
Flags: Integer;
begin
Flags:= SHGFI_SYSICONINDEX;
if Open then Flags:= Flags or SHGFI_OPENICON
else Flags:= Flags or SHGFI_SMALLICON;
SHGetFileInfo(PChar(FileName),
0,
FileInfo,
SizeOf(FileInfo),
Flags);
Result:= FileInfo.iIcon;
end;

procedure TCustomGFavoritesTree.SetRootCaption(Value: string);
begin
FRootCaption:= Value;
if TopItem <> nil then
TopItem.Text:= Value;
end;

procedure TCustomGFavoritesTree.DBLClick;
begin
inherited;
if Assigned(FOnUrlClick) and (SelectedFavorite <> nil)
and (SelectedFavorite.FavoriteType = gftUrl) then
begin
FOnUrlClick(Self, SelectedFavorite.Url);
end;
end;

procedure TCustomGFavoritesTree.RefreshRoot;
begin
if FUpdating then Exit;
FUpdating:= True;
try
CreateRoot;
finally
FUpdating:= False;
end;
end;

procedure TCustomGFavoritesTree.WndProc(var Msg: TMessage);
var
Node: TTreeNode;
begin
inherited;
case Msg.Msg of
WM_RBUTTONDOWN:
begin
if not(csDesigning in ComponentState) then
begin
Node:= GetNodeAt(LOWORD(Msg.lParam), HIWORD(Msg.LParam));
if Node <> nil then Node.Selected:= true;
end;
end;
WM_MOUSEMOVE:
begin
if FShowUrlHint then
begin
Node:= GetNodeAt(LOWORD(Msg.lParam), HIWORD(Msg.lParam));
if (Node <> nil) and (Node.Data <> nil) then Hint:= TGFavorite(Node.Data).Url;
end;
end;
end;
end;

procedure TCustomGFavoritesTree.DeleteNode(Node: TTreeNode);
begin
if (Node = nil) or (Node.Data = nil) or not TGFavorite(Node.Data).CanDelete then exit;
if TGFavorite(Node.Data).Delete then
Node.Delete;
end;

procedure TCustomGFavoritesTree.EditNode(Node: TTreeNode);
begin
if (Node = nil) or (Node.Data = nil) then exit;
Node.Selected:= True;
Node.EditText;
end;

procedure TCustomGFavoritesTree.OrganizeFavorites;
var
H: HWnd;
p: procedure(Handle: THandle; Path: PChar); stdcall;
begin
H:= LoadLibrary(PChar('shdocvw.dll'));
if H <> 0 then begin
p:= GetProcAddress(H, PChar('DoOrganizeFavDlg'));
if Assigned(p) then p(Application.Handle, PChar(Favorites[0].FullFileName));
end;
FreeLibrary(h);
RefreshRoot;
end;

procedure TCustomGFavoritesTree.ExportFavorites;
var
Sh: ISHellUIHelper;
begin
Sh:= CreateComObject(CLSID_SHELLUIHELPER) as ISHELLUIHELPER;
sh.ImportExportFavorites(FALSE, '');
end;

procedure TCustomGFavoritesTree.ImportFavorites;
var
Sh: ISHellUIHelper;
begin
Sh:= CreateComObject(CLSID_SHELLUIHELPER) as ISHELLUIHELPER;
sh.ImportExportFavorites(TRUE, '');
RefreshRoot;
end;

function TCustomGFavoritesTree.GetIEVersion: Extended;
var
Reg: TRegistry;
S: string;
Code: integer;
begin
Reg:= TRegistry.Create;
with Reg do begin
RootKey:= HKEY_LOCAL_MACHINE;
OpenKey('Software/Microsoft/Internet Explorer', False);
if ValueExists('Version') then S:= ReadString('Version')
else S:= '0';
CloseKey;
Free;
end;
Val(System.Copy(S, 1, 3), Result, Code);
if Code <> 0 then Result:= 1.0;
end;

procedure TCustomGFavoritesTree.SetShowUrlHint(Value: Boolean);
begin
FShowUrlHint:= Value;
if Value then ShowHint:= True;
end;

end.
 
//和网上其它的 Favorites 控件和 Delphi 6 所带的 TShellTreeView 相比,本控件主要有以下优点
//1:支持处理多语言的文件名(但由于delphi的原因,不能正确显示除英文和 system local language 以外的语言)
//2:提供了对 TreeView 的 rename, delete 操作,并且结果能正确的反应在你的 Favorites 中
//3:提供了比较好的用户界面,如:右键选择节点,使用了 shellimage
//4:提供了比较好的编程接口,如:ShowUrlHint , OnUrlClick, Import, Export 等等

//您可以任意使用这个控件,如果您修改了代码,请给我一份 copy, 如果您发现了 bug 或者想追加什么功能,请告诉我 l940801@yahoo.com

//警告:虽然到目前为止还没有发现 bug, 但测试并不充分,对于您使用这个控件所造成的一切后果,本人不承担任何责任

//一点说明:有的地方处理的比较复杂,主要是基于以下两个原因
//1:速度,2:多语言文件名支持

//由于使用了 Shell Image,如果您某一个 favorites dir 下 favorites 比较多的话,
//当打开这个目录的时候,速度要慢一些,如果您不满意,可以修改程序为不使用
 
我的问题是
在 procedure TCustomGFavoritesTree.Loaded;
我使用了 if (csDesigning in ComponentState) then Exit; 来避免设计时显示 favorites,
这实在是不得已,因为我曾经尝试让控件在设计期就能显示 favorites,
设计时没问题,但运行的时候总是要报错,开始以为可能是 window handle 创建次序问题,
但我参考 TShellTreeView,override 了 CreateWnd, DestroyWnd 等等方法之后还是没法解决
这个问题,现在的控件代码是没有问题的,只是没法在设计期显示 node 而已,
还请高手帮我改改,让它在设计期也能显示 favorites,感激不尽,送上 200 大洋聊表心意。
 
to 940801:
你好!做得不错!我改了一下,可以在设计时看到效果了,已经发了一份给你.请查收.
 
bbkxjy,谢谢,你的改动确实解决了问题,不过李颖兄在 cndev.net
提出了一种另一种简单的改法:
http://www.cndev.net/club/tc06PeT/view/delphi/12376.html

1。
property Items; 改为 property Items stored false; //不保存节点信息
2。
override CreateWnd, 将 Loaded 中的代码移到 CreateWnd 中,去掉 Loaded 方法


btw: 我个人认为 Delphi 的 TShellTreeView 中有不少多余的代码
例如 DestroyWnd,WMDestory 就没有必要了,因为 Destroy 中有 ClearItems 的调用。

如果你感兴趣,不知你注意到没有 TShellTreeView 在处理 history 的时候有 bug,
而且也不支持多语言
所以我模仿 TShellTreeView 只保留了相关的功能做了一个 TGHistoryTree,
和 TGFavoritesTree 很相似,不过是用 PItemIDList 来实现的,也支持多语言。
如果你感兴趣,我就寄一个给你。此外我还在做一个 TGBookmarkTree,是读写 netscape
bookmark 的 TreeView, 功能很多,不过代码现在还有点乱
 
接受答案了.
 
后退
顶部