1.uses ActiveX//加上ActiveX单元initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;这些代码加在 end. 前!2.遍历收藏夹目录取出所有文件动态添加到菜单上!
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;这些代码加在 end. 前!2.遍历收藏夹目录取出所有文件动态添加到菜单上!
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;implementationuses Registry, Inifiles;{ 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[i] = 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.
ehom(？！) 兄：
我用USEs Activex ，编辑时，报错呀。而且你说把初始化语写在END前，是什么意思，可以详细点描述吗？
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus;一般程序前,不都有这些东东?加个Activex单元(其实OLE2也可以!^_^)!
然后所有程序最后不都有个"end."?
initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;
加在那个"end."前!
TO
ehom(？！) 兄：编辑菜单的查找（在当前网页）功能应该怎么实现。好像用WebBrowser1.ExecWB(OLECMDID_FIND, OLECMDEXECOPT_PROMPTUSER);
不行。
我在吗？
DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle, GetClientRect);上面程序可以让WebBrowser获得焦点!
然后用SendKeys函数向WebBrowser发送Ctrl+F使用IOleCommandTarget接口的成员函数
var
VI, VO: OleVariant;
IECommand: IOleCommandTarget;IECommand := WebBrowser1.Document as IOleCommandTarget;
IECommand.Exec(nil, OLECMDID_FIND,OLECMDEXECOPT_DODEFAULT, VI,VO);也可以自己写代码
var
Doc: IHtmlDocument2;
TxtRange: IHtmlTxtRange;
begin
Doc :=WebBrowser1.Document as IHtmlDocument2;
Doc.SelectAll;
TxtRange :=Doc.Selection.CreateRange as IHtmlTxtRange;
TxtRange.FindText('Test',0.0);
TxtRange.Select;
end;
ehom(？！) 兄：var
VI, VO: OleVariant;
IECommand: IOleCommandTarget;
begin
with WebBrowser1.Application as IOleobject do
DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle, GetClientRect);
//上面程序可以让WebBrowser获得焦点!
//然后用SendKeys函数向WebBrowser发送Ctrl+F
//使用IOleCommandTarget接口的成员函数
IECommand := WebBrowser1.Document as IOleCommandTarget;
IECommand.Exec(nil, OLECMDID_FIND,OLECMDEXECOPT_DODEFAULT, VI,VO);
end;
但是执行这段话，网页上一点反映都没有呀，是什么原因呀？
var
VI, VO: OleVariant;
IECommand: IOleCommandTarget;IECommand := WebBrowser1.Document as IOleCommandTarget;
IECommand.Exec(nil, OLECMDID_FIND,OLECMDEXECOPT_DODEFAULT, VI,VO);那就用第一和第三种方法!