Add web browsing features to our program (continued)
Private sub mnufilesaveas_click ()
BRWWEBBROWSER.SETFOCUS
ON Error ResMe next
BRWWEBBROWSER.EXECWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT
'Save as
'The following is saved in the original way as
'Dim Sfile As String
'
'
'With dlgcommondialog
'.Dialogtitle = "Save As ..."
'.Cancelerror = false
'' .Filename = me.brwwebbrowser.locationname
'' Todo: Set the flag and properties of the CommON Dialog control
'.Filter = "html file (* .html, *. Htm) | * .html; * HTM | text file (* .txt) | * .txt | ASP file (* .asp) | * .asp" & _
'"| Graphic file (* .bmp; *. Jpg; *. JPEG; *. Gif) | * .bmp; *. Jpg; *. Jpeg; *. Gif | All files (*. *) | *. * "
'.Showsave
'If len (.filename) = 0 THEN
'Exit Sub
'End if
'Sfile = .filename
'End with
'' Todo: Add the code that handles the open file
'Brwwebbrowser.navigate sfile
'
'' To do save as ...
End Sub
Private sub mnufileSetPage_click ()
BRWWEBBROWSER.SETFOCUS
ON Error ResMe next
BRWWEBBROWSER.EXECWB OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT
'page settings
End Sub
Private sub mnufileview_click ()
BRWWEBBROWSER.SETFOCUS
ON Error ResMe next
BRWWEBBROWSER.EXECWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT
'Printing preview
End Sub
Private sub mnufilework_click ()
Me.mnufilework.checked = not me.mnufilework.checked
Me.brwwebbrowser.offline = me.mnufilework.checked
'Offline
End Sub
First, WebBrowser control
WebBrowser controls can not only open web pages, but also open a lot of other formatting files and browse files on the hard disk. This is benefited from the OLE policy of MS.
When browsing a web page, the default is open with IE when the new window is opened, and the following code is turned on using a personal browser.
Private sub brwwebbrowser_newwindow2 (PPDISP Asbject, Cancel As Boolean)
DIM FRMWB AS frmmainexploer
Set frmwb = new frmmainexploerfrmwb.brwwebbrowser.registersbrowser = TRUE
Set ppdisp = frMwb.brwwebbrowser.object
FRMWB.Visible = TRUE
End Sub
Update window title
Private sub brwwebbrowser_titlechange (Byval Text As String)
Me.caption = text
End Sub
In the page, you may have the button's button, click it to close the instance of our webbrowser control, the following code is to avoid the occurrence.
Private sub brwwebbrowser_windowclosing (byval ischildwindow as boolean, ca Zonel as boolean)
If ischildwindow = false kil
Cancel = TRUE
Else
Cancel = false
END IF
End Sub
Useless code
Private sub mnuhelptest_click ()
BRWWEBBROWSER.SETFOCUS
ON Error ResMe next
BRWWEBBROWSER.EXECWB OLECMDID_NEW, OLECMDEXECOPT_DODEFAULT
End Sub
You can also open the API provided by the SHDOCVW.DLL with the shell to open the Internet option.
PRIVATE SUB mnutooloption_click ()
DIM DBLRETURN AS DOUBLE
DBLRETURN = shell ("rundll32.exe shell32.dll, control_rundll inetcpl.cpl, 0", 5)
End Sub
Full screen display, for the WebBrowser control.
Private sub mnuviewfullscreen_click ()
Me.brwwebbrowser.execwb olecmdid_zoom, Olecmdexecopt_dodefault
End Sub
Second, Internet Explorer Automation
The following code shows how to control an instance of Internet Explorer Automation.
DIM IE as Shdocvw.InterneTexplorer
'
'Set ie = createObject ("InternetExplorer.Application")' Create an instance
'' IE.NAVIGATE2 "C: /"
'IE.Fullscreen = false' is full screen
'Ie.visible = true
'IE.toolbar = true' Whether to display the toolbar
'Ie.menubar = true' Whether to display a menu
'IE.statusbar = true' Displays the status bar
'IE.Resizable = false' is variable window size.
In IE6, add a personal column, plus four browsing strips in the search bar, favorites, and history. The following is the code that controls the following four browsing strips.
'' Ie.showbrowserbar "{30D02401-6A81-11D0-8274-00C04FD5AE38}", TRUE
'' 'Ie.showbrowserbar "{EFA24E61-B078-11D0-89E4-00C04FC9E26E}", TRUE
'
'IE.SHOWBROWSERBAR "{EFA24E62-B078-11D0-89E4-00C04FC9E26E}", TRUE
'
'Ie.showbrowserbar "{EFA24E63-B078-11D0-89E4-00C04FC9E26E}", TRUE
Third, the grammatical explanation in mshtml
The following is a syntax analysis feature that uses MSHTML.DLL to simulate the code in the Borland special issue in the "Programmer Camp 2001".
DIM STRFILEPATH AS STRING
Dim withevents myie as shdocvw.internetExplorer
Private submmand1_click ()
ON Error ResMe next
Me.dlgopen.showopen
StrfilePath = DLGOPEN.FileName
Me.brwie.navigate2 strfilepath
End Sub
Private sub fascist2_click ()
'On Error Resume Next
DIM DOC AS IHTMLDocument2 'IHTML Document
SET DOC = Me.Brwie.Document
DIM Eles as htmlelementCollection 'IHTML Element Collection
DIM ELE AS IHTMLEMENT
DIM Strlink As String
Dim Ancho as htmlanchorelement 'Spear
DIM IMG As IhtmlimGElement
DIM I as integer
i = 0
List1.clear
IF doc is nothing then
'Msgbox "Document is nothing!"
Else
SET Eles = Doc.All
For Each ELE IN ELES
If Ele.Tagname = "a" THEN
Strlink = ele.innertext
IF strlink = "" "
Strlink = "EMPTY!"
END IF
Set ancho = ele
Strlink = Strlink & "-" & ancho.href
List1.addItem strlink
END IF
NEXT
Text1 = doc.mimetype
END IF
End Sub
Private sub flow_load ()
Set myie = creteObject ("InternetExplorer.Application)
Myie.visible = true
End Sub
Fourth, SHDOCVW.DLL and INETCPL API
Public const Max_path = 260
Public const csidl_favorites = & h6
Public Declare Function LaunchinternetControlPanel lib "inetcpl.cpl" (byval hwndparent as long) As long
Public Declare Function LaunchConnectionDialog LIB "INETCPL.CPL" (Byval Hwndparent As Long) As longpublic declare function launchsecuritydialog lib "inetcpl.cpl" (Byval Hwndparent As Long) As long
Public Declare Function LaunchsiteCertDialog Lib "inetcpl.cpl" (byval hwndparent as long) As long
Public Declare Function OpenFONTSDIALOG LIB "INETCPL.CPL" (Byval Hwndparent As Long) AS Long
Public Declare Function Doorganizefavdlg Lib "Shdocvw.dll" (Byval Hwndparent As String) AS LONG
Public Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" (ByVal hwndOwner As Long, ByVal lpszPath As String, ByVal nFolder As Long, ByVal fCreate As Long) As Long
Public Declare Function Doaddtofavdlg Lib "Shdocvw.dll" (Byval Hwndparent As String) AS LONG
Public Declare Function AddURLTOFAVORITES LIB "Shdocvw.dll" is a problem with the parameter definition of the function of this function.
'
'Private submmand1_click ()
'DIM RC AS Long
'' Displays the control panel of the Internet option
'Rc = launchinternetControlPanel (me.hwnd)
'Debug.print getLastError
'IF rc = 0 THEN
'MsgBox "LaunchinternetControlPanel Failed!", Vbexclamation
'End if
'End Sub
'
'Private sub command2_click ()
'DIM RC AS Long
The connection panel in the '' IE Control Panel
'Rc = launchConnectionDialog (me.hwnd)
'Debug.print getLastError
'IF rc = 0 THEN
'MsgBox "LaunchConnectionDialog Failed!", Vbexclamation
'End if
'End Sub
'
'Private submmand3_click ()
'DIM RC AS Long
Directory in 'DIM STRFAVPATH AS STRING * MAX_PATH' 'Favorites
'ShgetspecialFolderPath Me.hwnd, Strfavpath, CSIDL_FAVORITES, FALSE
Saturing favorites
'Rc = doorganizefavdlg (Me.hwnd, Strfavpath)
'Debug.print getLastError
'IF rc = 0 THEN
'Msgbox "Doorganizefavdlg Failed!", Vbexclamation
'End if
'End Sub
'
'Private sub command4_click ()
'DIM RC AS Long
'
'Rc = launchsitecertdialog (me.hwnd)
'Debug.print getLastError
'IF rc = 0 THEN
'Msgbox "launchsitecertdialog failed!", Vbexclamation
'End if
'End Sub
'
'
'' '
'Private submmand6_click ()
'DIM RC AS Long
'DIM STRFAVPATH AS STRING * MAX_PATH
'
'ShgetspecialFolderPath Me.hwnd, Strfavpath, CSIDL_FAVORITES, FALSE
'Add to your favorites, but the parameters of this function I have no experimental processing, it will be wrong.
'Rc = addurltofavorites (Me.hwnd, Trim (strfavpath))
'Debug.print getLastError
'IF rc = 0 THEN
'Msgbox "Doorganizefavdlg Failed!", Vbexclamation
'End if
'
'End Sub
to sum up
In fact, many articles have written this in this regard, I still write these experiences to everyone. It is because I want to sort out a relatively full thing to give you a reference. In fact, there are still many features I have not implemented, for example, how to block or change the right-click menu in WebBrowserControl, because webbrowser control does not provide hWnd to us; do not know how to get web code in the WebBrowser control, and implement full screen; Find in the webbrowser control; change the size of the web text, and encoding, etc. If you have any new discovery, remember to tell me (Mousebox@21cn.com).
