Konu: Baska seyle ugrasirken eski koda denk geldim...
iyi kodlardan birisi gibi geldi. Umarim birinin isine yarar. Sag klik denemeyi unutmayin:
Visual Fox Pro
Public oForm
oForm = NewObject('HTMLViewerForm')
oForm.Show
Local loDocument
loDocument = oForm.htMLVIEWER.obJECT.document
Select cust_id,company,contact,country,region from customer into cursor crsCustomer
loTableX = _GetTable(loDocument)
loDocument.body.AppendChild(loTableX)
_cliptext = loDocument.body.outerHTML
Procedure _GetTable
Lparameters toDocument
Local Array aHeaders[1], aColumns[1]
Local oTable,oThead,oTFoot,oTBody,oCaption, jx
oTable = toDocument.createElement("TABLE")
oThead = toDocument.createElement("THEAD")
oTBody1 = toDocument.createElement("TBODY")
oTBody2 = toDocument.createElement("TBODY")
oTBody3 = toDocument.createElement("TBODY")
oTFoot = toDocument.createElement("TFOOT")
oCaption = toDocument.createElement("CAPTION")
* Insert the created elements into oTable.
With oTable
.Border = 1
.Id = 'customers'
*.Style.borderCollapse="collapse"
.Style.BorderColor = "#000000"
.Style.BorderWidth = "thin"
.Style.BorderStyle = "solid"
.appendChild(oThead)
.appendChild(oTBody1)
.appendChild(oTBody2)
.appendChild(oTBody3)
.appendChild(oTFoot)
.appendChild(oCaption)
.cellSpacing = 0
.cellPadding = 0
Endwith
oTBody1.bgColor = "#E0E0E0"
oTBody2.bgColor = "#00FFFF"
oTBody3.bgColor = "#FF00FF"
Select crsCustomer
* Insert a row into the header and set its background color.
oThead.bgColor = "lightskyblue"
lcHeaders = "cust_id,company,contact,country"
oRow = toDocument.createElement("TR")
oCell = toDocument.createElement("TH")
oCell.rowspan = 2
oCell.innerText = "Customer ID"
oRow.appendChild(oCell)
oCell = toDocument.createElement("TH")
oCell.rowspan = 2
oCell.innerText = "Company"
oRow.appendChild(oCell)
oCell = toDocument.createElement("TH")
oCell.colspan = 2
oCell.innerText = "Showed Up"
oRow.appendChild(oCell)
oThead.appendChild(oRow)
oRow = toDocument.createElement("TR")
oCell = toDocument.createElement("TH")
oCell.innerText = "Contact"
oRow.appendChild(oCell)
oCell = toDocument.createElement("TH")
oCell.innerText = "Country"
oRow.appendChild(oCell)
oThead.appendChild(oRow)
Scan
oRow = toDocument.createElement("TR")
If country='USA'
oTBody2.appendChild(oRow)
Else
If country='Germany'
oTBody1.appendChild(oRow)
Else
oTBody3.appendChild(oRow)
endif
endif
*CustID
oCell = toDocument.createElement("TD")
oCell.Rowspan=2
oCell.style.fontWeight = "bold"
oCell.innerText = Trim(cust_id)
oRow.appendChild(oCell)
*Company
oCell = toDocument.createElement("TD")
* oCell.Rowspan=2
oCell.innerText = Trim(company)
oRow.appendChild(oCell)
*Contact
oCell = toDocument.createElement("TD")
* oCell.Rowspan=2
oCell.innerText = Trim(contact)
oRow.appendChild(oCell)
* Country and region
oCell = toDocument.createElement("TD")
* oCell.Rowspan=2
oCell.innerText = Trim(country)
oRow.appendChild(oCell)
oSubRow = toDocument.createElement("TR")
If country='USA'
oTBody2.appendChild(oSubRow)
Else
If country='Germany'
oTBody1.appendChild(oSubRow)
Else
oTBody3.appendChild(oSubRow)
endif
endif
* Country and region
oCell = toDocument.createElement("TD")
oCell.colspan=3
oCell.style.fontStyle = "italic"
oCell.innerText = Trim(country - (' - ' + region))
If region='WA'
oCell.bgColor = "#FF2020"
endif
oSubRow.appendChild(oCell)
Endscan
* Create and insert rows and cells into the footer row.
oRow = toDocument.createElement("TR")
oTFoot.appendChild(oRow)
oCell = toDocument.createElement("TD")
oRow.appendChild(oCell)
oCell.innerText = Textmerge("Total <<Reccount()>>")
oCell.colSpan = 4
oCell.bgColor = "lightskyblue"
* Set the innerText of the caption and position it at the bottom of the table.
oCaption.innerText = "Caption Here"
oCaption.Style.FontSize = "14 pt"
oCaption.Style.Color = "Blue"
oCaption.Align = "top"
Return oTable
Define Class HTMLViewerForm As Form
DataSession = 2
Top = 0
Left = 0
Height = 500
Width = 800
DoCreate = .T.
Caption = "HTML sample"
cHTML = ""
cHTMFile = Forcepath(Sys(2015)+'.htm',Sys(2023))
EmptyHTM = Forcepath('empty.htm',Sys(2023))
DoNotErase = .F.
Add Object htmlviewer As OleControl With ;
Top = 0, Left = 0, Height = 500, Width = 800, Visible = .T., ;
OleClass = 'Shell.Explorer'
Procedure Init
Text to m.lcBody noshow
<html>
<HEAD>
<STYLE>
.menuItem {font-family:sans-serif;font-size:10pt;width:100;padding-left:20;
background-Color:menu;color:black}
.highlightItem {font-family:sans-serif;font-size:10pt;width:100;padding-left:20;
background-Color:highlight;color:white}
.clickableSpan {padding:4;width:500;background-Color:blue;color:white;border:5px gray solid}
</STYLE>
<SCRIPT>
//<!--
function displayMenu() {
whichDiv=event.srcElement;
menu1.style.leftPos+=10;
menu1.style.posLeft=event.clientX;
menu1.style.posTop=event.clientY;
menu1.style.display="";
menu1.setCapture();
}
function switchMenu() {
el=event.srcElement;
if (el.className=="menuItem") {
el.className="highlightItem";
} else if (el.className=="highlightItem") {
el.className="menuItem";
}
}
function clickMenu() {
menu1.releaseCapture();
menu1.style.display="none";
el=event.srcElement;
if (el.id=="mnuRed") {
whichDiv.style.backgroundColor="red";
} else if (el.id=="mnuGreen") {
whichDiv.style.backgroundColor="green";
} else if (el.id=="mnuBlue") {
whichDiv.style.backgroundColor="blue";
} else if (el.id=="mnuYellow") {
whichDiv.style.backgroundColor="yellow";
}
}
//-->
</SCRIPT>
</HEAD>
<body oncontextmenu="if (!event.ctrlKey){displayMenu();return false;}">
<div id=menu1 onclick="clickMenu()" onmouseover="switchMenu()" onmouseout="switchMenu()" style="position:absolute;display:none;width:100;background-Color:menu; border: outset 3px gray">
<div class="menuItem" id=mnuRed>Red</div>
<div class="menuItem" id=mnuGreen>Green</div>
<div class="menuItem" id=mnuBlue>Blue</div>
<div class="menuItem" id=mnuYellow>Yellow</div>
</div><body></html>
endtext
* StrToFile('<HTML><BODY oncontextmenu="return false"></BODY></HTML>',this.cHTMFile)
StrToFile(m.lcBody,this.cHTMFile)
This.htmlviewer.navigate2('file://'+this.cHTMFile)
*!* This.htmlviewer.navigate2('about:blank')
*!* With This.htmlviewer.Document
*!* oBody = .createElement('body')
*!* oBody.oncontextmenu = "return false"
*!* .appendChild(oBody)
*!* Endwith
EndProc
Procedure Destroy
Erase (this.cHTMFile)
endproc
Procedure htmlviewer.Refresh
Nodefault
Endproc
Procedure Resize
This.htmlviewer.Height = This.Height
This.htmlviewer.Width = This.Width
Endproc
Enddefine
