怎样生成收藏夹菜单!帮帮我吧!(15分)

  • 主题发起人 主题发起人 jericho3164
  • 开始时间 开始时间
J

jericho3164

Unregistered / Unconfirmed
GUEST, unregistred user!
.我在菜单栏上设计了和IE一样的收藏夹的菜单,已经设计好了“添加到收藏夹和整理收藏夹”,但是我不会写下面的那种动态生成的收藏夹内的网址,那是怎么办的?希望给出详细的代码!
俺只有15分了,希望大家帮帮我吧!
 
15分太少了[:D]
 
http://torry.net/vcl/menus/menuenhancments/favorites.zip有此免费控件
------------------
TFavoritesMenu v.1.1 FWS 220 Kb 30 Jul 2001
By Roberto Cardentey Ruiz. VCL component show a Menu with all your favorites internet link present in your Favorite directory (Internet Explorer only).
Fully functional
Source: Included
Exe-demo included


Download: D5 D6

 
procedure TMainForm.FavItemClick(Sender: TObject);
var
i:Integer;
WorkDir:String;
begin
for i:=TMenuItem(Sender).Count-1 downto 3 do
TMenuItem(Sender).Delete(i);
WorkDir:=GetFavDir;
CreateFavMenu(WorkDir,FavItem);
end;

function TMainForm.GetFavDir: String;
//获得收藏夹的目录
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders', False) then
Result :=Reg.ReadString('Favorites');
finally
Reg.CloseKey;
Reg.Free;
End;
end;


procedure TMainForm.CreateFavMenu(Const WorkDir:String;Var MenuItem:TMenuItem);
var
SearchRec:TSearchRec;
FWorkDir:String;
SubMenuItem:TMenuItem;
begin
FWorkDir :=WorkDir;
if (FindFirst(FWorkDir +'/*.*', faDirectory,SearchRec)=0) then
begin
repeat
if (SearchRec.Attr and faDirectory = faDirectory) then
Begin
if (SearchRec.Name <>'.')and (SearchRec.Name <>'..') then
begin
SubMenuItem:=TMenuItem.Create(Application);
SubMenuItem.Caption :=SearchRec.Name;
SubMenuItem.ImageIndex:=21;
MenuItem.Add(SubMenuItem);
CreateFavMenu(FWorkDir+'/'+SearchRec.Name,SubMenuItem);
end;
end;
until FindNext(SearchRec) <> 0;
end;
FindClose(SearchRec);

if (FindFirst(FWorkDir +'/*.*', faDirectory,SearchRec)=0) then
begin
repeat
if (SearchRec.Attr and faDirectory <> faDirectory) then
begin
SubMenuItem:=TMenuItem.Create(MenuItem);
SubMenuItem.Caption :=Copy(SearchRec.Name,1,Length(SearchRec.Name)-4);
SubMenuItem.ImageIndex:=22;
if Length(SubMenuItem.Caption) >25 then
SubMenuItem.Caption :=Copy(SubMenuItem.Caption,1,25)+'...';
SubMenuItem.Hint :=GetUrlFileURL(FWorkDir,SearchRec.Name);
SubMenuItem.OnClick :=MenuItem_FaClick;
MenuItem.Add(SubMenuItem);
end;
until FindNext(SearchRec) <> 0;
End;
FindClose(SearchRec);
end;

这是我以前写的代码,你看一下。
 
基本同意
 
多人接受答案了。
 

Similar threads

回复
0
查看
1K
不得闲
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
825
DelphiTeacher的专栏
D
D
回复
0
查看
831
DelphiTeacher的专栏
D
后退
顶部