From 1fdc55c45cb59cb9e9786eb3c541afc1cdb4f330 Mon Sep 17 00:00:00 2001 From: Luiz Rafael Culik Date: Tue, 25 Dec 2001 16:51:58 +0000 Subject: [PATCH] See Changelog 2001-12-25 14:40 UTC-0300 --- harbour/contrib/htmllib/Makefile | 25 + harbour/contrib/htmllib/Makefile.bc | 203 +++ harbour/contrib/htmllib/colors.ch | 190 ++ harbour/contrib/htmllib/counter.prg | 88 + harbour/contrib/htmllib/default.ch | 274 +++ harbour/contrib/htmllib/errorsys.prg | 296 ++++ harbour/contrib/htmllib/ferror.ch | 87 + harbour/contrib/htmllib/forms.ch | 287 +++ harbour/contrib/htmllib/htmbrows.prg | 213 +++ harbour/contrib/htmllib/html.ch | 763 ++++++++ harbour/contrib/htmllib/htmutil.prg | 209 +++ harbour/contrib/htmllib/jlist.prg | 338 ++++ harbour/contrib/htmllib/jwindow.prg | 434 +++++ harbour/contrib/htmllib/lowfiles.ch | 59 + harbour/contrib/htmllib/ocgi.prg | 309 ++++ harbour/contrib/htmllib/oedit.prg | 666 +++++++ harbour/contrib/htmllib/ofile.prg | 560 ++++++ harbour/contrib/htmllib/oframe.prg | 224 +++ harbour/contrib/htmllib/ohtm.prg | 2432 ++++++++++++++++++++++++++ harbour/contrib/htmllib/oini.prg | 507 ++++++ harbour/contrib/htmllib/outil.prg | 297 ++++ 21 files changed, 8461 insertions(+) create mode 100644 harbour/contrib/htmllib/Makefile create mode 100644 harbour/contrib/htmllib/Makefile.bc create mode 100644 harbour/contrib/htmllib/colors.ch create mode 100644 harbour/contrib/htmllib/counter.prg create mode 100644 harbour/contrib/htmllib/default.ch create mode 100644 harbour/contrib/htmllib/errorsys.prg create mode 100644 harbour/contrib/htmllib/ferror.ch create mode 100644 harbour/contrib/htmllib/forms.ch create mode 100644 harbour/contrib/htmllib/htmbrows.prg create mode 100644 harbour/contrib/htmllib/html.ch create mode 100644 harbour/contrib/htmllib/htmutil.prg create mode 100644 harbour/contrib/htmllib/jlist.prg create mode 100644 harbour/contrib/htmllib/jwindow.prg create mode 100644 harbour/contrib/htmllib/lowfiles.ch create mode 100644 harbour/contrib/htmllib/ocgi.prg create mode 100644 harbour/contrib/htmllib/oedit.prg create mode 100644 harbour/contrib/htmllib/ofile.prg create mode 100644 harbour/contrib/htmllib/oframe.prg create mode 100644 harbour/contrib/htmllib/ohtm.prg create mode 100644 harbour/contrib/htmllib/oini.prg create mode 100644 harbour/contrib/htmllib/outil.prg diff --git a/harbour/contrib/htmllib/Makefile b/harbour/contrib/htmllib/Makefile new file mode 100644 index 0000000000..eb70bb63ab --- /dev/null +++ b/harbour/contrib/htmllib/Makefile @@ -0,0 +1,25 @@ +# +# $Id$ +# + +ROOT = ../../ + +C_SOURCES=\ + +PRG_SOURCES=\ + ohtm.prg \ + ocgi.prg \ + oedit.prg \ + oframe.prg \ + oini.prg \ + ofile.prg \ + jwindow.prg \ + htmutil.prg \ + counter.prg \ + errorsys.prg \ + htmbrows.prg \ + jlist.prg \ + +LIBNAME=html + +include $(TOP)$(ROOT)config/lib.cf diff --git a/harbour/contrib/htmllib/Makefile.bc b/harbour/contrib/htmllib/Makefile.bc new file mode 100644 index 0000000000..d7caa4da81 --- /dev/null +++ b/harbour/contrib/htmllib/Makefile.bc @@ -0,0 +1,203 @@ +# +# $Id$ +# + +# +# Makefile for Harbour Project for Borland C/C++ 3.x, 4.x, 5.x compilers +# + +# +# NOTE: You can use these envvars to configure the make process: +# (note that these are all optional) +# +# CFLAGS - Extra C compiler options for libraries and for +# executables +# C_USR - Extra C compiler options for libraries and for +# executables (GNU make compatible envvar) +# CLIBFLAGS - Extra C compiler options for the libraries +# HARBOURFLAGS - Extra Harbour compiler options +# PRG_USR - Extra Harbour compiler options +# (GNU make compatible envvar) +# + +# +# NOTE: "echo." intentionally used instead of "echo", to avoid conflicts +# with external commands named echo. +# + +!if $d(B16) + +CC = bcc +AS = tasm + +# Borland C/C++ (DOS 16 bits) +CFLAGS = -mh $(CFLAGS) + +BIN_DIR = bin\b16 +OBJ_DIR = obj\b16 +LIB_DIR = lib\b16 + +!else + +CC = bcc32 +AS = tasm32 + +BIN_DIR = ..\..\bin\b32 +OBJ_DIR = ..\..\obj\b32 +LIB_DIR = ..\..\lib\b32 + +# This is needed, otherwise the libs may overflow when +# debug info is requested with -v -y +ARFLAGS = /P32 + +!endif + +!if !$d(BCC_NOOPTIM) +CFLAGS = -O2 $(CFLAGS) +!endif + +# +# Directory macros. These should never have to change. +# + +INCLUDE_DIR = ..\..\include;include +TOOLS_DIR = source +TOOLS1_DIR = examples +# +# C compiler definition and C flags. These should never have to change. +# + +CFLAGS = -I$(INCLUDE_DIR) -d $(C_USR) $(CFLAGS) +CLIBFLAGS = -c $(CFLAGS) $(CLIBFLAGS) +CLIBFLAGSDEBUG = -v $(CLIBFLAGS) +HARBOURFLAGS = -i$(INCLUDE_DIR) -n -w0 -gc0 $(PRG_USR) $(HARBOURFLAGS) -p +LDFLAGS = $(LDFLAGS) + +# +# Macros to access our library names +# + +TOOLS_LIB = $(LIB_DIR)\html.lib + +HARBOUR_EXE = $(BIN_DIR)\harbour.exe + +# +# Rules +# + +# +# TOOLS.LIB rules +# +TOOLS_LIB_OBJS = \ +$(OBJ_DIR)\ohtm.obj \ +$(OBJ_DIR)\htmbrows.obj \ +$(OBJ_DIR)\oedit.obj \ +$(OBJ_DIR)\ofile.obj \ +$(OBJ_DIR)\jlist.obj \ +$(OBJ_DIR)\oini.obj \ +$(OBJ_DIR)\jwindow.obj \ +$(OBJ_DIR)\ocgi.obj \ +$(OBJ_DIR)\oframe.obj \ +$(OBJ_DIR)\counter.obj \ +$(OBJ_DIR)\errorsys.obj \ +$(OBJ_DIR)\htmutil.obj + +# +# Our default target +# + +all: \ + $(TOOLS_LIB) \ + +# +# Library dependencies and build rules +# + +$(TOOLS_LIB) : $(TOOLS_LIB_OBJS) + + +$(OBJ_DIR)\ohtm.c : $(TOOLS_DIR)\ohtm.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\ohtm.obj : $(OBJ_DIR)\ohtm.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\htmbrows.c : $(TOOLS_DIR)\htmbrows.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\htmbrows.obj : $(OBJ_DIR)\htmbrows.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\oedit.c : $(TOOLS_DIR)\oedit.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\oedit.obj : $(OBJ_DIR)\oedit.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\ofile.c : $(TOOLS_DIR)\ofile.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\ofile.obj : $(OBJ_DIR)\ofile.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\jlist.c : $(TOOLS_DIR)\jlist.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\jlist.obj : $(OBJ_DIR)\jlist.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + + +$(OBJ_DIR)\oini.c : $(TOOLS_DIR)\oini.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\oini.obj : $(OBJ_DIR)\oini.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\jwindow.c : $(TOOLS_DIR)\jwindow.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\jwindow.obj : $(OBJ_DIR)\jwindow.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\ocgi.c : $(TOOLS_DIR)\ocgi.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\ocgi.obj : $(OBJ_DIR)\ocgi.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\oframe.c : $(TOOLS_DIR)\oframe.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\oframe.obj : $(OBJ_DIR)\oframe.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\counter.c : $(TOOLS1_DIR)\counter.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\counter.obj : $(OBJ_DIR)\counter.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\errorsys.c : $(TOOLS_DIR)\errorsys.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\errorsys.obj : $(OBJ_DIR)\errorsys.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\htmutil.c : $(TOOLS_DIR)\htmutil.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\htmutil.obj : $(OBJ_DIR)\htmutil.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + diff --git a/harbour/contrib/htmllib/colors.ch b/harbour/contrib/htmllib/colors.ch new file mode 100644 index 0000000000..cab39345ff --- /dev/null +++ b/harbour/contrib/htmllib/colors.ch @@ -0,0 +1,190 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Colors include file for HTMLLIB + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#ifndef _COLORS_CH + +#define ALICEBLUE '#A0CF00' +#define ANTIQUEWHITE '#FFE8D0' +#define AQUA '#00FFFF' +#define AQUAMARINE '#7FFFD0' +#define AZURE '#F0FFFF' +#define BEIGE '#F0F7DF' +#define BISQUE '#FFE7C0' +#define BLACK '#000000' +#define BLANCHEDALMOND '#FFE8CF' +#define BLUE '#0000FF' +#define BLUEVIOLET '#8F28E0' +#define BROWN '#A0282F' +#define BURLYWOOD '#DFB880' +#define CADETBLUE '#5F9FA0' +#define CHARTREUSE '#7FFF00' +#define CHOCOLATE '#D0861F' +#define CORAL '#FF7F50' +#define CORNFLOWERBLUE '#6097EF' +#define CORNSILK '#FFF8DF' +#define CRIMSON '#DF173F' +#define CYAN '#00FFFF' +#define DARKBLUE '#00008F' +#define DARKCYAN '#00888F' +#define DARKGOLDENROD '#BF87F0' +#define DARKGRAY '#AFA8AF' +#define DARKGREEN '#006700' +#define DARKKHAKI '#BFB76F' +#define DARKMAGENTA '#8F008F' +#define DARKOLIVEGREEN '#50682F' +#define DARKORANGE '#FF8F00' +#define DARKORCHID '#9F30CF' +#define DARKRED '#8F0000' +#define DARKSALMON '#EF977F' +#define DARKSEAGREEN '#8FBF8F' +#define DARKSLATEBLUE '#4F3F8F' +#define DARKSLATEGRAY '#2F4F4F' +#define DARKTURQUOISE '#00CFD0' +#define DARKVIOLET '#9000D0' +#define DEEPPINK '#FF1790' +#define DEEPSKYBLUE '#00BFFF' +#define DIMGRAY '#6F686F' +#define DODGERBLUE '#1F90FF' +#define FIREBRICK '#B02020' +#define FLORALWHITE '#FFF8F0' +#define FORESTGREEN '#208820' +#define FUCHSIA '#FF00FF' +#define GAINSBORO '#DFDFDF' +#define GHOSTWHITE '#FFF8FF' +#define GOLD '#FFD700' +#define GOLDENROD '#DFA720' +#define GRAY '#808080' +#define GREEN '#008000' +#define GREENYELLOW '#AFFF2F' +#define HONEYDEW '#F0FFF0' +#define HOTPINK '#FF68B0' +#define INDIANRED '#CF5F5F' +#define INDIGO '#4F0080' +#define IVORY '#FFFFF0' +#define KHAKI '#F0E78F' +#define LAVENDER '#E0E7FF' +#define LAVENDERBLUSH '#FFF0F0' +#define LAWNGREEN '#7FFF00' +#define LEMONCHIFFON '#FFF8CF' +#define LIGHTBLUE '#AFD8E0' +#define LIGHTCORAL '#F08080' +#define LIGHTCYAN '#E0FFFF' +#define LIGHTGOLDENRODYELLOW '#FFF8D0' +#define LIGHTGREEN '#90EF90' +#define LIGHTGREY '#D0D0D0' +#define LIGHTPINK '#FFB7C0' +#define LIGHTSALMON '#FFA07F' +#define LIGHTSEAGREEN '#20B0AF' +#define LIGHTSKYBLUE '#80CFFF' +#define LIGHTSLATEGRAY '#70889F' +#define LIGHTSTEELBLUE '#B0C7DF' +#define LIGHTYELLOW '#FFFFE0' +#define LIME '#00FF00' +#define LIMEGREEN '#30CF30' +#define LINEN '#FFF0E0' +#define MAGENTA '#FF00FF' +#define MAROON '#800000' +#define MEDIUMAQUAMARINE '#60CFAF' +#define MEDIUMBLUE '#0000CF' +#define MEDIUMORCHID '#BF57D0' +#define MEDIUMPURPLE '#9070DF' +#define MEDIUMSEAGREEN '#3FB070' +#define MEDIUMSLATEBLUE '#7F68EF' +#define MEDIUMSPRINGGREEN '#00F89F' +#define MEDIUMTURQUOISE '#4FD0CF' +#define MEDIUMVIOLETRED '#C01780' +#define MIDNIGHTBLUE '#1F1870' +#define MINTCREAM '#F0FFFF' +#define MISTYROSE '#FFE7E0' +#define MOCCASIN '#FFE7B0' +#define NAVAJOWHITE '#FFDFAF' +#define NAVY '#000080' +#define OLDLACE '#FFF7E0' +#define OLIVE '#808000' +#define OLIVEDRAB '#6F8F20' +#define ORANGE '#FFA700' +#define ORANGERED '#FF4700' +#define ORCHID '#DF70D0' +#define PALEGOLDENROD '#EFE8AF' +#define PALEGREEN '#9FF89F' +#define PALETURQUOISE '#AFEFEF' +#define PALEVIOLETRED '#DF7090' +#define PAPAYAWHIP '#FFEFD0' +#define PEACHPUFF '#FFD8BF' +#define PERU '#CF873F' +#define PINK '#FFC0CF' +#define PLUM '#DFA1DF' +#define POWDERBLUE '#B0E0E0' +#define PURPLE '#800080' +#define RED '#FF0000' +#define ROSYBROWN '#BF8F8F' +#define ROYALBLUE '#4068E0' +#define SADDLEBROWN '#8F4710' +#define SALMON '#FF8070' +#define SANDYBROWN '#F0A760' +#define SEAGREEN '#2F8850' +#define SEASHELL '#FFF7EF' +#define SIENNA '#A0502F' +#define SILVER '#C0C0C0' +#define SKYBLUE '#80CFEF' +#define SLATEBLUE '#6F58CF' +#define SLATEGRAY '#708090' +#define SNOW '#FFF8FF' +#define SPRINGGREEN '#00FF7F' +#define STEELBLUE '#4080B0' +#define TAN '#D0B78F' +#define TEAL '#008080' +#define THISTLE '#DFBFDF' +#define TOMATO '#FF6040' +#define TURQUOISE '#40E0D0' +#define VIOLET '#EF80EF' +#define WHEAT '#F0DFB0' +#define WHITE '#FFFFFF' +#define WHITESMOKE '#F0F7F0' +#define YELLOW '#FFFF00' +#define YELLOWGREEN '#9FCF30' + +#define _COLORS_CH +#endif diff --git a/harbour/contrib/htmllib/counter.prg b/harbour/contrib/htmllib/counter.prg new file mode 100644 index 0000000000..cd7a7888b3 --- /dev/null +++ b/harbour/contrib/htmllib/counter.prg @@ -0,0 +1,88 @@ +#include "html.ch" +#include "forms.ch" +#include "default.ch" + + + +PROC CounterCGI() +LOCAL lIsPost := .F. +LOCAL cCounterDat := "counter.dat" +LOCAL oFrm, oEd, oSub + +LOCAL oHtm, oCgi + +SET DATE BRITISH + +IF "POST" $ UPPER(GETENV("REQUEST_METHOD")) + lIsPost := .T. + oCgi := oCGI():New() // get server parameters/variables +ENDIF + +oHtm := HTML():CGINew( "Counter.htm", "My Counter File" ) + +oHtm:SetPageColor(CLR_DARK_YELLOW ) //"#FFFFCC") +oHtm:SetTextColor(CLR_WHITE) +oHtm:SetbgImage("/images/back/bg32.bmp") +oHtm:Setcenter( .f. ) +oHtm:qout( "" ) +SET FONT "Verdana" SIZE 3 OF oHtm + +DEFINE FORM oFrm ; + CAPTION "A Simple Counter" ; + NAME "MyForm"; + ACTION "/cgi-bin/counter.exe?" ; + FRAME + +CONTROL EDIT NAME "User" ; + MAXCHARS 20 ; + SIZE 20 ; + CAPTION "User Name:" ; + IN oFrm + +LINE BREAK IN oFrm +LINE IN oFrm +LINE BREAK IN oFrm +SPACE 80 IN oFrm + +CONTROL SUBMIT NAME cSubmit VALUE (" Ok ") IN oFrm + +ACTIVATE oFrm + +SET FONT "Verdana" SIZE 3 OF oHtm +oHtm:defineTable( 2,, 90,, "#9196A0" ) +oHtm:newTableRow() +oHtm:newTableCell() +oHtm:QOut( "Page Visited :" + TRANSFORM( incCounter(), "999,999,999" ) + +htmlSpace(2)+"Times") +oHtm:EndTableCell() +oHtm:EndTableRow() +oHtm:EndTable() + +oHtm:cgiClose() +RETURN + + +// +FUNCTION IncCounter() +LOCAL n := 0 + +IF FILE("Counter.dat") + n := VAL(MEMOREAD("counter.dat")) +ELSE + n := 0 +ENDIF +MEMOWRIT( "counter.dat", STR( n+1 ) ) +RETURN n + + +// + FUNCTION GetCounter() +LOCAL n := 0 + +IF FILE("Counter.dat") + n := VAL(MEMOREAD("counter.dat")) +ELSE + incCounter() +ENDIF +RETURN n + + diff --git a/harbour/contrib/htmllib/default.ch b/harbour/contrib/htmllib/default.ch new file mode 100644 index 0000000000..437f79938c --- /dev/null +++ b/harbour/contrib/htmllib/default.ch @@ -0,0 +1,274 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * DEFAULT.CH some default definition to HTMLLIB + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#ifndef _DEFAULT_CH_ + +//#ifndef _BOX_CH +//#include "box.ch" +//#endif + +#ifndef _INKEY_CH +#include "inkey.ch" +#endif + +#ifndef _COMMON_CH +#include "common.ch" +#endif + +#xTranslate PERCENT( , ) => ; + ( ( * ) / 100 ) + +// --> Default parameters +#xcommand DEFAULT := ; + [, := ] => ; + := IIf( == nil, , ) ;; + [ := IIf( == nil, , ); ] + +#xcommand DEFAULT TO [, TO ] ; + => ; + IF == NIL ; := ; END ; + [; IF == NIL ; := ; END ] + +// --> OOPs +#xtranslate BYNAME [, ] => :: := [; :: := ] +#xtranslate BYNAME DEFAULT => :: := BYDEFAULT , +#xtranslate BYDEFAULT , => IIF( == NIL, , ) + + +// --> Save/Restore video state... +#xtranslate SaveState() => { row(), ; + col(), ; + SetColor(), ; + SetCursor(), ; + SaveScreen(,,,,) } + + +#xtranslate RestState() => DispBegin() ;; + RestScreen(,,,,\[\5]) ;; + SetColor(\[\3] ) ;; + SetCursor(\[\4]) ;; + SetPos(\[\1], \[\2] ) ;; + DispEnd() + + +// --> Save/Restore Table state +#xTranslate DbSaveState() => IIF( USED(),; + { Select(), ; + Recno(), ; + OrdBagName(0),; + OrdSetFocus() ; + },; + NIL ) + +#xTranslate DbRestState( ) => IIF( != NIL, ; + ( Select( \[\1] ), ; + OrdListAdd(\[\3] ), ; + OrdSetFocus(\[\4] ), ; + DbGoto(\[\2] )),) + + +// --> Display a Message at MAXROW() with optional colour... +#xTranslate Message(,) => ; + DispOutAt( maxrow(), 0, PadC(, MaxCol()+1 ), ; + IIF( EMPTY(#), "R/W", # ) ) + + +// --> Display a backdrop desktop with optional color +#xTranslate DeskTop([]) => ; + DispBox( 0,0,maxrow(),maxcol(), replicate("",9), [] ) + + +// --> Display a box with shadow (without savescreen() ) +#xTranslate ShadBox( , , , , , ) ; + => ; + DispBegin() ;; + RESTSCREEN( +1,+2,+1,+2,; + TRANSFORM( ; + SAVESCREEN( +1,+2,+1,+2 ),; + REPLICATE( 'X', ( -+1 ) * ( -+1 ) ) ) );; + DispBox( , , , , [], [] );; + SetPos( +1, +1 );; + DispEnd() + + +// --> Display a box with shadow: Saves screen for WClose() +// --> *MUST* pass to variable, e.g. +// --> +// --> LOCAL aWin := WOpen( 10, 10, 20, 30, B_DOUBLE + " ", "N/W" ) +// --> +#xTranslate WOpen( , , , , [], [] ) ; + => ; + { , , +1, +2, ; + SAVESCREEN( , , +1, +2 ) } ;; + DispBegin() ;; + RESTSCREEN( +1,+2,+1,+2,; + TRANSFORM( SAVESCREEN( +1,+2,+1,+2 ),; + REPLICATE( 'X', ( -+1 ) * ( -+1 ) ) ) );; + DispBox( , , , , ; + IIF(EMPTY(#), "Ŀ ", ), ; + IIF(EMPTY(#),"W/B", ) );; + SetPos( +1, +1 );; + DispEnd() + + +// --> Display a Caption for a WOpen() window +#xTranslate WTitle( , , ) => ; + DispBox( \[1\], \[2\], ; + \[1\], \[4\]-2, ; + replicate(" ",9), ; + IIF( EMPTY(#), "b/w", # ) ) ;; + DispOutAt( \[1\], \[2\], ; + PADC(, (\[4\]-\[2\])-1, " " ), ; + IIF( EMPTY(#), "b/w", # )) + +// --> Closes a window created with WOpen() - Restores screen +#xTranslate WClose() => RestScreen( \[1\], \[2\], ; + \[3\], \[4\], ; + \[5\] ) + + +// --> Save/Restore full screen - *MUST* pass to/from var +#xtranslate ScreenSave() => SAVESCREEN( 0, 0, 24, 79 ) +#xtranslate ScreenRest( ) => RESTSCREEN( 0, 0, 24, 79, ) + +// --> Build a Picture template +#xtranslate CAPFIRST() => ( "!" + REPLICATE( "X", LEN( ) -1 )) + +// --> Array shrink +#xTranslate ASHRINK( ) => ; + ADEL ( , LEN( ) ) ; + ; ASIZE( , LEN( ) - 1 ) + + +// --> Number to Trimmed String +#xTranslate NTRIM( ) => LTRIM(STR( )) +#xTranslate NUMTRIM( ) => LTRIM(STR( )) +// --> Convert logical to character +#xtranslate LTOC() => IIF( , "T", "F") + +// --> Convert character to logical +#xTranslate CTOL() => IIF( $ "TtYy", .T., .F.) + + +// --> Left trim a numeric +#xtranslate LSTR() => LTRIM( Str( ) ) + + +// --> Carriage Return + Line Feed +#xtranslate CRLF() => ( + CHR(13)+CHR(10) ) +#xtranslate CRLF() => CHR(13) + CHR(10) + + +// --> create a Get/Set Block +#define GSB( xVar) {|x| IIF(x == NIL, xVar, xVar := x )} + +#xtranslate GetSetBlock() => {|x| IIF(x == NIL, , := x )} + +#translate GETSET( , ) => ; + := IIF( == NIL, , := ) + + +// --> Convert Character String to Code Block +#xTranslate COMPILE() => &("{||" + + "}") + + +// --> Errors... +#define Beep() Tone(300,3) + +#xTranslate ErrorTone() => ( TONE( 1000,.01), ; + TONE( 1400,.01), ; + TONE( 1800,.01) ; + ) + + +#define DEF_PATH SET(_SET_DEFAULT) + + +// --> GETs ... +//#define OK_GETS() LASTKEY() != K_ESC .AND. UPDATED() + + + +/* + DATA TYPES +*/ +#xtranslate IS_ARRAY() => (VALTYPE()=="A") +#xtranslate IS_BLOCK() => (VALTYPE()=="B") +#xtranslate IS_CHAR() => (VALTYPE()=="C") +#xtranslate IS_DATA() => ( \>=32 .AND. \<= 253) +#xtranslate IS_DATE() => (VALTYPE()=="D") +#xtranslate IS_DEF() => !(TYPE() $ "UE") +#xtranslate IS_DIGIT() => ISDIGIT() +#xtranslate IS_INT() => ()==INT() ) +#xtranslate IS_LOGIC() => (VALTYPE()=="L") +#xtranslate IS_MEMO() => (VALTYPE()=="M") +#xtranslate IS_NUM() => (VALTYPE()=="N") +#xtranslate IS_OBJECT()=> (VALTYPE()=="O") +#xtranslate IS_TIME() => (VAL(LEFT ,2)) \< 24 .AND. ; + VAL(SUBSTR(,4,2)) \< 60 .AND. ; + VAL(RIGHT(,2 )) \<60 ) + +#translate ISNIL( ) => ( == NIL ) +#translate ISARRAY( ) => ( valtype( ) == "A" ) +#translate ISBLOCK( ) => ( valtype( ) == "B" ) +#translate ISCHARACTER( ) => ( valtype( ) == "C" ) +#translate ISDATE( ) => ( valtype( ) == "D" ) +#translate ISLOGICAL( ) => ( valtype( ) == "L" ) +#translate ISMEMO( ) => ( valtype( ) == "M" ) +#translate ISNUMBER( ) => ( valtype( ) == "N" ) +#translate ISOBJECT( ) => ( valtype( ) == "O" ) + + +#command REPEAT => DO WHILE .T. +#command UNTIL <*lexpr*> => IF (); EXIT ; END ; ENDDO + +#command IF THEN <*statement*> =>; + IIF() ; ; END + +#command IF THEN ELSE =>; + IIF() ; ; ELSE ; ; END + +#define _DEFAULT_CH_ +#endif diff --git a/harbour/contrib/htmllib/errorsys.prg b/harbour/contrib/htmllib/errorsys.prg new file mode 100644 index 0000000000..2a0ba0088b --- /dev/null +++ b/harbour/contrib/htmllib/errorsys.prg @@ -0,0 +1,296 @@ +/* + * $Id$ + */ + + +/*** +* +* Errorsys.prg +* +* Standard Clipper error handler +* +* Copyright (c) 1990-1993, Computer Associates International, Inc. +* All rights reserved. +* +* Compile: /m /n /w +* +*/ + +/* + * Harbour Project source code: + * HTML output conversion + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + + + + +#include "default.ch" +#include "error.ch" + + +#define DEF_ERR_HEADER "Date : "+DTOC(Date())+"
"+; + "Time : "+Time()+"
" + + +// put messages to STDERR +#command ? => ?? Chr(13) + Chr(10) ; ?? +#command ?? => OutErr() + + +// used below +#xTranslate NTRIM() => ALLTrim( Str( ) ) + +REQUEST HARDCR +REQUEST MEMOWRIT + +STATIC sbFixCorrupt +STATIC scErrFooter := " " + + +/*** +* ErrorSys() +* +* Note: automatically executes at startup +*/ + +// +PROC ErrorSys() +// + ErrorBlock( {|e| DefError(e)} ) +return + + + +/*** +* DefError() +*/ + +// +STATIC FUNC DefError(e) +// +local i, cMessage:= "" +Local cErrString := "" +LOCAL nDispCount := DispCount() +Local aError := {} +LOCAL nH := IF( PageHandle() == NIL, 0, PageHandle() ) + + // by default, division by zero yields zero + IF ( e:genCode == EG_ZERODIV ) + return (0) + END + + IF ( e:genCode == EG_CORRUPTION ) + if valtype(sbFixCorrupt) == "B" + EVAL( sbFixCorrupt, e ) + RETURN .F. + ELSE + RETURN .F. + ENDIF + ENDIF + + // for network open error, set NETERR() and subsystem default + IF ( e:genCode == EG_OPEN .and. (e:osCode == 32 .OR. e:osCode == 5); + .and. e:canDefault ) + + NETERR(.T.) + RETURN (.F.) // NOTE + + END + + + // for lock error during APPEND BLANK, set NETERR() and subsystem default + IF ( e:genCode == EG_APPENDLOCK .and. e:canDefault ) + + NETERR(.T.) + RETURN (.F.) // NOTE + + END + + // build error message + cMessage += ErrorMessage(e) + + + // display message and traceback + IF ( !Empty(e:osCode) ) + cMessage += " (DOS Error : " + NTRIM(e:osCode) + ")" + END + + // RESET System // + + cErrString := CRLF()+""+CRLF() + cErrString += '' + + cErrString += '" + + cErrString += '" + + cErrString += '' + cErrString += '' + cErrString += '"+CRLF()+""+CRLF()+"
' + cErrstring += ''+CRLF() + cErrString += "ERROR REPORT" + cErrString += "
' + cErrstring += ''+CRLF() + cErrString += DEF_ERR_HEADER + cErrString += "
' + cErrstring += ''+CRLF() + cErrString += ''+cMessage+'' + + + cErrString += '
'+CRLF() + cErrstring += ''+CRLF() + cErrString += "ERRORCODE...... :"+ NTRIM(e:GenCode)+"
"+CRLF() + cErrString += "SUBSYSTEM..... :"+ e:SubSystem +"
"+CRLF() + cErrString += "DESCRIPTION...:"+ e:Description +"
"+CRLF() + cErrString += "OPERATION......:"+ e:Operation +"
"+CRLF() + cErrString += "FILENAME........ :"+ e:FileName +"
"+CRLF() + cErrString += "TRIES............. :"+ NTRIM(e:Tries)+CRLF() + + cErrString += '
' + cErrstring += ''+CRLF() + cErrstring += '' + + i := 2 + + while ( !Empty(ProcName(i)) ) + + cErrString += "Called from "+ Trim(ProcName(i)) + ; + "(" + NTRIM(ProcLine(i)) + ")
" + CRLF() + + i++ + END + + cErrstring += '
' + cErrString += '
' + cErrstring += ''+CRLF() + cErrstring += "Extra Notes..." + + cErrString += "
"+CRLF() + FWrite( nH, "
"+cErrString+CRLF() ) + // Write/Append Error Log + MemoWrit( "Error.Log", HARDCR(cErrString)+CRLF()+; + HARDCR( MEMOREAD("Error.Log") ) ) + + FWrite( nH, ""+CRLF()+""+CRLF()+""+CRLF() ) + +/* + FWrite( nH, "
"+CRLF() ) + FWrite( nH, "]+CRLF() ) + FWrite( nH, "
"+CRLF() ) + FWrite( nH, [
"+CRLF()+""+CRLF() ) + + CLOSE ALL + + // give up + ErrorLevel(1) + QUIT + +RETURN(.F.) + + + +// +FUNCTION SetCorruptFunc( bFunc ) +// +if valtype( bFunc ) == "B" + sbFixCorrupt := bFunc +ENDIF + +RETURN sbFixCorrupt + + +FUNCTION SetErrorFooter() +RETURN( scErrFooter ) + + +/*** +* ErrorMessage() +*/ +// +STATIC FUNC ErrorMessage(e) +// +local cMessage :="" + + // start error message + cMessage += if( e:severity > ES_WARNING, "Error ", "Warning " ) + + + // add subsystem name if available + IF ( ValType(e:subsystem) == "C" ) + cMessage += e:subsystem() + ELSE + cMessage += "???" + END + + + // add subsystem's error code if available + if ( ValType(e:subCode) == "N" ) + cMessage += ("/" + NTRIM(e:subCode)) + ELSE + cMessage += "/???" + END + + + // add error description if available + if ( ValType(e:description) == "C" ) + cMessage += ("
" + e:description) + END + + + // add either filename or operation + if ( !Empty(e:filename) ) + cMessage += (": " + e:filename) + + ELSEIF ( !Empty(e:operation) ) + cMessage += (": " + e:operation) + + END + cMessage += CRLF() + + +return (cMessage) + diff --git a/harbour/contrib/htmllib/ferror.ch b/harbour/contrib/htmllib/ferror.ch new file mode 100644 index 0000000000..f4897d92a3 --- /dev/null +++ b/harbour/contrib/htmllib/ferror.ch @@ -0,0 +1,87 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * FERROR.CH Internal HTMLLIB module + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#ifndef _FERROR_CH_ + +#define _LAST_IO_ERROR IF(FError() == 0, "", _IO_ERRORS[Ferror()] ) + +#define _IO_ERRORS { ; + "", ; //1 + "File not found", ; //2 + "Path not found", ; //3 + "Too many files open", ; //4 + "Access denied", ; //5 + "Invalid handle", ; //6 + "", ; //7 + "Insufficient memory", ; //8 + "", ; //9 + "", ; //10 + "", ; //11 + "", ; //12 + "", ; //13 + "", ; //14 + "Invalid drive specified", ; //15 + "", ; //16 + "", ; //17 + "", ; //18 + "Attempted to write to a write-protected disk", ; //19 + "", ; //20 + "Drive not ready", ; //21 + "", ; //22 + "Data CRC error", ; //23 + "", ; //24 + "", ; //25 + "", ; //26 + "", ; //27 + "", ; //28 + "Write fault", ; //29 + "Read fault", ; //30 + "", ; //31 + "Sharing violation", ; //32 + "Lock Violation" ; //33 + } + +#define _FERROR_CH_ +#endif diff --git a/harbour/contrib/htmllib/forms.ch b/harbour/contrib/htmllib/forms.ch new file mode 100644 index 0000000000..a048138db9 --- /dev/null +++ b/harbour/contrib/htmllib/forms.ch @@ -0,0 +1,287 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * FORMS.CH Include file to create forms + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#ifndef _FORMS_CH + +#xCommand DEFINE FORM ; + [NAME ] ; + [METHOD ] ; + [ACTION ] ; + [ENCTYPE ] ; + [TARGET ] ; + [ONSUBMIT ] ; + [ONRESET ] ; + [] ; + [CAPTION ] ; + [CAPCOLOR ] ; + [CAPFONTCOLOR ] ; + [CAPIMAGE ] ; + [BGIMAGE ] ; + [FONTCOLOR ] ; + [COLOR ] ; + [WIDTH ] ; + => ; + := Form():New( [], [], [], ; + <.frame.>, ) ;; + [:setTarget( <(target)> ) ;] ; + [:setEncType( <(enctype)> ) ;] ; + [:setCapClr( <(capclr)> ) ;] ; + [:setCapFntClr( <(capfntclr)> ) ;] ; + [:setCapImage( <(capimage)> ) ;] ; + [:setBgImage( <(bgimg)> ) ;] ; + [:setFontColor( <(fntclr)> ) ;] ; + [:setFrmColor( <(clr)> ) ;] ; + [:setwidth( ) ;] ; + [:setAction( <(action)> ) ;] ; + [:setOnSubmit( <(onsubmit)> ) ;] ; + [:setOnReset( <(onreset)> ) ] + + +#xCommand ACTIVATE ; + =>; + :Put(.T.) ; :End() + + +// --> Controls + +#xCommand CONTROL ; + [OF ]; + [] ; + [ALIGN ]; + [WRAP ] ; + [NAME ] ; + [VALUE ] ; + [SIZE ] ; + [MAXCHARS ] ; + [ROWS ] ; + [COLS ] ; + [ONCHANGE ] ; + [ONSELECT ] ; + [ONFOCUS ] ; + [ONBLUR ] ; + [ONCLICK ] ; + [ONMOUSEOVER ] ; + [ONMOUSEOUT ] ; + [ONMOUSEUP ] ; + [ONMOUSEDOWN ] ; + [ONKEYDOWN ] ; + [ONKEYUP ] ; + [ONKEYPRESS ] ; + [PICTURE ] ; + [] ; + [] ; + [] ; + [] ; + [CAPTION ] ; + [STYLE "+CRLF() +; + ''+CRLF()+; + CRLF()+; + ''+CRLF()+; + CRLF()+; + '"+CRLF() +cStr += '"+CRLF() +cStr += '"+CRLF() + +AADD( ::aScript, cStr ) +cStr := "" + +cStr += "Collapsable Lists: Basic Example"+CRLF() +cStr += ""+CRLF() +cStr += ''+CRLF() +cStr += '
'+CRLF() +//cStr += '
'+CRLF() + +FOR i = 0 TO ::nItems +cStr += '
'+CRLF() +NEXT +cStr += ""+CRLF() + +AADD( ::aScript, cStr ) + +RETURN Self + + +/**** +* +* +* +* +* +*/ + +METHOD Put( cFile ) CLASS NcList +IF cFile == NIL +::nH := STD_OUT +ELSE +::nH := FCreate(cFile) +ENDIF + +AEVAL( ::aScript, {|e| fWrite( ::nH, e ) }) + +FClose( ::nH ) + +RETURN Self diff --git a/harbour/contrib/htmllib/jwindow.prg b/harbour/contrib/htmllib/jwindow.prg new file mode 100644 index 0000000000..c2130a4219 --- /dev/null +++ b/harbour/contrib/htmllib/jwindow.prg @@ -0,0 +1,434 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Java Window Class + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + + +#include "hbclass.ch" +#include "html.ch" +#include "default.ch" + + +Class JWindow + +DATA nH +DATA Name init "" +DATA oHtm +DATA VarName init "" +DATA URL init "" +DATA Features init "" + +DATA ScreenX, ScreenY init 100 +DATA height, width init 300 +DATA innerHeight, innerWidth, outerHeight init 0 +DATA alwaysRaised, alwaysLowered init .F. +DATA Menubar, personalBar init .F. +DATA location, directories, copyHistory init .F. +DATA Toolbar init .F. +DATA Status, TitleBar init .T. +DATA Scrollbars, Resizable, dependent init .T. + +DATA Title +DATA aScriptSRC +DATA aServerSRC +DATA bgImage, bgColor, fontColor +DATA Style + +DATA onLoad +DATA onUnLoad + +METHOD New( cVarName, cUrl, cName, x, y, w, h ) + +METHOD setOnLoad( c ) INLINE ::onLoad := c +METHOD setOnUnLoad( c ) INLINE ::onUnLoad := c + + +METHOD Alert( c ) INLINE ::QOut( "alert('c')" ) +METHOD confirm(c) INLINE ::QOut( "confirm('c')" ) +METHOD SetSize(x,y,h,w) +METHOD Write( c ) +METHOD lineBreak() INLINE ::QOut( "
" ) +METHOD Paragraph() INLINE ::QOut( "

" ) +METHOD center(l) INLINE ::QOut( IF( l , "
", "
" ) ) +METHOD bold(l) INLINE ::QOut( IF( l , "", "" ) ) +METHOD Italic(l) INLINE ::QOut( IF( l , "", "" ) ) +METHOD ULine(l) INLINE ::QOut( IF( l , "", "" ) ) +METHOD Put() +METHOD Begin() +METHOD End() +METHOD QOut( c ) +METHOD WriteLN( c ) INLINE ::qOut( c ) +METHOD SetFeatures( alwaysRaised, alwaysLowered,; + Resizable, Menubar, personalBar,; + dependent, location, directories,; + Scrollbars, Status, TitleBar, Toolbar ) + +METHOD ImageURL( cImage, cUrl, nHeight, nBorder, ; + cOnClick, cOnMsover, cOnMsout,; + cName, cAlt ) + +//METHOD Debug() INLINE __clsDebug( self ) NOSELF + +ENDCLASS + + + +/**** +* +* Start a new window definition +* +* +* +*/ + +METHOD New( cVarName, cUrl, cName, x, y, w, h ) Class JWindow + +DEFAULT cVarName := "newWin" +DEFAULT cURL := " " +DEFAULT cName := cVarName //"newWin" +DEFAULT x := 100 +DEFAULT y := 100 +DEFAULT h := 300 +DEFAULT w := 300 + +::nH := PageHandle() +::oHtm := oPage() +::varName := cVarName +::URL := cUrl +::Name := cName + +::ScreenX := x +::ScreenY := y +::height := h +::width := w + +// objectViewer( self ) + + +RETURN Self + + + +/**** +* +* Set the properties of the window +* +* +* +*/ + +METHOD SetFeatures( alwaysRaised, alwaysLowered,; + Resizable, Menubar, personalBar,; + dependent, location, directories,; + Scrollbars, Status, TitleBar, Toolbar, copyHistory ) Class JWindow + +LOCAL cStr := "" + +DEFAULT alwaysRaised := ::alwaysRaised +DEFAULT alwaysLowered := ::alwaysLowered +DEFAULT Resizable := ::Resizable +DEFAULT Menubar := ::Menubar +DEFAULT personalBar := ::personalBar +DEFAULT dependent := ::dependent +DEFAULT location := ::location +DEFAULT directories := ::directories +DEFAULT Scrollbars := ::Scrollbars +DEFAULT Status := ::Status +DEFAULT TitleBar := ::TitleBar +DEFAULT Toolbar := ::Toolbar +DEFAULT copyHistory := ::copyHistory + + +IF alwaysRaised ; cStr += "alwaysraised=yes," ; ELSE ; cStr += "alwaysraised=no," ;ENDIF +IF alwaysLowered ; cStr += "alwayslowered=yes," ; ELSE ; cStr += "alwayslowered=no," ;ENDIF +IF Resizable ; cStr += "resizable=yes," ; ELSE ; cStr += "resizable=no," ;ENDIF +IF Menubar ; cStr += "menubar=yes," ; ELSE ; cStr += "menubar=no," ;ENDIF +IF personalBar ; cStr += "personalbar=yes," ; ELSE ; cStr += "personalbar=no," ;ENDIF +IF dependent ; cStr += "dependent=yes," ; ELSE ; cStr += "dependent=no," ;ENDIF +IF location ; cStr += "location=yes," ; ELSE ; cStr += "location=no," ;ENDIF +IF directories ; cStr += "directories=yes," ; ELSE ; cStr += "directories=no," ;ENDIF +IF Scrollbars ; cStr += "scrollbars=yes," ; ELSE ; cStr += "scrollbars=no," ;ENDIF +IF Status ; cStr += "status=yes," ; ELSE ; cStr += "status=no," ;ENDIF +IF TitleBar ; cStr += "titlebar=yes," ; ELSE ; cStr += "titlebar=no," ;ENDIF +IF Toolbar ; cStr += "toolbar=yes," ; ELSE ; cStr += "toolbar=no," ;ENDIF +IF copyHistory ; cStr += "copyHistory=yes," ; ELSE ; cStr += "copyHistory=no," ;ENDIF + +::features += IF( EMPTY( ::Features ), cStr+",", cStr ) + + +RETURN Self + + + + +/**** +* +* set the size for the window +* +* +* +*/ + +METHOD SetSize(x,y,h,w) Class JWindow +LOCAL cStr := "" +DEFAULT x := ::ScreenX ,; + y := ::ScreenY ,; + h := ::height ,; + w := ::width + +::ScreenX := x +::ScreenY := y +::height := h +::width := w + +cStr := "screenX="+ NTRIM(::screenX) +"," + +cStr:= cStr+ "screenY="+ NTRIM(::screenY) +"," +cStr:= cStr+ "height=" + NTRIM(::height) +"," +cStr:= cStr+ "width=" + NTRIM(::width) + +::features += IF( EMPTY( ::Features ), cStr+",", cStr ) + +RETURN Self + + + +/**** +* +* Open the window from within the current document +* +* +* +*/ + +METHOD Put() Class JWindow +LOCAL cStr := "" + +IF ::nH == NIL + ::nH := pageHandle() + IF ::nH == NIL + RETURN Self + ENDIF +ENDIF + +IF Empty( ::features ) + ::setSize() + ::setFeatures() +endif + +IF VALTYPE( ::name ) != "C" + ::name := "newWin" +ENDIF + +cStr += ::varName + " = window.open('"+; + ::URL +"', '"+; + ::varName + "', '"+; + ::features + "')" + +JavaCMD( ::nH, cStr ) + +RETURN Self + + +/**** +* +* Output stand alone Javascript code in the current document +* +*/ + +METHOD Write( c ) Class JWindow + JavaCMD( ::nH, ::varName+".document.write('"+c+"')" + CRLF() ) +RETURN Self + + +/**** +* +* Output Javascript (or HTML) code in the current document and +* in the current script +* +*/ + +METHOD QOut( c ) Class JWindow + FWrite( ::nH, ::varName+".document.write('"+c+"')"+CRLF() ) +RETURN Self + + +/**** +* +* Begin HTML output to the window from within the current document +* and the current script +* +* +*/ + +METHOD Begin() Class JWindow +LOCAL i + +FWrite( ::nH, ""+CRLF() ) + +RETURN Self + + +/**** +* +* End HTML output to the window +* +* +* +*/ + +METHOD End() Class JWindow + +JavaCMD( ::nH, ::varName+".document.write('')" + CRLF() ) + +RETURN Self + + + + +/**** +* +* Place an image link to the window +* +* +* +*/ + +METHOD ImageURL( cImage, cUrl, nHeight, nBorder, ; + cOnClick, cOnMsover, cOnMsout,; + cName, cAlt ) Class JWindow + + +LOCAL cStr := "" + +DEFAULT cUrl := "" + +IF cName != NIL + cStr += ' NAME= "'+cName + '"'+CRLF() +ENDIF +IF cAlt != NIL + cStr += ' ALT= "'+cAlt+ '"'+CRLF() +ENDIF + +IF nBorder != NIL + cStr += " BORDER = "+NTRIM(nBorder) + CRLF() +ENDIF + +IF nHeight != NIL + cStr += " HEIGHT = "+NTRIM(nHeight) + "% " + CRLF() +ENDIF + +IF cOnClick != NIL + cStr += ' onClick="'+cOnClick+'"' + CRLF() +ENDIF +IF cOnMsOver != NIL + cStr += ' onMouseOver="'+cOnMsOver+'"' + CRLF() +ENDIF +IF cOnMsOut != NIL + cStr += ' onMouseOut="'+cOnMsOut+'"'+CRLF() +ENDIF + +IF cURL != NIL + ::QOut( '
' ) +ELSE + ::QOut( '' ) +ENDIF +RETURN Self + + + +//*** EOF ***// + diff --git a/harbour/contrib/htmllib/lowfiles.ch b/harbour/contrib/htmllib/lowfiles.ch new file mode 100644 index 0000000000..9667213aae --- /dev/null +++ b/harbour/contrib/htmllib/lowfiles.ch @@ -0,0 +1,59 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * LOWFILES.CH low files commands + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +// Lowfiles.ch + +#include "fileio.ch" + +#translate FGOTOP() => FSEEK( , 0 ) + +#translate FGOBOTTOM() => FSEEK( , 0, FS_END) + +#translate FPOS() => FSEEK( , 0, FS_RELATIVE ) + +#translate FBOF() => (FPOS() == 0) + +#translate FEOF() => (FPOS() == FSize()) + diff --git a/harbour/contrib/htmllib/ocgi.prg b/harbour/contrib/htmllib/ocgi.prg new file mode 100644 index 0000000000..4b8add7536 --- /dev/null +++ b/harbour/contrib/htmllib/ocgi.prg @@ -0,0 +1,309 @@ + +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Cgi Class + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + + +#include "hbclass.ch" +#include "default.ch" +#include "html.ch" + + + +CLASS oCgi FROM HTML + +DATA nH +DATA Server_Software +DATA Server_Name +DATA Gateway_Interface +DATA Server_Protocol +DATA Server_Port +DATA Request_Method +DATA Http_Accept +DATA Http_User_agent +DATA Http_Referer +DATA Path_Info +DATA Path_Translated +DATA Script_Name +DATA Query_String +DATA Remote_Host +DATA Remote_Addr +DATA ipAddress +DATA Remote_User +DATA Auth_Type +DATA Auth_User +DATA Auth_Pass +DATA Content_Type +DATA Content_Length +DATA Annotation_Server + +DATA aQueryFields INIT {} + +METHOD New( c ) +METHOD CGIField( c ) + +METHOD toObject() + + +ENDCLASS + + + +/**** +* +* oCgi():new() +* +* +* +*/ + +METHOD New( cInBuffer ) Class oCgi +LOCAL cBuff, i, nBuff +LOCAL aTemp := {} +LOCAL aVar := {} + + // function in oHtm.prg + ::nH := PageHandle() + + ::Server_Software := GetEnv( "SERVER_SOFTWARE" ) + ::Server_Name := GetEnv( "SERVER_NAME" ) + ::Gateway_Interface := GetEnv( "GATEWAY_INTERFACE" ) + ::Server_Protocol := GetEnv( "SERVER_PROTOCOL" ) + ::Server_Port := GetEnv( "SERVER_PORT" ) + ::Request_Method := GetEnv( "REQUEST_METHOD" ) + ::Http_Accept := GetEnv( "HTTP_ACCEPT" ) + ::Http_User_agent := GetEnv( "HTTP_USER_AGENT" ) + ::Http_Referer := GetEnv( "HTTP_REFERER" ) + ::Path_Info := GetEnv( "PATH_INFO" ) + ::Path_Translated := GetEnv( "PATH_TRANSLATED" ) + ::Script_Name := GetEnv( "SCRIPT_NAME" ) + ::Query_String := GetEnv( "QUERY_STRING" ) + ::Remote_Host := GetEnv( "REMOTE_HOST" ) + ::Remote_Addr := GetEnv( "REMOTE_ADDR" ) + ::ipAddress := GetEnv( "REMOTE_ADDR" ) + ::Remote_User := GetEnv( "REMOTE_USER" ) + ::Auth_Type := GetEnv( "AUTH_TYPE" ) + ::Auth_User := GetEnv( "AUTH_USER" ) + ::Auth_Pass := GetEnv( "AUTH_PASS" ) + ::Content_Type := GetEnv( "CONTENT_TYPE" ) + ::Content_Length := GetEnv( "CONTENT_LENGTH" ) + ::Annotation_Server := GetEnv( "ANNOTATION_SERVER" ) + + IF cInBuffer != NIL + ::Query_String := RTRIM( cInBuffer ) + ELSE + IF "POST" $ UPPER(::Request_Method) + ::Query_String := RTRIM(FReadStr( STD_IN, VAL(::CONTENT_LENGTH) )) + ENDIF + ENDIF + + IF !empty( ::Query_String ) + + ::aQueryFields := {} + + aTemp := listAsArray( ::Query_String, "&" ) // separate fields + + IF LEN( aTemp ) != 0 + FOR i=1 TO LEN( aTemp ) + aVar := LISTASARRAY( aTemp[i], "=" ) + IF LEN( aVar ) == 2 + AADD(::aQueryFields, {aVar[1], decodeURL(aVar[2]) } ) + ENDIF + NEXT + ENDIF + ENDIF + +//#ifdef _CLASS_CH +RETURN ::ToObject() //Self +//#else +//RETURN Self +//#endif + + + +//#ifdef _CLASS_CH + + +/**** +* +* oCgi():ToObject() +* +* Creates instance variables out of CGI FORM return values +* or URL encoded content. +* +* It subclasses the oCGI class to a *new* class +*/ + +METHOD ToObject() CLAss ocgi +local i, bBlock +local cFldName +LOCAL nScope:=1 +LOCAL aDb, oDb, hNewClass, oNew, n +LOCAL hNew +STATIC sn := 0 + +// --> create new oObject class from this one... +sn++ +//aDB := ClassNew( "NewCgi"+STRZERO(sn,3), {|| oCGI() }, "cgi" ) +aDb:= hbClass():New("NewCgi"+STRZERO(sn,3),__CLS_PARAM("oCgi" ) ) +FOR i = 1 TO LEN( ::aQueryFields ) + IF ::aQueryFields[i,2] == NIL .OR. EMPTY(::aQueryFields[i,2]) + ::aQueryFields[i,2] := "" + ENDIF + //ClassData( ::aQueryFields[i,1], ::aQueryFields[i,2] ) + adb:AddData( ::aQueryFields[i,1],::aQueryFields[i,2],,nScope) +// adb:AddData( ,,,nScope) +// aDb:AddMultiData(,,if(.F.,1,if(.F.,2,if(.F.,4,nScope) ) ) + if(.F.,16,0 ),__MULTIPARAM("nH" ) ) +NEXT +adb:Create() +//aDB := ClassMAKE() +//hNewClass := aDB[_CLASS_HANDLE] +oNew := adb:Instance() +//aDb := ClassEndIns( oNew, aDB ) +//aDB[_CLASS_OBJECT] := oNew +//oNew:Dict := aDB +oNew:aQueryFields := ::aQueryFields +oNew:Server_Software := ::Server_Software +oNew:Server_Name := ::Server_Name +oNew:Gateway_Interface := ::Gateway_Interface +oNew:Server_Protocol := ::Server_Protocol +oNew:Server_Port := ::Server_Port +oNew:Request_Method := ::Request_Method +oNew:Http_Accept := ::Http_Accept +oNew:Http_User_agent := ::Http_User_agent +oNew:Http_Referer := ::Http_Referer +oNew:Path_Info := ::Path_Info +oNew:Path_Translated := ::Path_Translated +oNew:Script_Name := ::Script_Name +oNew:Query_String := ::Query_String +oNew:Remote_Host := ::Remote_Host +oNew:Remote_Addr := ::Remote_Addr +oNew:ipAddress := ::ipAddress +oNew:Remote_User := ::Remote_User +oNew:Auth_Type := ::Auth_Type +oNew:Content_Type := ::Content_Type +oNew:Content_Length := ::Content_Length +oNew:Annotation_Server := ::Annotation_Server +oNew:nH := IF( PageHandle()==NIL, STD_OUT, PageHandle() ) + +RETURN oNew + +//#endif + +// ripped from HARBOUR + +METHOD CGIField( cQueryName ) Class oCgi + + LOCAL cRet := "" + LOCAL nRet + + DEFAULT cQueryName := "" + + nRet := aScan( ::aQueryFields, ; + { |x| upper( x[1] ) = upper( cQueryName ) } ) + + IF nRet > 0 + cRet := ::aQueryFields[nRet, 2] + ENDIF + +RETURN( cRet ) + + +// ripped from HARBOUR + +FUNCTION ParseString( cString, cDelim, nRet ) + + LOCAL cBuf, aElem, nPosFim, nSize, i + + nSize := len( cString ) - len( StrTran( cString, cDelim, '' ) ) + 1 + aElem := array( nSize ) + + cBuf := cString + i := 1 + FOR i := 1 TO nSize + nPosFim := at( cDelim, cBuf ) + + IF nPosFim > 0 + aElem[i] := substr( cBuf, 1, nPosFim - 1 ) + ELSE + aElem[i] := cBuf + ENDIF + + cBuf := substr( cBuf, nPosFim + 1, len( cBuf ) ) + + NEXT i + +RETURN( aElem[ nRet ] ) + + +// ripped from HARBOUR + +FUNCTION Hex2Dec( cHex ) + + LOCAL aHex := { { "0", 00 }, ; + { "1", 01 }, ; + { "2", 02 }, ; + { "3", 03 }, ; + { "4", 04 }, ; + { "5", 05 }, ; + { "6", 06 }, ; + { "7", 07 }, ; + { "8", 08 }, ; + { "9", 09 }, ; + { "A", 10 }, ; + { "B", 11 }, ; + { "C", 12 }, ; + { "D", 13 }, ; + { "E", 14 }, ; + { "F", 15 } } + LOCAL nRet + LOCAL nRes + + nRet := ascan( aHex, { |x| upper( x[1] ) = upper( left( cHex, 1 ) ) } ) + nRes := aHex[nRet, 2] * 16 + nRet := ascan( aHex, { |x| upper( x[1] ) = upper( right( cHex, 1 ) ) } ) + nRes += aHex[nRet, 2] + + RETURN( nRes ) + diff --git a/harbour/contrib/htmllib/oedit.prg b/harbour/contrib/htmllib/oedit.prg new file mode 100644 index 0000000000..75dea5e9da --- /dev/null +++ b/harbour/contrib/htmllib/oedit.prg @@ -0,0 +1,666 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Editing and Forms Class for HTMLLIB + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + + +#include "hbclass.ch" +#include "default.ch" +#include "forms.ch" +#include "html.ch" + +#define _OPTION_TEXT 1 +#define _OPTION_VALUE 2 +#define _OPTION_LABEL 3 +#define _OPTION_SELECTED 4 +#define _OPTION_DISABLED 5 + + +STATIC soForm + +/**** +* +* Class HControl() +* +* +*/ + +CLASS HControl // ALIAS hCtr +DATA nH +DATA Document +DATA Form + + +DATA Caption +DATA lBreak INIT .F. + + +DATA Type INIT "TEXT" +DATA Name +DATA Value +DATA Size +DATA rows, cols + +DATA cOutPut INIT "" + +DATA Picture INIT "@X" + +DATA aOptions INIT {} // SELECT options + +DATA TabIndex INIT 0 +DATA disabled INIT .F. +DATA readOnly INIT .F. +DATA Multiple INIT .F. +DATA style +DATA id + +DATA MaxLength // length in chars +DATA MaxChars // length on screen + +DATA Checked INIT .F. // checkboxes... + +DATA Source, Align // images... +DATA Wrap // textarea + +DATA onBlur +DATA onChange +DATA onFocus +DATA onSelect +DATA onClick +DATA onMouseOver +DATA onMouseOut +DATA onMouseDown +DATA onMouseup +DATA onKeyPress +DATA onKeyDown +DATA onKeyUp +DATA onSelect + +METHOD SetName( c ) INLINE ::Name := c +METHOD SetValue( c ) INLINE ::Value := c +METHOD SetStyle( c ) INLINE ::Style := c +METHOD SetId( c ) INLINE ::id := c +METHOD SetRows( c ) INLINE ::Rows := c +METHOD SetCols( c ) INLINE ::Cols := c +METHOD SetCaption(c) INLINE ::Caption := c +METHOD SetPicture(c) INLINE ::picture := c +METHOD SetOnBlur(c) INLINE ::onBlur := c +METHOD SetOnChange(c) INLINE ::onChange := c +METHOD SetOnFocus(c) INLINE ::onFocus := c +METHOD SetOnSelect(c) INLINE ::onSelect := c +METHOD SetOnClick(c) INLINE ::onClick := c +METHOD SetOnMsOver(c) INLINE ::onMouseOver := c +METHOD SetOnMsOut(c) INLINE ::onMouseOut := c +METHOD SetSize( n ) INLINE ::Size := n +METHOD SetMaxChars( n ) INLINE ::MaxChars := n +METHOD SetChecked( l ) INLINE ::Checked := l +METHOD SetAlign( c ) INLINE ::Align := c +METHOD SetWrap( c ) INLINE ::wrap := c +METHOD SetSource( c ) INLINE ::Source := c +METHOD SetReadOnly( l ) INLINE ::readOnly := l +METHOD SetDisabled( l ) INLINE ::disabled := l +METHOD SetMultiple( l ) INLINE ::multiple := l +METHOD SetOnMsDown(c) INLINE ::onMouseDown := c +METHOD SetOnMsUp(c) INLINE ::onMouseup := c +METHOD SetOnKPress(c) INLINE ::onKeyPress := c +METHOD SetOnKDown(c) INLINE ::onKeyDown := c +METHOD SetOnKUp(c) INLINE ::onKeyUp := c +METHOD SetOnSelect(c) INLINE ::onSelect := c + +//METHOD Debug() INLINE __clsDebug( self ) + +METHOD Put(lPut) +METHOD AddOption( cOption, cValue, cLabel, lSelected, lDisabled ) +METHOD SetControl( name,rows,cols,size,maxchars,value,onfocus,; + onblur,onchange,onselect,onclick,onmsover,onmsout,; + onmsdown,onmsup,onkdown,onkup,onkprs, ; + pic,cap,dis,ro,lMulti,checked,; + align,wrap,type, Style, Id ) + +ENDCLASS + + + +/**** +* +* HControl():Put() +* +* +*/ + +method Put(lPut) CLASS HControl +LOCAL i, cStr := "" + +::nH := pageHandle() +::form := currentForm() + +::cOutput += IF( ::lBreak, CRLF()+"
", CRLF() ) + +IF ::Caption != NIL + ::cOutput += ::Caption + HTMLSPACE(2) +" "+CRLF() +ENDIF + +IF ::Type == "SELECT" +::cOutPut += CRLF()+' " ) +ENDIF + + +RETURN Self + + + +/**** +* +* HControl():AddOption() +* +*/ + +method AddOption( cOption, cValue, cLabel, lSelected, lDisabled ) CLASS HControl +AADD( ::aOptions, { cOption, cValue, cLabel, lSelected, lDisabled } ) +RETURN Self + + + +/**** +* +* HControl():setControl() +* +* Batch set control properties/methods +* +* All default to NIL. See controls.ch +*/ + +method setControl( name,rows,cols,size,maxchars,value,onfocus,; + onblur,onchange,onselect,onclick,onmsover,onmsout,; + onmsdown,onmsup,onkdown,onkup,onkprs, ; + pic,cap,dis,ro,lMulti,checked,; + align,wrap,type, Style, Id ) CLASS HControl +::name := name +::rows := rows +::cols := cols +::size := size +::maxChars := maxchars +::value := value +::onFocus := onfocus +::onBlur := onblur +::onChange := onchange +::onSelect := onselect +::onClick := onclick +::onMouseOver := onmsover +::onMouseOut := onmsout +::onMouseDown := onmsdown +::onMouseUp := onmsup +::onKeyDown := onkdown +::onKeyUp := onkup +::onKeyPress := onkprs +::picture := pic +::caption := cap +::disabled := dis +::readonly := ro +::Multiple := lMulti +::Checked := checked +::Align := align +::Wrap := wrap +::type := type +::Style := Style +::Id := Id + +RETURN Self + + + +/**** +* +* Class Form() +* +* +* +*/ + + +CLASS Form + +DATA nH +DATA aControls init {} +DATA Name init "" +DATA Action +DATA Method //"mailto:name@site" +DATA EncType init "multipart/form-data" +DATA onSubmit +DATA onReset +DATA Target +DATA Frame init .F. +DATA Caption init "" +DATA CaptionColor init "black" +DATA CapFontColor init "white" +DATA CaptionImage +DATA bgImage +DATA fontColor init "black" +DATA Color init "#9196A0" +DATA width init 90 + +DATA cOutput init "" + +METHOD setHandle( h ) INLINE ::nH := h + +METHOD setName( c ) INLINE ::Name := c +METHOD setAction( c ) INLINE ::Action := c +METHOD setMethod( c ) INLINE ::Method := c +METHOD setEncType( c ) INLINE ::encType := c +METHOD setOnSubmit( c ) INLINE ::onSubmit := c +METHOD setOnReset( c ) INLINE ::onReset := c +METHOD setTarget( c ) INLINE ::Target := c +METHOD setCapClr( c ) INLINE ::CaptionColor := c +METHOD setCapFntClr( c ) INLINE ::CapFontColor := c +METHOD setCapImage( c ) INLINE ::CaptionImage := c +METHOD setBgImage( c ) INLINE ::bgImage := c +METHOD setFontColor( c ) INLINE ::FontColor := c +METHOD setFrmColor( c ) INLINE ::Color := c +METHOD setwidth( c ) INLINE ::width := c + + +METHOD AddControl( o ) INLINE IF(Valtype(o)=="O",; + (o:nH := ::nH, o:Form := Self),), ; + AADD( ::aControls, o ) + +METHOD PutControls() INLINE AEVAL( ::aControls, {|e| e:Put() } ) +METHOD New( cName, cAction, cMethod, lFrame, cCaption, nWidth ) +METHOD Put( lPutControls) +METHOD End() +METHOD GetControl( cName) + +//METHOD Debug() INLINE __clsDebug( self ) NOSELF + +ENDCLASS + + +/**** +* +* Form():New() +* +* +*/ + + +method New( cName, cAction, cMethod, lFrame, cCaption, nWidth ) CLASS Form + +DEFAULT cName := "Form1" +DEFAULT cMethod := "POST" +DEFAULT lFrame := .F. +DEFAULT cCaption := "" +DEFAULT nWidth := 90 + +::Name := cName +::Method := cMethod + +::nH := PageHandle() + +::Frame := lFrame +::Caption := cCaption +::width := nWidth + +::aControls := {} + +soForm := Self + +RETURN Self + + + +/**** +* +* Form():Put() +* +* +*/ + +method Put( lPutControls ) CLASS Form + +DEFAULT lPutControls := .F. + +IF VALTYPE(::width) != "N" + ::width := 90 +ENDIF + +IF VALTYPE( ::color ) != "C" + ::Color := "#9196A0" +ENDIF + +IF VALTYPE( ::fontColor ) != "C" + ::fontColor := "black" +ENDIF + +IF VALTYPE( ::CaptionColor ) != "C" + ::CaptionColor := "black" +ENDIF + + +IF ::Frame + ::cOutPut := CRLF()+CRLF()+CRLF()+"" +CRLF()+CRLF() + FWrite( ::nH, ::cOutput ) + ::cOutPut := '"+CRLF() + FWrite( ::nH, ::cOutput ) + ::cOutPut := ''+CRLF() + IF ::Caption != NIL + ::cOutPut := "'+CRLF() + FWrite( ::nH, ::cOutput ) + ENDIF + + ::cOutPut := ""+::Caption+""+CRLF() + FWrite( ::nH, ::cOutput ) + ::cOutPut := "" + FWrite( ::nH, ::cOutput ) + ENDIF + + ::cOutPut := '' +CRLF() + FWrite( ::nH, ::cOutput ) + ::cOutPut := ''+CRLF() + FWrite( ::nH, ::cOutput ) + ENDIF + +ENDIF +::cOutput+= CRLF()+"
" + CRLF() ) +IF ::Frame + FWrite( ::nH, ""+CRLF() ) + FWrite( ::nH, "
"+CRLF() ) + FWrite( ::nH, "
"+CRLF() ) +Endif +FWrite( ::nH, CRLF()+CRLF()+"" +CRLF()+CRLF()+CRLF() ) +RETURN Self + + + +/**** +* +* Form():getControl() +* +* Retrieve a form control object by name +* +*/ + +method getControl( cName ) CLASS Form + +LOCAL oRet +LOCAL nPos := ASCAN( ::aControls, {|e| e:name = cName } ) +IF nPos > 0 + oRet := ::aControls[nPos] +ENDIF + +RETURN oRet + + + +/**** +* +* oForm() +* +* Return current form +* +*/ + +FUNCTION oForm() +RETURN soForm + + diff --git a/harbour/contrib/htmllib/ofile.prg b/harbour/contrib/htmllib/ofile.prg new file mode 100644 index 0000000000..a6b86d9fb7 --- /dev/null +++ b/harbour/contrib/htmllib/ofile.prg @@ -0,0 +1,560 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Base fileIO class. + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + + +#include "hbclass.ch" + +#include "default.ch" +#include "fileio.ch" +#include "ferror.ch" +//#include "simpleio.ch" + +#translate FPOS() => FSEEK( , 0, FS_RELATIVE ) + +#ifdef TEST +PROC TEST() +LOCAL oF +oF := FileBase():New( "c:\autoexec.bat" ) //oFile.prg" ) +oF:Open() +? of:handle +while !oF:EOF() +? oF:ReadLine() +inkey(0) +ENDDO +#endif + + +// + CLASS FileBase // ALIAS FB +// +DATA Buffer INIT "" // Self[1] +DATA Name INIT "" +DATA Handle //INIT -999 +DATA FileSize INIT 0 +DATA BytesRead INIT 0 +DATA cPage INIT "" +DATA nPage INIT 0 +DATA nPageSize INIT 1024 +DATA nRecord INIT 0 + +METHOD New( cName ) +METHOD Open( nMode ) +METHOD Close() INLINE FClose( ::Handle ), ; + ::Handle := -999 + +METHOD Rename(c) INLINE FRename( ::File, c ) == 0 +METHOD Erase() INLINE Ferase( ::File ) == 0 +METHOD Exists() INLINE File( ::File ) +METHOD Error() INLINE Ferror() != 0 + +METHOD Tell() INLINE Fseek(::handle,FS_RELATIVE,0) +METHOD Pointer() INLINE FPOS( ::handle ) +METHOD ReadStr(n) INLINE ::Buffer := ; + FReadStr( ::Handle, n ) +METHOD Write( c, n ) INLINE FWrite( ::Handle, c, n ) +METHOD WriteByte( n ) +METHOD WriteInt( n ) +METHOD WriteLong( n ) +METHOD GetBuffer() INLINE ::Buffer + +METHOD GoTop() INLINE FSEEK( ::Handle, 0 ) +METHOD GoBottom() INLINE FSEEK( ::Handle, 0, FS_END) +METHOD Bof() INLINE ( FPOS(::Handle) == 0) +METHOD Eof() INLINE FPOS(::Handle) == ::FileSize +METHOD Seek( n, o ) INLINE FSeek( ::Handle, n, o) +METHOD Create( n ) +METHOD Size() + +METHOD _Read( n, c ) +METHOD ReadAhead( n, c ) +METHOD ReadLine( n ) +METHOD PrevLine( nBytes ) +METHOD ReadByte() +METHOD ReadInt() +METHOD ReadLong() + +METHOD GoTo( n ) +METHOD Skip( n ) + +METHOD MaxPages(n) +METHOD PrevPage(n) +METHOD NextPage(n) + +ENDCLASS + + + +// +METHOD New( cName ) CLASS FileBase +// +::Name := cName +::Buffer := "" // Self[1] +::Handle := 0 +::FileSize := 0 +::BytesRead := 0 +::cPage := "" +::nPage := 0 +::nPageSize := 1024 +::nRecord := 0 +RETURN Self + + +/* +** ::Open( [] ) --> lSuccess +*/ + +// +METHOD Open( nMode ) CLASS FileBase +// +DEFAULT nMode := FO_EXCLUSIVE //SHARED +::Handle := FOpen( ::Name, nMode ) +IF ::Handle > 0 + ::Size() +ENDIF +RETURN ::Handle > 0 + + +/* +** ::Create( [] ) --> lSuccess +*/ +// +METHOD Create( nAttr ) CLASS FileBase +// +LOCAL nSuccess +DEFAULT nAttr := 0 +nSuccess := FCreate( ::Name, nAttr ) +::Handle := nSuccess +RETURN (nSuccess != -1) + + + +/* +** ::Size() --> nFileSize +** +** RETURNs the size in bytes of the current file. +*/ + +// +METHOD Size() CLASS FileBase +// +LOCAL nCurrent,nLength + +nCurrent := FPOS( ::Handle ) +nLength := FSEEK( ::Handle, 0, FS_END ) + +FSEEK( ::Handle, nCurrent ) +::FileSize := nLength + +RETURN( nLength ) + + + +/* +** ::Read( [], [@] ) --> nBytesRead +*/ + +// +METHOD _Read( nSize, cBuff ) CLASS FileBase +// +LOCAL nBytesRead + +DEFAULT nSize := 1024 +DEFAULT cBuff := SPACE(nSize) + +::BytesRead := FRead( ::Handle, @cBuff, nSize ) +::Buffer := cBuff + +RETURN( cBuff ) //nBytesRead ) + + + +/* +** ::ReadAhead( [], [@] ) --> nBytesRead +** +** Read forward in the file without moving the pointer. +*/ + +// +METHOD ReadAhead( nSize, cBuff ) CLASS FileBase +// +LOCAL nBytesRead, nCurrent + +DEFAULT nSize := 1024 +DEFAULT cBuff := SPACE(nSize) + +// --> save position in file +nCurrent := FPOS( ::Handle ) + +// --> read ahead +::BytesRead := FRead( ::Handle, @cBuff, nSize ) + +// --> RETURN to saved position +FSEEK( ::Handle, nCurrent ) + +RETURN( cBuff ) + + + +/* +** ::ReadLine( [] ) --> cLine +*/ + +// +METHOD Readline( nSize ) CLASS FileBase +// +LOCAL cString, nCurrent, nCr + +DEFAULT nSize := 1024 + +IF nSize <= 0 + RETURN( "" ) +ENDIF + +nCurrent := FSEEK( ::Handle, 0, 1 ) +cString := FREADSTR( ::Handle, nSize ) +nCr := AT( CHR(13), cString ) + +FSEEK( ::Handle,nCurrent,0 ) +FSEEK( ::Handle,nCr+1,1 ) + +::Buffer := SUBSTR( cString, 1, nCr-1 ) +::nRecord++ + +RETURN ::Buffer + + + +/* +** ::ReadByte() --> nByte or -1 if unsuccessfull +*/ + +// +METHOD ReadByte() CLASS FileBase +// +LOCAL nRet, nBytes +LOCAL cBuff := SPACE( 1 ) + +nBytes := FRead( ::Handle, @cBuff, 1 ) + +RETURN( IF( nBytes > 0, ASC(cBuff), -1 ) ) + + + +/* +** ::ReadInt() --> nUnsignedInt or -1 if unsuccessfull +*/ + +// +METHOD ReadInt() CLASS FileBase +// +LOCAL nRet, nBytes +LOCAL cBuff := SPACE( 2 ) + +nBytes := FRead( ::Handle, @cBuff, 2 ) + +RETURN( IF( nBytes > 0, BIN2I(cBuff), -1 ) ) + + + +/* +** ::ReadLong() --> nLong or -1 if unsuccessfull +*/ + +// +METHOD ReadLong() CLASS FileBase +// +LOCAL nRet, nBytes +LOCAL cBuff := SPACE( 4 ) + +nBytes := FRead( ::Handle, @cBuff, 4 ) + +RETURN( IF( nBytes > 0, BIN2L(cBuff), -1 ) ) + + + + +/* +** ::WriteByte( nByte ) --> lSuccess +*/ + +// +METHOD WriteByte( nByte ) CLASS FileBase +// +LOCAL lSuccess := ( FWrite( ::nHandle, chr( nByte ), 1 ) == 1 ) +RETURN lSuccess + + + + +/* +** ::WriteInt( nInt ) --> lSuccess +*/ + +// +METHOD WriteInt( nInt ) CLASS FileBase +// +LOCAL lSuccess := ( FWrite( ::nHandle, I2BIN( nInt ), 2 ) == 2 ) +RETURN lSuccess + + + +/* +** ::WriteLong( nLong ) --> lSuccess +*/ + +// +METHOD WriteLong( nLong ) CLASS FileBase +// +LOCAL lSuccess := ( FWrite( ::nHandle, L2BIN( nLong ), 4 ) == 4 ) +RETURN( lSuccess ) + + + +/* +** ::GOTO( ) --> nPrevPos +** +** Skips to line from top. RETURNs previous position in file. +** +*/ + +// +METHOD GoTo( nLine ) CLASS FileBase +// +LOCAL nCount := 1 +LOCAL nPos := FPOS( ::Handle ) + +::GoTop() + +IF nLine < 0 // don't accept < 0 + RETURN( nPos ) +ELSEIF nLine == 0 + nLine := 1 + ::nRecord := 1 + ::GoTop() + RETURN( nPos ) +ENDIF + +WHILE !::EOF() + + ::ReadLine() + + IF nCount == nLine ; EXIT ; ENDIF + + nCount++ +ENDDO + +RETURN( nPos ) + + +/* +** ::Skip( [] ) --> nPrevPos +** +** Skips to line from top. RETURNs previous position in file. +** +*/ + +// +METHOD Skip( nLines ) CLASS FileBase +// +LOCAL nCount := 0 +LOCAL nPos := FPOS( ::Handle ) + +DEFAULT nLines := 1 + +IF nLines <= 0 // don't accept < 0 + + RETURN nPos + +ENDIF + +WHILE !::EOF() + + IF nCount == nLines ; EXIT ; ENDIF + + ::ReadLine() + nCount++ +ENDDO +RETURN( nPos ) + + +/* +** ::MaxPages( ) --> nMaxPages +*/ + +// +METHOD MaxPages( nPageSize ) CLASS FileBase +// +DEFAULT nPageSize := ::nPageSize +RETURN( ::Size() / nPageSize ) + + + +/* +** ::PrevPage( [] ) --> cPage +*/ + +// +METHOD PrevPage( nBytes ) CLASS FileBase +// + +DEFAULT nBytes := 1024 + +IF nBytes <= 0 + RETURN( "" ) +ENDIF + +IF !::BOF() + FSEEK( ::Handle, -nBytes, FS_RELATIVE) + ::cPage := FREADSTR( ::Handle, nBytes ) + FSEEK( ::Handle, -nBytes, FS_RELATIVE) + ::nPage-- +ENDIF + +RETURN( ::cPage ) + + + +/* +** ::NextPage( [] ) --> cPage +*/ + +// +METHOD NextPage( nBytes ) CLASS FileBase +// + +DEFAULT nBytes := 1024 + +IF nBytes <= 0 + RETURN( "" ) +ENDIF + +IF !::EOF() + ::cPage := FREADSTR( ::Handle, nBytes ) + ::nPage++ +ENDIF + +RETURN( ::cPage ) + + +/* +** ::PrevLine( [] ) --> ::Buffer +*/ +// +METHOD PrevLine( npBytes ) CLASS FileBase +// +LOCAL fHandle := ::Handle +LOCAL nOrigPos := FPOS(fHandle), nMaxRead, nNewPos, ; + lMoved, cBuff, nWhereCrLf, nPrev, cTemp + +DEFAULT npBytes := 256 + + IF nOrigPos == 0 + + lMoved := .F. + + ELSE + + lMoved := .T. + + // Check preceeding 2 chars for CR+LF + FSeek(fHandle, -2, FS_RELATIVE) + cTemp := Space(2) + FRead(fHandle, @cTemp, 2) + + IF cTemp == CRLF() + FSeek(fHandle, -2, FS_RELATIVE) + ENDIF + + nMaxRead := MIN( npBytes, FPOS(fHandle)) + + cBuff := Space(nMaxRead) + nNewPos := FSeek(fHandle, -nMaxRead, FS_RELATIVE) + FRead(fHandle, @cBuff, nMaxRead) + nWhereCrLf := RAT( CRLF(), cBuff ) + IF nWhereCrLf == 0 + + nPrev := nNewPos + ::Buffer := cBuff + + ELSE + + nPrev := nNewPos + nWhereCrLf + 1 + ::Buffer := SubStr(cBuff, nWhereCrLf + 2) + + ENDIF + + FSeek(fHandle, nPrev, FS_SET) + + ENDIF + +RETURN IF( lMoved, ::Buffer, "" ) + + +/* + * * * * * UNCHECKED !!! * * * * * + +METHOD PrevLine( nBytes ) CLASS FileBase +LOCAL cRet, cPage := "" +LOCAL nAt := 0 +LOCAL nPos := FPOS( ::Handle ) +DEFAULT nBytes := 1024 + +IF nBytes <= 0 + RETURN( "" ) +ENDIF + +IF !( FPOS(::Handle) == 1) // !BOF() + FSEEK( ::Handle, -nBytes, FS_RELATIVE) // position back + cPage := FREADSTR( ::Handle, nBytes ) // read forward + nAt := RAT( Chr(13), cPage ) // find crlf() + cRet := RIGHT( cPage, nAt+1) + //FSEEK( ::Handle, -(nAt-1), FS_RELATIVE) + FSEEK( ::Handle, nPos ) + FSEEK( ::Handle, -(nAT-1), 1 ) +ENDIF + +RETURN( cRet ) +*/ + diff --git a/harbour/contrib/htmllib/oframe.prg b/harbour/contrib/htmllib/oframe.prg new file mode 100644 index 0000000000..9a697e5e83 --- /dev/null +++ b/harbour/contrib/htmllib/oframe.prg @@ -0,0 +1,224 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * HTMLLIB Frame Class + * + * Copyright 2000 Manos Aspradakis + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#include "hbclass.ch" +#include "default.ch" +#include "html.ch" + + + +CLASS Frameset +DATA nH +DATA FName +DATA Title init "FrameSet01" + + +METHOD New( fName, title ) +METHOD StartSet( aRows, aCols, onLoad, onUnload ) +METHOD EndSet() +METHOD End() +METHOD Frame( cName, cURL, lBorder, lResize, lScrolling,; + marginwidth, marginheight, cTarget, cScrolling ) + +//METHOD Debug() INLINE __clsDebug( self ) NOSELF + +ENDCLASS + + + +// +METHOD New( cFName, cTitle ) CLASS Frameset + +LOCAL cStr := "" + +DEFAULT cTitle := "" + +::FName := cFName +::Title := cTitle + + +IF ::FName == NIL + cStr += "Content-Type: text/html"+CRLF()+CRLF() +// cStr := "" + ::nH := STD_OUT +ELSE + cStr := "" + ::nH := FCreate( ::FName ) +ENDIF + +cStr += ""+CRLF()+; + " "+CRLF()+; + " "+::Title+""+CRLF()+; + " "+CRLF() + +FWrite( ::nH, cStr ) + +RETURN Self + + + +// +METHOD StartSet( aRows, aCols, onLoad, onUnload ) CLASS Frameset +LOCAL i +LOCAL cStr := "" + +cStr += CRLF()+" "+CRLF() ) +RETURN Self + + +// +Method End() CLASS Frameset +FWrite( ::nH, ""+CRLF() ) +IF ::FName != NIL + FClose( ::nH ) +ENDIF +RETURN Self + + +// +METHOD Frame( cName, cURL, lBorder, lResize, lScrolling,; + marginwidth, marginheight, cTarget, cScrolling ) CLASS Frameset + +LOCAL cStr + +DEFAULT lBorder := .T. +DEFAULT lResize := .T. +DEFAULT lScrolling := .F. +DEFAULT cScrolling := "AUTO" +DEFAULT cTarget := "_self" //"_blank" + +cStr := " + * www - http://www.harbour-project.org + * + * 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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * Porting this library to Harbour + * + * See doc/license.txt for licensing terms. + * + */ + +#include "default.ch" +#include "hbclass.ch" +#include "html.ch" + +STATIC saGreek := {} +STATIC snHtm := NIL //0 +STATIC scForm := 0 +STATIC soPage := 0 + + +/**** +* +* Class HTML() +* +* +* Constructors : +* +* Html():New() Creates a new HTML document +* +* Html():CGINew() Creates a new CGI-HTML document +* +*/ + +CLASS Html + +DATA nH +DATA FName, Title +DATA FontFace INIT "Verdana" // Note! +DATA FontSize INIT 1 +DATA FontColor INIT "black" +DATA aImages +DATA BaseURL, BaseTarget +DATA lFont init .F. + +// --- INIT --- // +METHOD New( cFile, cTitle, cLinkTitle, cCharSet, cScriptSRC,; + bgImage, bgColor, txtColor, cJavaCode,; + onLoad, onUnload, cLinkClr, cVLinkClr, cALinkClr,; + cStyle, aimages, baseURL, baseTarget,; + nRefresh, cRefreshURL ,cStyleScr,lnocache) +METHOD CGINew( cTitle, cLinkTitle, cCharSet, cScriptSRC, bgImage, bgColor, txtColor, cJavaCode, onLoad, onUnload, cLinkClr, cVLinkClr, cALinkClr,cStyle, aImages, aServerSrc, baseURL, baseTarget,nRefresh, cRefreshURL ,cStyleScr,lnocache) + +/* METHOD Debug() INLINE __clsDebug( self ) NOSELF */ + +// --- HEADER --- // +METHOD SetPageColor( cColor ) INLINE FWrite(::nH, '' ) +METHOD SetTextColor( cColor ) INLINE FWrite(::nH, '' ) +METHOD SetBgImage( cImage ) INLINE FWrite(::nH, '' ) + +// --- END --- // +METHOD Close() +METHOD CGIClose() + + +// --- FONTS --- // +METHOD SetCenter( lOn ) INLINE FWrite( ::nH, IF( lOn, "
", "
" ) ) +METHOD SetFont( cFont, lBold, lItalic, lULine, nSize, cColor ,lSet) +METHOD StartFont( cFont, lBold, lItalic, lULine, nSize, cColor ,lSet) +METHOD DefineFont( cFont, cType, nSize, cColor , lSet) +METHOD EndFont() + + +// --- OUTPUT --- // + +METHOD Say( str, font, size, type, color ,style) + +METHOD QQOut( c ) INLINE ; + DEFAULT(c, ""), ; + FWrite( ::nH, c ) + +METHOD QOut( c ) INLINE ; + DEFAULT(c, ""), ; + FWrite( ::nH, CRLF()+c+'
'+CRLF() ) + +METHOD Write( c ) INLINE ; + DEFAULT(c, ""), ; + FWrite( ::nH, c ) + +METHOD WriteLN( c ) INLINE ; + DEFAULT( c, "" ),; + FWrite( ::nH, CRLF()+c+'
'+CRLF() ) + +METHOD SayColor( t, c ) INLINE ; + DEFAULT( t, "" ),; + DEFAULT( c, "black" ),; + FWrite(::nH, ''+t+'') + +METHOD Space( n ) INLINE ; + DEFAULT( n, 1 ),; + FWrite( ::nH, replicate( " ", n) ) + +METHOD PutImage( cImage, nBorder, nHeight,; + cOnclick, cOnMsOver, cOnMsOut, ; + cName, cAlt, cTarget ,nWidth,lbreak) + +METHOD Text( cText, nCols, lWrap ) ; + INLINE ; + DEFAULT( lWrap, .T. ),; + DEFAULT( nCols, 80 ),; + FWrite( ::nH, "", ">")+CRLF()+; + cText+CRLF()+""+CRLF() ) + + +METHOD MultiCol( txt, cols, gutter, width ) INLINE ; + DEFAULT( txt, "" ),; + DEFAULT( cols, 2 ),; + DEFAULT( gutter, 5 ),; + DEFAULT( width, 100 ),; + FWrite( ::nH, '' ),; + FWrite( ::nH, txt ),; + FWrite( ::nH, "" ) + +// --- COSMETICS --- // +METHOD PutHeading( cText, nWeight, lCentered ) + +METHOD HLine( nSize, nWidth, lShade, cColor) +/* INLINE ; + nSize := IF( nSize == NIL, 3, nSize ),; + nWidth := IF( nWidth == NIL, 90, nWidth ),; + FWrite( ::nH, '

'+CRLF()+'


') +*/ +METHOD PutParagraph() INLINE FWrite( ::nH, "

"+CRLF() ) + +METHOD Paragraph( l, c, style ) + +METHOD PutBreak() INLINE FWrite( ::nH, "
"+CRLF() ) + + +METHOD Marquee( cText, cFont, cFntColor, nFntSize, ; + cAlign, nWidth, nHeight, cbgColor, ; + cBehavior, cDirection , ; + nScrollAmt, nScrollDelay, loop,; + onMsOver, onMsOut, onClick, onStart, onFinish ) + +METHOD StartMarquee( cFont, cFntColor, nFntSize, ; + cAlign, nWidth, nHeight, cbgColor, ; + cBehavior, cDirection , ; + nScrollAmt, nScrollDelay, loop, ; + onMsOver, onMsOut, onClick, onStart, onFinish ) +METHOD EndMarquee() + +// --- URLs --- // +METHOD PutTextUrl( cText, cUrl, cOnClick, cOmMsOver, cOnMsout, cTarget ,/*new parameters*/ font,clr,size,style,bld,lbreak,cClass) +METHOD PutImageUrl( cImage, nBorder, nHeight,nWidth, cUrl,; + cOnclick, cOnMsOver, cOnMsOut, cName, cAlt, cTarget ,nWidth,lbreak,cClass) + + + +// --- TABLES --- // +METHOD DefineTable( nCols, nBorder, nWidth,nHeight, ColorFore, ColorBG, ; + l3d, lRuleCols, lRuleRows, ; + cClrDark, cClrLight, ncellpadding, ncellspacing,cAling ,lRules,bgImage,cStyle) + +METHOD TableHead( cHead, cColor, cAlign, ; + cFont, nSize, cFntColor, nHeight, cBgPic ) + +METHOD NewTableRow(cColor) +METHOD EndTableRow() +METHOD NewTableCell( cAlign, cColor, ; + cFont, nSize, cFntColor, nHeight, ; + cBgPic, ; + nWidth, lWrap,; + nCSpan, nRSpan ,cValing,clrdrk,clrlt,cBdrClr,cclass) + +METHOD EndTableCell() +METHOD EndTable() + + +// --- LISTS --- // +method newList() INLINE FWrite( ::nH, "
    "+CRLF() ) +method ListItem() INLINE FWrite( ::nH, "
  • " ) +method EndList() INLINE FWrite( ::nH, "
" ) + + +// --- FORMS --- // +METHOD NewForm( cMethod, cAction, cName ) +METHOD FormImage( cText, name, File ) +METHOD FormGet( cType, cName, xValue, nSize ) +METHOD FormReset( c ) +METHOD FormSubmit( c ) +METHOD FormQOut( c ) INLINE FWrite( ::nH, c + '
'+CRLF() ) +METHOD FormQQOut( c ) INLINE FWrite( ::nH, c + CRLF() ) +METHOD EndForm() INLINE FWrite( ::nH, CRLF()+""+CRLF() ) + +METHOD PushButton( cName, cCaption, ; + cCgiApp,; + cOnClick, ; + cOnFocus, cOnBlur, ; + cOnMsOver, cOnMsOut,; + style, id ) + +METHOD endButton() + +METHOD Button( cName, cCaption, ; + cOnClick, cCGIApp, ; + cOnMsOver, cOnMsOut,; + style, id ) + +METHOD iFrame( name, src, border, ; + marginwidth, marginheight, ; + scrolling, allign, ; + width, height) + + +// --- JAVA SUPPORT --- // +METHOD StartJava() INLINE ; + FWRITE( ::nH, '"+CRLF() ) + +METHOD serverCode(c) INLINE FWRITE( ::nH, ""+; + SPACE(9) + c +CRLF()+; + ""+CRLF() ) + +// standard output + +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(cName,cValue) +METHOD EndOBJect() +METHOD PutLinkName( cName ) +ENDCLASS + + + + +/**** +* +* Html():New() +* +* Starts a new HTML disk file. +*/ + +METHOD New( cFile, cTitle, cLinkTitle, cCharSet, aScriptSRC,; + bgImage, bgColor, txtColor, aJavaCode,; + onLoad, onUnload, cLinkClr, cVLinkClr, cALinkClr,; + cStyle, aImages, cBaseURL, cBaseTarget,; + nRefresh, cRefreshURL ,cStyleScr,lnocache) CLASS Html + +LOCAL i + +DEFAULT cFile := "file1.htm" +DEFAULT cTitle := "test HTML page" +DEFAULT cLinkTitle := cTitle +DEFAULT cRefreshURL:= "" +DEFAULT cCharset := "windows-1253" + +::nH := FCreate( cFile ) +::Title := cTitle +::FName := cFile + +FWRITE( ::nH, ''+CRLF() +; + ''+CRLF() +; + ' ' +cTitle+' '+CRLF() ) + +IF cBaseURL != NIL +FWRITE( ::nH, ""+CRLF() ) +ENDIF +IF cStyleScr != NIL + FWRITE( ::nH, ' "+CRLF()) +ENDIF + +FWRITE( ::nH, ' '+CRLF()+; + ' '+CRLF() ) + +IF nRefresh != NIL + FWrite( ::nH, [ ] ) +ENDIF + +if lnocache + FWrite( ::nH, [ ]) +ENDIF +IF aJavaCode != NIL + AEVAL( aJavaCode, {|e| JavaCMD( ::nH, e ) } ) +ENDIF + +IF aScriptSrc != NIL + FOR i =1 TO LEN( aScriptSrc ) + FWRITE( ::nH, ; + ''+CRLF() ) + NEXT +ENDIF + + +// preload images... +IF aImages != NIL + ::aImages := aImages + FWRITE( ::nH, ; + ''+CRLF() ) + +ENDIF + + +IF cStyle != NIL + FWRITE( ::nH, ""+CRLF() ) +ENDIF + +FWrite( ::nH,; + CRLF()+''+; + CRLF()+'' ) +FWrite( ::nH, CRLF() ) + + +IF bgImage != NIL + ::SetBgImage( bgImage ) +ENDIF + +IF bgColor != NIL + ::SetPageColor( bgColor ) +ENDIF + +IF txtColor != NIL + ::SetTextColor( txtColor ) +ENDIF + +snHtm := ::nH + +soPage := Self + +RETURN self + + + +/**** +* +* Html():CGINew() +* +* Starts a new CGI-HTML stream file. +*/ + +METHOD CGINew( cTitle, cLinkTitle, cCharSet, aScriptSRC,; + bgImage, bgColor, txtColor, aJavaCode, ; + onLoad, onUnload, ; + cLinkClr, cVLinkClr, cALinkClr, ; + cStyle, aImages, aServerSrc, ; + cBaseURL, cBaseTarget,; + nRefresh, cRefreshURL,cStyleScr ,lNocache) CLASS Html + +LOCAL i + + +//DEFAULT lAuthenticate := .F. +DEFAULT cTitle := "CGI HTML page" +DEFAULT cLinkTitle := cTitle +DEFAULT cRefreshURL:= "" +DEFAULT cCharset := "windows-1253" + +::nH := STD_OUT //FCreate( cFile ) +::Title := cTitle +::FName := "CGIOUT.HTM" + +FWRITE( ::nH, 'Content-Type: text/html'+CRLF()+CRLF() ) + +/* +IF lAuthenticate == .T. .and. ; + ( EMPTY(GetEnv( "AUTH_USER" )) .OR. EMPTY( GetEnv( "AUTH_PASS" )) ) + FWRITE( ::nH,""+CRLF() ) + FWRITE( ::nH,"HTTP/1.0 401 Not Authorized"+CRLF() ) + FWRITE( ::nH,'WWW-Authenticate:Basic Realm="'+cTitle+'"'+CRLF() ) + FWRITE( ::nH,""+CRLF() ) + FClose( ::nH ) + RETURN Self +ENDIF +*/ + +FWRITE( ::nH, ''+CRLF() +; + ''+CRLF() +; + ' ' +cTitle+' '+CRLF() ) + +IF cBaseURL != NIL +FWRITE( ::nH, ""+CRLF() ) +ENDIF + +FWRITE( ::nH, ' '+CRLF()+; + ' '+CRLF() ) + +IF cStyleScr != NIL + FWRITE( ::nH, ' "+CRLF()) +ENDIF +IF nRefresh != NIL + FWrite( ::nH, [ ] ) +ENDIF +if lnocache + FWrite( ::nH, [ ]) +ENDIF + +IF aJavaCode != NIL + AEVAL( aJavaCode, {|e| JavaCMD( ::nH, e ) } ) +ENDIF + +IF aScriptSrc != NIL + FOR i =1 TO LEN( aScriptSrc ) + FWRITE( ::nH, ; // RUNAT=SERVER + ''+CRLF() ) + NEXT +ENDIF + +IF aServerSrc != NIL + FOR i =1 TO LEN( aServerSrc ) + FWRITE( ::nH, ; // RUNAT=SERVER + ''+CRLF() ) + NEXT +ENDIF + +// preload images... +IF aImages != NIL + ::aImages := aImages + FWRITE( ::nH, ; + ''+CRLF() ) + +ENDIF + +IF cStyle != NIL + FWRITE( ::nH, ""+CRLF() ) +ENDIF + +FWrite( ::nH,; + ''+CRLF()+; + '' ) + +FWrite( ::nH, CRLF() ) + +IF bgImage != NIL + ::SetBgImage( bgImage ) +ENDIF + +IF bgColor != NIL + ::SetPageColor( bgColor ) +ENDIF + +IF txtColor != NIL + ::SetTextColor( txtColor ) +ENDIF + +snHtm := ::nH + +soPage := Self + +RETURN self + + + +/**** +* +* Html():SetFont() +* +* obvious... +*/ + +METHOD SetFont( cFont, lBold, lItalic, lULine, nSize, cColor ,lSet) CLASS Html +LOCAL cStr := CRLF()+'' + if lset + ::fontColor := cColor + endif +ELSE + cStr += ">" +ENDIF + + +IF lBold != NIL + IF( lBold, cStr += '', cStr += '') +ENDIF +IF lItalic != NIL + IF( lItalic, cStr += '', cStr += '') +ENDIF + +IF lULine != NIL + IF( lULine, cStr += '', cStr += '') +ENDIF + +cStr += '' +FWrite( ::nH, cStr + CRLF() ) +RETURN Self + + +/**** +* +* Html():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) CLASS Html +LOCAL cStr := "' + if lSet + ::fontColor := cColor + endif +ELSE + cStr += ">" +ENDIF + +IF lBold != NIL + IF( lBold, cStr += '', cStr += '') +ENDIF +IF lItalic != NIL + IF( lItalic, cStr += '', cStr += '') +ENDIF + +IF lULine != NIL + IF( lULine, cStr += '', cStr += '') +ENDIF + +FWrite( ::nH, cStr + CRLF() ) + +RETURN Self + + +/**** +* +* Html():DefineFont() +* +* Begin a font definition by font type "name". +* Use ::endFont() to cancel this font +*/ + +METHOD DefineFont( cFont, cType, nSize, cColor ,lSet) CLASS Html +LOCAL cStr := "' + if lset + ::fontColor := cColor + endif +ELSE + cStr += ">" +ENDIF + + +IF cType != NIL + cStr += cType +ENDIF + +FWrite( ::nH, cStr + CRLF() ) + +RETURN Self + + + +/**** +* +* Html():EndFont() +* +* End a font definition +*/ + +METHOD endFont() CLASS Html +FWrite( ::nH, '' + CRLF() ) +RETURN Self + + + +/**** +* +* Html():say() +* +* +* +*/ + +METHOD Say( str, font, size, type, color ,style) CLASS Html +LOCAL cOut := "" +LOCAL lBold := .F., lItalic:= .F., lULine := .F.,lEm:=.f.,lStrong:=.f. +Local nSize:=Size +DEFAULT str := "" +DEFAULT font := ::FontFace +DEFAULT size := ::FontSize +DEFAULT color:= ::FontColor +if Font != nil .or. Size !=Nil .or. color != Nil +cOut := '' +Else + cOut += '>' +Endif +endif +IF VALTYPE( type ) == "C" + 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 +FWrite( ::nH, cOut+CRLF() ) + +RETURN Self + + + + +/**** +* +* Html():paragraph() +* +* +* +*/ + +METHOD Paragraph( lStart, cAlign, cStyle ) CLASS Html +LOCAL cStr := "'+ ; + CRLF() ) +ELSE +FWrite( ::nH, CRLF()+; + '
'+ ; + CRLF() ) +ENDIF + +RETURN Self + + + +/**** +* +* Html():PutHeading() +* +* Put an HTML heading ( large text ) +*/ + +METHOD PutHeading( cText, nWeight, lCentered ) CLASS Html +DEFAULT nWeight := 3 +DEFAULT lCentered := .F. + +IF lCentered +FWrite( ::nH, "
" ) +ENDIF + +FWrite( ::nH, ""+cText+""+CRLF() ) + +IF lCentered +FWrite( ::nH, "
" ) +ENDIF + +RETURN Self + + + + +/**** +* +* Html():putTextURL() +* +* Put a text link. +*/ + +METHOD PutTextUrl( cText , cUrl , cOnClick, cOnMsOver, cOnMsout, cTarget , font, clr, size, style, bld,lbreak,cClass) CLASS Html + +LOCAL cStr := "" +DEFAULT cUrl := "" +DEFAULT bld := .F. + +FWrite( ::nH, ; + ''+cStr ) + IF font != NIL .or. clr != NIL .or. size != NIL .or. style != NIL + FWrite (::nH,; + '
') +Endif +IF bld + FWrite (::nH,; + '') +Endif + +FWrite( ::nH, ; + ''+if(lBreak,'
'+CRLF(),CRLF() )) + + +RETURN Self + + + + +/**** +* +* Html():putImageURL() +* +* Put an Image link. +*/ + +Method PutImageUrl( cImage, nBorder, nHeight, cUrl, ; + cOnclick, cOnMsOver, cOnMsOut, cName, cAlt, cTarget ,nWidth,lbreak,cClass) CLASS Html +LOCAL cStr := "" + +IF cName != NIL + cStr += ' NAME= "'+cName + '"' +CRLF() +ENDIF +IF cAlt != NIL + cStr += ' ALT= "'+cAlt+ '"' +CRLF() +ENDIF +IF nBorder != NIL + cStr += " border = "+if(valtype(nBorder)=="N",NUMTRIM(nBorder),nBorder) +CRLF() +ENDIF +IF nHeight != NIL .and. valtype(nHeight)=="N" + cStr += " height = "+NUMTRIM(nHeight) + " " +CRLF() +ELSEIF nHeight != NIL .and. valtype(nHeight)=="C" + cStr += " height = "+nHeight +" " +CRLF() +ENDIF + +IF nWidth!= NIL .and. valtype(nWidth)=="N" + cStr += " width = "+NUMTRIM(nWidth) + " " +CRLF() +ELSEIF nWidth!= NIL .and. valtype(nWidth)=="C" + cStr += " width = "+nWidth + " " +CRLF() +endif +IF cOnClick != NIL + cStr += ' onClick="'+cOnClick+'"' +CRLF() +ENDIF +IF cOnMsOver != NIL + cStr += ' onMouseOver="'+cOnMsOver+'"' +CRLF() +ENDIF +IF cOnMsOut != NIL + cStr += ' onMouseOut="'+cOnMsOut+'"' +CRLF() +ENDIF + +IF cTarget != NIL +cStr += ' TARGET='+cTarget +CRLF() +ENDIF + +FWrite( ::nH, ; + ''+ if(lBreak,'
'+CRLF(),"" )) + +RETURN Self + +Method PutTextImageUrl( cImage, nBorder, nHeight, cUrl, ; + cOnclick, cOnMsOver, cOnMsOut, cName, cAlt, cTarget ,nWidth,lbreak,cClass,cText) CLASS Html +LOCAL cStr := "" + +IF cName != NIL + cStr += ' NAME= "'+cName + '"' +ENDIF +IF cAlt != NIL + cStr += ' ALT= "'+cAlt+ '"' +ENDIF +IF nBorder != NIL + cStr += " border = "+NUMTRIM(nBorder) +ENDIF +IF nHeight != NIL .and. valtype(nHeight)=="N" + cStr += " height = "+NUMTRIM(nHeight) + " " +ELSEIF nHeight != NIL .and. valtype(nHeight)=="C" + cStr += " height = "+nHeight +" " +ENDIF + +IF nWidth!= NIL .and. valtype(nWidth)=="N" + cStr += " width = "+NUMTRIM(nWidth) + " " +ELSEIF nWidth!= NIL .and. valtype(nWidth)=="C" + cStr += " width = "+nWidth + " " +endif +IF cOnClick != NIL + cStr += ' onClick="'+cOnClick+'"' +ENDIF +IF cOnMsOver != NIL + cStr += ' onMouseOver="'+cOnMsOver+'"' +ENDIF +IF cOnMsOut != NIL + cStr += ' onMouseOut="'+cOnMsOut+'"' +ENDIF + +IF cTarget != NIL +cStr += ' TARGET='+cTarget +ENDIF + +FWrite( ::nH, ; + ''+cText+ ''+ if(lBreak,'
'+CRLF(),"" )) + +RETURN Self + + + +/**** +* +* Html():putImage() +* +* Put an Image. +*/ + +Method PutImage( cImage, nBorder, nHeight, ; + cOnclick, cOnMsOver, cOnMsOut, cName, cAlt, cTarget ,nWidth,lbreak) CLASS Html +LOCAL cStr := "" + +IF cName != NIL + cStr += ' NAME= "'+cName + '"' +ENDIF +IF cAlt != NIL + cStr += ' ALT= "'+cAlt+ '"' +ENDIF +IF nBorder != NIL .and. valtype(nBorder)=="N" + cStr += " BORDER = "+NUMTRIM(nBorder) +ELSEIF nBorder != NIL .and. valtype(nBorder)=="C" + cStr += " BORDER = "+ '"'+nBorder+'"' +ENDIF + +IF nHeight != NIL .and. valtype(nHeight)=="N" + cStr += " HEIGHT = "+NUMTRIM(nHeight) + " " +ELSEIF nHeight != NIL .and. valtype(nHeight)=="C" + cStr += " HEIGHT = "+'"'+nHeight + '"' +ENDIF +IF nWidth!= NIL .and. valtype(nWidth)=="N" + cStr += " width = "+NUMTRIM(nWidth) + " " +ELSEIF nWidth!= NIL .and. valtype(nWidth)=="C" + cStr += " width = "+nWidth + " " +endif + +IF cOnClick != NIL + cStr += ' onClick="'+cOnClick+'"' +ENDIF +IF cOnMsOver != NIL + cStr += ' onMouseOver="'+cOnMsOver+'"' +ENDIF +IF cOnMsOut != NIL + cStr += ' onMouseOut="'+cOnMsOut+'"' +ENDIF + +IF cTarget != NIL +cStr += ' TARGET="'+cTarget+'"' +ENDIF +FWrite( ::nH, ; + ''+if(lBreak,'
'+CRLF(),"" ) ) + +RETURN Self + + + + + +/**** +* +* Html():Close() +* +* Close an HTML disk file +* +*/ + +METHOD Close() CLASS Html +FWrite( ::nH, ""+CRLF() ) +FWrite( ::nH, ""+CRLF() ) +FClose( ::nH ) +RETURN Self + + +/**** +* +* Html():CGIClose() +* +* Close a CGI-HTML stream file +*/ + +METHOD cgiClose() CLASS Html +FWrite( ::nH, ""+CRLF() ) +FWrite( ::nH, ""+CRLF() ) +FWrite( ::nH, CRLF() ) +RETURN Self + + + +/**** +* +* Html():defineTable() +* +* Start an HTML table definition. +* +* +*/ + +METHOD DefineTable( nCols, nBorder, nWidth, nHeight, ColorFore, ColorBG, ; + l3d, lRuleCols, lRuleRows, cClrDark, cClrLight,cClrBorder, ; + nCellPadding, nCellSpacing,cAling,lRules,bgImage,cStyle) CLASS Html + +LOCAL cStr := ""+ CRLF()+CRLF()+"', "")+""+CRLF() +//cStr += cHead + ''+""+CRLF() + +FWrite(::nH, cStr ) + +RETURN Self + + + +/**** +* +* Html():newTableRow() +* +* Start a table row definition. +* +*/ + +METHOD NewTableRow( cColor ) CLASS Html +LOCAL cStr := SPACE(5)+""+CRLF() ) +RETURN Self + + + + +/**** +* +* Html():newTableCell() +* +* Start a table cell definition. +* +*/ + +METHOD NewTableCell( cAlign, cColor, ; + cFont, nSize, cFntColor, nHeight, ; + cBgPic, nWidth, lWrap, ; + nColspan, nRowspan,cValign ,clrdrk,clrlt,cBdrClr,cClass) CLASS Html + +LOCAL cStr := SPACE(10)+"" + ELSE + cStr += ">" + ENDIF + ::lFont:=.t. +ENDIF + +FWrite(::nH, cStr ) +RETURN Self + + + +/**** +* +* Html():endTableCell() +* +* End a table cell definition. +* +*/ + +METHOD EndTableCell() CLASS Html +if ::lFont +FWrite(::nH, ""+CRLF() ) +else +FWrite(::nH, ""+CRLF() ) +endif +::lFont:=.f. +RETURN Self + + + + +/**** +* +* Html():endTable() +* +* End a table definition. +*/ + +METHOD EndTable() CLASS Html +FWrite(::nH, "
"+CRLF() ) +FWrite(::nH, CRLF()+""+ CRLF()+CRLF() ) +RETURN Self + + + + + +// +// FORMS... +// + + +/**** +* +* Html():newForm() +* +* Creates a new form +* +*/ + +METHOD NewForm( cMethod, cAction, cName ) CLASS Html + +DEFAULT cMethod := "POST" +DEFAULT cName := "newForm" + +FWRITE( ::nH, CRLF()+"'+CRLF() ) + +scForm := cName + +RETURN Self + + + +/**** +* +* Html():FormGet() +* +* Adds a form edit field +* +*/ + +METHOD FormGet( cType, cName, xValue, nSize ) CLASS Html +default cType := "edit" + +FWrite( ::nH, '" ) +RETURN Self + + + +/**** +* +* Html():FormSubmit() +* +* Adds a form submit button +* +*/ + +METHOD FormSubmit( cText ) CLASS Html +FWrite( ::nH, ''+CRLF() ) +RETURN Self + + + + + +/**** +* +* Html():FormImage() +* +* Adds a form image button +* +*/ + +METHOD FormImage( cText, name, File ) CLASS Html +FWrite( ::nH, ''+CRLF() ) +RETURN Self + + +/**** +* +* Html():FormReset() +* +* Adds a reset button +* +*/ + +METHOD FormReset( cText ) CLASS Html + +FWrite( ::nH, ''+CRLF() ) + +RETURN Self + + + + +/**** +* +* Html():pushButton() +* +* Insert a standalone push button and assign an action to it +* Either pass onClick or cCgiApp - not both +*/ + +METHOD PushButton( cName, cCaption, ; + cCgiApp,; + cOnClick, ; + cOnFocus, cOnBlur, ; + cOnMsOver, cOnMsOut,; + style, id ) CLASS Html + +LOCAL cStr := CRLF()+"" ) + +RETURN Self + + + +/**** +* +* Html():Button() +* +* Insert a standalone "+CRLF() ) +RETURN Self + + + + +/**** +* +* Html():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 Html + + +LOCAL cStr := "" + +DEFAULT cFont := "Verdana" +DEFAULT cFntColor := "white" +DEFAULT nFntSize := 3 +DEFAULT cAlign := "middle" +DEFAULT nWidth := 100 +DEFAULT cText := "" +DEFAULT cBgColor := "black" +DEFAULT cBehavior := "scroll" // "slide" "alternate" +DEFAULT cDirection := "left" // "slide" "alternate" +DEFAULT nScrollAmt := 5 +DEFAULT nScrolldelay := 2 +DEFAULT loop := 0 + +::StartFont( cFont,,,, nFntSize, cFntColor ) + +FWrite( ::nH, '') +FWrite( ::nH, cText ) + +FWrite( ::nH, ""+CRLF() ) +// FWrite( ::nH, cStr ) +::EndFont() + +RETURN Self + + + +/**** +* +* Html():StartMarquee() +* +* Start a scrolling marquee effect definition +* +*/ + +METHOD StartMarquee( cFont, cFntColor, nFntSize, ; + cAlign, nWidth, nHeight, cbgColor, ; + cBehavior, cDirection , ; + nScrollAmt, nScrollDelay, loop, ; + onMsOver, onMsOut, onClick, onStart, onFinish ) CLASS Html + +LOCAL cStr := "" + +DEFAULT cFont := "Verdana" +DEFAULT cFntColor := "white" +DEFAULT nFntSize := 3 +DEFAULT cAlign := "middle" +DEFAULT nWidth := 100 +DEFAULT cBgColor := "black" +DEFAULT cBehavior := "scroll" // "slide" "alternate" +DEFAULT cDirection := "left" // "slide" "alternate" +DEFAULT nScrollAmt := 5 +DEFAULT nScrolldelay := 2 +//DEFAULT loop := -1 + +::StartFont( cFont,,,, nFntSize, cFntColor ) + +cStr += ''+; + CRLF() + +FWrite( ::nH, cStr ) +::EndFont() + +RETURN Self + + +/**** +* +* Html():endMarquee() +* +* +* +*/ + +METHOD EndMarquee() CLASS Html +FWrite( ::nH, ""+CRLF() ) +RETURN Self + + + + +/**** +* +* Html():iFrame() +* +* Define an inline frame. +* +*/ + +METHOD iFrame( name, src, border, marginwidth, marginheight, ; + scrolling, align, width, height) CLASS Html + +LOCAL cStr := "