*!* Author: Cetin BASOZ
Public oForm
oForm = Createobject('htmlSample', GetHTML())
oForm.Show()
Function GetHTML
*Return HTMLShowerx()
Local myVar
TEXT to myVar noshow
<html>
<head>
<title>New User Sign Up</title>
<script language="JScript">
var message="Don't use RIGHT CLICK"
function click(e) {
if (document.all) {
if (event.button == 2) {
alert(message);
return false;
}
}
if (document.layers) {
if (e.which == 3) {
alert(message);
return false;
}
}
}
if (document.layers) {
document.captureEvents(Event.MOUSEDOWN);
}
document.onmousedown=click;
function LoadTreeView()
{
var TreeView1 = document.all('Tree001');
var oNode = TreeView1.Nodes.Add(null,0,"top","My Tree");
TreeView1.Nodes.Add("top",4,"root0","Main node 0");
TreeView1.Nodes.Add("top",4,"root1","Main node 1");
TreeView1.Nodes.Add("top",4,"root2","Main node 2");
TreeView1.Nodes.Add("root1",4,"child11","Child11");
TreeView1.Nodes.Add("root1",4,"child12","Child12");
TreeView1.Nodes.Add("root2",4,"child21","Child21");
TreeView1.Nodes.Add("child11",4,"child111","child111");
TreeView1.Nodes.Add("child11",4,"child113","child113");
TreeView1.Nodes.Add("child113",3,"child112","child112");
oNode.Expanded = true;
var TreeView2 = document.all('Tree002');
var oNode = TreeView2.Nodes.Add(null,0,"top","My Tree");
TreeView2.Nodes.Add("top",4,"root0","Main node 0");
TreeView2.Nodes.Add("top",4,"root1","Main node 1");
TreeView2.Nodes.Add("top",4,"root2","Main node 2");
TreeView2.Nodes.Add("root1",4,"child11","Child11");
TreeView2.Nodes.Add("root1",4,"child12","Child12");
TreeView2.Nodes.Add("root2",4,"child21","Child21");
TreeView2.Nodes.Add("child11",4,"child111","child111");
TreeView2.Nodes.Add("child11",4,"child113","child113");
TreeView2.Nodes.Add("child113",3,"child112","child112");
oNode.Expanded = true;
}
function CheckTable(dbcPath,dbfName)
{
var strCn = "Provider=VFPOLEDB;Data Source=" + dbcPath;
var strSQL = "select * from " + dbfName;
var oConn = new ActiveXObject("Adodb.Connection");
oConn.ConnectionString = strCn;
oConn.Open;
var oRS = oConn.Execute(strSQL);
var lst="<TABLE border='1'><TR>";
var Maxfields=5;
var MaxRows=20;
for (i=0;i<Math.min(oRS.Fields.Count,Maxfields);i++)
{
lst += "<TH>";
lst += oRS.Fields(i).Name;
lst += "</TH>";
}
lst += "</TR>";
var counter=0;
while (!oRS.eof && counter < MaxRows)
{
lst += "<TR>";
for (i=0;i<Math.min(oRS.Fields.Count,Maxfields);i++)
{
lst += "<TD>";
lst += oRS.Fields(i).Value;
lst += "</TD>";
}
lst += "</TR>";
oRS.MoveNext();
counter++;
}
lst += "</TABLE>";
oConn.Close();
tablelist.innerHTML = lst;
return true;
}
</script>
</head>
<body bgcolor=Turquoise onload="LoadTreeView();">
<h1 align="Center"><font color="#000080">New User Sign Up</font></h1>
<form method="GET" action="empty.htm" target="_self" name="myForm">
<table border="0" cellspacing="1">
<tr><td>ID</td><td><input type="text" name="ID" ID="SSNNumber" size="16" maxlength="16"></td></tr>
<tr><td>First Name</td><td><input type="text" name="First" size="30" maxlength="15"></td></tr>
<tr><td>Last Name</td><td><input type="text" name="Last" size="30" maxlength="20"></td></tr>
<td>Gender?</td>
<td>
<select name="Selection1">
<option value="0">- Gender -</option>
<option value="1">Female</option>
<option value="2">Male</option>
</select></td></tr>
<tr>
<td>Multi Selection</td>
<td>
<select multiple name="MulSelection">
<option value="0">- Sports you watch -</option>
<option value="1">Basketball</option>
<option value="2">Soccer</option>
<option value="3">Football</option>
<option value="4">Volleyball</option>
<option value="5">Formula1</option>
<option value="6">Nascar</option>
</select></td></tr>
</table>
<TEXTAREA ID=txtComments STYLE="overflow:scroll; width:70%; height:150">
Sometimes an HTML based VFP form can be cool.
Think you could have syntax coloring on a form :)
Play flash movie (better play "Need For Speed" - post me too if you find a flash version), have a calendar etc.
</TEXTAREA>
<p>
<A HREF="newpage.htm" TARGET="_self">Go to New Page.</A>
<input type=submit name=sub1 value="Write" onclick='document.all("submitter").value="writeButton";'>
<input type=submit name=sub2 value="Update" onclick='document.all("submitter").value="updateButton";'>
<input type=submit name=sub3 value="Clear" onclick='document.all("submitter").value="clearButton";'>
<p>
<object name="Treeview" classid="clsid:C74190B6-8589-11D1-B16A-00C0F0283628"
id="Tree001" width="242" height="159">
<param name="_ExtentX" value="6403">
<param name="_ExtentY" value="4207">
<param name="_Version" value="393217">
<param name="HideSelection" value="0">
<param name="Indentation" value="1000">
<param name="LabelEdit" value="0">
<param name="LineStyle" value="0">
<param name="PathSeparator" value="/">
<param name="Sorted" value="0">
<param name="Style" value="7">
<param name="Checkboxes" value="0">
<param name="FullRowSelect" value="0">
<param name="HotTracking" value="0">
<param name="Scroll" value="1">
<param name="SingleSel" value="0">
<param name="ImageList" value>
<param name="BorderStyle" value="0">
<param name="Appearance" value="1">
<param name="MousePointer" value="0">
<param name="Enabled" value="1">
<param name="OLEDragMode" value="0">
<param name="OLEDropMode" value="0">
</object>
</p>
<p>
<object name="Treeview" classid="clsid:C74190B6-8589-11D1-B16A-00C0F0283628"
id="Tree002" width="242" height="159">
<param name="_ExtentX" value="6403">
<param name="_ExtentY" value="4207">
<param name="_Version" value="393217">
<param name="HideSelection" value="0">
<param name="Indentation" value="1000">
<param name="LabelEdit" value="0">
<param name="LineStyle" value="0">
<param name="PathSeparator" value="/">
<param name="Sorted" value="0">
<param name="Style" value="7">
<param name="Checkboxes" value="0">
<param name="FullRowSelect" value="0">
<param name="HotTracking" value="0">
<param name="Scroll" value="1">
<param name="SingleSel" value="0">
<param name="ImageList" value>
<param name="BorderStyle" value="0">
<param name="Appearance" value="1">
<param name="MousePointer" value="0">
<param name="Enabled" value="1">
<param name="OLEDragMode" value="0">
<param name="OLEDropMode" value="0">
</object>
</p>
</form>
<input type=hidden name="submitter" value=0>
<p>Browse a VFP table</p>
<table>
<TR><TD>Locate DBC</TD><TD><input type='file' size='80' name='DBCLOCATION'></TD></TR>
<TR><TD>TableName</TD><TD><input type='text' size='80' name='TABLENAME'></TD></TR>
</TABLE><HR>
<input type='button' value='List' onClick="CheckTable(DBCLOCATION.value,TABLENAME.value);return;">
<div id='tablelist'></div>
</body>
</html>
ENDTEXT
Return myVar
Define Class htmlSample As Form
Top = 0
Left = 0
Height = 600
Width = 800
DoCreate = .T.
Caption = "HTML sample"
cHTML = "<html><body></body></html>"
cHTMFile = ''
DoNotErase = .T.
Add Object htmlviewer As OleControl With ;
Top = 0, ;
Left = 0, ;
Height = 600, ;
Width = 800, ;
Visible = .T., ;
Name = "HTMLViewer", ;
OleClass = 'Shell.Explorer'
Procedure Destroy
If !This.DoNotErase And !Empty(This.cHTMFile) And File(This.cHTMFile)
Erase (This.cHTMFile)
Endif
Endproc
Procedure Init
Lparameters tcHTML, tlIsFile
If m.tlIsFile And !Empty(m.tcHTML) And File(m.tcHTML)
This.cHTMFile = m.tcHTML
This.DoNotErase = .T.
With Thisform.htmlviewer
.Navigate2('file://'+This.cHTMFile)
Do While .ReadyState # 4 && Wait for ready state
Enddo
Endwith
Else
If !Empty(m.tcHTML)
This.cHTMFile = Forcepath(Sys(2015)+'.htm',Sys(2023))
This.DoNotErase = .F.
Strtofile(m.tcHTML, This.cHTMFile)
With Thisform.htmlviewer
.Navigate2('file://'+This.cHTMFile)
Do While .ReadyState # 4 && Wait for ready state
Enddo
Endwith
Else
With This.htmlviewer
.Navigate2("about:blank")
.Document.Write(This.cHTML)
Endwith
Endif
Endif
Endproc
Procedure htmlviewer.NavigateError
Lparameters pdisp, url, frame, statuscode, Cancel
TEXT to m.lcParamList textmerge noshow
pdisp = pdisp
url = <<url>>
frame = <<frame>>
statuscode = <<statuscode>>
Cancel = <<Cancel>>
ENDTEXT
Messagebox(m.lcParamList)
Cancel = .T.
Endproc
Procedure htmlviewer.BeforeNavigate2
Lparameters pdisp, url, Flags, targetframename, postdata, headers, Cancel
TEXT to m.lcParamList textmerge noshow
pdisp = pdisp
url = <<url>>
flags = <<flags>>
targetframename = <<targetframename>>
postdata = <<postdata>>
headers = <<headers>>
Cancel = <<Cancel>>
ENDTEXT
Messagebox(m.lcParamList)
* oFrm = This.Object.Document.myForm
lcVals = ""
If This.Object.Document.Forms.Length > 0
For Each oFrm In This.Object.Document.Forms
lcVals = lcVals + oFrm.Name + Chr(13)
If oFrm.elements.Length > 0
For Each oElem In oFrm.elements
If oElem.Name = "Treeview"
lcVals = lcVals + "Name :" + oElem.Name + '::'+ oElem.Id + '::'+ "/Value:"+;
Iif(!Isnull(oElem.SelectedItem),;
oElem.SelectedItem.Key,"NULL") + Chr(13)
Else
If oElem.Type = "select-multiple"
lcList=''
For ix=0 To oElem.Length-1
If oElem.Item(ix).Selected
lcList = lcList + Iif(Empty(lcList),'',',')+oElem.Item(ix).Value
Endif
Endfor
lcVals = lcVals + "Name :" + oElem.Name + '::'+ oElem.Id + '::'+ "/Value:"+lcList + Chr(13)
Else
lcVals = lcVals + "Name :" + oElem.Name + '::'+ oElem.Id + '::'+ "/Value:"+oElem.Value + Chr(13)
Endif
Endif
oElem = .Null.
Endfor
Endif
oFrm = .Null.
Endfor
Endif
Cancel = .T. && prevents actual navigation
lcVals = lcVals + Chr(13)+Chr(10)+;
'Submitted by:'+Transform(This.Object.Document.All("submitter").Value)
Messagebox(lcVals)
Endproc
Procedure htmlviewer.Refresh
Nodefault
Endproc
Enddefine
. Birkaç örnekte indirdim fakat farklı sayfada açılması için ayarlanmış linkleri devre dışı bırakamıyorum