fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
6227518ceaaa4d10a4fc4e5d952664bb11e5cf2b
harbour-core/harbour/source/rtl/alert.prg
Viktor Szakats 8e15abc1bd 2009-10-07 11:22 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) 
* tests/transtst.prg
  * doc/pp.txt
  * doc/en-EN/string.txt
  * doc/en-EN/terminal.txt
  * doc/en-EN/dbstrux.txt
  * include/hbpp.h
  * include/std.ch
  * include/hbclass.ch
  * include/hbsetup.ch
  * include/hbdefs.h
  * include/dbedit.ch
  * include/hbapigt.h
  * include/hbextern.ch
  * include/hbexprb.c
  * ChangeLog
  * source/pp/ppcore.c
  * source/vm/macro.c
  * source/vm/hvm.c
  * source/vm/cmdarg.c
  * source/vm/arrays.c
  * source/vm/proc.c
  * source/vm/memvars.c
  * source/vm/arrayshb.c
  * source/vm/memvclip.c
  * source/common/hbverdsp.c
  * source/common/hbstr.c
  * source/common/hbdate.c
  * source/rtl/setposbs.c
  * source/rtl/round.c
  * source/rtl/oldbox.c
  * source/rtl/trim.c
  * source/rtl/tpopup.prg
  * source/rtl/einstvau.prg
  * source/rtl/setta.prg
  * source/rtl/transfrm.c
  * source/rtl/browse.prg
  * source/rtl/tget.prg
  * source/rtl/setfunc.prg
  * source/rtl/achoice.prg
  * source/rtl/strzero.c
  * source/rtl/natmsgu.c
  * source/rtl/strtran.c
  * source/rtl/errapiu.c
  * source/rtl/einstvar.prg
  * source/rtl/dbedit.prg
  * source/rtl/einstv52.prg
  * source/rtl/console.c
  * source/rtl/mousehb.c
  * source/rtl/chrasc.c
  * source/rtl/dircmd.prg
  * source/rtl/oldclear.c
  * source/rtl/hbgtcore.c
  * source/rtl/dirdrive.c
  * source/rtl/mlcfunc.c
  * source/rtl/datesx.c
  * source/rtl/accept.c
  * source/rtl/defpathu.c
  * source/rtl/tgetlist.prg
  * source/rtl/input.prg
  * source/rtl/alert.prg
  * source/rtl/tmenuitm.prg
  * source/rtl/shadowu.c
  * source/rtl/tbrowse.prg
  * source/rdd/dbfntx/dbfntx1.c
  * source/rdd/dbdelim.prg
  * source/rdd/rddordu.prg
  * source/rdd/workarea.c
  * source/rdd/dbnubs.c
  * source/rdd/rddinfo.c
  * source/rdd/dbstruxu.prg
  * source/rdd/sdf1.c
  * source/rdd/dbfnsx/dbfnsx1.c
  * source/rdd/dbcmd.c
  * source/rdd/dbfcdx/dbfcdx1.c
  * source/rdd/dbdrop.c
  * source/rdd/delim1.c
  * source/rdd/dbf1.c
  * source/rdd/dbrename.c
  * source/rdd/dbexists.c
  * source/rdd/fieldhb.c
  * contrib/hbct/ctwin.c
  * contrib/hbct/cursor.c
  * contrib/xhb/xhbver.prg
  * contrib/xhb/xhbtrim.c
  * utils/hbtest/rt_main.ch
  * utils/hbtest/rt_trans.prg
  * utils/hbtest/rt_misc.prg
  * utils/hbtest/rt_stra.prg
  * utils/hbtest/rt_array.prg
  * examples/hbdoc/examples/core_es/dbstrux.txt
  *  examples/hbdoc2/hbdoc2.prg
    * HB_C52_STRICT -> HB_CLP_STRICT
      We use it cover strict Clipper compatibility in general, not 
      just for C5.2.
    * HB_C52_UNDOC -> HB_CLP_UNDOC
      We use it cover Clipper undocumented stuff in general, not 
      just C5.2 version specific ones.
2009-10-07 09:35:33 +00:00

176 lines
4.3 KiB
Plaintext
Raw Blame History

/*
* $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 (harbour.01 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. [vszakats] */
/* NOTE: Clipper handles these buttons { "Ok", "", "Cancel" } in a buggy way.
This is fixed. [vszakats] */
#ifdef HB_CLP_UNDOC
STATIC s_lNoAlert
#endif
FUNCTION Alert( cMessage, aOptions, cColorNorm )
LOCAL cColorHigh
LOCAL aOptionsOK
LOCAL nEval
#ifdef HB_CLP_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_CLP_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_CLP_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_CLP_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_CLP_UNDOC
PROCEDURE __NONOALERT()
s_lNoAlert := .F.
RETURN
#endif
Reference in New Issue View Git Blame Copy Permalink