From f16b5cf107f7dcdeea7164c0013338be5e4a7c0f Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Sun, 30 Sep 2012 10:17:43 +0000 Subject: [PATCH] 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( , ) -> __XSaveGetColor( , ) -> __XSaveGetAttr( , ) -> * 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 --- harbour/ChangeLog | 33 +++++++++++ harbour/contrib/hbnf/datecnfg.prg | 11 ++-- harbour/contrib/hbnf/dispmsg.prg | 1 - harbour/contrib/hbnf/ftround.prg | 13 ++--- harbour/contrib/hbnf/popadder.prg | 73 ++++--------------------- harbour/contrib/hbnf/tests/aredit.prg | 5 +- harbour/contrib/hbnf/tests/calendar.prg | 7 ++- harbour/contrib/hbnf/tests/clrsel.prg | 6 +- harbour/contrib/hbnf/tests/d2e.prg | 5 +- harbour/contrib/hbnf/tests/dispmsg.prg | 6 +- harbour/contrib/hbnf/tests/menu1.prg | 2 +- harbour/contrib/hbnf/tests/popadder.prg | 6 +- harbour/include/harbour.hbx | 3 + harbour/src/rtl/Makefile | 1 + harbour/src/rtl/savebuff.prg | 68 +++++++++++++++++++++++ 15 files changed, 149 insertions(+), 91 deletions(-) create mode 100644 harbour/src/rtl/savebuff.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index c44ed37658..f353d2ef91 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -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( , ) -> + __XSaveGetColor( , ) -> + __XSaveGetAttr( , ) -> + + * 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 diff --git a/harbour/contrib/hbnf/datecnfg.prg b/harbour/contrib/hbnf/datecnfg.prg index 60502faa77..e31a24fa52 100644 --- a/harbour/contrib/hbnf/datecnfg.prg +++ b/harbour/contrib/hbnf/datecnfg.prg @@ -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 diff --git a/harbour/contrib/hbnf/dispmsg.prg b/harbour/contrib/hbnf/dispmsg.prg index 05aaa51663..c365d8d67d 100644 --- a/harbour/contrib/hbnf/dispmsg.prg +++ b/harbour/contrib/hbnf/dispmsg.prg @@ -26,7 +26,6 @@ * */ -#include "inkey.ch" #include "setcurs.ch" // beginning of demo program diff --git a/harbour/contrib/hbnf/ftround.prg b/harbour/contrib/hbnf/ftround.prg index 96711633f0..ad1420de3a 100644 --- a/harbour/contrib/hbnf/ftround.prg +++ b/harbour/contrib/hbnf/ftround.prg @@ -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 diff --git a/harbour/contrib/hbnf/popadder.prg b/harbour/contrib/hbnf/popadder.prg index bf8b8833f4..f74441a061 100644 --- a/harbour/contrib/hbnf/popadder.prg +++ b/harbour/contrib/hbnf/popadder.prg @@ -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 | diff --git a/harbour/contrib/hbnf/tests/aredit.prg b/harbour/contrib/hbnf/tests/aredit.prg index 53d17fc0ea..f5ef396f93 100644 --- a/harbour/contrib/hbnf/tests/aredit.prg +++ b/harbour/contrib/hbnf/tests/aredit.prg @@ -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. - diff --git a/harbour/contrib/hbnf/tests/calendar.prg b/harbour/contrib/hbnf/tests/calendar.prg index 9dfe38f536..af737a260c 100644 --- a/harbour/contrib/hbnf/tests/calendar.prg +++ b/harbour/contrib/hbnf/tests/calendar.prg @@ -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 - diff --git a/harbour/contrib/hbnf/tests/clrsel.prg b/harbour/contrib/hbnf/tests/clrsel.prg index e2f326e85e..75c7b0580b 100644 --- a/harbour/contrib/hbnf/tests/clrsel.prg +++ b/harbour/contrib/hbnf/tests/clrsel.prg @@ -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 - diff --git a/harbour/contrib/hbnf/tests/d2e.prg b/harbour/contrib/hbnf/tests/d2e.prg index 0da06d48e4..da6a6cad15 100644 --- a/harbour/contrib/hbnf/tests/d2e.prg +++ b/harbour/contrib/hbnf/tests/d2e.prg @@ -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 - diff --git a/harbour/contrib/hbnf/tests/dispmsg.prg b/harbour/contrib/hbnf/tests/dispmsg.prg index c695b97e17..186f3249e9 100644 --- a/harbour/contrib/hbnf/tests/dispmsg.prg +++ b/harbour/contrib/hbnf/tests/dispmsg.prg @@ -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 - diff --git a/harbour/contrib/hbnf/tests/menu1.prg b/harbour/contrib/hbnf/tests/menu1.prg index ff61d128e6..6aaad18ba0 100644 --- a/harbour/contrib/hbnf/tests/menu1.prg +++ b/harbour/contrib/hbnf/tests/menu1.prg @@ -2,7 +2,7 @@ * $Id$ */ -// DUMMY PROCEDURE NAME SO "CCMDLINE" WILL BE LOCAL +#include "setcurs.ch" PROCEDURE Main( cCmdLine ) diff --git a/harbour/contrib/hbnf/tests/popadder.prg b/harbour/contrib/hbnf/tests/popadder.prg index 7e876f5925..254384853e 100644 --- a/harbour/contrib/hbnf/tests/popadder.prg +++ b/harbour/contrib/hbnf/tests/popadder.prg @@ -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 call FT_Adder @@ -41,4 +42,3 @@ PROCEDURE Main() SET KEY K_ALT_A // Reset RETURN - diff --git a/harbour/include/harbour.hbx b/harbour/include/harbour.hbx index e1006d726d..cb405943f3 100644 --- a/harbour/include/harbour.hbx +++ b/harbour/include/harbour.hbx @@ -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 => EXTERNAL diff --git a/harbour/src/rtl/Makefile b/harbour/src/rtl/Makefile index fb7ac79004..a45edef6d7 100644 --- a/harbour/src/rtl/Makefile +++ b/harbour/src/rtl/Makefile @@ -257,6 +257,7 @@ PRG_SOURCES := \ radiogrp.prg \ readkey.prg \ readvar.prg \ + savebuff.prg \ scrollbr.prg \ setfunc.prg \ setta.prg \ diff --git a/harbour/src/rtl/savebuff.prg b/harbour/src/rtl/savebuff.prg new file mode 100644 index 0000000000..bbe20802c8 --- /dev/null +++ b/harbour/src/rtl/savebuff.prg @@ -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 ) )