/*
* Main HTML CLASS for HTMLLIB
*
* Copyright 2000 Manos Aspradakis
* Copyright 2000 Luiz Rafael Culik (Porting this library to Harbour)
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; see the file LICENSE.txt. If not, write to
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbclass.ch"
#include "cgi.ch"
THREAD STATIC t_nHtm := NIL
THREAD STATIC t_cForm := 0
THREAD STATIC t_oPage := 0
/****
*
* Class THtml()
*
* Constructors :
*
* THtml():New() Creates a new HTML document
*
* THtml():CGINew() Creates a new CGI-HTML document
*
*/
CREATE CLASS THtml
VAR nH
VAR FName, TITLE
VAR FontFace INIT "Verdana"
VAR FontSize INIT 1
VAR FontColor INIT "black"
VAR aImages
VAR lCgi INIT .F.
VAR cStr Init ""
VAR BaseURL, BaseTarget
VAR lFont INIT .F.
#if 0
METHOD New( cFile, cTitle, cLinkTitle, cCharSet, cScriptSRC, ;
BGIMAGE, BGCOLOR, txtColor, cJavaCode, ;
onLoad, onUnload, cLinkClr, cVLinkClr, cALinkClr, ;
cStyle, aimages, baseURL, baseTarget, ;
nRefresh, cRefreshURL, cStyleScr, lnocache )
#endif
METHOD Newalt( cType )
METHOD cgiNew( cTitle, cLinkTitle, cCharSet, aScriptSRC, ;
BGIMAGE, BGCOLOR, txtColor, aJsCode, ;
onLoad, onUnload, ;
cLinkClr, cVLinkClr, cALinkClr, ;
cStyle, aImages, aServerSrc, ;
cBaseURL, cBaseTarget, ;
nRefresh, cRefreshURL, cStyleScr, ;
lNocache, NOF, nMarginTop, nMarginHeight, ;
nMarginWidth, nMarginLeft, lCgi, cFile )
METHOD New( cTitle, cLinkTitle, cCharSet, aScriptSRC, ;
BGIMAGE, BGCOLOR, txtColor, aJsCode, ;
onLoad, onUnload, ;
cLinkClr, cVLinkClr, cALinkClr, ;
cStyle, aImages, aServerSrc, ;
cBaseURL, cBaseTarget, ;
nRefresh, cRefreshURL, cStyleScr, ;
lNocache, NOF, nMarginTop, nMarginHeight, ;
nMarginWidth, nMarginLeft, lCgi, cFile )
METHOD CGIClose()
METHOD SetPageColor( cColor, lBody ) INLINE hb_default( @lBody, .T. ), ::cStr += iif( lBody, '', ' bgcolor="' + cColor + '" ' )
METHOD SetTextColor( cColor, lBody ) INLINE hb_default( @lBody, .T. ), ::cStr += iif( lBody, '', ' text="' + cColor + '" ' )
METHOD SetBgImage( cImage, lBody ) INLINE hb_default( @lBody, .T. ), ::cStr += iif( lBody, '', ' background="' + cImage + '" ' )
METHOD Close()
METHOD SetCenter( lOn ) INLINE ::cStr += iif( lOn, "", " " )
METHOD SetFont( cFont, lBold, lItalic, lULine, nSize, cColor, lSet )
METHOD StartFont( cFont, lBold, lItalic, lULine, nSize, cColor, lSet, lPut )
METHOD DefineFont( cFont, cType, nSize, cColor, lSet )
METHOD EndFont()
METHOD Say( str, font, size, type, color, style )
METHOD QQOut( c ) INLINE hb_default( @c, "" ), ::cStr += c
METHOD QOut( c ) INLINE hb_default( @c, "" ), ::cStr += CRLF() + c + "' + t + " "
METHOD Space( n ) INLINE hb_default( @n, 1 ), ::cStr += Replicate( " ", n )
METHOD PutImage( cImage, nBorder, nHeight, cOnclick, cOnMsOver, cOnMsOut, ;
cName, cAlt, cTarget, nWidth, lBreak, ID, MAP, ALING, HSPACE )
METHOD Text( cText, nCols, lWrap ) INLINE hb_default( @lWrap, .T. ), hb_default( @nCols, 80 ), ;
::cStr += "", ">" ) + CRLF() + cText + CRLF() + "" + CRLF()
METHOD MultiCol( txt, cols, gutter, width ) INLINE hb_default( @txt, "" ), ;
hb_default( @cols, 2 ), ;
hb_default( @gutter, 5 ), ;
hb_default( @width, 100 ), ;
::cStr += '', ;
::cStr += txt, ;
::cStr += " "
METHOD PutHeading( cText, nWeight, lCentered )
METHOD HLine( nSize, nWidth, lShade, cColor )
METHOD PutParagraph() INLINE ::cStr += "
" + CRLF()
METHOD Paragraph( lStart, cAlign, cStyle )
METHOD PutBreak() INLINE ::cStr += "" + CRLF()
METHOD ListItem() INLINE ::cStr += " "
METHOD EndList() INLINE ::cStr += " "
METHOD NewForm( cMethod, cAction, cName )
METHOD FormImage( cText, name, File )
METHOD FormEdit( cType, cName, xValue, nSize )
METHOD FormReset( cText )
METHOD FormSubmit( cText )
METHOD FormQOut( c ) INLINE ::cStr += c + "" + Space( 9 ) + c + CRLF() + " " + CRLF()
METHOD FWrite( c ) INLINE FWrite( ::nH, c )
METHOD FWriteLN( c ) INLINE FWrite( ::nH, c + CRLF() )
METHOD Span( c, Style )
METHOD PutTextImageUrl( cImage, nBorder, nHeight, cUrl, cOnclick, ;
cOnMsOver, cOnMsOut, cName, cAlt, cTarget, nWidth, lbreak, cClass, cText )
METHOD Comment( cText )
METHOD ADDoBJECT( cType, cClassid, cAling, cCode, lDisable, cCodeBase, ;
cName, nWidth, nHeight )
METHOD ADDPARAM( cType, cValue )
METHOD EndOBJect()
METHOD PutLinkName( cName )
METHOD NewMap( cName ) INLINE ::cStr += ""
METHOD MapArea( Shape, Alt, Coord, Url ) INLINE ;
::cStr += " "
ENDCLASS
/****
*
* THtml():CGINew()
*
* Starts a new CGI-HTML stream file.
*/
METHOD cgiNew( cTitle, cLinkTitle, cCharSet, aScriptSRC, ;
BGIMAGE, BGCOLOR, txtColor, aJsCode, ;
onLoad, onUnload, ;
cLinkClr, cVLinkClr, cALinkClr, ;
cStyle, aImages, aServerSrc, ;
cBaseURL, cBaseTarget, ;
nRefresh, cRefreshURL, cStyleScr, ;
lNocache, NOF, nMarginTop, nMarginHeight, ;
nMarginWidth, nMarginLeft, lCgi, cFile ) CLASS THtml
HB_SYMBOL_UNUSED( lCgi )
return ::new( cTitle, cLinkTitle, cCharSet, aScriptSRC, ;
BGIMAGE, BGCOLOR, txtColor, aJsCode, ;
onLoad, onUnload, ;
cLinkClr, cVLinkClr, cALinkClr, ;
cStyle, aImages, aServerSrc, ;
cBaseURL, cBaseTarget, ;
nRefresh, cRefreshURL, cStyleScr, ;
lNocache, NOF, nMarginTop, nMarginHeight, ;
nMarginWidth, nMarginLeft, .T., cFile )
METHOD New( cTitle, cLinkTitle, cCharSet, aScriptSRC, ;
BGIMAGE, BGCOLOR, txtColor, aJsCode, ;
onLoad, onUnload, ;
cLinkClr, cVLinkClr, cALinkClr, ;
cStyle, aImages, aServerSrc, ;
cBaseURL, cBaseTarget, ;
nRefresh, cRefreshURL, cStyleScr, ;
lNocache, NOF, nMarginTop, nMarginHeight, ;
nMarginWidth, nMarginLeft, lCgi, cFile ) CLASS THtml
LOCAL i
__defaultNIL( @lCgi, .F. )
::lCgi := lCgi
IF lCgi
__defaultNIL( @cTitle, "New CGI-HTML page" )
__defaultNIL( @cLinkTitle, cTitle )
__defaultNIL( @cRefreshURL, "" )
__defaultNIL( @cCharset, "windows-1251" )
__defaultNIL( @lNocache, .F. )
ELSE
__defaultNIL( @cFile, "file1.htm" )
__defaultNIL( @cTitle, "New HTML page" )
__defaultNIL( @cLinkTitle, cTitle )
__defaultNIL( @cRefreshURL, "" )
__defaultNIL( @cCharset, "windows-1251" )
__defaultNIL( @lNocache, .F. )
ENDIF
::nH := STD_OUT
::Title := cTitle
IF lCgi
::FName := "cgiout.htm"
ELSE
::FName := cFile
ENDIF
IF lCgi
::cStr += "Content-Type: text/html" + CRLF() + CRLF()
FWrite( ::nh, ::cStr )
ENDIF
::cStr := ''
::cStr += '' + CRLF() + ;
"" + CRLF() + ;
" " + cTitle + " " + CRLF()
IF cBaseURL != NIL
::cStr += "'
IF lset
::fontColor := cColor
ENDIF
ELSE
cStr += ">"
ENDIF
IF lBold != NIL
iif( lBold, cStr += '', cStr += ' ' )
ENDIF
IF lItalic != NIL
iif( lItalic, cStr += '', cStr += ' ' )
ENDIF
IF lULine != NIL
iif( lULine, cStr += '', cStr += ' ' )
ENDIF
cStr += ''
::cStr += cStr + CRLF()
RETURN Self
/****
*
* THtml():StartFont()
*
* Begin a font definition. They may be nested but make sure you
* end the definition appropriately later
*/
METHOD StartFont( cFont, lBold, lItalic, lULine, nSize, cColor, lSet, lPut ) CLASS THtml
LOCAL cStr := "'
IF lSet
::fontColor := cColor
ENDIF
ELSE
cStr += ">"
ENDIF
ELSE
cStr += ">"
ENDIF
IF lBold != NIL
iif( lBold, cStr += '', cStr += ' ' )
ENDIF
IF lItalic != NIL
iif( lItalic, cStr += '', cStr += ' ' )
ENDIF
IF lULine != NIL
iif( lULine, cStr += '', cStr += ' ' )
ENDIF
::cStr += cStr + CRLF()
RETURN Self
/****
*
* THtml():DefineFont()
*
* Begin a font definition by font type "name".
* Use ::endFont() to cancel this font
*/
METHOD DefineFont( cFont, cType, nSize, cColor, lSet ) CLASS THtml
LOCAL cStr := "'
IF lset
::fontColor := cColor
ENDIF
ELSE
cStr += ">"
ENDIF
IF cType != NIL
cStr += cType
ENDIF
::cStr += cStr + CRLF()
RETURN Self
/****
*
* THtml():EndFont()
*
* End a font definition
*/
METHOD EndFont() CLASS THtml
::cStr += ' ' + CRLF()
RETURN Self
/****
*
* THtml():say()
*
*
*
*/
METHOD Say( str, font, size, type, color, style ) CLASS THtml
LOCAL cOut := ""
LOCAL lBold := .F.
LOCAL lItalic := .F.
LOCAL lULine := .F.
LOCAL lEm := .F.
LOCAL lStrong := .F.
LOCAL nSize := Size
__defaultNIL( @str, "" )
__defaultNIL( @FONT, ::FontFace )
__defaultNIL( @size, ::FontSize )
__defaultNIL( @COLOR, ::FontColor )
IF FONT != NIL .OR. Size != NIL .OR. COLOR != NIL
cOut := ''
ELSE
cOut += ">"
ENDIF
ENDIF
IF HB_ISSTRING( type )
IF "<" $ type
IF "" $ type
lBold := .T.
cOut += ""
ENDIF
IF "" $ type
lItalic := .T.
cOut += ""
ENDIF
IF "" $ type
lULine := .T.
cOut += ""
ENDIF
IF "" $ type
lEm := .T.
cOut += ""
ENDIF
IF "" $ type
lStrong := .T.
cOut += ""
ENDIF
ENDIF
ENDIF
cOut += str
IF lBold
cOut += " "
ENDIF
IF lItalic
cOut += ""
ENDIF
IF lULine
cOut += ""
ENDIF
IF lStrong
cOut += ""
ENDIF
IF lEm
cOut += ""
ENDIF
IF FONT != NIL .OR. Size != NIL .OR. COLOR != NIL
cOut += " "
ENDIF
::cStr += cOut + CRLF()
RETURN Self
/****
*
* THtml():paragraph()
*
*
*
*/
METHOD Paragraph( lStart, cAlign, cStyle ) CLASS THtml
LOCAL cStr := ""
ENDIF
::cStr += "" + cText + " " + CRLF()
IF lCentered
::cStr += ""
ENDIF
RETURN Self
/****
*
* THtml():putTextURL()
*
* Put a text link.
*/
METHOD PutTextUrl( cText, cUrl, cOnClick, cOnMsOver, cOnMsout, cTarget, font, clr, size, style, bld, lbreak, cClass ) CLASS THtml
LOCAL cStr := ""
__defaultNIL( @cUrl, "" )
__defaultNIL( @bld, .F. )
__defaultNIL( @lBreak, .F. )
::cStr += ;
'" + cStr
IF FONT != NIL .OR. clr != NIL .OR. size != NIL .OR. style != NIL
::cStr += ;
' '
ENDIF
IF bld
::cStr += ;
''
ENDIF
::cStr += ;
'' + iif( lBreak, "" + cText + ' ' + iif( lBreak, "', "" ) + "" + CRLF()
::cStr += cStr
RETURN Self
/****
*
* THtml():NewTableRow()
*
* Start a table row definition.
*
*/
METHOD NewTableRow( cColor, vAling, aLing ) CLASS THtml
LOCAL cStr := Space( 5 ) + "" + CRLF()
RETURN Self
/****
*
* THtml():NewTableCell()
*
* Start a table cell definition.
*
*/
METHOD NewTableCell( cAlign, cColor, ;
cFont, nSize, cFntColor, nHeight, ;
cBgPic, nWidth, lWrap, ;
nColspan, nRowspan, cValign, clrdrk, clrlt, cBdrClr, cClass, lNoFont ) CLASS THtml
LOCAL cStr := Space( 10 ) + ""
ELSE
cStr += ">"
ENDIF
::lFont := .T.
ENDIF
::cStr += cStr
RETURN Self
/****
*
* THtml():EndTableCell()
*
* End a table cell definition.
*
*/
METHOD EndTableCell() CLASS THtml
IF ::lFont
::cStr += "" + CRLF()
ELSE
::cStr += "" + CRLF()
ENDIF
::lFont := .F.
RETURN Self
/****
*
* THtml():EndTable()
*
* End a table definition.
*/
METHOD EndTable() CLASS THtml
::cStr += "
" + CRLF()
::cStr += CRLF() + CRLF() + CRLF()
RETURN Self
/****
*
* THtml():NewForm()
*
* Creates a new form
*
*/
METHOD NewForm( cMethod, cAction, cName ) CLASS THtml
__defaultNIL( @cMethod, "POST" )
__defaultNIL( @cName, "newForm" )
::cStr += CRLF() + "' + CRLF()
RETURN Self
/****
*
* THtml():FormImage()
*
* Adds a form image button
*
*/
METHOD FormImage( cText, name, file ) CLASS THtml
HB_SYMBOL_UNUSED( cText )
::cStr += ' push button and assign an action to it
*
*/
METHOD Button( cName, cCaption, ;
cOnClick, ;
cCGIApp, ;
cOnMsOver, cOnMsOut, ;
Style, ID ) CLASS THtml
LOCAL cStr := CRLF() + "" + CRLF()
RETURN Self
/****
*
* THtml():EndButton()
*
* End a definition
*
*/
METHOD EndButton() CLASS THtml
::cStr += CRLF() + CRLF() + " " + CRLF()
RETURN Self
/****
*
* THtml():Marquee()
*
* Display a scrolling marquee effect
*
*/
METHOD Marquee( cText, cFont, cFntColor, nFntSize, ;
cAlign, nWidth, nHeight, cbgColor, ;
cBehavior, cDirection, ;
nScrollAmt, nScrollDelay, LOOP, ;
onMsOver, onMsOut, onClick, onStart, onFinish ) CLASS THtml
__defaultNIL( @cFont, "Verdana" )
__defaultNIL( @cFntColor, "white" )
__defaultNIL( @nFntSize, 3 )
__defaultNIL( @cAlign, "middle" )
__defaultNIL( @nWidth, 100 )
__defaultNIL( @cText, "" )
__defaultNIL( @cBgColor, "black" )
__defaultNIL( @cBehavior, "scroll" )
__defaultNIL( @cDirection, "left" )
__defaultNIL( @nScrollAmt, 5 )
__defaultNIL( @nScrolldelay, 2 )
__defaultNIL( @LOOP, 0 )
::StartFont( cFont, , , , nFntSize, cFntColor )
::cStr += '" + ;
CRLF()
::cStr += cStr
::EndFont()
RETURN Self
/****
*
* THtml():EndMarquee()
*
*/
METHOD EndMarquee() CLASS THtml
::cStr += " " + CRLF()
RETURN Self
/****
*
* THtml():iFrame()
*
* Define an inline frame.
*
*/
METHOD iFrame( name, src, border, marginwidth, marginheight, ;
scrolling, align, WIDTH, HEIGHT ) CLASS THtml
LOCAL cStr := "