fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2012-09-30 12:15 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* include/harbour.hbx
  * src/rtl/Makefile
  + src/rtl/savebuff.prg
    + added few helper functions to work on savescreen buffers
      __XSaveGetChar( <cSaveScreen>, <nPos> ) -> <cChar>
      __XSaveGetColor( <cSaveScreen>, <nPos> ) -> <nColor>
      __XSaveGetAttr( <cSaveScreen>, <nPos> ) -> <nAttr>

  * contrib/hbnf/datecnfg.prg
    % minor optimization
    ! fixed to not use != on string

  * contrib/hbnf/dispmsg.prg
    % deleted unnecessary header

  * contrib/hbnf/ftround.prg
    * formatting

  * contrib/hbnf/popadder.prg
    ! fixed parts that directly manipulated savescreen buffers
    ! use HB_SHADOW() instead of locally rolled solutions that
      manipulates savescreen buffers

  * contrib/hbnf/tests/aredit.prg
  * contrib/hbnf/tests/calendar.prg
  * contrib/hbnf/tests/clrsel.prg
  * contrib/hbnf/tests/d2e.prg
  * contrib/hbnf/tests/dispmsg.prg
  * contrib/hbnf/tests/menu1.prg
  * contrib/hbnf/tests/popadder.prg
    ! fixed missing headers
This commit is contained in:
Viktor Szakats
2012-09-30 10:17:43 +00:00
parent cc825da61a
commit f16b5cf107
15 changed files with 149 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
harbour/ChangeLog
View File

@@ -16,6 +16,39 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-09-30 12:15 UTC+0200 Viktor Szakats (harbour syenar.net)
* include/harbour.hbx
* src/rtl/Makefile
+ src/rtl/savebuff.prg
+ added few helper functions to work on savescreen buffers
__XSaveGetChar( <cSaveScreen>, <nPos> ) -> <cChar>
__XSaveGetColor( <cSaveScreen>, <nPos> ) -> <nColor>
__XSaveGetAttr( <cSaveScreen>, <nPos> ) -> <nAttr>
* contrib/hbnf/datecnfg.prg
% minor optimization
! fixed to not use != on string
* contrib/hbnf/dispmsg.prg
% deleted unnecessary header
* contrib/hbnf/ftround.prg
* formatting
* contrib/hbnf/popadder.prg
! fixed parts that directly manipulated savescreen buffers
! use HB_SHADOW() instead of locally rolled solutions that
manipulates savescreen buffers
* contrib/hbnf/tests/aredit.prg
* contrib/hbnf/tests/calendar.prg
* contrib/hbnf/tests/clrsel.prg
* contrib/hbnf/tests/d2e.prg
* contrib/hbnf/tests/dispmsg.prg
* contrib/hbnf/tests/menu1.prg
* contrib/hbnf/tests/popadder.prg
! fixed missing headers
2012-09-30 00:41 UTC+0200 Viktor Szakats (harbour syenar.net)
* include/button.ch
* changed file mime-type to UTF8

11
harbour/contrib/hbnf/datecnfg.prg
View File

@@ -26,22 +26,23 @@
*
*/
FUNCTION FT_DATECNFG( cFYStart , nDow )
FUNCTION FT_DATECNFG( cFYStart, nDow )
THREAD STATIC t_aDatePar := { "1980.01.01", 1 }
LOCAL dCheck, cDateFormat := Set( _SET_DATEFORMAT )
LOCAL dCheck
LOCAL cDateFormat
IF HB_ISSTRING( cFYStart )
dCheck := CToD( cFYStart )
IF DToC( dCheck ) != " " // TOFIX
IF ! Empty( dCheck )
/* No one starts a Fiscal Year on 2/29 */
IF Month( dCheck ) == 2 .AND. Day( dcheck ) == 29
dCheck --
dCheck--
ENDIF
Set( _SET_DATEFORMAT, "yyyy.mm.dd" )
cDateFormat := Set( _SET_DATEFORMAT, "yyyy.mm.dd" )
t_aDatePar[ 1 ] := DToC( dCheck )
Set( _SET_DATEFORMAT, cDateFormat )
ENDIF

1
harbour/contrib/hbnf/dispmsg.prg
View File

@@ -26,7 +26,6 @@
*
*/
#include "inkey.ch"
#include "setcurs.ch"
// beginning of demo program

13
harbour/contrib/hbnf/ftround.prg
View File

@@ -54,7 +54,7 @@ FUNCTION FT_ROUND( nNumber, nRoundToAmount, cRoundType, cRoundDirection, ;
// Yes, Convert to Nearest Fraction
nRoundToAmount := 10 ** nRoundToAmount
ENDIF // LEFT( cRoundType, 1 ) == NEAREST_DECIMAL
ENDIF
// Are We Already Within the Acceptable
// Error Factor??
@@ -74,12 +74,10 @@ FUNCTION FT_ROUND( nNumber, nRoundToAmount, cRoundType, cRoundDirection, ;
nResult := Int( ( nRoundToAmount * nResult ) + .5 + nAcceptableError ) / ;
nRoundToAmount
ENDIF // ABS( INT( nResult * nRoundToAmount ) -
// ( mResult * nRoundAmount ) ) >
// nAcceptableError
ENDIF
ELSE // Yes, Round to Nearest Whole Number
// or to Zero Places
// or to Zero Places
nRoundToAmount := Max( nRoundToAmount, 1 )
@@ -101,11 +99,10 @@ FUNCTION FT_ROUND( nNumber, nRoundToAmount, cRoundType, cRoundDirection, ;
ENDCASE
ENDIF // LEFT(cRoundType,1)!=NEAREST_WHOLE or
// nRoundToAmount == 0
ENDIF
IF nNumber < 0 // Was the Number Negative??
nResult := -nResult // Yes, Make the Result Negative Also
ENDIF
RETURN nResult // FT_Round
RETURN nResult

73
harbour/contrib/hbnf/popadder.prg
View File

@@ -142,6 +142,7 @@ FUNCTION FT_Adder()
LOCAL nOldLastKey := LastKey()
LOCAL lShowRight := .T.
LOCAL aAdder := Array( 23 )
LOCAL tmp, tmp1
// Must prevent recursive calls
IF t_lAdderOpen
@@ -217,12 +218,8 @@ FUNCTION FT_Adder()
IF lTape
RestScreen( 4 + nTopOS, 6 + nTapeSpace, 22 + nTopOS, 35 + nTapeSpace, cTapeScr )
ENDIF
// TOFIX: manipulating savescreen buffers
IF Left( SaveScreen( 6 + nTopOS, 26 + nAddSpace, 6 + nTopOS, 27 + nAddSpace ), 1 ) ;
!= " "
// TOFIX: manipulating savescreen buffers
IF Left( SaveScreen( 6 + nTopOS, 19 + nAddSpace, 6 + nTopOS, 20 + nAddSpace ), 1 ) ;
== "S"
IF !( __XSaveGetChar( SaveScreen( 6 + nTopOS, 26 + nAddSpace, 6 + nTopOS, 27 + nAddSpace ), 0 ) == " " )
IF __XSaveGetChar( SaveScreen( 6 + nTopOS, 19 + nAddSpace, 6 + nTopOS, 20 + nAddSpace ), 0 ) == "S"
cMoveTotSubTot := "S"
ELSE
cMoveTotSubTot := "T"
@@ -230,9 +227,11 @@ FUNCTION FT_Adder()
ELSE
cMoveTotSubTot := " "
ENDIF
// TOFIX: manipulating savescreen buffers
cTotal := _ftCharOdd( SaveScreen( 4 + nTopOS, 8 + nAddSpace, 4 + ;
nTopOS, 25 + nAddSpace ) )
tmp := SaveScreen( 4 + nTopOS, 8 + nAddSpace, 4 + nTopOS, 25 + nAddSpace )
cTotal := ""
FOR tmp1 := 0 TO 16
cTotal += __XSaveGetChar( tmp, tmp1 )
NEXT
_ftPopWin() // Remove Adder
lShowRight := ! lShowRight
nAddSpace := iif( lShowRight, 40, 0 ) + nLeftOS
@@ -959,8 +958,7 @@ STATIC FUNCTION _ftDisplayTape( aAdder, nKey )
lTape := .T.
SetColor( "N/W" )
cTapeScr := SaveScreen( 4 + nTopOS, 6 + nTapeSpace, 22 + nTopOS, 35 + nTapeSpace )
_ftShadow( 22 + nTopOS, 8 + nTapeSpace, 22 + nTopOS, 35 + nTapeSpace )
_ftShadow( 5 + nTopOS, 33 + nTapeSpace, 21 + nTopOS, 35 + nTapeSpace )
hb_Shadow( 4 + nTopOS, 6 + nTapeSpace, 21 + nTopOS, 33 + nTapeSpace )
SetColor( "R+/W" )
@ 4 + nTopOS, 6 + nTapeSpace, 21 + nTopOS, 33 + nTapeSpace BOX B_SINGLE
SetColor( "GR+/W" )
@@ -1319,8 +1317,7 @@ STATIC FUNCTION _ftError( cMessage, xDontReset )
nRight := nLeft + nWide + 4
cErrorScr := SaveScreen( nTop, nLeft, nBot + 1, nRight + 2 )
_ftShadow( nBot + 1, nLeft + 2, nBot + 1, nRight + 2, 8 )
_ftShadow( nTop + 1, nRight + 1, nBot, nRight + 2, 8 )
hb_Shadow( nTop, nLeft, nBot, nRight )
@ nTop, nLeft, nBot, nRight BOX B_SINGLE
@ nTop, nLeft + Int( nWide / 2 ) - 1 SAY " ERROR "
@ nBot - 1, nLeft + Int( nWide - 28 ) / 2 + 3 SAY "Press any key to continue..."
@@ -1465,8 +1462,7 @@ STATIC FUNCTION _ftPushWin( t, l, b, r, cTitle, cBotTitle, nWinColor )
nWinColor := iif( nWinColor == NIL, _ftNextWinColor(), nWinColor )
AAdd( t_aWindow, { t, l, b, r, nWinColor, SaveScreen( t, l, b + 1, r + 2 ), lAutoWindow } )
_ftShadow( b + 1, l + 2, b + 1, r + 2 )
_ftShadow( t + 1, r + 1, b, r + 2 )
hb_Shadow( t, l, b, r )
_ftSetWinColor( nWinColor, W_BORDER )
@ t, l, b, r BOX B_SINGLE
@@ -1561,33 +1557,6 @@ STATIC FUNCTION _ftSetWinColor( nWin, nStd, nEnh, nBord, nBack, nUnsel )
t_aWinColor[ nBack, nWin ] + "," + ;
t_aWinColor[ nUnsel, nWin ] )
/*+- Function ---------------------------------------------------------------+
| Name: _ftShadow() Docs: Keith A. Wire |
| Description: Create a shadow on the screen in the coordinates given |
| Author: Keith A. Wire |
| Date created: 10-03-93 Date updated: 10-03-93 |
| Time created: 01:40:56pm Time updated: 01:40:56pm |
| Copyright: None - Public Domain |
+--------------------------------------------------------------------------+
| Arguments: nTop |
| : nLeft |
| : nBottom |
| : nRight |
| Return Value: NIL |
| See Also: _ftPushWin() |
+--------------------------------------------------------------------------+
*/
STATIC FUNCTION _ftShadow( nTop, nLeft, nBottom, nRight )
// TOFIX: manipulating savescreen buffers
LOCAL theShadow := SaveScreen( nTop, nLeft, nBottom, nRight )
RestScreen( nTop, nLeft, nBottom, nRight, ;
Transform( theShadow, Replicate( "X", Len( theShadow ) / 2 ) ) )
RETURN NIL
/*+- Function ---------------------------------------------------------------+
| Name: _ftLastWinColor Docs: Keith A. Wire |
| Description: Decrement the active window color number and return the |
@@ -1690,26 +1659,6 @@ STATIC FUNCTION _ftInitColors
RETURN NIL
/*+- Function ---------------------------------------------------------------+
| Name: _ftCharOdd() Docs: Keith A. Wire |
| Description: Remove all the even numbered characters in a string. |
| Author: Keith A. Wire |
| Date created: 10-03-93 Date updated: 10-03-93 |
| Time created: 01:41:50pm Time updated: 01:41:50pm |
| Copyright: None - Public Domain |
+--------------------------------------------------------------------------+
| Arguments: cString |
| Notes: Used for example to strip all the attribute characters |
| : from a screen save. |
+--------------------------------------------------------------------------+
*/
STATIC FUNCTION _ftCharOdd( cString )
cString := Transform( cString, Replicate( "X", Len( cString ) / 2 ) )
RETURN StrTran( cString, "" )
/*+- Function ---------------------------------------------------------------+
| Name: _ftPosRepl() Docs: Keith A. Wire |
| Description: Replace the Character at nPosit in cString with cChar |

5
harbour/contrib/hbnf/tests/aredit.prg
View File

@@ -1,7 +1,9 @@
/*
* $Id$
* $Id$
*/
#include "inkey.ch"
PROCEDURE Main()
// Thanks to Jim Gale for helping me understand the basics
@@ -64,4 +66,3 @@ FUNCTION TestGet( b, ar, nDim, nElem )
@ nRow, nCol SAY ""
RETURN .T.

7
harbour/contrib/hbnf/tests/calendar.prg
View File

@@ -1,7 +1,9 @@
/*
* $Id$
* $Id$
*/
#include "inkey.ch"
PROCEDURE Main()
LOCAL aRet
@@ -12,7 +14,7 @@ PROCEDURE Main()
ft_numlock( .F. )
ENDIF
hb_keyPut( K_F1 )
aRet := ft_calendar( 10, 40, "w+/rb", .T. , .T. ) //display calendar, return all.
aRet := ft_calendar( 10, 40, "w+/rb", .T. , .T. ) // display calendar, return all.
@ 1, 0 SAY "Date :" + DToC( aRet[ 1 ] )
@ 2, 0 SAY "Month Number:" + Str( aRet[ 2 ], 2, 0 )
@ 3, 0 SAY "Day Number :" + Str( aRet[ 3 ], 2, 0 )
@@ -23,4 +25,3 @@ PROCEDURE Main()
@ 8, 0 SAY "Current Time:" + aRet[ 8 ]
RETURN

6
harbour/contrib/hbnf/tests/clrsel.prg
View File

@@ -1,7 +1,10 @@
/*
* $Id$
* $Id$
*/
#include "common.ch"
#include "setcurs.ch"
PROCEDURE Main( cVidMode )
LOCAL nRowDos := Row()
@@ -50,4 +53,3 @@ PROCEDURE Main( cVidMode )
SetBlink( .F. ) // doesn't appear to be reset from FT_RestSets
RETURN

5
harbour/contrib/hbnf/tests/d2e.prg
View File

@@ -1,11 +1,12 @@
/*
* $Id$
* $Id$
*/
#include "common.ch"
PROCEDURE Main( cNum, cPrec )
DEFAULT cPrec TO Str( DEFAULT_PRECISION )
QOut( ft_d2e( Val( cNum ), Val( cPrec ) ) )
RETURN

6
harbour/contrib/hbnf/tests/dispmsg.prg
View File

@@ -1,7 +1,10 @@
/*
* $Id$
* $Id$
*/
#include "inkey.ch"
#include "setcurs.ch"
PROCEDURE Main()
LOCAL cDosScrn
@@ -61,4 +64,3 @@ PROCEDURE Main()
RestScreen( , , , , cDosScrn )
SetPos( nDosRow, nDosCol )
QUIT

2
harbour/contrib/hbnf/tests/menu1.prg
View File

@@ -2,7 +2,7 @@
* $Id$
*/
// DUMMY PROCEDURE NAME SO "CCMDLINE" WILL BE LOCAL
#include "setcurs.ch"
PROCEDURE Main( cCmdLine )

6
harbour/contrib/hbnf/tests/popadder.prg
View File

@@ -1,7 +1,9 @@
/*
* $Id$
* $Id$
*/
#include "inkey.ch"
PROCEDURE Main()
LOCAL nSickHrs := 0
@@ -10,7 +12,6 @@ PROCEDURE Main()
LOCAL GetList := {}
SET SCOREBOARD OFF
_ftSetScrColor( STD_SCREEN, STD_VARIABLE )
CLS
SET KEY K_ALT_A TO FT_Adder // Make <ALT-A> call FT_Adder
@@ -41,4 +42,3 @@ PROCEDURE Main()
SET KEY K_ALT_A // Reset <ALT-A>
RETURN

3
harbour/include/harbour.hbx
View File

@@ -1488,6 +1488,9 @@ DYNAMIC __wapi_GetOEMCP
DYNAMIC __XHelp
DYNAMIC __XRestScreen
DYNAMIC __XSaveScreen
DYNAMIC __XSaveGetChar
DYNAMIC __XSaveGetColor
DYNAMIC __XSaveGetAttr
#if defined( __HBEXTREQ__ ) .OR. defined( __HBEXTERN__HARBOUR__REQUEST )
#uncommand DYNAMIC <fncs,...> => EXTERNAL <fncs>

1
harbour/src/rtl/Makefile
View File

@@ -257,6 +257,7 @@ PRG_SOURCES := \
radiogrp.prg \
readkey.prg \
readvar.prg \
savebuff.prg \
scrollbr.prg \
setfunc.prg \
setta.prg \

68
harbour/src/rtl/savebuff.prg Normal file
View File

@@ -0,0 +1,68 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* SaveScreen() buffer help functions
*
* Copyright 2012 Viktor Szakats (harbour syenar.net)
* www - http://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, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbgtinfo.ch"
FUNCTION __XSaveGetChar( cSaveScreen, nPos )
RETURN iif( hb_gtInfo( HB_GTI_COMPATBUFFER ),;
Chr( hb_BPeek( cSaveScreen, nPos * 2 + 1 ) ),;
hb_UChar( hb_BPeek( cSaveScreen, nPos * 4 + 2 ) * 256 + hb_BPeek( cSaveScreen, nPos * 4 + 1 ) ) )
FUNCTION __XSaveGetColor( cSaveScreen, nPos )
RETURN iif( hb_gtInfo( HB_GTI_COMPATBUFFER ),;
hb_BPeek( cSaveScreen, nPos * 2 + 2 ),;
hb_BPeek( cSaveScreen, nPos * 4 + 3 ) )
FUNCTION __XSaveGetAttr( cSaveScreen, nPos )
RETURN iif( hb_gtInfo( HB_GTI_COMPATBUFFER ),;
0,;
hb_BPeek( cSaveScreen, nPos * 4 + 4 ) )