delphi WebBrowser1 delphi 開發瀏覽器字型大小:T|T
Delphi3開始有了TWebBrowser構件,不過那時是以ActiveX控制項的形式出現twebbrows activex
delphi的,而且需要自己引入,在其後的4.0和5.0中,它就在需要引入自己封裝好shdocvw.dll之後作為Internet構件組之一出現在構件面板上了。internet shdocvw
之一常常聽到有人罵Delphi的協助做得極差,這次的TWebBrowser又是Microsoft的東twebbrows microsoft
delphi東,自然
這裡有平時我自己用TWebBrowser做程式的一些心得和上網收集twebbrows 平時心得到的部分例子和資料,整理了一下,希望能給有興趣用TWebBrowsertwebbrows
資料希望編程的朋友帶來些協助。
-----------------------------------------------------------------
TWebBrowser控制項開啟本地網頁檔案,如何讓它不彈出警告
TWebBrowser控制項開啟
包含了js代碼本地的網頁檔案就會彈出錯誤對twebbrows 錯誤網頁話框
請問怎麼才能去掉這個對話方塊並且能執行js指令碼?<
type="text/JavaScript">alimama_pid="mm_10249644_1605763_5018464";
alimama_type="f";alimama_sizecode ="tl_1x1_8"; alimama_fontsize=12;
alimama_bordercolor="FFFFFF"; alimama_bgcolor="FFFFFF10249644 1605763 bgcolor";
alimama_titlecolor="0000FF"; alimama_underline=0; alimama_height=22;
alimama_width=0;< src="http://a.alimama.cn/inf.js"
type="text/javascript">
網友回複:TWebBrowser控制項開啟包含了js代碼的本地網頁檔案就會彈twebbrows 網頁代碼出錯誤對話方塊
請問怎麼才能去掉這個對話方塊並且能執行js指令碼?
看到一些郵件用戶端的編輯器就是調用了本地網頁檔案,編輯器客戶看到但是卻不彈出對話方塊
網友回複:TWebBrowser的OnDownloadComplete事件裡面執行
(WebBrowser1.Document
as IHTMLDocument2).parentWindow.execScript('window.onerror=function(){return
true}','JavaScript');
網友回複:謝謝ideation_shang
------------------------------------------------------------------
注意:
1、CSS對列印的控制:
<!--media=print
這個屬性可以在列印時有效-->
<style
media=print>
.Noprint{display:none;}
.PageNext{page-break-after:
always;}
</style>
Noprint樣式可以使頁面上的列印按鈕等不出現在列印頁面noprint 列印出現上,這一點非常重要,因為它可以用最少的程式碼完成最需重要可以代碼要的功能
PageNext樣式可以設定分頁,在需要分頁的地方<div class="PageNext">pagenext class
需要;</div>就OK了,呵呵
-----------------------------------------------------------------
WebBrowser.ExecWB(1,1)
開啟
WebBrowser.ExecWB(2,1) 關閉現在所有的IE視窗,並開啟一個新視窗
WebBrowser.ExecWB(4,1)
儲存網頁
WebBrowser.ExecWB(6,1) 列印
WebBrowser.ExecWB(7,1)
預覽列印
WebBrowser.ExecWB(8,1) 列印版面設定
WebBrowser.ExecWB(10,1)
查看頁面屬性
WebBrowser.ExecWB(15,1) 好像是撤銷,有待確認
WebBrowser.ExecWB(17,1)
全選
WebBrowser.ExecWB(22,1) 重新整理
WebBrowser.ExecWB(45,1)
關閉表單無提示
----------------------------------------------------------
1、初始化和終止化(Initialization
& Finalization)
大家在執行TWebBrowser的某個方法以進行期望的操作,如ExecWB等twebbrows execwb
操作的時候可能都碰到過“試圖啟用未註冊的丟失目標”或&ldquoldquo 丟失可能;OLE對象未註冊”等錯誤,或者並沒有出錯但是得不到希望得不到錯誤希望的結果,比如不能將選中的網頁內容複寫到剪貼簿等。以剪貼簿內容網頁前用它編程的時候,我發現ExecWB有時侯起作用但有時侯又不execwb
作用發現行,在Delphi產生的預設工程主視窗上加入TWebBrowser,運行時並不會twebbrows delphi 加入出現“OLE對象未註冊”的錯誤。同樣是一個偶然的機會,錯誤出現同樣我才知道OLE對象需要初始化和終止化(懂得的東東實在太初始化需要懂得少了)。
我用我的前一篇文章《Delphi程式視窗動畫&正常排列平delphi
正常排列鋪的解決》所說的方法編程,運行時出了上面所說的錯誤錯誤運行方法,我便猜想應該有OleInitialize之類的語句,於是,找到並加上了下oleiniti
之類於是面幾句話,終於搞定!究其原因,我想大概是由於TWebBrowser是一twebbrows 終於原因個嵌入的OLE對象而不算是用Delphi編寫的VCL吧。
Initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;
這幾句話放在主視窗所有語句之後,“end.”之前。
-----------------------------------------------------------------------------------
2、EmptyParam
在Delphi 5中TWebBrowser的Navigate方法被多次重載:
procedure Navigate(const URL: WideString); overload;
procedure
Navigate(const URL: WideString; var Flags: OleVariant); overload;
procedure
Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName:
OleVariant); overload;
procedure Navigate(const URL: WideString; var
Flags: OleVariant; varTargetFrameName: OleVariant; var PostData:
OleVariant); overload;
procedure Navigate(const URL: WideString; var Flags:
OleVariant; varTargetFrameName: OleVariant; var PostData: OleVariant; var
Headers:OleVariant); overload;
而在實際應用中,使用後幾種方法調用時,由於我們使用應用方法很少用到後面幾個參數,但函式宣告又要求是變數參數,參數聲明後面一般的做法如下:
var
t:OleVariant;
begin
webbrowser1.Navigate(edit1.text,t,t,t,t);
end;
需要定義變數t(還有很多地方要用到它),很麻煩需要定義變數。其實我們可以用EmptyParam來代替(EmptyParam是一個公用的Variant空變數,emptyparam variant
公用不要對它賦值),只需一句話就可以了:
webbrowser1.Navigate(edit1.text,EmptyParam,EmptyParam,EmptyParam,EmptyParam);
雖然長一點,但比每次都定義變數方便得多。當然,雖然方便定義也可以使用第一種方式。
Webbrowser1.Navigate(edit1.text)
-----------------------------------------------------------------------------------
3、命令操作
常用的命令操作用ExecWB方法即可完成,ExecWBexecwb 操作命令同樣多次被重載:
procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT);
overload;
procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT; var
pvaIn:
OleVariant); overload;
procedure ExecWB(cmdID: rOLECMDID;
cmdexecopt: OLECMDEXECOPT; var pvaIn:
OleVariant; var pvaOut:
OleVariant); overload;
開啟: 彈出“開啟Internet地址”對話方塊,CommandID為OLECMDID_OPEN(若commandid olecmdid
internet瀏覽器版本為IE5.0,則此命令不可用)。
另存新檔:調用“另存新檔”對話方塊。
ExecWB(OLECMDID_SAVEAS,OLECMDEXECOPT_DODEFAULT,
EmptyParam,
EmptyParam);
列印、預覽列印和版面設定: 調用“列印”、“打列印設定調用印預覽”和“版面設定”對話方塊(IE5.5及以上版本才支對話方塊設定以上持預覽列印,故實現應該檢查此命令是否可用)。
ExecWB(OLECMDID_PRINT,
OLECMDEXECOPT_DODEFAULT, EmptyParam,
EmptyParam);
if
QueryStatusWB(OLECMDID_PRINTPREVIEW)=3
then
ExecWB(OLECMDID_PRINTPREVIEW,
OLECMDEXECOPT_DODEFAULT,
EmptyParam,EmptyParam);
ExecWB(OLECMDID_PAGESETUP,
OLECMDEXECOPT_DODEFAULT, EmptyParam,
EmptyParam);
剪下、複製、粘貼、全選: 功能無須多說,需要注需要剪下粘貼意的是:剪下和粘貼不僅對編輯框文字,而且對網頁上的文字網頁粘貼非編輯框文字同樣有效,用得好的話,也許可以做出功能文字也許可以特殊的東東。獲得其命令使能狀態和執行命令的方法有兩命令方法執行種(以複製為例,剪下、粘貼和全選分別將各自的關鍵字關鍵字分別粘貼替換即可,分別為CUT,PASTE和SELECTALL):
A、用TWebBrowser的QueryStatusWB方法。
If(QueryStatusWB(OLECMDID_COPY)=OLECMDF_ENABLED)
or
OLECMDF_SUPPORTED) then
ExecWB(OLECMDID_COPY,
OLECMDEXECOPT_DODEFAULT,
EmptyParam,
EmptyParam);
B、用IHTMLDocument2的QueryCommandEnabled方法。
Var
Doc:
IHTMLDocument2;
begin
Doc :=WebBrowser1.Document as
IHTMLDocument2;
if Doc.QueryCommandEnabled('Copy')
then
Doc.ExecCommand('Copy',false,EmptyParam);
end;
尋找: 參考第九條“尋找”功能。
-----------------------------------------------------------------------------------
4、字型大小
類似“字型”菜單上的從“最大”到“最小”五項(菜單類似對應整數0~4,Largest等假設為五個功能表項目的名字,Tag 屬性largest
整數對應分別設為0~4)。
A、讀取當前頁面字型大小。
Var
t:
OleVariant;
Begin
WebBrowser1.ExecWB(OLECMDID_ZOOM,
OLECMDEXECOPT_DONTPROMPTUSER,
EmptyParam,t);
case t
of
4: Largest.Checked :=true;
3: Larger.Checked
:=true;
2: Middle.Checked :=true;
1: Small.Checked
:=true;
0: Smallest.Checked
:=true;
end;
end;
B、設定頁面字型大小。
Largest.Checked
:=false;
Larger.Checked :=false;
Middle.Checked
:=false;
Small.Checked :=false;
Smallest.Checked
:=false;
TMenuItem(Sender).Checked :=true;
t
:=TMenuItem(Sender).Tag;
WebBrowser1.ExecWB(OLECMDID_ZOOM,
OLECMDEXECOPT_DONTPROMPTUSER,
t,t);
-----------------------------------------------------------------------------------
5、添加到收藏夾和整理收藏夾
const
CLSID_ShellUIHelper: TGUID =
'{64AB4BB7-111E-11D1-8F79-00C04FCtguid clsid 1112FBE1}';
var
p:procedure(Handle: Thandle; Path: Pchar); stdcall;
procedure TForm1.OrganizeFavorite(Sender: Tobject);
var
H:
HWnd;
begin
H := LoadLibrary(Pchar('shdocvw.dll'));
if H
<> 0 then
begin
p := GetProcAddress(H,
Pchar('DoOrganizeFavDlg'));
if Assigned(p) then p(Application.Handle,
Pchar(FavFolder));
end;
FreeLibrary(h);
end;
procedure
TForm1.AddFavorite(Sender: Tobject);
var
ShellUIHelper:
ISHellUIHelper;
url, title: Olevariant;
begin
Title :=
Webbrowser1.LocationName;
Url := Webbrowser1.LocationUrl;
if Url
<> ' then
begin
ShellUIHelper :=
CreateComObject(CLSID_SHELLUIHELPER) as
IShellUIHelper;
ShellUIHelper.AddFavorite(url,
title);
end;
end;
用上面的通過ISHellUIHelper介面來開啟“添加到收藏夾”對話方塊對話方塊介面收藏的方法比較簡單,但是有個缺陷,就是開啟的視窗不是模比較方法缺陷式視窗,而是獨立於應用程式的。可以想象,如果使用與使用應用可以OrganizeFavorite過程同樣的方法來開啟對話方塊,由於可以指定父視窗的對話方塊方法可以控制代碼,自然可以實現強制回應視窗(效果與在資源管理員和IE效果模式可以中開啟“添加到收藏夾”對話方塊相同)。問題顯然是這樣對話方塊這樣問題的,上面兩個過程的作者當時只知道shdocvw.dll中DoOrganizeFavDlg的原型而不shdocvw
原型當時知道DoAddToFavDlg的原型,所以只好用ISHellUIHelper介面來實現(或許是他不夠介面原型不夠嚴謹,認為是否是強制回應視窗無所謂?)。
下面的過程就告訴你DoAddToFavDlg的函數原型。需要注意的是,需要告訴注意這樣開啟的對話方塊並不執行“添加到收藏夾”的操作,它對話方塊這樣操作只是告訴應用程式使用者是否選擇了“確定”,同時在DoAddToFavDlg的告訴應用確定第二個參數中返回使用者希望放置Internet捷徑的路徑,建立internet 參數第二.Url檔案的工作由應用程式自己來完成。
Procedure TForm1.AddFavorite(IE: TEmbeddedWB);
procedure
CreateUrl(AUrlPath, Aurl: Pchar);
var
URLfile:
TIniFile;
begin
URLfile :=
TIniFile.Create(String(AUrlPath));
Rlfile.WriteString('InternetShortcut', 'URL', String(Aurl));
Rlfile.Free;
end;
var
AddFav: function(Handle:
Thandle;
UrlPath: Pchar; UrlPathSize: Cardinal;
Title: Pchar;
TitleSize: Cardinal;
FavIDLIST: pItemIDList): Bool;
stdcall;
Fdoc: IHTMLDocument2;
UrlPath, url, title:
array[0..MAX_PATH] of char;
H: HWnd;
pidl:
pItemIDList;
FRetOK: Bool;
begin
Fdoc :=
IHTMLDocument2(IE.Document);
if Fdoc = nil then
exit;
StrPCopy(Title, Fdoc.Get_title);
StrPCopy(url,
Fdoc.Get_url);
if Url <> ' then
begin
H :=
LoadLibrary(Pchar('shdocvw.dll'));
if H <> 0
then
begin
SHGetSpecialFolderLocation(0, CSIDL_FAVORITES,
pidl);
AddFav := GetProcAddress(H,
Pchar('DoAddToFavDlg'));
if Assigned(AddFav) then
FRetOK
:=AddFav(Handle, UrlPath, Sizeof(UrlPath), Title, Sizeof(Title),
pidl)
end;
FreeLibrary(h);
if FRetOK
then
CreateUrl(UrlPath, Url);
end
end;
-----------------------------------------------------------------------------------
6、使WebBrowser獲得焦點
TWebBrowser非常特殊,它從TWinControl繼承來的SetFocus方法並不能使得它所twebbrows setfocu 方法包含的文檔獲得焦點,從而不能立即使用Internet
Explorer本身具有得internet explor
使用快速鍵,解決方案如下:<
procedure TForm1.SetFocusToDoc;
begin
if WebBrowser1.Document
<> nil then
with WebBrowser1.Application as Ioleobject
do
DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle,
GetClientRect);
end;
除此之外,我還找到一種更簡單的方法,這裡一併列除此之外這裡並列出:
if WebBrowser1.Document <> nil
then
IHTMLWindow2(IHTMLDocument2(WebBrowser1.Document).ParentWindow).focus
剛找到了更簡單的方法,也許是最簡單的:
if WebBrowser1.Document <> nil
then
IHTMLWindow4(WebBrowser1.Document).focus
還有,需要判斷文檔是否獲得焦點這樣來做:
if IHTMLWindow4(WebBrowser1.Document).hasfocus then
-----------------------------------------------------------------------------------
7、點擊“提交”按鈕
如同程式裡每個表單上有一個“預設”按鈕一樣,Web一樣按鈕每個頁面上的每個Form也有一個“預設”按鈕——即屬性為“Submitsubmit form
按鈕”的按鈕,當使用者按下斷行符號鍵時就相當於按一下滑鼠了“Submitsubmit
斷行符號鍵相當”。但是TWebBrowser似乎並不響應斷行符號鍵,並且,即使把包含TWebBrowser的twebbrows
斷行符號鍵似乎表單的KeyPreview設為True,在表單的KeyPress事件裡還是不能截獲使用者向keypreview keypress
事件TWebBrowser發出的按鍵。
我的解決辦法是用ApplicatinEvents構件或者自己編寫Tapplication對象的OnMessage事onmessag tapplic
構件件,在其中判斷訊息類型,對鍵盤訊息做出響應。至於點至於響應判斷擊“提交”按鈕,可以通過分析網頁原始碼的方法來實現原始碼網頁方法,不過我找到了更為簡單快捷的方法,有兩種,第一種是更為不過方法我自己想出來的,另一種是別人寫的代碼,這裡都提供給自己這裡出來大家,以做參考。
A、用SendKeys函數向WebBrowser發送斷行符號鍵
在Delphi5光碟片上的Info/Extras/SendKeys目錄下有一個SndKey32.pas檔案,sendkei delphi
sndkei其中包含了兩個函數SendKeys和AppActivate,我們可以用SendKeys函數來向WebBrowser發appactiv webbrows
sendkei送斷行符號鍵,我現在用的就是這個方法,使用很簡單,在WebBrowserwebbrows 斷行符號鍵使用獲得焦點的情況下(不要求WebBrowser所包含的文檔獲得焦點),webbrows 焦點包含用一條語句即可:
Sendkeys('~',true);// press RETURN key
SendKeys函數的詳細參數說明等,均包含在SndKey32.pas檔案中sendkei sndkei 參數。
B、在OnMessage事件中將接受到的鍵盤訊息傳遞給WebBrowser。
Procedure TForm1.ApplicationEvents1Message(var Msg: TMsg; var Handled:
Boolean);
{fixes the malfunction of some keys within webbrowser
control}
const
StdKeys = [VK_TAB, VK_RETURN]; { standard keys
}
ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT]; { extended keys
}
fExtended = $01000000; { extended key flag }
begin
Handled
:= False;
with Msg do
if ((Message >= WM_KEYFIRST) and (Message
<= WM_KEYLAST)) and
((wParam in StdKeys) or
{$IFDEF
VER120}(GetKeyState(VK_CONTROL) < 0) or {$ENDIF}
(wParam in ExtKeys)
and
((lParam and fExtended) = fExtended)) then
try
if
IsChild(Handle, hWnd) then { handles all browser related messages
}
begin
with {$IFDEF
VER120}Application_{$ELSE}Application{$ENDIF}
as
IOleInPlaceActiveObject do
Handled :=
TranslateAccelerator(Msg) = S_OK;
if not Handled
then
begin
Handled :=
True;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
except
end;
end;
// MessageHandler
(此方法來自EmbeddedWB.pas)
-----------------------------------------------------------------------------------
8、直接從TWebBrowser得到網頁源碼及Html
下面先介紹一種極其簡單的得到TWebBrowser正在訪問的網頁源twebbrows
極其得到碼的方法。一般方法是利用TWebBrowser控制項中的Document對象提供的IPersistStreamInit接twebbrows document
一般口來實現,具體就是:先檢查WebBrowser.Document對象是否有效,無效則document webbrows
檢查退出;然後取得IPersistStreamInit介面,接著取得HTML源碼的大小,分配全域全域大小分配堆記憶體塊,建立流,再將HTML文本寫到流中。程式雖然不算雖然建立記憶體複雜,但是有更簡單的方法,所以實現代碼不再給出。其方法代碼所以實基本上所有IE的功能TWebBrowser都應該有較為簡單的方法來實現twebbrows
較為基本,擷取網頁源碼也是一樣。下面的代碼將網頁源碼顯示在下面顯示一樣Memo1中。
Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);
同時,在用TWebBrowser瀏覽HTML檔案的時候要將其儲存為文本文twebbrows 瀏覽本檔案就很簡單了,不需要任何的文法解析工具,因為TWebBrowser也完twebbrows 工具需要成了,如下:
Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterText);
-----------------------------------------------------------------------------------
9、“尋找”功能
尋找對話方塊可以在文檔獲得焦點的時候通過按鍵Ctrl-F對話方塊焦點按鍵來調出,程式中則調用IOleCommandTarget對象的成員函數Exec執行OLECMDID_FIND操作olecmdid
操作執行來調用,下面給出的方法是如何在程式中用代碼來做出文下面方法如何字選擇,即你可以自己設計尋找對話方塊。
Var
Doc: IHtmlDocument2;
TxtRange:
IHtmlTxtRange;
begin
Doc :=WebBrowser1.Document as
IHtmlDocument2;
Doc.SelectAll; //此處為簡寫,選擇全部文檔的方法selectal
方法文檔請參見第三條命令操作
//這句話尤為重要,因重要尤為為IHtmlTxtRange對象的方法能夠操作的前提是
//Document已經有一個文字選document
文字一個擇地區。由於接著執行下面的語句,所以不會
//看到文檔全選的過程看到過程文檔。
TxtRange
:=Doc.Selection.CreateRange as IHtmlTxtRange;
TxtRange.FindText('Text to
be searched',0.0);
TxtRange.Select;
end;
還有,從Txt.Get_text可以得到當前選中的文字內容,某些得到文字當前時候是有用的。
-----------------------------------------------------------------------------------
10、提取網頁中所有連結
這個方法來自大富翁論壇hopfield朋友的對一個問題的回答hopfield 自大問題,我本想自己實驗,但總是沒成功。
Var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,I:integer;
item:OleVariant;
begin
doc:=WebBrowser1
.Document as
IHTMLDocument2;
all:=doc.Get_links; //doc.Links亦可
len:=all.length;
for
I:=0 to len-1 do
begin
item:=all.item(I,varempty); //EmpryParam亦可
memo1.lines.add(item.href);
end;
end;
-----------------------------------------------------------------------------------
11、設定TWebBrowser的編碼
為什麼我總是錯過很多機會?其實早就該想到的,但為什麼錯過想到是一念之差,便即天壤之別。當時我要是肯再多考慮一下一念之差天壤之別當時,多實驗一下,這就不會排到第11條了。下面給出一個下面實驗一個函數,搞定,難以想象的簡單。
Procedure SetCharSet(AWebBrowser: TWebBrowser; ACharSet:
String);
var
RefreshLevel:
OleVariant;
Begin
IHTMLDocument2(AWebBrowser.Document).Set_CharSet(ACharSet);
RefreshLevel
:=7; //這個7應該從這個應該註冊表來,協助有Bug。
AWebBrowser.Refresh2(RefreshLevel);
End;
12、從WEBBOWSER中直接存為MHT代碼
procedure WB_SaveAs_MHT(WB: TWebBrowser; FileName: string);
var
Msg:
IMessage;
Conf: IConfiguration;
Stream: _Stream;
URL: widestring;
{
_Stream定義在ADODB_TLB單元.IMessage和IConfiguration介面代碼來自cdosys.dll.
CDO_TLB產生過程:選擇菜單PROJECT中的"Import
Type Library", 然後選擇"C:/WINDOWS/system32librari project system/cdosys.dll"
檔案,按下"Create
unit"按鈕.}
begin
if not Assigned(WB.Document) then Exit;
URL :=
WB.LocationURL;
Msg := CoMessage.Create;
Conf :=
CoConfiguration.Create;
try
Msg.Configuration :=
Conf;
Msg.CreateMHTMLBody(URL, cdoSuppressAll, '', '');
Stream :=
Msg.GetStream;
Stream.SaveToFile(FileName,
adSaveCreateOverWrite);
finally
Msg := nil;
Conf := nil;
Stream :=
nil;
end;
end; (* WB_SaveAs_MHT *)<
type="text/JavaScript"><script type="text/JavaScript">
alimama_pid="mm_10249644_1605763_5027492"; alimama_type="f";alimama_sizecode
="tl_1x5_8"; alimama_fontsize=1210249644 5027492 1605763;
alimama_bordercolor="FFFFFF"; alimama_bgcolor="FFFFFF";
alimama_titlecolor="0000FF"; alimama_underline=0; alimama_height=22;
alimama_width=0;< src="http://a.alimama.cn/inf.js"
type="text/javascript">