Files
harbour-core/harbour/source/rtl/alert.prg
Viktor Szakats 52e2e002e5 2009-05-12 09:25 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* doc/cmdline.txt
  * doc/howtosvn.txt
    + Added CC copyright.

  * source/rtl/alert.prg
  * include/hbextern.ch
    + HB_ALERT(). Now this function holds all extended features:
      nDelay support and any type for first parameter.
    * ALERT() now behaves completely along Clipper version, without
      extensions. HB_EXTENSION no longer modifies its behaviour, so
      if someone needs these extended features, there is no need to
      build with HB_EXTENSION, only ALERT() calls have to be
      converted to HB_ALERT(). INCOMPATIBLE (in some scenarios).

  * contrib/hbtip/utils.c
    % TIP_TIMESTAMP() code cleaned to remove redundancy of
      having two full distinct copies of this function. Now
      platform independent parts are kept common.
    ! TIP_TIMESTAMP() fixed hb_parl() to hb_parnl() for 'hours'
      parameter. I wonder how this bug wasn't noticed till now.
      Please someone test, maybe I'm missing the point of this
      parameter, but it's unlikely the intent was a logical value
      as it's later converted to timestamp.

  * contrib/hbtip/thtml.prg
  * contrib/hbtip/sendmail.prg
  * contrib/hbtip/httpcln.prg
  * contrib/hbtip/ftpcln.prg
    * END -> END*
    * Minor formatting.

  * contrib/hbtip/base64x.c
  * contrib/hbtip/smtpcln.prg
    * Formatted.
    * Minor optimizations (File() -> hb_FileExists(), ::AuthPlain()
      simplification).
    % BUILDUSERPASSSTRING() rewritten in Harbour. It's a very
      simple function.
2009-05-12 07:32:45 +00:00

178 lines
4.5 KiB
Plaintext

/*
* $Id$
*/
/*
* Harbour Project source code:
* ALERT(), HB_ALERT() functions
*
* Released to Public Domain by Vladimir Kazimirchik <v_kazimirchik@yahoo.com>
* www - http://www.harbour-project.org
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999-2001 Viktor Szakats <viktor.szakats@syenar.hu>
* Changes for higher Clipper compatibility, console mode, extensions
* __NONOALERT()
*
* See COPYING for licensing terms.
*
*/
#include "box.ch"
#include "common.ch"
#include "inkey.ch"
#include "setcurs.ch"
#include "hbgtinfo.ch"
/* TOFIX: Clipper defines a clipped window for Alert() [vszakats] */
/* NOTE: Clipper will return NIL if the first parameter is not a string, but
this is not documented. This implementation converts the first
parameter to a string if another type was passed. You can switch back
to Clipper compatible mode by undefining constant HB_EXTENSION. [vszakats] */
/* NOTE: Clipper handles these buttons { "Ok", "", "Cancel" } in a buggy way.
This is fixed. [vszakats] */
#ifdef HB_C52_UNDOC
STATIC s_lNoAlert
#endif
FUNCTION Alert( cMessage, aOptions, cColorNorm )
LOCAL cColorHigh
LOCAL aOptionsOK
LOCAL nEval
#ifdef HB_C52_UNDOC
DEFAULT s_lNoAlert TO hb_argCheck( "NOALERT" )
IF s_lNoAlert
RETURN NIL
ENDIF
#endif
IF ! ISCHARACTER( cMessage )
RETURN NIL
ENDIF
cMessage := StrTran( cMessage, ";", Chr( 10 ) )
IF ! ISARRAY( aOptions )
aOptions := {}
ENDIF
IF ! ISCHARACTER( cColorNorm ) .OR. Empty( cColorNorm )
cColorNorm := "W+/R" // first pair color (Box line and Text)
cColorHigh := "W+/B" // second pair color (Options buttons)
ELSE
cColorHigh := StrTran( StrTran( iif( At( "/", cColorNorm ) == 0, "N", SubStr( cColorNorm, At( "/", cColorNorm ) + 1 ) ) + "/" +;
iif( At( "/", cColorNorm ) == 0, cColorNorm, Left( cColorNorm, At( "/", cColorNorm ) - 1 ) ), "+", "" ), "*", "" )
ENDIF
aOptionsOK := {}
FOR nEval := 1 TO Len( aOptions )
IF ISCHARACTER( aOptions[ nEval ] ) .AND. ! Empty( aOptions[ nEval ] )
AAdd( aOptionsOK, aOptions[ nEval ] )
ENDIF
NEXT
IF Len( aOptionsOK ) == 0
aOptionsOK := { "Ok" }
#ifdef HB_C52_STRICT
/* NOTE: Clipper allows only four options [vszakats] */
ELSEIF Len( aOptionsOK ) > 4
ASize( aOptionsOK, 4 )
#endif
ENDIF
RETURN hb_gtAlert( cMessage, aOptionsOK, cColorNorm, cColorHigh )
/* NOTE: xMessage can be of any type. This is a Harbour extension over Alert(). */
/* NOTE: nDelay parameter is a Harbour extension over Alert(). */
FUNCTION hb_Alert( xMessage, aOptions, cColorNorm, nDelay )
LOCAL cMessage
LOCAL cColorHigh
LOCAL aOptionsOK
LOCAL nEval
LOCAL lFirst
LOCAL cLine
#ifdef HB_C52_UNDOC
DEFAULT s_lNoAlert TO hb_argCheck( "NOALERT" )
IF s_lNoAlert
RETURN NIL
ENDIF
#endif
IF PCount() == 0
RETURN NIL
ENDIF
IF ISARRAY( xMessage )
cMessage := ""
lFirst := .T.
FOR nEval := 1 TO Len( xMessage )
IF ISCHARACTER( cLine := xMessage[ nEval ] )
cMessage += iif( lFirst, "", Chr( 10 ) ) + cLine
lFirst := .F.
ENDIF
NEXT
ELSEIF ISCHARACTER( xMessage )
cMessage := StrTran( xMessage, ";", Chr( 10 ) )
ELSE
cMessage := hb_CStr( xMessage )
ENDIF
IF ! ISARRAY( aOptions )
aOptions := {}
ENDIF
IF !ISCHARACTER( cColorNorm ) .OR. Empty( cColorNorm )
cColorNorm := "W+/R" // first pair color (Box line and Text)
cColorHigh := "W+/B" // second pair color (Options buttons)
ELSE
cColorHigh := StrTran( StrTran( iif( At( "/", cColorNorm ) == 0, "N", SubStr( cColorNorm, At( "/", cColorNorm ) + 1 ) ) + "/" +;
iif( At( "/", cColorNorm ) == 0, cColorNorm, Left( cColorNorm, At( "/", cColorNorm ) - 1 ) ), "+", "" ), "*", "" )
ENDIF
aOptionsOK := {}
FOR nEval := 1 TO Len( aOptions )
IF ISCHARACTER( aOptions[ nEval ] ) .AND. ! Empty( aOptions[ nEval ] )
AAdd( aOptionsOK, aOptions[ nEval ] )
ENDIF
NEXT
IF Len( aOptionsOK ) == 0
aOptionsOK := { "Ok" }
#ifdef HB_C52_STRICT
/* NOTE: Clipper allows only four options [vszakats] */
ELSEIF Len( aOptionsOK ) > 4
ASize( aOptionsOK, 4 )
#endif
ENDIF
RETURN hb_gtAlert( cMessage, aOptionsOK, cColorNorm, cColorHigh, nDelay )
#ifdef HB_C52_UNDOC
PROCEDURE __NONOALERT()
s_lNoAlert := .F.
RETURN
#endif