webbrowser和菜单的问题,等着结贴,要快呀(100分)

  • 主题发起人 sjt61991
  • 开始时间
S

sjt61991

Unregistered / Unconfirmed
GUEST, unregistred user!
//收藏夹单元
unit FavoritesMenu;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus;

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

TFavoritesMenu = class(TComponent) //收藏主菜单类
private
{ Private declarations }
FMenuItem: TMenuItem; //菜单项
FMaxLength: integer;
FOnUrlClick: TUrlNotifyEvent;
FImageFolder: integer;
FImageUrl: integer;
FSorted: boolean;
procedure FillFavorites(Directory: string; AMenuItem: TMenuItem);
function CreateMenuOption(AFileName: string; AMenuItem: TMenuItem):
TMenuItem;
function CreateMenuOptionDir(AFileName: string;
AMenuItem: TMenuItem): TMenuItem;
procedure DoClickUrl(Sender: TObject);
function ReadUrl(AFileName: string): string;
protected
{ Protected declarations }
procedure Notification(AComponent: TComponent; Operation: TOperation);
override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure Refresh;
published
{ Published declarations }
property MenuItem: TMenuItem read FMenuItem write FMenuItem;
property MaxLength: integer read FMaxLength write FMaxLength default 30;
property ImageFolder: integer read FImageFolder write FImageFolder default 0;
property ImageUrl: integer read FImageUrl write FImageUrl default 1;
property OnUrlClick: TUrlNotifyEvent read FOnUrlClick write FOnUrlClick;
property Sorted: boolean read FSorted write FSorted default True;
end;

implementation

uses Registry, Inifiles,unit1;

{ TFavoritesMenu }

constructor TFavoritesMenu.Create(AOwner: TComponent);
begin
inherited;
FMaxLength := 30;
FImageFolder := 0;
FImageUrl := 1;
FSorted := True;
end;

procedure TFavoritesMenu.DoClickUrl(Sender: TObject);
begin
if Assigned(FOnUrlClick) then FOnUrlClick(Sender, TMenuItem(Sender).Hint);

end;

function TFavoritesMenu.ReadUrl(AFileName: string): string;
var
Reg: TIniFile;
begin
Reg := TIniFile.Create(AFileName);
result := Reg.ReadString('InternetShortcut', 'URL', 'non url');
Reg.Free;
end;

function TFavoritesMenu.CreateMenuOption(AFileName: string; AMenuItem:
TMenuItem): TMenuItem;
var
Item: TMenuItem;
Cap: string;
Url: string;
begin
Item := TMenuItem.Create(AMenuItem);
Cap := Copy(ExtractFileName(AFileName), 1,
Length(ExtractFileName(AFileName)) - 4);
if Length(Cap) > FMaxLength then
Cap := Copy(Cap, 1, FMaxLength) + '..';
Item.ImageIndex := FImageUrl;
Item.Caption := Cap;
Item.Hint := ReadUrl(AFileName);
Item.OnClick := DoClickUrl;
AMenuItem.Add(Item);
result := Item;
end;

function PosRight(sub: char; s: string): integer;
var
i: integer;
begin
result := -1;
for i := Length(s) downto 1 do
if s = sub then
begin
result := i;
break;
end;
end;

function TFavoritesMenu.CreateMenuOptionDir(AFileName: string; AMenuItem:
TMenuItem): TMenuItem;
var
Item: TMenuItem;
p: integer;
begin
Item := TMenuItem.Create(AMenuItem);
p := PosRight('/', AFileName);
Item.Caption := Copy(AFileName, p + 1, Length(AfileName));
Item.ImageIndex := FImageFolder;
if FSorted then
AMenuItem.Insert(0, Item)
else
AMenuItem.Add(Item);
result := Item;
end;

procedure TFavoritesMenu.FillFavorites(Directory: string; AMenuItem: TMenuItem);
var
search: TSearchRec;
Item: TMenuItem;
begin
if Directory[length(Directory)] <> '/' then Directory := Directory + '/';
if FindFirst(Directory + '*.*', faArchive + fadirectory, search) = 0 then
begin
repeat
if ((search.Attr and fadirectory) = fadirectory) and (search.name[1] <>
'.') then
begin
Item := CreateMenuOptionDir(Directory + search.Name, AMenuItem);
FillFavorites(Directory + search.Name, Item);
end
else if ((search.Attr and faArchive) = faArchive) then
CreateMenuOption(Directory + search.Name, AMenuItem);
until FindNext(search) <> 0;
FindClose(search);
end;
end;

procedure TFavoritesMenu.Refresh;
var
Reg: TRegistry;
InitDir: string;
begin
Reg := TRegistry.Create;
Reg.OpenKey('Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders', false);
InitDir := Reg.ReadString('Favorites');
Reg.Free;
FillFavorites(InitDir, FMenuItem);
end;

procedure TFavoritesMenu.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (Operation = opRemove) and (AComponent = FMenuItem) then FMenuItem := nil;
end;

end.
//---------------主窗体单元----
var
fMenu: TFavoritesMenu;
procedure TForm1.FormCreate(Sender: TObject);

begin
fmenu:=TFavoritesmenu.Create(self);

fmenu.MenuItem:=na1;
fmenu.ImageFolder:=1;
fmenu.ImageUrl:=0;
fmenu.Sorted:=true;
fmenu.Refresh;
end;
请问如何实现在主单元中生成的菜单中单击菜单,在主窗体中的WEBBrowser1打开要对应的收藏夹的内容。
 
没有人知道吗?up 一下也好啊
 
up有分~!
 
路过,up
 
路人甲,UP
 
TFavoritesMenu 应该有个 onUrlclick 事件
procedure Tform1.onurlclick(Sender: TObject; Url: string);
begin
webbrowser1.Navigate(Url)
end;
 
多人接受答案了。
 

Similar threads

顶部