romfast/vfp_roaauto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
656d98697fc4da3437a508fdfc855a290ac9eda5
vfp_roaauto/COMUN/programe/ashowcursor.prg

922 lines
29 KiB
Plaintext
Raw Blame History

**
** wwshowcursor.fxp
**
EXTERNAL ARRAY lvHeader
ENDPROC
*
DEFINE CLASS aShowCursor AS CUSTOM
DIMENSION afIeldlist[1]
nfIeldcount = 0
ctAbletitle = ""
chEaderstring = ""
chEaderbgcolor = "DarkBlue"
chEadercolor = "White"
chEaderfont = "Verdana,Helvetica"
ctAblebgcolor = "#EEEEEE"
caLternatingbgcolor = "#B0DAFF"
laLternaterows = .F.
ctAblewidth = "98%"
ctAbleborder = "2"
ceXtratabletags = 'style="font:normal normal 10pt Verdana;border-collapse: collapse;border-color:black" bordercolor="darkgray"'
ccEllpadding = "3"
ccEllspacing = "0"
naSciileftcolumns = 20
nmEmowidth = 25
lcEntertable = .T.
lsUmnumerics = .F.
lsHowastable = .T.
lsOrtable = .F.
npAge_itemsperpage = 0
npAge_showpage = 0
npAge_totalpages = 0
npAge_nextpage = 0
npAge_prevpage = 0
cpAge_pageurl = ""
cpAge_linkhtml = ""
cpAge_oldalias = ""
nfOrcetoprelist = 40000
ohTml = .NULL.
cbAseurl = ""
ckEyfield = ""
ckEytype = "N"
ctAblefieldlist = ""
ctAbleeditfieldlist = ""
ctAblerecordfieldlist = ""
ctAblesortcolumn = ""
laLlowadd = .T.
laLlowdelete = .T.
coLdalias = ""
cnEwalias = ""
cSumLista= ""
lSumLista = .F.
*
PROCEDURE INIT
LPARAMETER loHtml
IF VARTYPE(loHtml)<>"O"
THIS.ohTml = CREATEOBJECT('wwResponseStringNoBuffer')
ELSE
THIS.ohTml = loHtml
ENDIF
THIS.nfIeldcount = AFIELDS(THIS.afIeldlist)
ENDPROC
*
PROCEDURE SetCursor
LPARAMETER lcDbf
lcDbf = IIF(TYPE("lcDBF")="C", lcDbf, "")
lcStem = JUSTSTEM(lcDbf)
IF .NOT. USED(lcStem)
THIS.coLdalias = ALIAS()
USE (lcDbf) IN 0
ENDIF
SELECT (lcStem)
ENDPROC
*
PROCEDURE DESTROY
IF .NOT. EMPTY(THIS.coLdalias) .AND. USED(THIS.coLdalias)
USE IN (THIS.cnEwalias)
IF .NOT. EMPTY(THIS.coLdalias)
SELECT (THIS.coLdalias)
ENDIF
THIS.coLdalias = ""
THIS.cnEwalias = ""
ENDIF
ENDPROC
*
PROCEDURE BuildFieldListHeader
LPARAMETER lvHeader, llPrelist
LOCAL lcHeader, lnX
lcHeader = ""
IF .NOT. EMPTY(THIS.chEaderstring)
RETURN
ENDIF
IF THIS.lsOrtable .AND. EMPTY(THIS.cbAseurl)
THIS.cbAseurl = REQUEST.geTcurrenturl()+"&"
ENDIF
IF .NOT. llPrelist
IF TYPE("lvHeader[1]")<>"U"
lcHeader = ""
THIS.nfIeldcount = ALEN(lvHeader, 1)
FOR lnX = 1 TO THIS.nfIeldcount
lcHeader = lcHeader+'<TH><font FACE="'+ ;
THIS.chEaderfont+'" color="'+ ;
THIS.chEadercolor+'">'+lvHeader(lnX)+ ;
'</font></TH>'
ENDFOR
ELSE
FOR lnX = 1 TO THIS.nfIeldcount
IF THIS.afIeldlist(lnX,2)="M"
THIS.afIeldlist[lnX, 3] = THIS.nmEmowidth
ENDIF
IF THIS.afIeldlist(lnX,2)="T"
THIS.afIeldlist[lnX, 3] = 20
ENDIF
IF THIS.afIeldlist(lnX,2)="I"
THIS.afIeldlist[lnX, 3] = 9
ENDIF
IF THIS.lsOrtable .AND. THIS.afIeldlist(lnX,2)$"CNIL"
lcFieldName = PROPER(CHRTRAN(THIS.afIeldlist[lnX,1],"_"," ")) + " " + [<a href="] + THIS.cbAseurl + [Sorted=] + TRANSFORM(lnX) +[" ] + [style="color:]+THIS.chEadercolor+[;font:normal normal 12pt WebDings;text-decoration:none" title="Sort Ascending">] + CHR(0x35) +"</a> " + [<a href="] + THIS.cbAseurl + [Sorted=] + TRANSFORM(lnX) +[&SortDescending=True" ] + [style="color:]+THIS.chEadercolor+[;font:normal normal 12pt WebDings;text-decoration:none" title="Sort Descending">] + CHR(0x36) +"</a> " + CHR(13)+CHR(10)
ELSE
lcFieldName = PROPER(CHRTRAN(THIS.afIeldlist(lnX, ;
1), "_", " "))
ENDIF
lcHeader = lcHeader+'<TH><font FACE="'+ ;
THIS.chEaderfont+'" color="'+ ;
THIS.chEadercolor+'">'+lcFieldName+ ;
'</font></TH>'
ENDFOR
ENDIF
THIS.chEaderstring = '<TR BGCOLOR="'+THIS.chEaderbgcolor+'">'+ ;
lcHeader+'</TR>'
ELSE
IF TYPE("lvHeader[1]")="U"
lcHeader = ""
FOR lnX = 1 TO lnFields
IF LEN(TRIM(THIS.afIeldlist(lnX,1)))> ;
THIS.afIeldlist(lnX,3)
THIS.afIeldlist[lnX, 3] = ;
LEN(TRIM(THIS.afIeldlist(lnX,1)))
ENDIF
IF THIS.afIeldlist(lnX,2)="M"
THIS.afIeldlist[lnX, 3] = THIS.nmEmowidth
ENDIF
IF THIS.afIeldlist(lnX,2)="T"
THIS.afIeldlist[lnX, 3] = 20
ENDIF
IF THIS.afIeldlist(lnX,2)="I"
THIS.afIeldlist[lnX, 3] = 9
ENDIF
IF THIS.afIeldlist(lnX,2)$"NFBIY"
lcHeader = lcHeader+"<b>"+ ;
PADC(THIS.afIeldlist(lnX,1), ;
THIS.afIeldlist(lnX,3))+"</b> "
ELSE
lcHeader = lcHeader+"<b>"+ ;
PADC(THIS.afIeldlist(lnX,1), ;
THIS.afIeldlist(lnX,3))+"</b> "
ENDIF
ENDFOR
ELSE
lcHeader = ""
FOR lnX = 1 TO ALEN(lvHeader, 1)
IF LEN(TRIM(lvHeader(lnX)))>THIS.afIeldlist(lnX,3)
THIS.afIeldlist[lnX, 3] = ;
LEN(TRIM(THIS.afIeldlist(lnX,1)))
ENDIF
IF THIS.afIeldlist(lnX,2)="M"
THIS.afIeldlist[lnX, 3] = 20
ENDIF
IF THIS.afIeldlist(lnX,2)="T"
THIS.afIeldlist[lnX, 3] = 20
ENDIF
lnSizeloc = ATC(":", lvHeader(lnX))
IF lnSizeloc>0
lnSize = VAL(SUBSTR(ALLTRIM(lvHeader(lnX)), ;
lnSizeloc+1))
lvHeader[lnX] = SUBSTR(lvHeader(lnX), 1, lnSizeloc-1)
ELSE
lnSize = THIS.afIeldlist(lnX,3)
ENDIF
IF THIS.afIeldlist(lnX,2)$"NFBIY"
lcHeader = lcHeader+"<b>"+PADC(lvHeader(lnX), ;
lnSize)+"</b> "
ELSE
lcHeader = lcHeader+"<b>"+PADC(lvHeader(lnX), ;
lnSize)+"</b> "
ENDIF
ENDFOR
ENDIF
THIS.chEaderstring = lcHeader
ENDIF
ENDPROC
*
FUNCTION ShowCursor
LOCAL lcHeader, lnX, laTotals, lcOutput, lnSizeloc, lnSize, lvValue
IF EMPTY(ALIAS())
RETURN ""
ENDIF
IF THIS.lsOrtable
lnSort = VAL(REQUEST.quErystring("Sorted"))
IF lnSort>0
THIS.ctAblesortcolumn = TRANSFORM(lnSort)
IF .NOT. EMPTY(REQUEST.quErystring("SortDescending"))
THIS.ctAblesortcolumn = THIS.ctAblesortcolumn+ ;
" DESCENDING"
ENDIF
ENDIF
ENDIF
IF .NOT. EMPTY(THIS.ctAblefieldlist)
lcFields = THIS.ctAblefieldlist
lcOrder = IIF( .NOT. EMPTY(THIS.ctAblesortcolumn), "ORDER BY "+ ;
THIS.ctAblesortcolumn, "")
SELECT &lcFields FROM ALIAS() &lcOrder INTO CURSOR __TQuery
THIS.nfIeldcount = AFIELDS(THIS.afIeldlist)
ELSE
IF .NOT. EMPTY(THIS.ctAblesortcolumn)
lcOrder = IIF( .NOT. EMPTY(THIS.ctAblesortcolumn), ;
"ORDER BY "+THIS.ctAblesortcolumn, "")
SELECT * FROM ( ALIAS() ) &lcOrder INTO CURSOR __TQuery
ENDIF
ENDIF
lcOutput = ""
lnFields = THIS.nfIeldcount
lnReccount = RECCOUNT()
IF THIS.npAge_itemsperpage<>0
THIS.paGefilter()
lnReccount = RECCOUNT()
ENDIF
* IF thIs.lsUmnumerics
DIMENSION laTotals[1, lnFields]
laTotals = 0
* ENDIF
IF THIS.lSumLista
LOCAL lalistacol
DIMENSION lalistacol[1, lnFields]
lista2array(THIS.cSumLista,@lalistacol)
ENDIF
IF THIS.lsHowastable .AND. lnReccount*lnFields<=THIS.nfOrcetoprelist+1
IF .NOT. EMPTY(THIS.ctAbletitle)
lcTitle = '<TR><TH COLSPAN='+ALLTRIM(STR(lnFields))+ ;
' ALIGN="CENTER"><H2>'+THIS.ctAbletitle+ ;
'</H2></TH></TR>'
ELSE
lcTitle = ""
ENDIF
THIS.ohTml.WRITE(IIF(THIS.lcEntertable, '<CENTER>'+CHR(13)+ ;
CHR(10), '')+'<TABLE BGCOLOR="'+ ;
THIS.ctAblebgcolor+'" CELLPADDING="'+ ;
THIS.ccEllpadding+'" CELLSPACING="'+ ;
THIS.ccEllspacing+'" BORDER="'+ ;
THIS.ctAbleborder+'" '+IIF( .NOT. ;
EMPTY(THIS.ctAblewidth), ' WIDTH="'+ ;
THIS.ctAblewidth+'"', "")+' '+ ;
THIS.ceXtratabletags+'>'+CHR(13)+CHR(10)+IIF( ;
.NOT. EMPTY(lcTitle), lcTitle+CHR(13)+CHR(10), ""))
THIS.BuildFieldListHeader()
THIS.ohTml.WRITE(THIS.chEaderstring)
llAlternate = .T.
SCAN
lcRow = ""
FOR lnX = 1 TO lnFields
lcFieldName = THIS.afIeldlist(lnX,1)
lcFieldtype = THIS.afIeldlist(lnX,2)
lvValue = EVALUATE(lcFieldName)
DO CASE
CASE ISNULL(lvValue)
lcRow = lcRow+"<TD>n/a</TD>"
CASE lcFieldtype="C"
lcRow = lcRow+"<TD>"+IIF(EMPTY(lvValue), ;
"<BR>", TRIM(lvValue))+"</TD>"
CASE lcFieldtype="M"
lcRow = lcRow+"<TD >"+IIF(EMPTY(lvValue), ;
"<BR>", ;
THIS.ohTml.wrItememo(lvValue,.T.))+ ;
"</TD>"
CASE lcFieldtype$"NFBIY"
lcRow = lcRow+'<TD ALIGN=RIGHT>'+ ;
LTRIM(STR(lvValue, ;
THIS.afIeldlist(lnX,3), ;
THIS.afIeldlist(lnX,4)))+'</TD>'
IF THIS.lsUmnumerics OR (THIS.lSumLista AND ASCAN(lalistacol,ALLTRIM(STR(lnX)))>0)
laTotals[1, lnX] = laTotals(1,lnX)+lvValue
ENDIF
CASE lcFieldtype="L"
lcRow = lcRow+'<TD ALIGN=CENTER>'+ ;
IIF(lvValue, "True", "False")+'</TD>'
CASE lcFieldtype="D"
lcRow = lcRow+'<TD ALIGN=CENTER>'+ ;
IIF(EMPTY(lvValue), "<BR>", ;
DTOC(lvValue))+'</TD>'
CASE lcFieldtype="T"
lcRow = lcRow+'<TD ALIGN=CENTER>'+ ;
IIF(EMPTY(lvValue), "<BR>", ;
LOWER(TTOC(lvValue)))+'</TD>'
ENDCASE
ENDFOR
IF THIS.laLternaterows .AND. llAlternate
lcRow = '<TR style="background:'+ ;
THIS.caLternatingbgcolor+'" VALIGN=TOP>'+ ;
lcRow+"</TR>"
ELSE
lcRow = '<TR VALIGN=TOP>'+lcRow+"</TR>"
ENDIF
llAlternate = .NOT. llAlternate
THIS.ohTml.WRITE(lcRow+CHR(13)+CHR(10))
ENDSCAN
IF THIS.lsUmnumerics OR THIS.lSumLista &&
lcRow = ""
FOR lnX = 1 TO lnFields
lcFieldName = THIS.afIeldlist(lnX,1)
lcFieldtype = THIS.afIeldlist(lnX,2)
IF lcFieldtype$"NFBIY"
lnTotal = laTotals(1,lnX)
IF this.lsumlista AND ASCAN(lalistacol,ALLTRIM(STR(lnX)))<=0
lcRow = lcRow+"<TD></TD>"
ELSE
lcRow = lcRow+'<TD ALIGN=RIGHT><font color="'+ ;
THIS.chEadercolor+'"><B>'+STR(lnTotal, ;
THIS.afIeldlist(lnX,3)+1, ;
THIS.afIeldlist(lnX,4))+'</b></font></TD>'
ENDIF
ELSE
lcRow = lcRow+"<TD></TD>"
ENDIF
ENDFOR
THIS.ohTml.WRITE('<TR BGCOLOR="'+THIS.chEaderbgcolor+ ;
'"><B>'+lcRow+'</B></TR>'+CHR(13)+CHR(10))
ENDIF
IF THIS.npAge_itemsperpage<>0
IF USED("_TXQuery")
USE IN _TXQuery
ENDIF
IF USED(THIS.cpAge_oldalias)
SELECT (THIS.cpAge_oldalias)
ENDIF
IF .NOT. EMPTY(THIS.cpAge_linkhtml)
THIS.ohTml.faStwrite('<tr bgcolor="'+ ;
THIS.chEaderbgcolor+'"><td align="right" colspan="'+ ;
TRANSFORM(lnFields)+'">'+'<font color="'+ ;
THIS.chEadercolor+'">'+THIS.cpAge_linkhtml+ ;
'</font></td></tr>')
ENDIF
ENDIF
THIS.ohTml.WRITE("</TABLE>"+IIF(THIS.lcEntertable, '</CENTER>', ;
'')+CHR(13)+CHR(10))
ELSE
THIS.ohTml.WRITE('<PRE>'+CHR(13)+CHR(10)+IIF(THIS.lcEntertable, ;
'<CENTER>'+CHR(13)+CHR(10), ''))
IF .NOT. EMPTY(THIS.ctAbletitle)
lcTitle = '<H2>'+THIS.ctAbletitle+'</H2>'
ELSE
lcTitle = ""
ENDIF
THIS.chEaderstring = ""
THIS.BuildFieldListHeader( ,.T.)
THIS.ohTml.faStwrite(THIS.chEaderstring+CHR(13)+CHR(10))
SCAN
lcRow = ""
FOR lnX = 1 TO lnFields
lcFieldName = THIS.afIeldlist(lnX,1)
lcFieldtype = THIS.afIeldlist(lnX,2)
lvValue = EVALUATE(lcFieldName)
DO CASE
CASE ISNULL(lvValue)
lcRow = lcRow+PADC("n/a", ;
THIS.afIeldlist(lnX,3))
CASE lcFieldtype="C"
lcRow = lcRow+PADR(lvValue, ;
THIS.afIeldlist(lnX,3))
CASE lcFieldtype="M"
lcRow = lcRow+PADR(MLINE(lvValue, 1), 25)
CASE lcFieldtype$"NFBIY"
lcRow = lcRow+STR(lvValue, ;
THIS.afIeldlist(lnX,3), ;
THIS.afIeldlist(lnX,4))
IF THIS.lsUmnumerics OR (THIS.lSumLista AND ASCAN(lalistacol,ALLTRIM(STR(lnX)))>0)
laTotals[1, lnX] = laTotals(1,lnX)+lvValue
ENDIF
CASE lcFieldtype="L"
lcRow = lcRow+PADR(IIF(lvValue, "True ", ;
"False"), THIS.afIeldlist(lnX,3))
CASE lcFieldtype="D"
lcRow = lcRow+DTOC(lvValue)
CASE lcFieldtype="T"
lcRow = lcRow+TTOC(lvValue)
ENDCASE
lcRow = lcRow+" | "
ENDFOR
THIS.ohTml.faStwrite(lcRow+CHR(13)+CHR(10))
ENDSCAN
IF THIS.lsUmnumerics OR THIS.lSumLista
lcRow = ""
FOR lnX = 1 TO lnFields
lcFieldName = THIS.afIeldlist(lnX,1)
lcFieldtype = THIS.afIeldlist(lnX,2)
IF lcFieldtype$"NFBIY"
lnTotal = laTotals(1,lnX) &&
IF this.lSumLista AND ASCAN(lalistacol,ALLTRIM(STR(lnX)))<=0
lcRow = lcRow+SPACE(THIS.afIeldlist(lnX,3)+3)
ELSE
lcRow = lcRow+STR(lnTotal, THIS.afIeldlist(lnX, ;
3), THIS.afIeldlist(lnX,4))+" "
ENDIF
ELSE
lcRow = lcRow+SPACE(THIS.afIeldlist(lnX,3)+3)
ENDIF
ENDFOR
THIS.ohTml.faStwrite('<b>'+lcRow+'</b>')
ENDIF
THIS.ohTml.faStwrite(IIF(THIS.lcEntertable, '</CENTER>'+ ;
CHR(13)+CHR(10), '')+"</PRE>")
ENDIF
IF .NOT. EMPTY(THIS.ctAblefieldlist)
IF USED("__TQuery")
USE IN __TQuery
ENDIF
ENDIF
RETURN
ENDFUNC
*
PROCEDURE ShowASCIIRecord
LOCAL lnX, lcFieldcaption, lnFieldcount, lcFieldtype, lcFieldName
lcOutput = ""
lcFieldcaption = ""
IF .NOT. EMPTY(DBC()) .AND. INDBC(ALIAS()+'.'+THIS.afIeldlist(1,1), ;
'Field') .AND. TYPE(ALIAS()+"."+THIS.afIeldlist(1,1))<>"U"
FOR lnX = 1 TO THIS.nfIeldcount
lcFieldcaption = PROPER(PADL(DBGETPROP(ALIAS()+"."+ ;
THIS.afIeldlist(lnX,1), "FIELD", ;
"Caption"), 25))+": "
THIS.afIeldlist[lnX, 11] = lcFieldcaption
ENDFOR
ELSE
FOR lnX = 1 TO THIS.nfIeldcount
THIS.afIeldlist[lnX, 11] = ;
PADL(PROPER(THIS.afIeldlist(lnX,1)), ;
THIS.naSciileftcolumns)+": "
ENDFOR
ENDIF
FOR lnX = 1 TO THIS.nfIeldcount
lcFieldName = THIS.afIeldlist(lnX,1)
lcFieldtype = THIS.afIeldlist(lnX,2)
lcFieldcaption = THIS.afIeldlist(lnX,11)
lvValue = EVALUATE(lcFieldName)
lcRow = lcFieldcaption
DO CASE
CASE ISNULL(lvValue)
lcRow = lcRow+"n/a"
CASE lcFieldtype="C"
lcRow = lcRow+TRIM(lvValue)
CASE lcFieldtype="M"
lcRow = lcRow+THIS.ohTml.wrItememo(TRIM(lvValue),.T.)
CASE lcFieldtype$"NFBIY"
lcRow = lcRow+LTRIM(STR(lvValue, THIS.afIeldlist(lnX, ;
3), THIS.afIeldlist(lnX,4)))
CASE lcFieldtype="L"
lcRow = lcRow+IIF(lvValue, "True", "False")
CASE lcFieldtype="D"
lcRow = lcRow+DTOC(lvValue)
CASE lcFieldtype="T"
lcRow = lcRow+TTOC(lvValue)
ENDCASE
THIS.ohTml.WRITE(lcRow+CHR(13)+CHR(10))
ENDFOR
ENDPROC
*
PROCEDURE ShowRecord
LOCAL lnX, lcFieldcaption, lnFieldcount, lcFieldtype, lcFieldName
lcOutput = ""
lcFieldcaption = ""
lcFieldlist = THIS.ctAblerecordfieldlist
IF .NOT. EMPTY(lcFieldlist)
lcFields = lcFieldlist
lnRecno = RECNO()
SELECT &lcFields FROM ALIAS() WHERE RECNO() = lnRecno INTO CURSOR __TQuery
THIS.nfIeldcount = AFIELDS(THIS.afIeldlist)
ENDIF
THIS.ohTml.WRITE(IIF(THIS.lcEntertable, '<CENTER>'+CHR(13)+CHR(10), ;
'')+'<TABLE BGCOLOR="'+THIS.ctAblebgcolor+ ;
'" CELLPADDING='+THIS.ccEllpadding+' CELLSPACING='+ ;
THIS.ccEllspacing+' BORDER='+THIS.ctAbleborder+ ;
' WIDTH='+THIS.ctAblewidth+' '+THIS.ceXtratabletags+'>')
IF .NOT. EMPTY(DBC()) .AND. INDBC(ALIAS()+'.'+THIS.afIeldlist(1,1), ;
'Field') .AND. TYPE(ALIAS()+"."+THIS.afIeldlist(1,1))<>"U"
FOR lnX = 1 TO THIS.nfIeldcount
lcCaption = DBGETPROP(ALIAS()+"."+THIS.afIeldlist(lnX,1), ;
"FIELD", "Caption")
lcCaption = IIF( .NOT. EMPTY(lcCaption), lcCaption, ;
PROPER(THIS.afIeldlist(lnX,1)))
lcCaption = PROPER(STRTRAN(lcCaption, "_", " "))
lcFieldcaption = '<TR><TD VALIGN=TOP BGCOLOR='+ ;
THIS.chEaderbgcolor+'><b><font color="'+ ;
THIS.chEadercolor+'">'+lcCaption+":"+ ;
'</font></b></TD>'
THIS.afIeldlist[lnX, 11] = lcFieldcaption
ENDFOR
ELSE
FOR lnX = 1 TO THIS.nfIeldcount
THIS.afIeldlist[lnX, 11] = '<TR><TD VALIGN=TOP BGCOLOR='+ ;
THIS.chEaderbgcolor+'><b><font color="'+ ;
THIS.chEadercolor+'">'+ ;
PROPER(STRTRAN(THIS.afIeldlist(lnX,1), "_", ;
" "))+'</font></b></TD>'
ENDFOR
ENDIF
FOR lnX = 1 TO THIS.nfIeldcount
lcFieldName = THIS.afIeldlist(lnX,1)
lcFieldtype = THIS.afIeldlist(lnX,2)
lcFieldcaption = THIS.afIeldlist(lnX,11)
lvValue = EVALUATE(lcFieldName)
lcRow = lcFieldcaption
DO CASE
CASE ISNULL(lvValue)
lcRow = lcRow+"<TD>n/a</TD>"
CASE lcFieldtype="C" .OR. lcFieldtype="M"
lcRow = lcRow+"<TD>"+IIF(EMPTY(lvValue), "<BR>", ;
THIS.ohTml.wrItememo(lvValue,.T.))+"</TD>"
CASE lcFieldtype$"NFBY"
lcRow = lcRow+'<TD>'+LTRIM(STR(lvValue, ;
THIS.afIeldlist(lnX,3), THIS.afIeldlist(lnX, ;
4)))+'</TD>'
CASE lcFieldtype="I"
lcRow = lcRow+'<TD>'+TRANSFORM(lvValue)+'</TD>'
CASE lcFieldtype="L"
lcRow = lcRow+'<TD>'+IIF(lvValue, "True", "False")+'</TD>'
CASE lcFieldtype="D"
lcRow = lcRow+'<TD>'+IIF(EMPTY(lvValue), "<BR>", ;
DTOC(lvValue))+'</TD>'
CASE lcFieldtype="T"
lcRow = lcRow+'<TD>'+IIF(EMPTY(lvValue), "<BR>", ;
TTOC(lvValue))+'</TD>'
ENDCASE
THIS.ohTml.WRITE(lcRow+"</TR>"+CHR(13)+CHR(10))
ENDFOR
THIS.ohTml.WRITE("</TABLE>"+CHR(13)+CHR(10)+IIF(THIS.lcEntertable, ;
'</CENTER>'+CHR(13)+CHR(10), ""))
ENDPROC
*
PROCEDURE ShowObject
LPARAMETER loObject
LOCAL lnX, lcFieldcaption, lnFieldcount, lcFieldtype, lcFieldName, lcRow
lcOutput = ""
THIS.ohTml.WRITE(IIF(THIS.lcEntertable, '<CENTER>'+CHR(13)+CHR(10), ;
'')+'<TABLE BGCOLOR="'+THIS.ctAblebgcolor+ ;
'" CELLPADDING='+THIS.ccEllpadding+' CELLSPACING='+ ;
THIS.ccEllspacing+' BORDER='+THIS.ctAbleborder+ ;
' WIDTH='+THIS.ctAblewidth+' '+THIS.ceXtratabletags+'>')
lnFieldcount = AMEMBERS(laFields, loObject)
FOR lnX = 1 TO lnFieldcount
lcField = laFields(lnX)
lcRow = '<TR><TD VALIGN=TOP BGCOLOR='+THIS.chEaderbgcolor+ ;
'><b><font color="'+THIS.chEadercolor+'">'+ ;
PROPER(lcField)+":"+'</font></b></TD>'
lvValue = EVALUATE("loObject."+lcField)
lcType = VARTYPE(lvValue)
DO CASE
CASE ISNULL(lvValue)
lcValue = "null"
CASE lcType="C"
IF EMPTY(lvValue)
lcValue = "&nbsp;"
ELSE
lcValue = diSplaymemo(lvValue)
ENDIF
CASE lcType="D"
lcValue = TRANSFORM(lvValue)
CASE lcType="T"
lcValue = tiMetoc(lvValue)
CASE lcType="L"
lcValue = IIF(lvValue, "True", "False")
CASE lcType="O"
lcValue = "Object"
CASE lcType="U"
lcValue = "Undefined"
OTHERWISE
lcValue = TRANSFORM(lvValue)
ENDCASE
THIS.ohTml.WRITE(lcRow+"<td>"+lcValue+"</td></tr>"+CHR(13)+CHR(10))
ENDFOR
THIS.ohTml.WRITE(IIF(THIS.lcEntertable, '</CENTER>'+CHR(13)+CHR(10), ;
"")+"</TABLE>"+CHR(13)+CHR(10))
ENDPROC
*
PROCEDURE EditRecord
LOCAL lnX, lcFieldcaption, lnFieldcount, lcFieldtype, lcFieldName, ;
lcKeyvalue
lcOutput = ""
lcFieldcaption = ""
lcFieldlist = THIS.ctAbleeditfieldlist
IF .NOT. EMPTY(THIS.ckEyfield)
lcKeyvalue = EVALUATE(THIS.ckEyfield)
ELSE
lcKeyvalue = ""
ENDIF
IF .NOT. EMPTY(lcFieldlist)
lcFields = lcFieldlist
lnRecno = RECNO()
SELECT &lcFields FROM ALIAS() WHERE RECNO() = lnRecno INTO CURSOR __TQuery
THIS.nfIeldcount = AFIELDS(THIS.afIeldlist)
ENDIF
THIS.ohTml.WRITE(IIF(THIS.lcEntertable, '<CENTER>'+CHR(13)+CHR(10), ;
'')+'<TABLE BGCOLOR="'+THIS.ctAblebgcolor+ ;
'" CELLPADDING='+THIS.ccEllpadding+' CELLSPACING='+ ;
THIS.ccEllspacing+' BORDER='+THIS.ctAbleborder+ ;
' WIDTH='+THIS.ctAblewidth+' '+THIS.ceXtratabletags+ ;
'>'+CHR(13)+CHR(10))
IF .NOT. EMPTY(DBC()) .AND. INDBC(ALIAS()+'.'+THIS.afIeldlist(1,1), ;
'Field') .AND. TYPE(ALIAS()+"."+THIS.afIeldlist(1,1))<>"U"
FOR lnX = 1 TO THIS.nfIeldcount
lcCaption = DBGETPROP(ALIAS()+"."+THIS.afIeldlist(lnX,1), ;
"FIELD", "Caption")
lcCaption = IIF( .NOT. EMPTY(lcCaption), lcCaption, ;
PROPER(THIS.afIeldlist(lnX,1)))
lcCaption = PROPER(STRTRAN(lcCaption, "_", " "))
lcFieldcaption = '<TR><TD VALIGN=TOP BGCOLOR="'+ ;
THIS.chEaderbgcolor+'"><b><font color="'+ ;
THIS.chEadercolor+'">'+lcCaption+":"+ ;
'</font></b></TD>'+CHR(13)+CHR(10)
THIS.afIeldlist[lnX, 11] = lcFieldcaption
ENDFOR
ELSE
FOR lnX = 1 TO THIS.nfIeldcount
THIS.afIeldlist[lnX, 11] = '<TR><TD VALIGN=TOP BGCOLOR="'+ ;
THIS.chEaderbgcolor+'"><b><font color="'+ ;
THIS.chEadercolor+'">'+ ;
PROPER(STRTRAN(THIS.afIeldlist(lnX,1), "_", ;
" "))+'</font></b></TD>'+CHR(13)+CHR(10)
ENDFOR
ENDIF
FOR lnX = 1 TO THIS.nfIeldcount
lcFieldName = THIS.afIeldlist(lnX,1)
lcFieldtype = THIS.afIeldlist(lnX,2)
lnFieldwidth = THIS.afIeldlist(lnX,3)
lcFieldcaption = THIS.afIeldlist(lnX,11)
lvValue = EVALUATE(lcFieldName)
lcRow = lcFieldcaption
DO CASE
CASE lcFieldtype="C"
lcRow = lcRow+'<td><input type="text" name="'+ ;
lcFieldName+'" size='+ ;
TRANSFORM(lnFieldwidth)+' value="'+lvValue+ ;
'"></td>'
CASE lcFieldtype="M"
lcRow = lcRow+ ;
'<TD><textArea wrap=virtual cols=55 rows=5 name="'+ ;
lcFieldName+'">'+lvValue+'</textarea></TD>'
CASE lcFieldtype$"NFBIY"
lcRow = lcRow+'<td><input type="text" name="'+ ;
lcFieldName+'" size='+TRANSFORM(lnFieldwidth+ ;
1)+' value="'+TRANSFORM(lvValue)+'"></td>'
CASE lcFieldtype="L"
lcRow = lcRow+'<td><input type="text" name="'+ ;
lcFieldName+'" size=1 value="'+IIF(lvValue, ;
"T", "F")+'"></td>'
CASE lcFieldtype="D"
lcRow = lcRow+'<td><input type="text" name="'+ ;
lcFieldName+'" size=10 value="'+ ;
TRANSFORM(lvValue)+'"></td>'
CASE lcFieldtype="T"
lcRow = lcRow+'<td><input type="text" name="'+ ;
lcFieldName+'" size=15 value="'+ ;
LOWER(TRANSFORM(lvValue))+'"></td>'
ENDCASE
THIS.ohTml.WRITE(lcRow+"</tr>"+CHR(13)+CHR(10))
ENDFOR
IF .NOT. EMPTY(lcKeyvalue)
THIS.ohTml.WRITE('<input type="hidden" name="'+THIS.ckEyfield+ ;
'" value="'+TRANSFORM(lcKeyvalue)+'">')
ENDIF
THIS.ohTml.WRITE("</TABLE>"+IIF(THIS.lcEntertable, '</CENTER>'+ ;
CHR(13)+CHR(10), "")+CHR(13)+CHR(10))
ENDPROC
*
PROCEDURE SaveRecord
LOCAL lnX, lcFieldcaption, lnFieldcount, lcFieldtype, lcFieldName
FOR lnX = 1 TO THIS.nfIeldcount
lcFieldName = THIS.afIeldlist(lnX,1)
lcFieldtype = THIS.afIeldlist(lnX,2)
IF .NOT. REQUEST.isFormvar(lcFieldName)
LOOP
ENDIF
lvValue = REQUEST.FORM(lcFieldName)
DO CASE
CASE lcFieldtype="C" .OR. lcFieldtype="M"
REPLACE &lcFieldName WITH lvValue
CASE lcFieldtype$"NFBIY"
REPLACE &lcFieldName WITH VAL(lvValue)
CASE lcFieldtype="L"
REPLACE &lcFieldName WITH IIF(lvValue="T",.T.,.F.)
CASE lcFieldtype="D"
REPLACE &lcFieldName WITH CTOD(lvValue)
CASE lcFieldtype="T"
REPLACE &lcFieldName WITH CTOT(lvValue)
ENDCASE
ENDFOR
ENDPROC
*
PROCEDURE EditTable
LOCAL lcFields
lcAction = UPPER(REQUEST.quErystring("Action"))
lcId = REQUEST.quErystring("ID")
DO CASE
CASE lcAction="EDIT" .OR. lcAction="ADD"
IF .NOT. THIS.laLlowadd
THIS.ohTml.WRITE( ;
"Sorry! Adding is not allowed at this time..." ;
)
RETURN
ENDIF
IF lcAction="ADD"
llAdd = .T.
ELSE
llAdd = .F.
ENDIF
loResponse = THIS.ohTml
lcKeyfield = THIS.ckEyfield
IF llAdd
LOCATE FOR .F.
loResponse.WRITE([<form action="] + THIS.cbAseurl + [&Action=SaveNew&ID=] + lcId + [" method="POST">] +CHR(13)+CHR(10))
ELSE
IF THIS.ckEytype="N"
LOCATE FOR &lcKeyfield = VAL(lcId)
ELSE
LOCATE FOR &lcKeyfield = lcId
ENDIF
IF .NOT. FOUND()
loResponse.stAndardpage( ;
"Couldn't edit record. Invalid Key Field...", , ;
"NONE")
RETURN
ENDIF
loResponse.WRITE([<form action="] + THIS.cbAseurl + [&Action=Save&ID=] + lcId + [" method="POST">] +CHR(13)+CHR(10))
ENDIF
loResponse.WRITE([<form action="] + THIS.cbAseurl + [&Action=SaveNew&ID=] + lcId + [" method="POST">] +CHR(13)+CHR(10))
loResponse.WRITE( ;
'<input type="submit" name="btnSubmit" value=" Save " ACCESSKEY="S"><p>' ;
)
THIS.EditRecord()
loResponse.WRITE( ;
'<p><input type="submit" name="btnSubmit" value=" Save ">' ;
)
loResponse.WRITE('</form>'+CHR(13)+CHR(10))
CASE lcAction="SHOW"
loResponse = THIS.ohTml
lcKeyfield = THIS.ckEyfield
IF THIS.ckEytype="N"
LOCATE FOR &lcKeyfield = VAL(lcId)
ELSE
LOCATE FOR &lcKeyfield = lcId
ENDIF
IF .NOT. FOUND()
loResponse.stAndardpage( ;
"Couldn't edit record. Invalid Key Field...", ,"NONE")
RETURN
ENDIF
THIS.ShowRecord()
CASE lcAction="SAVE"
loResponse = THIS.ohTml
lcKeyfield = THIS.ckEyfield
IF lcAction="SAVENEW"
APPEND BLANK
ELSE
IF THIS.ckEytype="N"
LOCATE FOR &lcKeyfield = VAL(lcId)
ELSE
LOCATE FOR &lcKeyfield = lcId
ENDIF
IF .NOT. FOUND()
loResponse.erRormsg( ;
"Couldn't edit record. Invalid Key Field...")
RETURN
ENDIF
ENDIF
THIS.SaveRecord()
reSponse.reDirect(THIS.cbAseurl)
CASE lcAction="DELETE"
lcKeyfield = THIS.ckEyfield
IF .NOT. THIS.laLlowdelete
THIS.ohTml.WRITE( ;
"Sorry! Deleting is not allowed at this time..." ;
)
RETURN
ENDIF
IF THIS.ckEytype="N"
LOCATE FOR &lcKeyfield = VAL(lcId)
ELSE
LOCATE FOR &lcKeyfield = lcId
ENDIF
IF .NOT. FOUND()
THIS.ohTml.stAndardpage( ;
"Couldn't delete record. Invalid Key Field...")
RETURN
ENDIF
DELETE
reSponse.reDirect(THIS.cbAseurl)
OTHERWISE
IF THIS.laLlowadd
THIS.ohTml.WRITE('<a href="'+THIS.cbAseurl+ ;
'Action=Add">Add a new record</a><p>')
ENDIF
lcKeyfield = THIS.ckEyfield
IF EMPTY(THIS.ctAblefieldlist)
lcFields = "*"
ELSE
lcFields = THIS.ctAblefieldlist
ENDIF
lcOrder = IIF( .NOT. EMPTY(THIS.ctAblesortcolumn), ;
"ORDER BY "+THIS.ctAblesortcolumn, "")
SELECT &lcFields, PADR([<a href="] + THIS.cbAseurl + [Action=SHOW&ID=]+TRANS(&lcKeyfield)+[">Show</a> | <a href="] + THIS.cbAseurl + [Action=EDIT&Id=]+TRANS(&lcKeyfield)+[">Edit</a>] + IIF(THIS.laLlowdelete,[ | <a href="] + THIS.cbAseurl + [Action=DELETE&Id=]+TRANS(&lcKeyfield)+[">Delete</a>],[]), 254) AS Action FROM ALIAS() &lcOrder INTO CURSOR __TxQuery
THIS.nfIeldcount = AFIELDS(THIS.afIeldlist)
lcOldtablefieldlist = THIS.ctAblefieldlist
THIS.ctAblefieldlist = ""
THIS.ShowCursor()
THIS.ctAblefieldlist = lcOldtablefieldlist
USE IN __TxQuery
ENDCASE
ENDPROC
*
FUNCTION GetOutput
IF .NOT. ISNULL(THIS.ohTml)
RETURN THIS.ohTml.GetOutput()
ENDIF
RETURN ""
ENDFUNC
*
PROCEDURE paGefilter
LOCAL lnX, lcOutput, lcStyle, lnPages, lnReclow, lnHighrec, ;
lnEndpage, lnStartpage, lcNolinkstyle, lnReccount
IF EMPTY(THIS.npAge_showpage)
THIS.npAge_showpage = VAL(REQUEST.quErystring("PAGE"))
IF THIS.npAge_showpage<1
THIS.npAge_showpage = 1
ENDIF
ENDIF
lnReccount = RECCOUNT()
IF lnReccount<=THIS.npAge_itemsperpage
RETURN
ENDIF
THIS.cpAge_oldalias = ALIAS()
lnPages = lnReccount/THIS.npAge_itemsperpage
IF INT(lnPages)<lnPages
lnPages = INT(lnPages)+1
THIS.npAge_totalpages = lnPages
ELSE
THIS.npAge_totalpages = INT(lnPages)
ENDIF
IF THIS.npAge_showpage<lnPages
THIS.npAge_nextpage = THIS.npAge_showpage+1
ELSE
THIS.npAge_nextpage = 0
ENDIF
IF THIS.npAge_showpage>1
THIS.npAge_prevpage = THIS.npAge_showpage-1
ELSE
THIS.npAge_prevpage = 0
ENDIF
IF THIS.npAge_showpage=0
THIS.npAge_showpage = 1
ENDIF
IF THIS.npAge_showpage<=lnPages
lnReclow = (THIS.npAge_showpage-1)*THIS.npAge_itemsperpage+1
lnHighrec = THIS.npAge_showpage*THIS.npAge_itemsperpage
SELECT * FROM (THIS.cpAge_oldalias) WHERE RECNO()>=lnReclow ;
AND RECNO()<=lnHighrec INTO CURSOR _TXQuery
ENDIF
IF .NOT. EMPTY(THIS.cpAge_pageurl)
IF lnPages<=10
lnStartpage = 1
lnEndpage = lnPages
ELSE
lnStartpage = THIS.npAge_showpage-4
IF lnStartpage<1
lnStartpage = 1
ENDIF
lnEndpage = THIS.npAge_showpage+5
IF lnEndpage>lnPages
lnEndpage = lnPages
ENDIF
ENDIF
lcOutput="Pages: &nbsp;"
lcStyle = ' STYLE="color:'+THIS.chEadercolor+ ;
';text-decoration:none underline"'
lcNolinkstyle = ' STYLE="color:'+THIS.chEadercolor+';"'
FOR lnX = lnStartpage TO lnEndpage
IF lnX=THIS.npAge_showpage
lcOutput = lcOutput+' <b '+lcNolinkstyle+'>'+ ;
TRANSFORM(lnX)+'</b> '
ELSE
lcOutput = lcOutput+'<a href="'+THIS.cpAge_pageurl+ ;
'Page='+TRANSFORM(lnX)+'"'+lcStyle+'>'+ ;
TRANSFORM(lnX)+'</a> '
ENDIF
ENDFOR
lcOutput=lcOutput + [<b> &nbsp;&nbsp;&nbsp;&nbsp;<a href="] + THIS.cpAge_pageurl + [Page=1"] +lcStyle + [>1</a>]
lcOutput=lcOutput + [..<a href="] + THIS.cpAge_pageurl + [Page=] +TRANSFORM(lnPages) + ["] +lcStyle + [>] + TRANSFORM(lnPages) + [</a>&nbsp;&nbsp;]
IF THIS.npAge_prevpage<>0
lcOutput = lcOutput+' <a href="'+THIS.cpAge_pageurl+ ;
'Page='+TRANSFORM(THIS.npAge_prevpage)+'"'+ ;
lcStyle+'>Prev</a>'
ELSE
lcOutput=lcOutput + [ &nbsp; </b><span ] +lcNolinkstyle + [>Prev</span><b>]
ENDIF
IF THIS.npAge_nextpage<>0
lcOutput=lcOutput + [ &nbsp;<a href="] + THIS.cpAge_pageurl + [Page=] +TRANSFORM(THIS.npAge_nextpage) + ["] +lcStyle + [>Next</a>]
ELSE
lcOutput=lcOutput + [ &nbsp;</b><span ] +lcNolinkstyle + [>Next</span><b>]
ENDIF
THIS.cpAge_linkhtml=lcOutput + "&nbsp;</b>"
ENDIF
RETURN
ENDPROC
*
ENDDEFINE
*
Reference in New Issue View Git Blame Copy Permalink