A VFP multi Tabs browser

Published on by Yousfi Benameur


This Is  a basic multiTab IE BrowseR On a Visual FoxPro top level Form.
    it have the capabilities as follow:
	-create dynamically a new tab providing url navigation
	-removing any tab
	-type any url in the textbox (its autocomplete one sorted history alphabetically: Sorts entries alphabetically and is not case sensitive.)
      can rightclick on the textbox  to paste the captured clipboard (_cliptext).
	-can gather custom urls in the comboBox combo1 to fire them quickly each one in new Tab.
	-Each tab is a child of a vfp pageframe and contains an olecontrol "shell.explorer.2" as activeX

	-the form have
	      -navigation with Forward and Goback if the navigation is internally in tab.
	      -refresh the page
	      -edit the source page as txt file
	      -remove any active tab
	      -fires page setup dialog
	      -Print/preview the active page(print is integrated in preview).if have a virtual printer installed (as pdfCreator) then can save the web page to pdf,png,jpg,txt....
	      -Search dialog in any page (warning: some sites  robots make the find  dialog appear but entierely disabled even when firing with CTRL+F)
	      -Save the page as (htm,html,mht or txt).
	      -Fires document properties
	      -Increase, decrease zoom level of the page or set the normal zoom.
	      -erase the autocomplete textbox history (reset it).its natively saved in home(7)+"autocomp.dbf"
	      -capture the active page URL in clipboard.

	Of course this is a basic multi Tabs browser.can make graphics bitmaps instead text,add more decorations and  functionalities,...

Note: navigators are great memory consumers particulary when many tabs are opened.(can see with the task manager what it returns.
Important: this code is tested on windows10 pro,vfp9 SP2 and IE11 emulation.

*Added update version on 19 december 2015.see code *2*.


Click on code to select [then copy] -click outside to deselect


*1*
*yIE_Tabs.prg

publi yform
yform=newObject("yIE_tabs")
yform.show
read events
retu
*
DEFINE CLASS yIE_Tabs AS form
    Top = 7
	Left = -18
	Height = 609
	Width = 993
	ShowWindow = 2
	ShowTips = .T.
	Caption = "yBrowser multi Tabs"
	WindowState = 2
	BackColor = RGB(0,0,0)
	zoom = 0
	Name = "Form1"

	ADD OBJECT pageframe1 AS pageframe WITH ;
		ErasePage = .T., ;
		PageCount = 1, ;
		Anchor = 15, ;
		Top = 31, ;
		Left = 0, ;
		Width = 996, ;
		Height = 581, ;
		TabOrientation = 0, ;
		Themes = .F., ;
		Name = "Pageframe1", ;
		Page1.FontBold = .T., ;
		Page1.Caption = "", ;
		Page1.BackColor = RGB(0,0,0), ;
		Page1.ForeColor = RGB(255,255,255), ;
		Page1.Name = "Page1"

	*ADD OBJECT asup.pageframe1.page1.olecontrol1 AS olecontrol WITH ;
		Top = 0, ;
		Left = 0, ;
		Height = 581, ;
		Width = 995, ;
		Anchor = 15, ;
		Name = "Olecontrol1"

	ADD OBJECT command1 AS commandbutton WITH ;
		Top = 0, ;
		Left = 568, ;
		Height = 25, ;
		Width = 62, ;
		Anchor = 768, ;
		Caption = "Add Tab", ;
		Default = .T., ;
		MousePointer = 15, ;
		BackColor = RGB(128,255,0), ;
		Name = "Command1"

	ADD OBJECT text1 AS textbox WITH ;
		Anchor = 768, ;
		Height = 25, ;
		Left = 2, ;
		SelectOnEntry = .T., ;
		Top = 1, ;
		Width = 565, ;
		AutoComplete = 1, ;
		tooltiptext="Type any valid URL here or paste with rightclick", ;
		Name = "Text1"

	ADD OBJECT combo2 AS combobox WITH ;
		FontSize = 8, ;
		Anchor = 768, ;
		Height = 25, ;
		Left = 636, ;
		ToolTipText = "Functionalities", ;
		Top = 1, ;
		Width = 132, ;
		DisplayCount = 15, ;
		Name = "Combo2"

	ADD OBJECT combo1 AS combobox WITH ;
		FontSize = 8, ;
		Anchor = 768, ;
		Height = 25, ;
		Left = 823, ;
		ToolTipText = "Custom Urls", ;
		Top = 1, ;
		Width = 156, ;
		Name = "Combo1"

	ADD OBJECT label1 AS label WITH ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontSize = 18, ;
		Anchor = 768, ;
		BackStyle = 0, ;
		Caption = "?", ;
		Height = 32, ;
		Left = 784, ;
		MousePointer = 15, ;
		Top = -3, ;
		Width = 17, ;
		ForeColor = RGB(0,255,0), ;
		Name = "Label1"

	PROCEDURE ycreatetab
		lparameters url,ynum
		if empty(url)
		url="about:blank"
		endi

		try
		with thisform.pageframe1
		local n,xpage
		n=.pagecount+1
		m.xpage="page"+trans(n)
		.addObject(m.xpage,"page")

		local m.url,m.xpage
		do case
		case ynum=1
		m.url=allt(thisform.text1.value)
		case ynum=2
		m.url=allt(thisform.combo1.value)
		endcase

		with eval("."+m.xpage)

		do case
		case lower(substr(m.url,1,7))=="http://"
		.caption=strtran("..."+substr(strtran(allt(m.url),"http://",""),1,25),"/","",1)
		case lower(substr(m.url,1,4))="www."
		.caption="..."+substr(strtran(allt(m.url),"www.",""),1,25)
		case lower(substr(m.url,1,11))="http://www."
		.caption=strtran("..."+substr(strtran(allt(m.url),"http://www.",""),1,25),"/","",1)
		case lower(substr(m.url,1,12))=="https://www."
		.caption=strtran("..."+substr(strtran(allt(m.url),"https://www.",""),1,25),"/","",1)
		otherwise
		.caption="..."+substr(allt(m.url),1,25)
		endcase

		.backcolor=0
		.forecolor=rgb(255,255,255)
		.fontbold=.t.
		.refresh
		.addobject("olecontrol1","olecontrol","shell.explorer.2")
		with .olecontrol1
		.left=0
		.top=5
		.width=.parent.parent.width
		.height=.parent.parent.height
		.anchor=15
		.silent=.t.
		.visible=.t.
		.navigate(m.url)
		endwith
		.refresh
		endwith
		.refresh
		endwith
		sleep(1000)

		thisform.pageframe1.activePage=m.n
		Thisform.pageframe1.Pages(m.n).activate
		thisform.pageframe1.refresh

		catch
		messagebox("An error was occured !",+32+4096,"Error",1000)
		endtry
		retu
	ENDPROC

	PROCEDURE Destroy
		clea events
	ENDPROC

	PROCEDURE Init
		set safe off
		set talk off
		set safe off
		thisform.zoom=100
		with thisform.pageframe1.page1
		.ADDOBJECT("olecontrol1","olecontrol","Shell.explorer.2")
		
		with .olecontrol1
		.Top = 0
		.Left = 0
		.Height = 581
		.Width = 995
		.Anchor = 15
		.Name = "Olecontrol1"
	   .silent=.t.
	   .navigate("http://yousfi.over-blog.com/")	
		.visible=.t.
		endwith
		.caption="yousfi.over-blog.com"
		endwith
	ENDPROC

	PROCEDURE Load
		declare integer Sleep in kernel32 integer
	ENDPROC

	PROCEDURE pageframe1.Init
		with this
		.themes=.f.
		.page1.backcolor=0
		.page1.forecolor=rgb(255,255,255)
		.anchor=15
		endwith
	ENDPROC

	PROCEDURE pageframe1.Page1.RightClick
	ENDPROC

	*PROCEDURE olecontrol1.Init
	*	this.silent=.t.
	*	this.navigate("http://yousfi.over-blog.com/")
	*	this.parent.caption="yousfi.over-blog.com"
	*ENDPROC

	PROCEDURE command1.Click
		if ! empty(thisform.text1.value)
		thisform.ycreateTab(allt(thisform.text1.value),1)
		endi
	ENDPROC

	PROCEDURE text1.Click
		Keyboard "{CTRL+A}"
	ENDPROC

	PROCEDURE text1.RightClick
		this.value=_cliptext
	ENDPROC

	PROCEDURE text1.Valid
		thisform.command1.click()
	ENDPROC

	PROCEDURE combo2.Click
		local m.n
		m.n=thisform.pageframe1.activePage

		#DEFINE OLECMDID_PAGESETUP 8
		#DEFINE OLECMDEXECOPT_DODEFAULT 0
		#define OLECMDEXECOPT_PROMPTUSER  1
		#DEFINE LECMDEXECOPT_DONTPROMPTUSER 2
		#define OLECMDID_FIND  32
		#DEFINE OLECMDID_PRINT 6
		#DEFINE OLECMDID_PRINTPREVIEW 7
		#DEFINE OLECMDID_PROPERTIES 10
		#DEFINE OLECMDID_SAVEAS 4
		#define OLECMDID_OPTICAL_ZOOM 63

		try
		do case
		case this.value=1
		try
		thisform.pageframe1.pages(m.n).olecontrol1.goForward()
		catch
		endtry

		case this.value=2
		try
		thisform.pageframe1.pages(m.n).olecontrol1.goBack()
		catch
		endtry

		case this.value=3
		thisform.pageframe1.pages(m.n).olecontrol1.refresh

		case this.value=4
		local m.x,m.lcdest
		m.x=thisform.pageframe1.pages(m.n).olecontrol1.document.body.innerhtml
		m.lcdest=addbs(sys(2023))+"ysource.txt"
		strtofile(m.x,m.lcdest)
		run/n notepad  &lcdest


		case this.value=5
		try
		if n>1
		thisform.pageframe1.removeObject(thisform.pageframe1.pages(m.n).name)
		thisform.pageframe1.activePage=n-1
		else
		messagebox("At least one tab must stays in pageframe!",0+32+4096,'',1200)
		endi
		catch
		endtry

		case this.value=6
		thisform.pageframe1.pages(m.n).olecontrol1.ExecWB(OLECMDID_PAGESETUP,OLECMDEXECOPT_DODEFAULT)

		
		case this.value=7
		local apie
		apie=thisform.pageframe1.pages(m.n).olecontrol1


		*apIE.Execwb(OLECMDID_PRINT  ,LECMDEXECOPT_DONTPROMPTUSER )   &&to print directly
		apIE.Execwb(OLECMDID_PRINTPREVIEW  ,OLECMDEXECOPT_DODEFAULT)   &&preview
		apie=null

		case this.value=8
		thisform.pageframe1.pages(m.n).olecontrol1.setfocus
		thisform.pageframe1.pages(m.n).olecontrol1.ExecWB(OLECMDID_FIND , OLECMDEXECOPT_PROMPTUSER)
		

		case this.value=9
		thisform.pageframe1.pages(m.n).olecontrol1.ExecWB(OLECMDID_SAVEAS ,OLECMDEXECOPT_DODEFAULT)
		
		case this.value=10
		thisform.pageframe1.pages(m.n).olecontrol1.ExecWB(OLECMDID_PROPERTIES , OLECMDEXECOPT_DODEFAULT)
	
		case this.value=11
		thisform.zoom=thisform.zoom+10
		thisform.pageframe1.pages(n).olecontrol1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DODEFAULT, thisform.zoom, Null)
		wait window (trans(thisform.zoom)+" %") timeout 1
	

		case this.value=12
		#DEFINE OLECMDEXECOPT_DONTPROMPTUSER 2
		#define OLECMDID_OPTICAL_ZOOM 63
		thisform.zoom=thisform.zoom-10
		thisform.pageframe1.pages(n).olecontrol1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DODEFAULT, thisform.zoom, Null)
		wait window (trans(thisform.zoom)+" %") timeout 1

		case this.value=13
		thisform.zoom=100
		thisform.pageframe1.pages(n).olecontrol1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DODEFAULT, thisform.zoom, Null)
		wait window (trans(thisform.zoom)+" %") timeout 1

		case this.value=14
		       use home(7)+"autocomp.dbf"
				zap
				use in home(7)+"autocomp.dbf"

		CASE THIS.VALUE=15
		local m.x
		m.x=thisform.pageframe1.pages(n).olecontrol1.locationURL
		_cliptext=m.x
		messagebox(m.x+chr(13)+chr(13)+"active URL is in clipboard!",0+32+4096,'',1300)
		endcase

		catch
		messagebox("An error was occured!",16+4096,"Error",1000)
		endtry
	ENDPROC

	PROCEDURE combo2.Init
		with this
		.fontsize=8

		.additem("Go Forward")
		.additem("Go Back")
		.additem("Refresh")
		.additem("Code source")
		.additem("Remove this TAB")
		.additem("Page setUp")
		.additem("Print/Preview this TAB")
		.additem("Search dialog")
		.additem("Save this Tab as..")
		.additem("Document properties")
		.additem("increase zoom")
		.additem("decrease zoom")
		.additem("original zoom")
		.additem("Erase autocomp history")
		.additem("Capture active URL")

		.listindex=1
		.value=1
		.style=2
		endwith
	ENDPROC

	PROCEDURE combo1.Click
		_cliptext=allt(this.value)
		thisform.ycreateTab(allt(this.value),2)
	ENDPROC

	PROCEDURE combo1.Init
		with this
		.additem("https://www.foxite.com/forum/")
		.additem("http://www.elwatan.com/")
		.additem("http://www.lebuteur.com/")
		.additem("http://www.atoutfox.org/")
		.additem("http://www.news2news.com/vfp/index.php")
		.additem("http://www.sweetpotatosoftware.com/spsblog/")
		.additem("http://sandstorm36.blogspot.com/")
		.additem("http://fox.wikis.com/")
		.additem("https://www.google.dz/imghp?hl=fr&tab=wi&ei=eBFaVv3oDsKwa8HMiZAK&ved=0EKouCBYoAQ")
		.listindex=1
		.style=2
		endwith
	ENDPROC

	PROCEDURE label1.Click
		Messagebox("use GoBack to return to the original page!",0+32+4096,'',1300)
		TEXT to m.myvar noshow
		<body bgcolor=gray oncontextmenu="return false;">
		<center>
		<h2 style="color:white;background-color:navy;width:800;">An experimental multi tabs VFP browser</h2></center>
		<pre  style=" white-space: pre-wrap;
		 white-space: -moz-pre-wrap;
		 white-space: -pre-wrap;
		 white-space: -o-pre-wrap;
		 word-wrap: break-word;
		font-family:Courier New;
		font-size:11pt;
		font-weight:bold;
		background: linear-gradient(to right, rgba(255,0,0,0.25), orange, yellow, rgba(0,255,0,0.25), cyan, bisque, rgba(255,0,255,0.20));
		height:auto;
		color:#33001A;
		    -moz-border-radius: 20px;
		    -webkit-border-radius: 20px;
		    -khtml-border-radius: 20px;
		    border-radius: 20px;
		box-shadow: 3px 3px 3px #333;
		margin-left: 25px;
		padding:10px;
		width:90%;"
		>
		<code>
		This Is  a basic multiTab IE BrowseR On a Visual FoxPro Form.
	it have the capabilities as follow:
	-create dynamically a new tab providing url navigation
	-removing any tab
	-type any url in the textbox (its autocomplete one sorted history alphabetically)
      can rightclick on the textbox  to paste the captured clipboard (_cliptext).
	-can gather custom urls in the comboBox combo1 to fire them quickly each one in new Tab.
	-Each tab is a child of a vfp pageframe and contains an olecontrol "shell.explorer.2" as activeX

	-the form have
	      -navigation with Forward and Goback if the navigation is internally in tab.
	      -refresh the page
	      -edit the source page as txt file
	      -remove any active tab
	      -fires page setup dialog
	      -Print/preview the active page(print is integrated in preview).if have a virtual printer installed (as pdfCreator)
	       can save the web page to pdf,png,jpg,txt....
	      -Search dialog in any page (warning: some sites  robots make the find  dialog appear but entierely disabled)
	      -Save the page as (htm,html).can with additional small code save as text file(use document.body.innertext).
	      -Fires document properties
	      -Increase, decrease zoom level of the page or set the normal zoom.
	      -erase the autocomplete textbox history (reset it).its natively saved in home(7)+"autocomp.dbf"
	      -capture the active page URL in clipboard.

	Of course this is a basic multi Tabs browser.can make graphics bitmaps instead text,add more decorations and  functionalities,...
		</code>
		</pre>
		</body>
		ENDTEXT
		Local m.lcdest
		m.lcdest=Addbs(Sys(2023))+"temp.html"
		Strtofile(m.myvar,m.lcdest)
		With Thisform.pageframe1.page1
			.olecontrol1.Navigate(m.lcdest)
			.Caption="Summary help"
		Endwith
	ENDPROC

ENDDEFINE
*
*-- EndDefine: yIE_Tabs


A VFP multi Tabs browser
A VFP multi Tabs browser
A VFP multi Tabs browser

Click on code to select [then copy] -click outside to deselect

                  

*2* first updated version on saturday 19 december 2015
*see the summary help with all added functionalities

if !_vfp.startmode=0
on shutdown quit
endi

Publi yform
yform=Newobject("yIE_tabs")
yform.Show
Read Events
Retu

Define Class yIE_Tabs As Form
Top = 7
Left = -18
Height = 609
Width = 993
ShowWindow = 2
ShowTips = .T.
Caption = "yBrowser multi Tabs"
WindowState = 2
BackColor = Rgb(0,0,0)
Zoom = 0
yhisto = .F.
ycolor = 0
ytrans = .F.
Name = "YMASTER"

Add Object pageframe1 As PageFrame With ;
ErasePage = .T., ;
PageCount = 1, ;
Anchor = 15, ;
Top = 31, ;
Left = 0, ;
Width = 996, ;
Height = 581, ;
TabOrientation = 0, ;
Themes = .F., ;
Name = "Pageframe1", ;
Page1.FontBold = .T., ;
Page1.Caption = "", ;
Page1.BackColor = Rgb(0,0,0), ;
Page1.ForeColor = Rgb(255,255,255), ;
Page1.Name = "Page1"

Add Object command1 As CommandButton With ;
Top = 0, ;
Left = 458, ;
Height = 25, ;
Width = 62, ;
Anchor = 768, ;
Caption = "Add Tab", ;
Default = .T., ;
MousePointer = 15, ;
BackColor = Rgb(128,255,0), ;
Name = "Command1"

Add Object text1 As TextBox With ;
Anchor = 768, ;
Height = 25, ;
Left = 2, ;
SelectOnEntry = .T., ;
ToolTipText = "Type any valid URL here or paste with rightclick", ;
Top = 1, ;
Width = 454, ;
AutoComplete = 1, ;
Name = "Text1"

Add Object combo2 As ComboBox With ;
FontSize = 8, ;
Anchor = 768, ;
Height = 25, ;
Left = 666, ;
ToolTipText = "Functionalities", ;
Top = 1, ;
Width = 120, ;
DisplayCount = 15, ;
Name = "Combo2"

Add Object combo1 As ComboBox With ;
FontSize = 8, ;
Anchor = 768, ;
Height = 25, ;
Left = 809, ;
ToolTipText = "Custom Urls", ;
Top = 1, ;
Width = 156, ;
Name = "Combo1"

Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 18, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "?", ;
Height = 32, ;
Left = 788, ;
MousePointer = 15, ;
Top = -3, ;
Width = 17, ;
ForeColor = Rgb(0,255,0), ;
Name = "Label1"

Add Object combo3 As ComboBox With ;
FontSize = 8, ;
Anchor = 768, ;
Height = 25, ;
Left = 586, ;
ToolTipText = "Edition menu", ;
Top = 2, ;
Width = 74, ;
DisplayCount = 15, ;
Name = "Combo3"

Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 14, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "X", ;
Height = 25, ;
Left = 972, ;
MousePointer = 15, ;
Top = 3, ;
Width = 15, ;
ForeColor = Rgb(255,0,0), ;
ToolTipText = "Remove active TAB", ;
Name = "Label2"

Add Object label3 As Label With ;
FontName = "Webdings", ;
FontSize = 24, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "3", ;
Height = 25, ;
Left = 527, ;
MousePointer = 15, ;
Top = -3, ;
Width = 25, ;
ForeColor = Rgb(0,255,0), ;
ToolTipText = "GoBack", ;
Name = "Label3"

Add Object label4 As Label With ;
FontName = "Webdings", ;
FontSize = 24, ;
Anchor = 768, ;
BackStyle = 0, ;
Caption = "4", ;
Height = 25, ;
Left = 551, ;
MousePointer = 15, ;
Top = -3, ;
Width = 25, ;
ForeColor = Rgb(0,255,0), ;
ToolTipText = "GoForward", ;
Name = "Label4"

Procedure Init
Publi ymaster
ymaster=Thisform.Name

Set Safe Off
Set Talk Off
Set Safe Off
Thisform.Zoom=100
Thisform.ytrans=255

Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
If !File(m.yrep+"urlHistory.dbf")
Messagebox("History is absent in "+m.yrep+" the code creates this tables!",0+32+4096,"Error",1300)
Create Table urlHistory.Dbf (urlName M,CreateDate D(8),lastAccess D(8),xCount N(8.0))
Else
Use urlHistory Alias urlHistory Exclusive
Endi

With Thisform.pageframe1.Page1
.AddObject("olecontrol1","OleControl","Shell.explorer.2")
With .olecontrol1
    .Top = 0
	.Left = 0
	.Height = 581
	.Width = 995
	.Anchor = 15
	.Name = "Olecontrol1"
	.silent=.T.
	Local m.url
	m.url="http://yousfi.over-blog.com/"
	.Navigate(m.url)
	.Visible=.T.


Endwith
.Caption="First tab"
Endwith



sleep(1000)
Thisform.yhistory(m.url)
Endproc

Procedure Load
Declare Integer Sleep In kernel32 Integer
Declare Integer GetWindowLong In user32;
INTEGER HWnd, Integer nIndex
Declare Integer SetWindowLong In user32;
INTEGER HWnd, Integer nIndex, Integer dwNewLong
Declare Integer SetLayeredWindowAttributes In user32;
INTEGER HWnd, Integer crKey,;
SHORT bAlpha, Integer dwFlags

_Screen.WindowState=1
Endproc

Procedure pageframe1.Init
With This
.Themes=.F.
.Page1.BackColor=Thisform.ycolor
.Page1.ForeColor=Rgb(255,255,255)
.Anchor=15
Endwith
Endproc


Procedure ycreatetab
Lparameters url,ynum
If Empty(url)
Return .F.
Endi
Try
With Thisform.pageframe1
	Local N,xpage
	N=.PageCount+1
	m.xpage="page"+Trans(N)
	.AddObject(m.xpage,"page")

	Local m.url,m.xpage
	Do Case
		Case ynum=1
			m.url=Allt(Thisform.text1.Value)
		Case ynum=2
			m.url=Allt(Thisform.combo1.Value)
		Case ynum=3
			m.url=Allt(Thisform.yhisto)
		Case ynum=4
			m.url=Allt(url)

	Endcase

	With Eval("."+m.xpage)
		Do Case
			Case Lower(Substr(m.url,1,7))=="http://"
				.Caption=Strtran("..."+Substr(Strtran(Allt(m.url),"http://",""),1,25),"/","",1)
			Case Lower(Substr(m.url,1,4))="www."
				.Caption="..."+Substr(Strtran(Allt(m.url),"www.",""),1,25)
			Case Lower(Substr(m.url,1,11))="http://www."
				.Caption=Strtran("..."+Substr(Strtran(Allt(m.url),"http://www.",""),1,25),"/","",1)
			Case Lower(Substr(m.url,1,12))=="https://www."
				.Caption=Strtran("..."+Substr(Strtran(Allt(m.url),"https://www.",""),1,25),"/","",1)
			Otherwise
				.Caption="..."+Substr(Allt(m.url),1,25)
		Endcase
		.BackColor=Thisform.ycolor
		.ForeColor=Rgb(255,255,255)
		.FontBold=.T.
		.Refresh
		.AddObject("olecontrol1","olecontrol","shell.explorer.2")
		With .olecontrol1
			.Left=0
			.Top=5
			.Width=.Parent.Parent.Width
			.Height=.Parent.Parent.Height
			.Anchor=15
			.silent=.T.
			.Navigate(m.url)
			.Visible=.T.
		Endwith
	Endwith
	.Refresh
Endwith
sleep(1000)
Thisform.pageframe1.ActivePage=m.n
Thisform.pageframe1.Pages(m.n).Activate
Thisform.pageframe1.Refresh

Thisform.yhistory(m.url)
*******************
*thisform.ydisableCM()
******************
Catch
Messagebox("An error was occured !",+32+4096,"Error",1000)
Endtry
Retu
Endproc

Procedure yhistory
Lparameter yURL
Sele urlHistory
Locate For Allt(urlName)=Allt(yURL)
If Found()
Repl lastAccess With Datetime(), xCount With xCount+1
Else
Appe Blan
Repl urlName With yURL,CreateDate With Datetime()
Repl lastAccess With Datetime(),xCount With 1
Endi

*brow
Endproc

Procedure ydisablecm
sleep(4000)
Local m.myvar
TEXT to m.myvar noshow
document.addEventListener("contextmenu", function(e){ e.preventDefault();}, false);
ENDTEXT

N=Thisform.pageframe1.ActivePage
oo=Thisform.pageframe1.Pages(N).olecontrol1

Try
With oo.Document
	x=.createElement("SCRIPT")
	T =.createTextNode(m.myvar)
	x.appendChild(T)
	.body.appendChild(x)
Endwith
Catch
Endtry
Endproc

Procedure ytranspa
Lparameters ytrans
#Define GWL_EXSTYLE -20
#Define WS_EX_LAYERED 0x80000
#Define LWA_COLORKEY 1
#Define LWA_ALPHA 2
Local nExStyle, nRgb, nAlpha, nFlags
nExStyle = GetWindowLong(Thisform.HWnd, GWL_EXSTYLE)
nExStyle = Bitor(nExStyle, WS_EX_LAYERED)
= SetWindowLong(Thisform.HWnd, GWL_EXSTYLE, nExStyle)
= SetLayeredWindowAttributes(Thisform.HWnd, Thisform.BackColor,ytrans,LWA_ALPHA)
Endproc

Procedure Destroy
Use In urlHistory
Clea Events
Endproc



Procedure command1.Click
If ! Empty(Thisform.text1.Value)
Thisform.ycreatetab(Allt(Thisform.text1.Value),1)
Endi
Endproc

Procedure text1.Click
Keyboard "{CTRL+A}"
Endproc

Procedure text1.RightClick
This.Value=_Cliptext
Endproc


Procedure text1.Valid
Thisform.command1.Click()
Endproc

Procedure combo2.Click
Local m.n
m.n=Thisform.pageframe1.ActivePage
*ExecWB first parameter
#Define OLECMDID_FIND  32
#Define OLECMDID_OPTICAL_ZOOM 63
#Define OLECMDID_OPEN 1
#Define OLECMDID_NEW 2
#Define OLECMDID_SAVE 3
#Define OLECMDID_SAVEAS 4
#Define OLECMDID_SAVECOPYAS 5
#Define OLECMDID_PRINT 6
#Define OLECMDID_PRINTPREVIEW 7
#Define OLECMDID_PAGESETUP 8
#Define OLECMDID_SPELL 9
#Define OLECMDID_PROPERTIES 10
#Define OLECMDID_CUT 11
#Define OLECMDID_COPY 12
#Define OLECMDID_PASTE 13
#Define OLECMDID_PASTESPECIAL 14
#Define OLECMDID_UNDO 15
#Define OLECMDID_REDO 16
#Define OLECMDID_SELECTALL 17
#Define OLECMDID_CLEARSELECTION 18
#Define OLECMDID_ZOOM 19
#Define OLECMDID_GETZOOMRANGE 20
#Define OLECMDID_UPDATECOMMANDS 21
#Define OLECMDID_REFRESH 22
#Define OLECMDID_STOP 23
#Define OLECMDID_HIDETOOLBARS 24
#Define OLECMDID_SETPROGRESSMAX 25
#Define OLECMDID_SETPROGRESSPOS 26
#Define OLECMDID_SETPROGRESSTEXT 27
#Define OLECMDID_SETTITLE 28
#Define OLECMDID_SETDOWNLOADSTATE 29
#Define OLECMDID_STOPDOWNLOAD 30

*ExecWB second parameter
#Define OLECMDEXECOPT_DODEFAULT 0
#Define OLECMDEXECOPT_PROMPTUSER 1
#Define LECMDEXECOPT_DONTPROMPTUSER 2
#Define OLECMDEXECOPT_SHOWHELP 3

Try
Do Case
	Case This.Value=1
		Try
			Thisform.pageframe1.Pages(m.n).olecontrol1.GoForward()
		Catch
		Endtry

	Case This.Value=2
		Try
			Thisform.pageframe1.Pages(m.n).olecontrol1.GoBack()
		Catch
		Endtry

	Case This.Value=3
		Thisform.pageframe1.Pages(m.n).olecontrol1.Refresh

	Case This.Value=4
		Local m.x,m.lcdest
		m.x=Thisform.pageframe1.Pages(m.n).olecontrol1.Document.body.innerhtml
		m.lcdest=Addbs(Sys(2023))+"ysource.txt"
		Strtofile(m.x,m.lcdest)
		Run/N notepad  &lcdest

	Case This.Value=5
		Try
			If N>1
				Thisform.pageframe1.RemoveObject(Thisform.pageframe1.Pages(m.n).Name)
				Thisform.pageframe1.ActivePage=N-1
			Else
				Messagebox("At least one tab must stays in pageframe!",0+32+4096,'',1200)
			Endi
		Catch
		Endtry

	Case This.Value=6
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB(OLECMDID_PAGESETUP,OLECMDEXECOPT_DODEFAULT)
		**********
	Case This.Value=7
		Local apie
		apie=Thisform.pageframe1.Pages(m.n).olecontrol1

		*apIE.Execwb(OLECMDID_PRINT  ,LECMDEXECOPT_DONTPROMPTUSER )   &&to print directly
		apie.ExecWB(OLECMDID_PRINTPREVIEW  ,OLECMDEXECOPT_DODEFAULT)   &&preview
		apie=Null

	Case This.Value=8
		Thisform.pageframe1.Pages(m.n).olecontrol1.SetFocus
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB(OLECMDID_FIND , OLECMDEXECOPT_PROMPTUSER)


	Case This.Value=9
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB(OLECMDID_SAVEAS ,OLECMDEXECOPT_DODEFAULT)

	Case This.Value=10
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB(OLECMDID_PROPERTIES , OLECMDEXECOPT_DODEFAULT)

	Case This.Value=11
		Thisform.Zoom=Thisform.Zoom+10
		Thisform.pageframe1.Pages(N).olecontrol1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DODEFAULT, Thisform.Zoom, Null)
		Wait Window (Trans(Thisform.Zoom)+" %") Timeout 1

	Case This.Value=12
		#Define OLECMDEXECOPT_DONTPROMPTUSER 2
		#Define OLECMDID_OPTICAL_ZOOM 63
		Thisform.Zoom=Thisform.Zoom-10
		Thisform.pageframe1.Pages(N).olecontrol1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DODEFAULT, Thisform.Zoom, Null)
		Wait Window (Trans(Thisform.Zoom)+" %") Timeout 1

	Case This.Value=13
		Thisform.Zoom=100
		Thisform.pageframe1.Pages(N).olecontrol1.ExecWB(OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DODEFAULT, Thisform.Zoom, Null)
		Wait Window (Trans(Thisform.Zoom)+" %") Timeout 1


	Case This.Value=14
		Use Home(7)+"autocomp.dbf"
		Zap
		Use In Home(7)+"autocomp.dbf"

	Case This.Value=15
		Local m.x
		m.x=Thisform.pageframe1.Pages(N).olecontrol1.locationURL
		_Cliptext=m.x
		Messagebox(m.x+Chr(13)+Chr(13)+"active URL is in clipboard!",0+32+4096,'',1300)


	Case This.Value=16  &&clear history
		If Messagebox("Want indeed to clear history ?",4+64+4096,"clear hisrory")=6
			Sele urlHistory
			Zap
		Endi

		*Case This.Value=17
		*	*This command will remove all your browsing history from Internet Explorer 11 when it is run
		*	If Messagebox("Want indeed to clear IE11 browsing history ?",4+64+4096,"clear hisrory")=6
		*		Local m.x
		*		m.x="RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 255"
		*		Local oshell
		*		oshell=Newobject("wscript.shell")
		*		oshell.Run(m.x)
		*		oshell=Null
		*	Endi


Endcase
Catch
Messagebox("An error was occured!",16+4096,"Error",1000)
Endtry
Endproc


Procedure combo2.Init
With This
.FontSize=8
.AddItem("Go Forward")
.AddItem("Go Back")
.AddItem("Refresh")
.AddItem("Code source (txt)")
.AddItem("Remove this TAB")
.AddItem("Page setUp")
.AddItem("Print/Preview this TAB")
.AddItem("Search dialog")
.AddItem("Save this Tab as..")
.AddItem("Document properties")
.AddItem("increase zoom")
.AddItem("decrease zoom")
.AddItem("original zoom")
.AddItem("Erase autocomp history")
.AddItem("Capture active URL")
.AddItem("clear local history")
*.AddItem("clear IE browsing history")   &&for  full IE11
*.additem("Add this page to favoris")  &&needs a permanent table populating combo2
.ListIndex=1
.Value=1
.Style=2
Endwith
Endproc

Procedure combo1.Click
Thisform.ycreatetab(Allt(This.Value),2)
Endproc

Procedure combo1.Init  &&favoris
With This
.AddItem("https://www.foxite.com/forum/")
.AddItem("http://www.elwatan.com/")
.AddItem("http://www.lebuteur.com/")
.AddItem("http://www.atoutfox.org/")
.AddItem("http://www.news2news.com/vfp/index.php")
.AddItem("http://www.sweetpotatosoftware.com/spsblog/")
.AddItem("http://sandstorm36.blogspot.com/")
.AddItem("http://fox.wikis.com/")
.AddItem("http://www.msn.com")
.AddItem("https://www.google.dz/imghp?hl=fr&tab=wi&ei=eBFaVv3oDsKwa8HMiZAK&ved=0EKouCBYoAQ")
.ListIndex=1
.Style=2
Endwith
Endproc

Procedure label1.Click
Messagebox("use GoBack to return to the original page!",0+32+4096,'',1300)
TEXT to m.myvar noshow
<body bgcolor=gray oncontextmenu="return false;">
<center>
<br>
<h2 style="color:white;background-color:navy;width:800;">An experimental multi tabs VFP browser</h2></center>
<pre  style=" white-space: pre-wrap;
white-space: -moz-pre-wrap;
white-space: -pre-wrap;
white-space: -o-pre-wrap;
word-wrap: break-word;
font-family:Courier New;
font-size:10pt;
font-weight:bold;
background: linear-gradient(to right, rgba(255,0,0,0.25), orange, yellow, rgba(0,255,0,0.25), cyan, bisque, rgba(255,0,255,0.20));
height:auto;
color:#33001A;
-moz-border-radius: 20px;
-webkit-border-radius: 20px;
-khtml-border-radius: 20px;
border-radius: 20px;
box-shadow: 3px 3px 3px #333;
margin-left: 25px;
padding:10px;
width:90%;"
>
<code>
this is  a basic multiTab IE browser on a visual foxpro form.
it have the capabilities as follow:
-create dynamically a new tab providing url navigation
-removing any tab
-type any url in the textbox (its autocomplete one sorted history alphabetically)
can rightclick on the textbox  to paste the captured clipboard (_cliptext).
-can gather custom urls in the comboBox combo1 to fire them quickly each one in new Tab.
-Each tab is a child of a vfp pageframe and contains an olecontrol "shell.explorer.2" as activeX

-the form have
   -navigation with Forward and Goback if the navigation is internally in tab.
   -refresh the page
   -edit the source page as txt file or HTML file.
   -remove any active tab
   -fires page setup dialog
   -Print/preview the active page(print is integrated in preview).if have a virtual printer installed (as pdfCreator)
	can save the web page to pdf,png,jpg,txt....
   -Search dialog in any page (warning: some sites  robots make the find  dialog appear but entierely disabled)
   -Save the page as (htm,html).can with additional small code save as text file(use document.body.innertext).
   -Fires document properties,open  any typed url or local file
   -Increase, decrease zoom level of the page or set the normal zoom.
   -erase the autocomplete textbox history (reset it).its natively saved in home(7)+"autocomp.dbf"
   -capture the active page URL in clipboard.
   -Set or remove the form titlebar to make space area
   -set theme colors on form+pages
   -remove the local navigation history-recall it to fire any yrl of the history.
   -set or remove  transparency(200 to 255 (full opaque))
Of course this is a basic multi Tabs browser.can make graphics bitmaps instead text,add more decorations,
functionalities,...to continue...
</code>
</pre>
</body>
ENDTEXT
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"temp.html"
Strtofile(m.myvar,m.lcdest)

With Thisform.pageframe1.Page1
.olecontrol1.Navigate(m.lcdest)
.Caption="First Tab"
.Parent.ActivePage=1
Endwith
Thisform.yhistory(m.lcdest)
Endproc

Procedure combo3.Init
With This
.FontSize=8
.AddItem("copy selection")
.AddItem("Select all")
.AddItem("Undo")
.AddItem("Redo")
.AddItem("Find")
.AddItem("Refresh page")
.AddItem("Stop")
.AddItem("open URL or  local file")
.AddItem("Browse navigation history")
.AddItem("code source active page")
.AddItem("colors theme")
.AddItem("set transparency")
.AddItem("Titlebar on/off")
.ListIndex=1
.Value=1
.Style=2
Endwith
Endproc

Procedure combo3.Click
Local m.n
m.n=Thisform.pageframe1.ActivePage
*ExecWB first parameter
#Define OLECMDID_FIND  32
#Define OLECMDID_OPTICAL_ZOOM 63
#Define OLECMDID_OPEN 1
#Define OLECMDID_NEW 2
#Define OLECMDID_SAVE 3
#Define OLECMDID_SAVEAS 4
#Define OLECMDID_SAVECOPYAS 5
#Define OLECMDID_PRINT 6
#Define OLECMDID_PRINTPREVIEW 7
#Define OLECMDID_PAGESETUP 8
#Define OLECMDID_SPELL 9
#Define OLECMDID_PROPERTIES 10
#Define OLECMDID_CUT 11
#Define OLECMDID_COPY 12
#Define OLECMDID_PASTE 13
#Define OLECMDID_PASTESPECIAL 14
#Define OLECMDID_UNDO 15
#Define OLECMDID_REDO 16
#Define OLECMDID_SELECTALL 17
#Define OLECMDID_CLEARSELECTION 18
#Define OLECMDID_ZOOM 19
#Define OLECMDID_GETZOOMRANGE 20
#Define OLECMDID_UPDATECOMMANDS 21
#Define OLECMDID_REFRESH 22
#Define OLECMDID_STOP 23
#Define OLECMDID_HIDETOOLBARS 24
#Define OLECMDID_SETPROGRESSMAX 25
#Define OLECMDID_SETPROGRESSPOS 26
#Define OLECMDID_SETPROGRESSTEXT 27
#Define OLECMDID_SETTITLE 28
#Define OLECMDID_SETDOWNLOADSTATE 29
#Define OLECMDID_STOPDOWNLOAD 30

*ExecWB second parameter
#Define OLECMDEXECOPT_DODEFAULT 0
#Define OLECMDEXECOPT_PROMPTUSER 1
#Define LECMDEXECOPT_DONTPROMPTUSER 2
#Define OLECMDEXECOPT_SHOWHELP 3


Try
Thisform.pageframe1.Pages(m.n).olecontrol1.SetFocus
Do Case

	Case This.Value=1
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT)
	Case This.Value=2
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT)
	Case This.Value=3
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_DODEFAULT)
	Case This.Value=4
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB(OLECMDID_REDO, OLECMDEXECOPT_DODEFAULT)
	Case This.Value=5
		Thisform.pageframe1.Pages(m.n).olecontrol1.SetFocus
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB(OLECMDID_FIND , OLECMDEXECOPT_PROMPTUSER)
	Case This.Value=6
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB( OLECMDID_REFRESH, OLECMDEXECOPT_DODEFAULT)
	Case This.Value=7
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB(OLECMDID_STOP, OLECMDEXECOPT_DODEFAULT)
	Case This.Value=8
		Thisform.pageframe1.Pages(m.n).olecontrol1.ExecWB (OLECMDID_OPEN, OLECMDEXECOPT_DODEFAULT)
	Case This.Value=9
		*sele urlHistory
		*brow
		Do Form yhistory
	Case This.Value=10
		Local m.lcdest,m.yy
		m.yy=Thisform.pageframe1.Pages(m.n).olecontrol1. Document.documentElement.outerHTML
		m.yy=Strtran(m.yy,"<","<")
		m.yy=Strtran(m.yy,">","><br>")
		*****************************
		TEXT to m.x textmerge noshow
<body>
<pre style="  white-space: pre-wrap;
white-space: -moz-pre-wrap;
white-space: -pre-wrap;
white-space: -o-pre-wrap;
word-wrap: break-word;
font-family:Courier New;
font-size:10pt;
color:#000059;
background-color:bisque;
margin-left: 15px;
padding:10px;
width:95%">
<code>
<<m.yy>>
</code>
</pre>
</body>
		ENDTEXT
		m.lcdest=Addbs(Sys(2023))+"ysource.html"
		Strtofile(m.x,m.lcdest)
		Thisform.ycreatetab("file:///"+Allt(m.lcdest),4)

	Case This.Value=11
		Local m.xcolor
		m.xcolor=Getcolor()
		If m.xcolor=-1
			Return .F.
		Endi
		Thisform.ycolor=m.xcolor
		Thisform.BackColor=Thisform.ycolor
		With Thisform.pageframe1
			For i=1 To .PageCount
				.Pages(i).BackColor=Thisform.ycolor
			Endfor
		Endwith

	Case This.Value=12
		Local ytrans
		m.ytrans=Int(Val(Inputbox("Transparency:200-255 (opaque)","",Trans(Thisform.ytrans))))
		If !Between(m.ytrans,200,255)
			m.ytrans=240
		Endi
		Thisform.ytrans=m.ytrans
		Thisform.ytranspa(Thisform.ytrans)

	Case This.Value=13
		Thisform.TitleBar=Iif(Thisform.TitleBar=1,0,1)
		If Thisform.TitleBar=0
			Thisform.Height=Thisform.Height+33
		Else
			Thisform.Height=Thisform.Height-33
		Endi
Endcase
Catch
Messagebox("An error was occured!",16+4096,"Error",1000)
Endtry
Endproc

Procedure label2.Click
Local m.n
m.n=Thisform.pageframe1.ActivePage

Try
If m.n>1
	Thisform.pageframe1.RemoveObject(Thisform.pageframe1.Pages(m.n).Name)
	Thisform.pageframe1.ActivePage=N-1
Else
	Messagebox("At least one tab must stays in pageframe!",0+32+4096,'',1200)
Endi
Catch
Endtry
Endproc

Procedure label3.Click
Local m.n
m.n=Thisform.pageframe1.ActivePage
Try
Thisform.pageframe1.Pages(m.n).olecontrol1.GoBack()
Catch
Endtry
Endproc

Procedure label4.Click
Local m.n
m.n=Thisform.pageframe1.ActivePage
Try
Thisform.pageframe1.Pages(m.n).olecontrol1.GoForward()
Catch
Endtry
Endproc

Enddefine
*
*-- EndDefine: yIE_Tabs



this is the first revsion version of the first code with many added capabilities.
this is the first revsion version of the first code with many added capabilities.
this is the first revsion version of the first code with many added capabilities.
this is the first revsion version of the first code with many added capabilities.

this is the first revsion version of the first code with many added capabilities.

*outstanding issue :
-the rightclick on  any browser tab fires the native olecontrol menu.to disable this can add programmatly and dynamically a script by olecontrol1.document.createElement("script").....(see html5 canvas in previous posts)
 but this must be called all time at(start page, goback/goforward,refresh...) and must have the document ready  mandatory.the method ydisableCM() exists in code but not called.
 i try successfully this method but it slows the application.that why i dont apply it.

 

*Can successfuly build a project with this prg add a config.fpw and compile an executable

To be informed of the latest articles, subscribe:
Comment on this post