Modal dialog box (html and classic).

Published on by Yousfi Benameur


this shows a modal dialog box for an occidental or unicode (here arabic) text typed on a vfp editbox or saved in UTF-8 text file.
the dialog box is styled with css in code.can add more CSS styles to beautify more the dialog box.
A modal dialog box can returns always a result to the master programme.
can add any kind of button as vfp messagebox function does.
can adjust any of the parameters to configure the dialog box. try diffrent configuration values on form.
if the dialog box is centered on desktop the left and top parameters are unavailable otherwise can position the dialog exactly on desktop.
the best method to work with unicode languages is to save the original text as utf-8 text file (using for ex notepad) and call it as string form the code.
the web page must be encoded to UTF-8 MANDATORY with this line:
 <meta http-equiv="Content-Type" content="text/html; CHARSET=UTF-8">

this code was adapted from the news2news article cited in form.load code and from msdn.
i used vfp+javascript together to build the 2 codes below.
    


before begin and to make the code above working for unicode modal dialog box, copy this arabic text (or any unicode) ans save as arabic.txt but with UTF-8 format (notepad)

لا تزال الحكومة تدافع عن مشروع قانونها للمالية لسنة 2016، بتفويضها وزير المالية، عبد الرحمان بن خالفة، للدفاع
 عن أول قانون مجسد لسياسة التقشف، أمام نواب غرفتي البرلمان، بعد أكثر
من عشرية عاشتها الجزائر في بحبوحة مالية، لتأتي تقلبات أسعار النفط في الأسواق النفطية وتخلط حسابات الحكومة وتفرغ قانون المالية
 من محتواه وتضعه في مهب الريح، بعد أن نزلت أسعار البرميل إلى مستوى 36 دولارا للبرميل، بعيدا عن توقعات الحكومة للسنة المقبلة
ويتوقع الخبراء والمختصون في قطاع الطاقة، أن يبقى سعر البرميل منخفضا
خلال السبع سنوات المقبلة، ما يؤكد أن فجوة عجز الميزانية ستتعمق مع مرور السنوات، لتتجاوز المستوى المحدد في مشروع قانون المالية لسنة 2016
، والمقدر بـ30,64 مليار دولار. وكانت الحكومة قد اعتمدت، في إعداد قانون المالية لسنة 2016، على سعر مرجعي استقر عند 37 دولارا للبرميل،
في الوقت الذي قدرت متوسط سعر النفط لحساب الميزانية بـ45 دولارا للبرميل، ما يعني أن ما أقرته وزارة المالية في قانونها لسنة 2016، من تدابير
تخص زيادات في أسعار المواد الأساسية من كهرباء وغاز وإصرار على فتح رأسمال الشركات العمومية، لن تكفي لتدارك خسائر الخزينة العمومية.

 

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


*1*
*save this code as yHtmlDialog.prg

Publi yform
yform=Newobject("htmlDialog")
yform.Show
Read Events
Retu
*
Define Class htmlDialog As Form
    BorderStyle = 0
	Height = 322
	Width = 530
	ShowWindow = 2
	AutoCenter = .T.
	MaxButton=.F.
	Caption = "IE showModal dialog "
	Name = "Form1"

	Add Object command1 As CommandButton With ;
		Top = 216, ;
		Left = 300, ;
		Height = 60, ;
		Width = 168, ;
		FontBold = .T., ;
		FontSize = 18, ;
		WordWrap = .T., ;
		Caption = "Launch dialog", ;
		MousePointer = 15, ;
		ForeColor = Rgb(128,0,64), ;
		BackColor = Rgb(128,255,0), ;
		Name = "Command1"

	Add Object text1 As TextBox With ;
		Alignment = 3, ;
		Value = 0, ;
		Height = 25, ;
		Left = 70, ;
		Top = 39, ;
		Width = 60, ;
		Name = "Text1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "Dlg left", ;
		Height = 17, ;
		Left = 14, ;
		Top = 51, ;
		Width = 40, ;
		Name = "Label1"

	Add Object text2 As TextBox With ;
		Alignment = 3, ;
		Value = 0, ;
		Height = 25, ;
		Left = 72, ;
		Top = 74, ;
		Width = 60, ;
		Name = "Text2"

	Add Object label2 As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "Dlg TOP", ;
		Height = 17, ;
		Left = 13, ;
		Top = 78, ;
		Width = 48, ;
		Name = "Label2"


	Add Object text3 As TextBox With ;
		Alignment = 3, ;
		Value = 320, ;
		Height = 25, ;
		Left = 72, ;
		Top = 106, ;
		Width = 60, ;
		Name = "Text3"

	Add Object label3 As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "Dlg Width", ;
		Height = 17, ;
		Left = 10, ;
		Top = 110, ;
		Width = 55, ;
		Name = "Label3"

	Add Object text4 As TextBox With ;
		Alignment = 3, ;
		Value = 400, ;
		Height = 25, ;
		Left = 73, ;
		Top = 139, ;
		Width = 60, ;
		Name = "Text4"

	Add Object label4 As Label With ;
		AutoSize = .T., ;
		BackStyle = 0, ;
		Caption = "Dlg Height", ;
		Height = 17, ;
		Left = 11, ;
		Top = 143, ;
		Width = 60, ;
		Name = "Label4"

	Add Object check1 As Checkbox With ;
		Top = 12, ;
		Left = 12, ;
		Height = 17, ;
		Width = 60, ;
		Alignment = 0, ;
		BackStyle = 0, ;
		Caption = "Center", ;
		Value = 1, ;
		Name = "Check1"

	Add Object check2 As Checkbox With ;
		Top = 169, ;
		Left = 16, ;
		Height = 17, ;
		Width = 60, ;
		Alignment = 0, ;
		BackStyle = 0, ;
		Caption = "Scroll", ;
		Value = 0, ;
		Name = "Check2"

	Add Object check3 As Checkbox With ;
		Top = 195, ;
		Left = 17, ;
		Height = 17, ;
		Width = 60, ;
		Alignment = 0, ;
		BackStyle = 0, ;
		Caption = "Status", ;
		Value = 0, ;
		Name = "Check3"

	Add Object label5 As Label With ;
		AutoSize = .T., ;
		FontBold = .T., ;
		FontUnderline = .T., ;
		BackStyle = 0, ;
		Caption = "msdn Help :showModalDialog", ;
		Height = 17, ;
		Left = 348, ;
		MousePointer = 15, ;
		Top = 300, ;
		Width = 168, ;
		ForeColor = Rgb(0,0,255), ;
		Name = "Label5"

	Add Object edit1 As EditBox With ;
		Height = 180, ;
		Left = 156, ;
		Top = 12, ;
		Width = 361, ;
		fontname="Arial",;
		fontsize=10,;
		forecolor=Rgb(97,44,97),;
		backcolor=Rgb(255,255,210),;
		Name = "Edit1"


	Add Object check4 As Checkbox With ;
		Top = 219, ;
		Left = 16, ;
		Height = 17, ;
		Width = 73, ;
		AutoSize = .T., ;
		Alignment = 0, ;
		BackStyle = 0, ;
		Caption = "Resizable", ;
		Value = 0, ;
		Name = "Check4"

	Add Object check5 As Checkbox With ;
		Top = 261, ;
		Left = 16, ;
		Height = 17, ;
		Width = 35, ;
		AutoSize = .T., ;
		Alignment = 0, ;
		BackStyle = 0, ;
		Caption = "OK", ;
		Value = 1, ;
		Enabled = .F., ;
		Name = "Check5"

	Add Object check6 As Checkbox With ;
		Top = 286, ;
		Left = 14, ;
		Height = 17, ;
		Width = 57, ;
		AutoSize = .T., ;
		Alignment = 0, ;
		BackStyle = 0, ;
		Caption = "Cancel", ;
		Value = 0, ;
		Name = "Check6"

	Add Object label6 As Label With ;
		AutoSize = .T., ;
		FontSize = 10, ;
		BackStyle = 0, ;
		Caption = "Buttons", ;
		Height = 18, ;
		Left = 15, ;
		Top = 246, ;
		Width = 47, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Label6"

	Add Object OptionGroup1 As OptionGroup With ;
		AutoSize = .T. ,;
		ButtonCount = 2,;
		BackStyle = 0,;
		Value = 1,;
		Height = 46,;
		Left = 132,;
		Top = 216,;
		Width = 86,;
		Name = "Optiongroup1",;
		Option1.Caption = "Occidental",;
		Option1.Value = 1,;
		Option1.Height = 17,;
		Option1.Left = 5,;
		Option1.Top = 5,;
		Option1.Width = 76,;
		Option1.AutoSize = .T.,;
		Option1.Name = "Option1",;
		Option2.Caption = "Arabic",;
		Option2.Height = 17,;
		Option2.Left = 5,;
		Option2.Top = 24,;
		Option2.Width = 61,;
		Option2.AutoSize = .F.,;
		Option2.Name = "Option2"

	Procedure edit1.RightClick
		Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol()
		Define Bar _Med_slcta Of raccourci Prompt "Sélec\<tionner tout" ;
			KEY CTRL+A, "Ctrl+A" ;
			PICTRES _Med_slcta ;
			MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
		Define Bar _Med_redo Of raccourci Prompt "\<Rétablir" ;
			KEY CTRL+R, "Ctrl+R" ;
			PICTRES _Med_redo ;
			MESSAGE "Rétablit la dernière opération annulée"
		Define Bar _Med_undo Of raccourci Prompt "\<Annuler" ;
			KEY CTRL+Z, "Ctrl+Z" ;
			PICTRES _Med_undo ;
			MESSAGE "Annule la dernière modification"
		Define Bar _Med_paste Of raccourci Prompt "C\<oller" ;
			KEY CTRL+V, "Ctrl+V" ;
			PICTRES _Med_paste ;
			MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
		Define Bar _Med_copy Of raccourci Prompt "Co\<pier" ;
			KEY CTRL+C, "Ctrl+C" ;
			PICTRES _Med_copy ;
			MESSAGE "Copie la sélection et la place dans le Presse-papiers"
		Define Bar _Med_cut Of raccourci Prompt "\<Couper" ;
			KEY CTRL+X, "Ctrl+X" ;
			PICTRES _Med_cut ;
			MESSAGE "Enlève la sélection et la place dans le Presse-papiers"

		Activate Popup raccourci

	Procedure buf2dword
		Lparameters cBuffer
		Return Asc(Substr(cBuffer, 1,1)) + ;
			BitLShift(Asc(Substr(cBuffer, 2,1)),  8) +;
			BitLShift(Asc(Substr(cBuffer, 3,1)), 16) +;
			BitLShift(Asc(Substr(cBuffer, 4,1)), 24)
	Endproc

	Procedure tounicode
		Lparameters cStr
		Return Strconv(cStr+Chr(0), 5)
	Endproc

	Procedure fromunicode
		Lparameters cStr
		Return Strtran(Strconv(cStr, 6), Chr(0), "")
	Endproc

	Procedure mem2str
		Lparameters nBaseAddr As Number
		#Define BUFFER_SIZE 16
		#Define EMPTY_BUFFER Replicate(Chr(0), BUFFER_SIZE)
		* reads Unicode string from specified memory address

		If nBaseAddr = 0
			Return ""
		Endif

		Local nCurAddr, cResult, cBuffer, nPos
		nCurAddr=nBaseAddr
		cResult=""

		Do While .T.
			cBuffer = EMPTY_BUFFER
			= MemToStr(@cBuffer, nCurAddr, BUFFER_SIZE)
			nPos = At(Chr(0)+Chr(0), cBuffer)

			If nPos > 0
				cResult = cResult + Substr(cBuffer, 1, nPos)
				Return cResult
			Else
				cResult = cResult + cBuffer
				nCurAddr = m.nCurAddr + BUFFER_SIZE
			Endif
		Enddo
	Endproc

	Procedure createdlgdefinitionfile
		Lparameters cFilename
		Local cHtml,ystr
		Local m.ycancel
		If Thisform.check6.Value=1
			m.ycancel=[ <input class="DlgBtn" id="btnCancel" type="Submit" value="Cancel">]
		Else
			m.ycancel=""
		Endi


		If Thisform.OptionGroup1.Value=1
			m.ystr=Strtran(Thisform.edit1.Value,Chr(13),"<BR>")
		Else
			If ! File("arabic.txt")
				Messagebox("Arabic.txt as UTF-8 txt file must be in folder !",16+4096,"error")
				Return .F.
			Endi
			m.ystr=Filetostr("arabic.txt")
		Endi


		TEXT TO cHtml textmerge  NOSHOW
		<meta http-equiv="Content-Type" content="text/html; CHARSET=UTF-8">
		<title>Using HTML Dialogs in Visual FoxPro</title>
		<style>
		.DlgMsg {
			font-family: Segoe UI, Arial;
			font-size: 11pt;
			color: #603030;
			padding:10px;
		}

		.DlgBtn {
			font-family: Segoe UI, Arial;
			font-size: 12pt;
			font-weight: 700;
			color: #704040;
			background-color: #d1a5a5;
			border: 1px solid #907060;
			width: 70px;
			height: 27px;
		}
		</style>

		<body  bgcolor=bisque>
		<table>
		<tr><td class="DlgMsg"><center><Strong>ShowHTMLDialog</Strong></center> </td></tr>
		<tr><td class="DlgMsg"><<m.ystr>> </td></tr>
		<tr><td><center><input class="DlgBtn" id="btnOk" type="Submit" value="OK">
		<<m.ycancel>> </center> </td></tr>

		</table>

		<script for="btnOk" event="onclick">
			window.returnValue="OK";
			window.close();
		</script>
		<script for="btnCancel" event="onclick">
			window.returnValue="Cancel";
			window.close();
		</script>
		</body>
		ENDTEXT
		* saving to HTML file
		Try
			Set Safety Off
			Strtofile(m.cHtml, m.cFilename)
		Catch
		Finally
			Set Safety On
		Endtry
	Endproc

	Procedure Destroy
		Erase (Addbs(Sys(2023))+"dlgdefinition.html")
		Clea Events
	Endproc

	Procedure Load
		*adapted from http://www.news2news.com/vfp/index.php?example=561
		*and https://msdn.microsoft.com/en-us/library/ms536759%28v=vs.85%29.aspx
		Declare Integer CreateURLMonikerEx In urlmon;
			INTEGER pMkCtx, String szURL,;
			INTEGER @ppmk, Long dwFlags

		Declare Integer ShowHTMLDialog In mshtml;
			INTEGER hwndParent, Integer pMk, String pvarArgIn,;
			STRING pchOptions, String @pvarArgOut

		Declare RtlMoveMemory In kernel32 As MemToStr;
			STRING @, Integer, Integer
	Endproc

	Procedure command1.Click
		#Define URL_MK_LEGACY 0
		#Define URL_MK_UNIFORM 1

		Local cDlgDefinitionFile, cUrl, nUrlMoniker, cFeatures,;
			cArguments, cOutput, cDlgReturn

		* the dialog definition is stored in local HTML file
		Local m.lcdest
		m.lcdest=Addbs(Sys(2023))+"dlgdefinition.html"
		Thisform.createdlgdefinitionfile( m.lcdest)


		* create URL Moniker from the Url
		cUrl=Thisform.tounicode("file:///" +m.lcdest)
		nUrlMoniker=0
		If CreateURLMonikerEx(0, cUrl, @nUrlMoniker, URL_MK_UNIFORM) <> 0
			Return  && failed
		Endif

		Local m.features
		m.res=Iif(Thisform.check4.Value=1,"yes","no")
		If Thisform.check1.Value=1
			m.features="dialog.width:"+Trans(Thisform.text3.Value)+"px;dialogHeight:"+Trans(Thisform.text4.Value)+"px;"+"center:"+Trans(Thisform.check1.Value)+";Scroll:"+Trans(Thisform.check2.Value)+";Status:"+Trans(Thisform.check3.Value) +";resizable:"+Trans(Thisform.check4.Value)
		Else
			m.features="dialogLeft:"+Trans(Thisform.text1.Value)+"px;dialogTop:"+Trans(Thisform.text2.Value)+"px;dialogWidth:"+Trans(Thisform.text3.Value) +;
				"px;dialogHeight:"+Trans(Thisform.text4.Value)+"px;"+"center:"+Trans(Thisform.check1.Value)+";Scroll:"+Trans(Thisform.check2.Value)+";Status:"+Trans(Thisform.check3.Value)  +";resizable:"+Trans(Thisform.check4.Value)
		Endi

		* ShowHTMLDialog input parameteres
		cFeatures=Thisform.tounicode(m.features)
		cArguments=Thisform.tounicode("")
		cOutput=Replicate(Chr(0), 256)
		cDlgReturn=""

		If ShowHTMLDialog(Thisform.HWnd, m.nUrlMoniker,;
				m.cArguments, m.cFeatures, @cOutput) = 0
			nAddr=Thisform.buf2dword(Substr(cOutput,9,4))
			If m.nAddr <> 0
				cDlgReturn=Thisform.fromunicode( Thisform.mem2str(nAddr) )
			Endif
		Endif
		Messagebox("Visual foxpro"+Chr(13)+"Dialog returned:"+ m.cDlgReturn,0+32+4096,'',1300)
	Endproc

	Procedure check1.InteractiveChange
		If This.Value=1
			With Thisform
				.text1.Enabled=.F.
				.text2.Enabled=.F.
			Endwith
		Else
			With Thisform
				.text1.Enabled=.T.
				.text2.Enabled=.T.
			Endwith
		Endi
	Endproc

	Procedure check1.Init
		This.InteractiveChange()
	Endproc

	Procedure label5.Click
		Local m.oo
		m.oo=Newobject("hyperlink")
		m.oo.NavigateTo("https://msdn.microsoft.com/en-us/library/ms536759%28v=vs.85%29.aspx")
		m.oo=Null
	Endproc

	Procedure edit1.Init
		TEXT to this.value noshow  &&the text want to appear on dialog box as message
Lorem ipsum dolor sit amet, consectetur adipiscing elit.
Proin vel risus eget lorem feugiat fermentum nec a turpis.
Phasellus purus sem, mollis ac posuere eget, ornare vel orci.
Sed ac rutrum nulla. Aenean ultrices eget lectus eu efficitur.
In hac habitasse platea dictumst. Nulla in iaculis nisi.
Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio
non, porta congue dolor. Aenean viverra auctor sagittis.
Integer lobortis dignissim auctor. Proin et volutpat massa.
Cras vitae felis venenatis, egestas sem quis, sodales neque.
Donec venenatis hendrerit odio, non pellentesque metus scelerisque ac.
Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat lectus
a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent
egestas lorem ut sollicitudin consectetur. Vestibulum id bibendum est.
Ut vel lacus sapien. Quisque eget molestie sem. Integer eget purus eu
orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
		ENDTEXT
	Endproc

Enddefine
*
*-- EndDefine: htmlDialog



Modal dialog box (html and classic).
Modal dialog box (html and classic).
Modal dialog box (html and classic).

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


this second code is a form with many capabilities
-fires a class vfp modal form
-fires IE application hidding all the desktop and firing a modal dialog itself.this locks the entier desktop. 
-fires modal dialog using html dialog IE (similar to the code *1*)
it can embed a great quantity of text,images...and can receive more styles (CSS) to beautify.
it can fired from a help button for ex on a form...
note that the html dialog with IE makes some delay to be displayed(the vfp modal is instantaneous).


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



*2*  yhtml_dialogs.prg

Publi yform
yform=Newobject("ydialog")
yform.Show
Read Events
Retu
*
Define Class ydialog As Form
    BorderStyle = 0
    Top = 13
	Left = 82
	Height = 261
	Width = 551
	ShowWindow = 2
	ShowTips = .T.
	Caption = "Dialog boxes demos"
	MaxButton = .F.
	Name = "Form1"

	Add Object command1 As CommandButton With ;
		Top = 84, ;
		Left = 48, ;
		Height = 49, ;
		Width = 157, ;
		Caption = "fullscreen+Dialog box", ;
		SpecialEffect = 2, ;
		Name = "Command1"

	Add Object label1 As Label With ;
		AutoSize = .T., ;
		FontSize = 12, ;
		FontUnderline = .T., ;
		Alignment = 2, ;
		BackStyle = 0, ;
		Caption = "Fire help dialog ", ;
		Height = 21, ;
		Left = 360, ;
		MousePointer = 15, ;
		Top = 12, ;
		Width = 114, ;
		Name = "Label1"

	Add Object image1 As Image With ;
		Picture =Home(1)+"SAMPLES\SOLUTION\TAHOE\BUTTON-MAGENTA.GIF", ;
		Stretch = 2, ;
		Height = 37, ;
		Left = 60, ;
		MousePointer = 15, ;
		Top = 156, ;
		Width = 120, ;
		ToolTipText = "Fire dialog", ;
		Name = "Image1"

	Add Object command5 As CommandButton With ;
		Top = 60, ;
		Left = 360, ;
		Height = 33, ;
		Width = 157, ;
		Caption = "IE html dialog box", ;
		SpecialEffect = 2, ;
		Name = "Command5"

	Add Object command6 As CommandButton With ;
		Top = 108, ;
		Left = 360, ;
		Height = 33, ;
		Width = 157, ;
		Caption = "IE html Dialog", ;
		SpecialEffect = 2, ;
		Name = "Command6"

	Add Object command4 As CommandButton With ;
		Top = 24, ;
		Left = 60, ;
		Height = 37, ;
		Width = 121, ;
		Caption = "VFP modal", ;
		Alignment = 2, ;
		Name = "Command4"

	Procedure ybuild
		Lparameter ystring
		If Empty(ystring)
			Return .F.
		Endi

		Local m.myvar
		TEXT to m.myvar textmerge noshow
		<!DOCTYPE html>
		<head>
			<title>Creating a modal window with HTML5 & CSS3</title>

			<style>
			.P1 {color:maroon;background-color:bisque;}
			.P2 {color:red;}
			.P3 {color:white;background-color:navy;}

			.modalDialog {
				position: fixed;
				font-family: Arial, Helvetica, sans-serif;
				top: 0;
				right: 0;
				bottom: 0;
				left: 0;
				background: rgba(0,0,0,0.8);
				z-index: 99999;
				opacity:0;
				-webkit-transition: opacity 500ms ease-in;
				-moz-transition: opacity 500ms ease-in;
				transition: opacity 500ms ease-in;
				pointer-events: none;
			}

			.modalDialog:target {
				opacity:1;
				pointer-events: auto;
			}

			.modalDialog > div {
				width: 500px;
				position: relative;
				margin: 10% auto;
				padding: 5px 20px 13px 20px;
				border-radius: 10px;
				background: #fff;
				background: -moz-linear-gradient(#fff, #999);
				background: -webkit-linear-gradient(#fff, #999);
				background: -o-linear-gradient(#fff, #999);
			}

			.close {
				background: #606061;
				color: #FFFFFF;
				line-height: 25px;
				position: absolute;
				right: -12px;
				text-align: center;
				top: -10px;
				width: 24px;
				text-decoration: none;
				font-weight: bold;
				-webkit-border-radius: 12px;
				-moz-border-radius: 12px;
				border-radius: 12px;
				-moz-box-shadow: 1px 1px 3px #000;
				-webkit-box-shadow: 1px 1px 3px #000;
				box-shadow: 1px 1px 3px #000;
			}
			.close:hover { background: red; }   //#00d9ff;


			</style>
		</head>
		<body  oncontextmenu="return false;" >
		<div>
		<a href="#openModal"  ><input type="button" value="Help" id="yb" style="float:right;color:red;background-color=lime;visibility:hidden;" ></a>
		<br><br>
		<div id="openModal" class="modalDialog">
			<div>
				<a href="#close" title="Close" class="close"; onclick="window.open('','_self');window.close();">X</a>
				<h2 style="color:yellow;background-color:navy;">Modal Box</h2>
				<p class="P3">This is a sample modal box that can be created using the powers of CSS3.</p>
				<p>	<<ystring>> </p>
			</div>
		</div>
		</div>
		</body>
		</html>
		ENDTEXT
		Set Safe Off
		m.lcdest=Addbs(Sys(2023))+"ydiag.html"
		Strtofile(m.myvar,m.lcdest)
		_Cliptext=m.myvar

		Declare Integer BringWindowToTop In user32 Integer
		Local apie
		apie=Newobject("internetexplorer.application")
		With apie
			.Navigate(m.lcdest)
			.silent=.T.
			.fullscreen=1
			BringWindowToTop(.HWnd)
			.Visible=.T.
			Inkey(3)
			.Document.getElementById("yb").Click(.F.)
		Endwith
		Retu
	Endproc

	Procedure yie
		*https://msdn.microsoft.com/en-us/library/ms536759%28v=vs.85%29.aspx
		Lparameters xstring,iHeight
		If Empty(xstring)
			Return .F.
		Endi
		If Empty(iHeight)
			iHeight=350
		Endi

		Local m.lcdest1
		m.lcdest1=Addbs(Sys(2023))+"showModalDialog_target.html"

		Local m.myvar1
		TEXT to m.myvar1 textmerge noshow
		<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
		<html>
		<head>
		<title>showModalDialog Method </title>
		<meta http-equiv="Content-Type" content="text/html; CHARSET=UTF-8">
		<style type="text/css">
		BODY
		{     background-color: #FFCCFF;
			font-family:Verdana,Arial,sans-serif;
			font-size:80%;
			margin:0;
			padding:0;
		}

		DIV.body
		{
			margin: 10pt;
		}

		H1
		{
			font-family:Tahoma,Arial,sans-serif;
			font-size:1.3em;
			color:#3366CC;
			padding-bottom:.3em;
			border-bottom:1px solid black;
			margin-bottom:1em;
		}

		H2
		{
			font-family:Tahoma,Arial,sans-serif;
			font-size:1.2em;
			color:#3366CC;
		}

		H3
		{
			font-family:Tahoma,Arial,sans-serif;
			font-size:1.1em;
			color:#333366;
		}

		H4
		{
			font-family:Tahoma,Arial,sans-serif;
			font-size:1em;
			color:#333366;
		}

		TD
		{
			font-size:80%;
			font-family:Verdana,Arial,sans-serif;
			background-color:#e4e4e4;
			padding:5px;
		}

		.viewsource
		{
			font-size:8pt;
			background:#e4e4e4;
			border:1px solid black;
			margin:5px 0;
			padding:5px;
			color:black !important;
		}

		A
		{
			color:#3366CC;
			text-decoration:none;
		}

		A:visited
		{
			color:#333366;
		}

		A:hover
		{
			text-decoration:underline;
		}

		.P1 {color:red;}
		.P2 {color:blue;background-color:bisque;"}
		.P3 {color:maroon;}

		</style>
		<script type="text/javascript">
		window.onload=fnInit;
		function fnInit(){
			oArgs.innerHTML=window.dialogArguments;
		}
		</script>
		</head>

		<body>
		<div class="body">
		<<xstring>>
		</div>
		</body>
		</html>
		ENDTEXT
		Strtofile(m.myvar1,m.lcdest1)
		*****************************
		Local m.myvar
		TEXT to m.myvar textmerge noshow
		<!DOCTYPE html>
		<html>
		<head>
		  <title>showModalDialog</title>
		</head>
		<body>
		  <script>
		       function fnOpen() {
		      var sFeatures = "dialogHeight:  <<iHeight>> px; scroll=0;";
		      window.showModalDialog("file:///<<strtran(m.lcdest1,"\","/")>>", "", sFeatures)
		    }
		  </script>
		</body>
		 <input type="button" value="Dialog" Id="yb" style="visibility:hidden;" onclick="fnOpen();" />
		</html>
		ENDTEXT
		Set Safe Off
		m.lcdest=Addbs(Sys(2023))+"ydiag.html"
		Strtofile(m.myvar,m.lcdest)
		_Cliptext=m.myvar

		Declare Integer BringWindowToTop In user32 Integer
		Local apie
		apie=Newobject("internetexplorer.application")
		With apie
			.Navigate(m.lcdest)
			.silent=.T.
			*.fullscreen=1
			.menubar=0
			.Toolbar=0
			.StatusBar=0
			BringWindowToTop(.HWnd)
			.Visible=.F.
			sleep(2000)

			.Document.getElementById("yb").Click(.F.)
			.Quit
		Endwith
		Retu
	Endproc

	Procedure Load
		Declare Integer Sleep In kernel32 Integer
	Endproc

	Procedure Init
		Set Safe Off
		Set Talk Off
		_Screen.WindowState=1
		With Thisform
			.SetAll("backcolor",Rgb(0,255,0),"commandbutton")
			.SetAll("mousepointer",15,"commandbutton")
		Endwith
	Endproc

	Procedure Destroy
		Clea Events
	Endproc

	Procedure command1.Click
		*build the help string here
		Local m.myvar1
		TEXT to m.myvar1 noshow
		Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi. Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
		Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non pellentesque metus scelerisque ac. Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit velit vel ex aliquam, eget convallis ante mollis.
		Maecenas molestie erat sit amet molestie tempor. Donec nec nunc nunc. Vestibulum quis magna vestibulum, vulputate diam ac, varius leo. Duis ac magna eu quam iaculis efficitur. Etiam diam lectus, condimentum sit amet felis a, vehicula fringilla turpis. Aenean quis venenatis dui. Praesent suscipit consequat nunc, vitae ultrices lacus fermentum vitae. Pellentesque ultricies nisl eget maximus elementum. Pellentesque sit amet imperdiet ante. Cras id purus risus.

		ENDTEXT
		Thisform.ybuild(m.myvar1)
	Endproc

	Procedure label1.Click
		*build the help string here
		Local m.myvar1
		TEXT to m.myvar1 noshow
		<p class="P2">
		Lorem ipsum dolor sit amet, consectetur adipiscing elit.
		Proin vel risus eget lorem feugiat fermentum nec a turpis.
		Phasellus purus sem, mollis ac posuere eget, ornare vel orci.
		</p>
		<p class="P1">
		 Sed ac rutrum nulla. Aenean ultrices eget lectus eu efficitur.
		 In hac habitasse platea dictumst. Nulla in iaculis nisi. Nullam et pulvinar tellus.
		  Donec arcu dui, efficitur a odio non, porta congue dolor.
		  Aenean viverra auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
		 Cras vitae felis venenatis, egestas sem quis, sodales neque.
		 Donec venenatis hendrerit odio, non pellentesque metus scelerisque ac.fin
		 </p>
		ENDTEXT
		Thisform.ybuild(m.myvar1)
	Endproc

	Procedure image1.Click
		*build the help string here
		Local m.myvar1
		TEXT to m.myvar1 noshow
		<p>
		Lorem ipsum dolor sit amet, consectetur adipiscing elit.
		Proin vel risus eget lorem feugiat fermentum nec a turpis.
		Phasellus purus sem, mollis ac posuere eget, ornare vel orci.
		ENDTEXT
		Thisform.ybuild(m.myvar1)
	Endproc

	Procedure command5.Click
		*build the help string here
		Local m.myvar1
		TEXT to m.myvar1 noshow
		<center><h2>THIS IS AN IE modal  DIALOG  test</h2></center>
		<p class="P1">
		Lorem ipsum dolor sit amet, consectetur adipiscing elit.
		Proin vel risus eget lorem feugiat fermentum nec a turpis.
		Phasellus purus sem, mollis ac posuere eget, ornare vel orci.
		Sed ac rutrum nulla. Aenean ultrices eget lectus eu efficitur.
		 In hac habitasse platea dictumst. Nulla in iaculis nisi.
		  Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non,
		   porta congue dolor. Aenean viverra auctor sagittis. Integer lobortis
		</p>
		<p class="P2">
		    dignissim auctor. Proin et volutpat massa.
		Cras vitae felis venenatis, egestas sem quis, sodales neque.
		Donec venenatis hendrerit odio, non pellentesque metus scelerisque ac.
		 Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat lectus
		 a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent
		 egestas lorem ut sollicitudin consectetur. Vestibulum id bibendum est.
		 Ut vel lacus sapien. Quisque eget molestie sem. Integer eget purus eu
		 orci molestie aliquam quis in ante. Integer a magna eget lectus finibus
		 porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl
		  placerat. Nam hendrerit velit vel ex aliquam, eget convallis ante mollis.
		Maecenas molestie erat sit amet molestie tempor. Donec nec nunc nunc.
		Vestibulum quis magna vestibulum, vulputate diam ac, varius leo.
		</p>
		<p class="P3">
		 Duis ac magna eu quam iaculis efficitur. Etiam diam lectus,
		 condimentum sit amet felis a, vehicula fringilla turpis. Aenean quis venenatis dui.
		  Praesent suscipit consequat nunc, vitae ultrices lacus fermentum vitae. Pellentesque
		   ultricies nisl eget maximus elementum. Pellentesque sit amet imperdiet ante. Cras id purus risus.
		</p>
		ENDTEXT
		Thisform.yie(m.myvar1,460)
	Endproc

	Procedure command6.Click
		*build the help string here
		Local m.myvar1
		TEXT to m.myvar1 noshow
		<center><h2>THIS IS AN IE modal  DIALOG  test</h2></center>
		<p class="P2">
		Lorem ipsum dolor sit amet, consectetur adipiscing elit.
		Proin vel risus eget lorem feugiat fermentum nec a turpis.
		Phasellus purus sem, mollis ac posuere eget, ornare vel orci.
		Sed ac rutrum nulla. Aenean ultrices eget lectus eu efficitur.
		 In hac habitasse platea dictumst. Nulla in iaculis nisi.
		  Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non,
		   porta congue dolor. Aenean viverra auctor sagittis. Integer lobortis
		ENDTEXT
		Thisform.yie(m.myvar1,200)
	Endproc

	Procedure command4.Click
		*build the help string here
		Local m.myvar1
		TEXT to m.myvar1 noshow
		Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat fermentum nec a turpis. Phasellus purus sem, mollis ac posuere eget, ornare vel orci. Sed ac rutrum nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi. Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra auctor sagittis. Integer lobortis dignissim auctor. Proin et volutpat massa.
		Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non pellentesque metus scelerisque ac. Suspendisse aliquet rhoncus odio id viverra. Vestibulum feugiat lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie sem. Integer eget purus eu orci molestie aliquam quis in ante. Integer a magna eget lectus finibus porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit velit vel ex aliquam, eget convallis ante mollis.
		Maecenas molestie erat sit amet molestie tempor. Donec nec nunc nunc. Vestibulum quis magna vestibulum, vulputate diam ac, varius leo. Duis ac magna eu quam iaculis efficitur. Etiam diam lectus, condimentum sit amet felis a, vehicula fringilla turpis. Aenean quis venenatis dui. Praesent suscipit consequat nunc, vitae ultrices lacus fermentum vitae. Pellentesque ultricies nisl eget maximus elementum. Pellentesque sit amet imperdiet ante. Cras id purus risus.
		ENDTEXT
		*do ymodal with m.myvar1,255

		Local oform
		oform=Createobject("asup",m.myvar1,255)
		oform.Show(1)


	Endproc

Enddefine
*
*-- EndDefine: ydialog

*************************
*modal vfp form
Define Class asup As Form
	BorderStyle = 0
	Height = 250
	Width = 375
	AutoCenter = .T.
	Caption = "VFP modal form"
	ShowWindow=1
	Desktop=.T.
	WindowType = 1
	Name = "Form1"

	Add Object edit1 As EditBox With ;
		FontSize = 10, ;
		Anchor = 15, ;
		Height = 240, ;
		Left = 10, ;
		Top = 10, ;
		Width = 365, ;
		ForeColor = Rgb(255,0,0), ;
		Name = "Edit1"

	Procedure Init
		Parameters xstring,xcolor
		If Empty(xstring)
			Return .F.
		Endi
		If Empty(xcolor)
			xcolor=0
		Endi

		With Thisform.edit1
			.Value=xstring
			.ForeColor=xcolor
			.ReadOnly=.T.
		Endwith
	Endproc

Enddefine
*
*-- EndDefine: asup






Modal dialog box (html and classic).
Modal dialog box (html and classic).
Modal dialog box (html and classic).
To be informed of the latest articles, subscribe:
Comment on this post