167ef1f0c5
* contrib/htmllib/default.ch
* fixed IF/THEN command
* source/compiler/hbident.c
* source/compiler/harbour.l
* added memory duplication for macro text (&a._m)
* source/pp/ppcore.c
* fixed my last commits
* processed this file with indent
275 lines
10 KiB
Plaintext
275 lines
10 KiB
Plaintext
/*
|
||
* $Id$
|
||
*/
|
||
|
||
/*
|
||
* Harbour Project source code:
|
||
* DEFAULT.CH some default definition to HTMLLIB
|
||
*
|
||
* Copyright 2000 Manos Aspradakis <maspr@otenet.gr>
|
||
* 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 <culik@sl.conex.net>
|
||
* 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( <nVal>, <nPCent> ) => ;
|
||
( ( <nVal> * <nPCent> ) / 100 )
|
||
|
||
// --> Default parameters
|
||
#xcommand DEFAULT <uVar1> := <uVal1> ;
|
||
[, <uVarN> := <uValN> ] => ;
|
||
<uVar1> := IIf( <uVar1> == nil, <uVal1>, <uVar1> ) ;;
|
||
[ <uVarN> := IIf( <uVarN> == nil, <uValN>, <uVarN> ); ]
|
||
|
||
#xcommand DEFAULT <v1> TO <x1> [, <vn> TO <xn> ] ;
|
||
=> ;
|
||
IF <v1> == NIL ; <v1> := <x1> ; END ;
|
||
[; IF <vn> == NIL ; <vn> := <xn> ; END ]
|
||
|
||
// --> OOPs
|
||
#xtranslate BYNAME <V> [, <VN> ] => ::<V> := <V> [; ::<VN> := <VN> ]
|
||
#xtranslate BYNAME <V> DEFAULT <Val> => ::<V> := BYDEFAULT <V>, <Val>
|
||
#xtranslate BYDEFAULT <V>, <Val> => IIF( <V> == NIL, <Val>, <V> )
|
||
|
||
|
||
// --> Save/Restore video state...
|
||
#xtranslate SaveState() => { row(), ;
|
||
col(), ;
|
||
SetColor(), ;
|
||
SetCursor(), ;
|
||
SaveScreen(,,,,) }
|
||
|
||
|
||
#xtranslate RestState(<a>) => DispBegin() ;;
|
||
RestScreen(,,,,<a>\[5\]) ;;
|
||
SetColor(<a>\[3\] ) ;;
|
||
SetCursor(<a>\[4\]) ;;
|
||
SetPos(<a>\[1\], <a>\[2\] ) ;;
|
||
DispEnd()
|
||
|
||
|
||
// --> Save/Restore Table state
|
||
#xTranslate DbSaveState() => IIF( USED(),;
|
||
{ Select(), ;
|
||
Recno(), ;
|
||
OrdBagName(0),;
|
||
OrdSetFocus() ;
|
||
},;
|
||
NIL )
|
||
|
||
#xTranslate DbRestState( <a> ) => IIF( <a> != NIL, ;
|
||
( Select( <a>\[1\] ), ;
|
||
OrdListAdd(<a>\[3\] ), ;
|
||
OrdSetFocus(<a>\[4\] ),;
|
||
DbGoto(<a>\[2\] )),)
|
||
|
||
|
||
// --> Display a Message at MAXROW() with optional colour...
|
||
#xTranslate Message(<cMsg>,<c>) => ;
|
||
DispOutAt( maxrow(), 0, PadC(<cMsg>, MaxCol()+1 ), ;
|
||
IIF( EMPTY(#<c>), "R/W", #<c> ) )
|
||
|
||
|
||
// --> Display a backdrop desktop with optional color
|
||
#xTranslate DeskTop([<c>]) => ;
|
||
DispBox( 0,0,maxrow(),maxcol(), replicate("±",9), [<c>] )
|
||
|
||
|
||
// --> Display a box with shadow (without savescreen() )
|
||
#xTranslate ShadBox( <nTR>, <nTC>, <nBR>, <nBC>, <cStyle>, <cClrs> ) ;
|
||
=> ;
|
||
DispBegin() ;;
|
||
RESTSCREEN( <nTR>+1,<nTC>+2,<nBR>+1,<nBC>+2,;
|
||
TRANSFORM( ;
|
||
SAVESCREEN( <nTR>+1,<nTC>+2,<nBR>+1,<nBC>+2 ),;
|
||
REPLICATE( 'X', ( <nBR>-<nTR>+1 ) * ( <nBC>-<nTC>+1 ) ) ) );;
|
||
DispBox( <nTR>, <nTC>, <nBR>, <nBC>, [<cStyle>], [<cClrs>] );;
|
||
SetPos( <nTR>+1, <nTC>+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( <nTR>, <nTC>, <nBR>, <nBC>, [<cStyle>], [<cClrs>] ) ;
|
||
=> ;
|
||
{ <nTR>, <nTC>, <nBR>+1, <nBC>+2, ;
|
||
SAVESCREEN( <nTR>, <nTC>, <nBR>+1, <nBC>+2 ) } ;;
|
||
DispBegin() ;;
|
||
RESTSCREEN( <nTR>+1,<nTC>+2,<nBR>+1,<nBC>+2,;
|
||
TRANSFORM( SAVESCREEN( <nTR>+1,<nTC>+2,<nBR>+1,<nBC>+2 ),;
|
||
REPLICATE( 'X', ( <nBR>-<nTR>+1 ) * ( <nBC>-<nTC>+1 ) ) ) );;
|
||
DispBox( <nTR>, <nTC>, <nBR>, <nBC>, ;
|
||
IIF(EMPTY(#<cStyle>), "ÚÄ¿³ÙÄÀ³ ", <cStyle> ), ;
|
||
IIF(EMPTY(#<cClrs>),"W/B", <cClrs> ) );;
|
||
SetPos( <nTR>+1, <nTC>+1 );;
|
||
DispEnd()
|
||
|
||
|
||
// --> Display a Caption for a WOpen() window
|
||
#xTranslate WTitle( <aWin>, <cTitle>, <cClr> ) => ;
|
||
DispBox( <aWin>\[1\], <aWin>\[2\], ;
|
||
<aWin>\[1\], <aWin>\[4\]-2, ;
|
||
replicate(" ",9), ;
|
||
IIF( EMPTY(#<cClr>), "b/w", #<cClr> ) ) ;;
|
||
DispOutAt( <aWin>\[1\], <aWin>\[2\], ;
|
||
PADC(<cTitle>, (<aWin>\[4\]-<aWin>\[2\])-1, " " ), ;
|
||
IIF( EMPTY(#<cClr>), "b/w", #<cClr> ))
|
||
|
||
// --> Closes a window created with WOpen() - Restores screen
|
||
#xTranslate WClose(<aWin>) => RestScreen( <aWin>\[1\], <aWin>\[2\], ;
|
||
<aWin>\[3\], <aWin>\[4\], ;
|
||
<aWin>\[5\] )
|
||
|
||
|
||
// --> Save/Restore full screen - *MUST* pass to/from var
|
||
#xtranslate ScreenSave() => SAVESCREEN( 0, 0, 24, 79 )
|
||
#xtranslate ScreenRest( <c> ) => RESTSCREEN( 0, 0, 24, 79, <c> )
|
||
|
||
// --> Build a Picture template
|
||
#xtranslate CAPFIRST(<foo>) => ( "!" + REPLICATE( "X", LEN( <foo> ) -1 ))
|
||
|
||
// --> Array shrink
|
||
#xTranslate ASHRINK( <array> ) => ;
|
||
ADEL ( <array>, LEN( <array> ) ) ;
|
||
; ASIZE( <array>, LEN( <array> ) - 1 )
|
||
|
||
|
||
// --> Number to Trimmed String
|
||
#xTranslate NTRIM( <nNum> ) => LTRIM(STR( <nNum> ))
|
||
#xTranslate NUMTRIM( <nNum> ) => LTRIM(STR( <nNum> ))
|
||
// --> Convert logical to character
|
||
#xtranslate LTOC(<l>) => IIF( <l>, "T", "F")
|
||
|
||
// --> Convert character to logical
|
||
#xTranslate CTOL(<c>) => IIF( <c> $ "TtYy", .T., .F.)
|
||
|
||
|
||
// --> Left trim a numeric
|
||
#xtranslate LSTR(<n>) => LTRIM( Str( <n> ) )
|
||
|
||
|
||
// --> Carriage Return + Line Feed
|
||
#xtranslate CRLF(<str>) => ( <str> + 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(<xVar>) => {|x| IIF(x == NIL, <xVar>, <xVar> := x )}
|
||
|
||
#translate GETSET( <xVal>, <xParm> ) => ;
|
||
<xVal> := IIF( <xParm> == NIL, <xVal>, <xVal> := <xParm>)
|
||
|
||
|
||
// --> Convert Character String to Code Block
|
||
#xTranslate COMPILE(<c>) => &("{||" + <c> + "}")
|
||
|
||
|
||
// --> 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(<foo>) => (VALTYPE(<foo>)=="A")
|
||
#xtranslate IS_BLOCK(<foo>) => (VALTYPE(<foo>)=="B")
|
||
#xtranslate IS_CHAR(<foo>) => (VALTYPE(<foo>)=="C")
|
||
#xtranslate IS_DATA(<foo>) => (<foo> \>=32 .AND. <foo> \<= 253)
|
||
#xtranslate IS_DATE(<foo>) => (VALTYPE(<foo>)=="D")
|
||
#xtranslate IS_DEF(<foo>) => !(TYPE(<foo>) $ "UE")
|
||
#xtranslate IS_DIGIT(<foo>) => ISDIGIT(<foo>)
|
||
#xtranslate IS_INT(<foo>) => (<foo>)==INT(<foo>) )
|
||
#xtranslate IS_LOGIC(<foo>) => (VALTYPE(<foo>)=="L")
|
||
#xtranslate IS_MEMO(<foo>) => (VALTYPE(<foo>)=="M")
|
||
#xtranslate IS_NUM(<foo>) => (VALTYPE(<foo>)=="N")
|
||
#xtranslate IS_OBJECT(<foo>)=> (VALTYPE(<foo>)=="O")
|
||
#xtranslate IS_TIME(<foo>) => (VAL(LEFT <foo>,2)) \< 24 .AND. ;
|
||
VAL(SUBSTR(<foo>,4,2)) \< 60 .AND. ;
|
||
VAL(RIGHT(<foo>,2 )) \<60 )
|
||
|
||
#translate ISNIL( <v1> ) => ( <v1> == NIL )
|
||
#translate ISARRAY( <v1> ) => ( valtype( <v1> ) == "A" )
|
||
#translate ISBLOCK( <v1> ) => ( valtype( <v1> ) == "B" )
|
||
#translate ISCHARACTER( <v1> ) => ( valtype( <v1> ) == "C" )
|
||
#translate ISDATE( <v1> ) => ( valtype( <v1> ) == "D" )
|
||
#translate ISLOGICAL( <v1> ) => ( valtype( <v1> ) == "L" )
|
||
#translate ISMEMO( <v1> ) => ( valtype( <v1> ) == "M" )
|
||
#translate ISNUMBER( <v1> ) => ( valtype( <v1> ) == "N" )
|
||
#translate ISOBJECT( <v1> ) => ( valtype( <v1> ) == "O" )
|
||
|
||
|
||
#command REPEAT => DO WHILE .T.
|
||
#command UNTIL <*lexpr*> => IF (<lexpr>); EXIT ; END ; ENDDO
|
||
|
||
#command IF <lexpr> THEN <*statement*> =>;
|
||
IF(<lexpr>) ; <statement> ; END
|
||
|
||
#command IF <lexpr> THEN <statement1> ELSE <statement2> =>;
|
||
IF(<lexpr>) ; <statement1> ; ELSE ; <statement2> ; END
|
||
|
||
#define _DEFAULT_CH_
|
||
#endif
|