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

2012-10-08 18:28 UTC+0300 Pavel Tsarenko (tpe2 at mail.ru)

Browse Source 
* contrib/hbmisc/hbmisc.hbp
  + contrib/hbmisc/numtxtru.prg
    + added functions to convert a number and date to East Slavic (Russian,
      Ukrainian and Belorussian) text:
      NumToTxtRU() - convert a number
      MnyToTxtRU() - convert a money
      DateToTxtRU() - convert a date
  + tests/testmny.prg
    + added sample class Money with overloading of arithmetical operations
This commit is contained in:
Pavel Tsarenko
2012-10-08 15:31:49 +00:00
parent a350ea4610
commit 7891ee184b
4 changed files with 890 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
harbour/ChangeLog
View File

@@ -16,6 +16,17 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-10-08 18:28 UTC+0300 Pavel Tsarenko (tpe2 at mail.ru)
* contrib/hbmisc/hbmisc.hbp
+ contrib/hbmisc/numtxtru.prg
+ added functions to convert a number and date to East Slavic (Russian,
Ukrainian and Belorussian) text:
NumToTxtRU() - convert a number
MnyToTxtRU() - convert a money
DateToTxtRU() - convert a date
+ tests/testmny.prg
+ added sample class Money with overloading of arithmetical operations
2012-10-08 15:49 UTC+0200 Viktor Szakats (harbour syenar.net)
+ .gitattributes
+ added config file to setup EOL handling in a git repo

1
harbour/contrib/hbmisc/hbmisc.hbp
View File

@@ -30,6 +30,7 @@ hbedit.prg
nconvert.prg
numtxthu.prg
numtxten.prg
numtxtru.prg
stringp.prg
twirler.prg
udpds.prg

715
harbour/contrib/hbmisc/numtxtru.prg Normal file
View File

@@ -0,0 +1,715 @@
/*
* $Id: numtxtru.prg 17873 2012-10-08 17:39:24Z ptsarenko $
*/
/*
* Harbour Project source code:
* Functions to convert a number and date to East Slavic (Russian,
* Ukrainian and Belorussian) text
*
* NumToTxtRU() - convert a number
* MnyToTxtRU() - convert a money
* DateToTxtRU() - convert a date
*
* Copyright 2012 Pavel Tsarenko (tpe2 at mail.ru)
* 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.
*
*/
#define NTSR_RUS 1
#define NTSR_UKR 2
#define NTSR_BEL 3
#define NTSR_MALE 1
#define NTSR_FEMA 2
#define NTSR_MIDD 3
#define NTSR_1000_1 4
#define NTSR_1000_2 5
#define NTSR_1000_3 6
#define NTSR_CNT 7
#define NTSR_ROD 8
#define NTSR_ORDG 9
#define NTSR_CURR 10
#define NTSR_CENT 11
#define NTSR_MINUS 12
#define NTSR_MONTH 13
#define NTSR_YEAR 14
/* Russian messages */
STATIC aRus := {;
{ "­®«ì",;
"®¤¨­",;
"¤¢ ",;
"âà¨",;
"ç¥âëà¥",;
"¯ïâì",;
"è¥áâì",;
"ᥬì",;
"¢®á¥¬ì",;
"¤¥¢ïâì",;
"¤¥áïâì",;
"®¤¨­­ ¤æ âì",;
"¤¢¥­ ¤æ âì",;
"âਭ ¤æ âì", ;
"ç¥âëà­ ¤æ âì",;
"¯ïâ­ ¤æ âì",;
"è¥áâ­ ¤æ âì",;
"ᥬ­ ¤æ âì",;
"¢®á¥¬­ ¤æ âì",;
"¤¥¢ïâ­ ¤æ âì",;
"¤¢ ¤æ âì",;
"âਤæ âì",;
"á®à®ª",;
"¯ïâ줥áïâ",;
"è¥áâ줥áïâ",;
"ᥬ줥áïâ",;
"¢®á¥¬ì¤¥áïâ",;
"¤¥¢ï­®áâ®",;
"áâ®",;
"¤¢¥áâ¨",;
"âà¨áâ ",;
"ç¥âëà¥áâ ",;
"¯ïâìá®â",;
"è¥áâìá®â",;
"ᥬìá®â",;
"¢®á¥¬ìá®â",;
"¤¥¢ïâìá®â" },;
{ "­®«ì", "®¤­ ", "¤¢¥" },;
{ "­®«ì", "®¤­®" },;
{ "âëáïç ", "¬¨««¨®­", "¬¨««¨ à¤", "âਫ«¨®­", "ª¢ ¤à¨««¨®­" },;
{ "âëáïç¨", "¬¨««¨®­ ", "¬¨««¨ à¤ ", "âਫ«¨®­ ", "ª¢ ¤à¨««¨®­ " },;
{ "âëáïç", "¬¨««¨®­®¢", "¬¨««¨ à¤®¢", "âਫ«¨®­®¢", "ª¢ ¤à¨««¨®­®¢" },;
{ "­ã«¥¢®©",;
"¯¥à¢ë©",;
"¢â®à®©",;
"âà¥â¨©",;
"ç¥â¢¥àâë©",;
"¯ïâë©",;
"è¥á⮩",;
"ᥤ쬮©",;
"¢®á쬮©",;
"¤¥¢ïâë©",;
"¤¥áïâë©",;
"®¤¨­­ ¤æ âë©",;
"¤¢¥­ ¤æ âë©",;
"âਭ ¤æ âë©", ;
"ç¥âëà­ ¤æ âë©",;
"¯ïâ­ ¤æ âë©",;
"è¥áâ­ ¤æ âë©",;
"ᥬ­ ¤æ âë©",;
"¢®á¥¬­ ¤æ âë©",;
"¤¥¢ïâ­ ¤æ âë©",;
"¤¢ ¤æ âë©",;
"âਤæ âë©",;
"á®à®ª®¢®©",;
"¯ï⨤¥áïâë©",;
"è¥á⨤¥áïâë©",;
"ᥬ¨¤¥áïâë©",;
"¢®á쬨¤¥áïâë©",;
"¤¥¢ï­®áâë©",;
"á®âë©",;
"¤¢ãåá®âë©",;
"âà¥åá®âë©",;
"ç¥âëà¥åá®âë©",;
"¯ïâ¨á®âë©",;
"è¥áâ¨á®âë©",;
"ᥬ¨á®âë©",;
"¢®á쬨á®âë©",;
"¤¥¢ïâ¨á®âë©",;
"âëáïç­ë©", "¬¨««¨®­­ë©", "¬¨««¨ à¤­ë©", "âਫ«¨®­­ë©", "ª¢ ¤à¨««¨®­­ë©" },;
{ "",;
"",;
"¤¢ãå",;
"âà¥å",;
"ç¥âëà¥å",;
"¯ïâ¨",;
"è¥áâ¨",;
"ᥬ¨",;
"¢®á쬨",;
"¤¥¢ïâ¨",;
"¤¥áïâ¨",;
"®¤¨­­ ¤æ â¨",;
"¤¢¥­ ¤æ â¨",;
"âਭ ¤æ â¨", ;
"ç¥âëà­ ¤æ â¨",;
"¯ïâ­ ¤æ â¨",;
"è¥áâ­ ¤æ â¨",;
"ᥬ­ ¤æ â¨",;
"¢®á¥¬­ ¤æ â¨",;
"¤¥¢ïâ­ ¤æ â¨",;
"¤¢ ¤æ â¨",;
"âਤæ â¨",;
"á®à®ª ",;
"¯ï⨤¥áïâ¨",;
"è¥á⨤¥áïâ¨",;
"ᥬ¨¤¥áïâ¨",;
"¢®á쬨¤¥áïâ¨",;
"¤¥¢ï­®áâ®" },;
{ "¨©", "ìï", " ï", "ì¥", "®¥" },;
{ NTSR_MALE, "àã¡.", "àã¡«ì", "àã¡«ï", "àã¡«¥©" },;
{ NTSR_FEMA, "ª®¯.", "ª®¯¥©ª ", "ª®¯¥©ª¨", "ª®¯¥¥ª" },;
"¬¨­ãá",;
{ "ï­¢ àï", "䥢ࠫï", "¬ àâ ", " ¯à¥«ï", "¬ ï", "¨î­ï",;
"¨î«ï", " ¢£ãáâ ", "ᥭâï¡àï", "®ªâï¡àï", "­®ï¡àï", "¤¥ª ¡àï" },;
{ "£®¤", "£®¤ " } }
/* Ukrainian messages */
STATIC aUkr := {;
{ "­ã«ì",;
"®¤¨­",;
"¤¢ ",;
"âà¨",;
"ç®â¨à¨",;
"¯'ïâì",;
"èiáâì",;
"ái¬",;
"¢iái¬",;
"¤¥¢'ïâì",;
"¤¥áïâì",;
"®¤¨­ ¤æïâì",;
"¤¢ ­ ¤æïâì",;
"âਭ ¤æïâì",;
"ç®â¨à­ ¤æïâì",;
"¯'ïâ­ ¤æïâì",;
"èiáâ­ ¤æïâì",;
"ái¬­ ¤æïâì",;
"¢iái¬­ ¤æïâì",;
"¤¥¢'ïâ­ ¤æïâì",;
"¤¢ ¤æïâì",;
"âਤæïâì",;
"á®à®ª",;
"¯'ï⤥áïâ",;
"èiá⤥áïâ",;
"ái¬¤¥áïâ",;
"¢iái¬¤¥áïâ",;
"¤¥¢'ï­®áâ®",;
"áâ®",;
"¤¢iáâi",;
"âà¨áâ ",;
"ç®â¨à¨áâ ",;
"¯'ïâá®â",;
"èiáâá®â",;
"ái¬á®â",;
"¢iái¬á®â",;
"¤¥¢'ïâá®â" },;
{ "­ã«ì", "®¤­ ", "¤¢i" },;
{ "­ã«ì", "®¤­®" },;
{ "â¨áïç ", "¬i«ì®­", "¬i«ìïà¤", "âਫ쮭", "ª¢ ¤à¨«ì®­" },;
{ "â¨áïçi", "¬i«ì®­ ", "¬i«ìïठ", "âਫ쮭 ", "ª¢ ¤à¨«ì®­ " },;
{ "â¨áïç", "¬i«ì®­i¢", "¬i««ìïà¤i¢", "âਫ쮭i¢", "ª¢ ¤à¨«ì®­i¢" },;
{ "­ã«ì®¢¨©",;
"¯¥à訩",;
"¤à㣨©",;
"âà¥âi©",;
"ç¥â¢¥à⨩",;
"¯'ï⨩",;
"è®á⨩",;
"á쮬¨©",;
"¢®á쬨©",;
"¤¥¢'ï⨩",;
"¤¥áï⨩",;
"®¤¨­ ¤æï⨩",;
"¤¢ ­ ¤æï⨩",;
"âਭ ¤æï⨩", ;
"ç®â¨à­ ¤æï⨩",;
"¯'ïâ­ ¤æï⨩",;
"èiáâ­ ¤æï⨩",;
"ái¬­ ¤æï⨩",;
"¢iái¬­ ¤æï⨩",;
"¤¥¢'ïâ­ ¤æï⨩",;
"¤¢ ¤æï⨩",;
"âਤæï⨩",;
"á®à®ª®¢¨©",;
"¯'ï⨤¥áï⨩",;
"è¥á⨤¥áï⨩",;
"ᥬ¨¤¥áï⨩",;
"¢iá쬨¤¥áï⨩",;
"¤¥¢'ï­®á⨩",;
"á®â¨©",;
"¤¢ãåá®â¨©",;
"âàì®åá®â¨©",;
"ç®â¨à¥åá®â¨©",;
"¯'ïâ¨á®â¨©",;
"è¥áâ¨á®â¨©",;
"ᥬ¨á®â¨©",;
"¢iái¬á®â¨©",;
"¤¥¢'ïâ¨á®â¨©",;
"â¨áïç­¨©", "¬i«ì®­­¨©", "¬i«ìïभ¨©", "âਫ쮭­¨©", "ª¢ ¤à¨«ì®­­¨©" },;
{ "",;
"",;
"¤¢ãå",;
"âàì®å",;
"ç®â¨àì®å",;
"¯'ïâ¨",;
"è®áâ¨",;
"ᥬ¨",;
"¢iá쬨",;
"¤¥¢'ïâ¨",;
"¤¥áïâ¨",;
"®¤¨­ ¤æïâ¨",;
"¤¢ ­ ¤æïâ¨",;
"âਭ ¤æïâ¨", ;
"ç®â¨à­ ¤æïâ¨",;
"¯'ïâ­ ¤æïâ¨",;
"èiáâ­ ¤æïâ¨",;
"ái¬­ ¤æïâ¨",;
"¢iái¬­ ¤æïâ¨",;
"¤¥¢'ïâ­ ¤æïâ¨",;
"¤¢ ¤æïâ¨",;
"âਤæïâ¨",;
"á®à®ª ",;
"¯'ï⨤¥áïâ¨",;
"è¥á⨤¥áïâ¨",;
"ᥬ¨¤¥áïâ¨",;
"¢iá쬨¤¥áïâ¨",;
"¤¥¢'ï­®áâ®" },;
{ "i©", "ï", " ", "¥", "¥" },;
{ NTSR_FEMA, "£à­.", "£à¨¢­ï", "£à¨¢­i", "£à¨¢¥­ì" },;
{ NTSR_FEMA, "ª®¯.", "ª®¯i©ª ", "ª®¯i©ª¨", "ª®¯i©®ª" },;
"¬i­ãá",;
{ "áiç­ï", "«î⮣®", "¡¥à¥§­ï", "ª¢iâ­ï", "âà ¢­ï", "ç¥à¢­ï",;
"«¨¯­ï", "á¥à¯­ï", "¢¥à¥á­ï", "¦®¢â­ï", "«¨á⮯ ¤ ", "£à㤭ï" },;
{ "àiª", "பã" } }
/* Belorussian messages */
STATIC aBel := {;
{ "­ã«ì",;
" ¤§i­",;
"¤¢ ",;
"âàë",;
"ç âëàë",;
"¯ïæì",;
"èíáæì",;
"ᥬ",;
"¢®á¥¬",;
"¤§¥¢ïæì",;
"¤§¥áïæì",;
" ¤§i­ ææ æì",;
"¤¢ ­ ææ æì",;
"âàë­ ææ æì",;
"ç âëà­ ææ æì",;
"¯ïâ­ ææ æì",;
"è á­ ææ æì",;
"áשּׂ ææ æì",;
"¢ áשּׂ ææ æì",;
"¤§¥¢ïâ­ ææ æì",;
"¤¢ ææ æì",;
"âàëææ æì",;
"á®à ª",;
"¯ïæ줧¥áïâ",;
"èíáæ줧¥áïâ",;
"ᥬ¤§¥áïâ",;
"¢®á¥¬¤§¥áïâ",;
"¤§¥¢ï­®áâ ",;
"áâ®",;
"¤§¢¥áæ¥",;
"âàëáâ ",;
"ç âëàëáâ ",;
"¯ïæìá®â",;
"èíáìæìá®â",;
"áï¬á®â",;
"¢ áï¬á®â",;
"¤§¥¢ïæìá®â" },;
{ "­ã«ì", " ¤­ ", "¤¢¥" },;
{ "­ã«ì", " ¤­®" },;
{ "âëáïç ", "¬i«ìñ­", "¬i«ìïà¤", "âàë«ìñ­", "ª¢ ¤àë«ìñ­" },;
{ "âëáïçë", "¬i«ìñ­ ", "¬i«ìïठ", "âàë«ìñ­ ", "ª¢ ¤àë«ìñ­ " },;
{ "âëáïç", "¬i«ìñ­ ÷", "¬i«ìïठ÷", "âàë«ìñ­ ÷", "ª¢ ¤àë«ìñ­ ÷" },;
{ "­ã«ñ¢ë",;
"¯¥àèë",;
"¤àã£i",;
"âàí©æi",;
"ç æ좥àâë",;
"¯ïâë",;
"è®áâë",;
"áñ¬ë",;
"¢®áì¬ë",;
"¤§ï¢ïâë",;
"¤§ïáïâë",;
" ¤§i­ ææ âë",;
"¤¢ ­ ææ âë",;
"âàë­ ææ âë", ;
"ç âëà­ ææ âë",;
"¯ïâ­ ææ âë",;
"è á­ ææ âë",;
"áשּׂ ææ âë",;
"¢ áשּׂ ææ âë",;
"¤§¥¢ïâ­ ææ âë",;
"¤¢ ææ âë",;
"âàëææ âë",;
"á à ª ¢ë",;
"¯ïæi¤§¥áïâë",;
"è áìæi¤§ïáïâë",;
"áï¬i¤§ïáïâë",;
"¢ áì¬i¤§ïáïâë",;
"¤§¥¢ï­®áâë",;
"á®âë",;
"¤¢ãåá®âë",;
"âà®åá®âë",;
"ç âëà®åá®âë",;
"¯ïæiá®âë",;
"è áìæiá®âë",;
"áï¬iá®âë",;
"¢ áì¬iá®âë",;
"¤§¥¢ïæiá®âë",;
"âëáïç­ë", "¬i«ìñ­­ë", "¬i«ìïभë", "âàë«ìñ­­ë", "ª¢ ¤àë«ìñ­­ë" },;
{ "",;
"",;
"¤¢ãå",;
"âà å",;
"ç âëà®å",;
"¯ïæi",;
"è áæi",;
"áï¬i",;
"¢ áì¬i",;
"¤§¥¢ïæi",;
"¤§¥áïæi",;
" ¤§i­ ææ æi",;
"¤¢ ­ ææ æi",;
"âàë­ ææ æi",;
"ç âëà­ ææ æi",;
"¯ïâ­ ææ æi",;
"è á­ ææ æi",;
"áשּׂ ææ æi",;
"¢ áשּׂ ææ æi",;
"¤§¥¢ïâ­ ææ æi",;
"¤¢ ææ æi",;
"âàëææ æi",;
"á à ª ",;
"¯ïæi椧¥áïæi",;
"è áæi¤§¥áïæi",;
"áï¬i¤§¥áïæi",;
"¢ áì¬i¤§¥áïæi",;
"¤§¥¢ï­®áâ " },;
{ "i", "ïï", " ï", "ï¥", " ¥" },;
{ NTSR_MALE, "àã¡.", "àã¡¥«ì", "àã¡«i", "àã¡«¥÷" },;
{ NTSR_FEMA, "ª®¯.", "ª ¯¥©ª ", "ª ¯¥©ªi", "ª ¯¥¥ª" },;
"¬i­ãá",;
{ "áâ㤧¥­ï", "«îâë", "á ª ¢iª ", "ªà á ¢iª ", "¬ ï", "çíࢥ­ï",;
"«i¯¥­ï", "¦­i¢¥­ï", "¢¥à á­ï", "ª áâàëç­iª ", "«iáâ ¯ ¤ ", "á­¥¦ ­ï" },;
{ "£®¤", "£®¤ " } }
/* test procedure
procedure main
REQUEST HB_CODEPAGE_RU866
HB_CDPSelect( "RU866" )
? "Press ESC to break"
? "Russian"
Test( NTSR_RUS )
? "Ukrainian"
Test( NTSR_UKR )
? "Belorussian"
Test( NTSR_BEL )
Return
procedure test( nLang )
Local nTemp
dbCreate('_num'+LTrim(Str( nLang)),;
{{'NUM', 'N', 19, 0}, {'STR1', 'C', 100, 0}, {'STR2', 'C', 100, 0}, {'STR3', 'C', 50, 0}},, .t., 'num')
for nTemp := 1 to 1000000000
num->(dbAppend())
num->Num := nTemp
num->Str1 := MnyToTxtRU( nTemp + (nTemp%100)*0.01, nLang,, 3 )
num->Str2 := NumToTxtRU( nTemp, nLang,, .t. )
num->Str3 := DateToTxtRU( Date()+nTemp, nLang, .t. )
if nTemp % 1000 == 0
? nTemp
endif
if nTemp % 10000 == 0
if inkey() == 27
exit
endif
endif
next
close
return
*/
FUNCTION NumToTxtRU( nValue, nLang, nGender, lOrd )
/*
* nValue: integer value;
* nLang: language Id (1-3), russian (1) by default;
* nGender: masculine (default), feminine or neuter gender;
* lOrd: ordinals, cardinal numbers if omitted
*/
LOCAL aMsg := GetLangMsg( nLang )
LOCAL cRetVal
if nValue < 0
nValue := -nValue
cRetVal := aMsg[ NTSR_MINUS ] + " "
ELSE
cRetVal := ""
endif
nValue := Int( nValue )
cRetVal += NumToStrRaw( nValue, aMsg, nGender, lOrd )
RETURN cRetVal
FUNCTION MnyToTxtRU( nValue, nLang, nMode1, nMode2 )
/*
* nValue: integer value;
* nLang: language Id (1-3), russian (1) by default;
* nMode1: 1 - in words,
* 2 - in words and short name,
* 3 - in numbers,
* 4 - in numbers and short name;
* nMode2: mode for cents, in format as above
*/
LOCAL cRetVal
LOCAL aMsg := GetLangMsg( nLang )
LOCAL nCent
nValue := Round( nValue, 2 )
nCent := Round( (nValue - Int( nValue )) * 100, 0)
nValue := Int( nValue )
cRetVal := MnyToStrRaw( nValue, nLang, aMsg[ NTSR_CURR ], nMode1 ) + " " + ;
MnyToStrRaw( nCent, nLang, aMsg[ NTSR_CENT ], nMode2 )
Return cRetVal
FUNCTION DateToTxtRU( dDate, nLang, lWord )
LOCAL aMsg := GetLangMsg( nLang )
LOCAL cRetVal, nTemp
if ! Empty( dDate )
nTemp := Day( dDate )
if lWord != nil
cRetVal := NumToStrRaw( nTemp, aMsg, NTSR_MIDD, .t. )
else
cRetVal := LTrim( Str( nTemp ) )
endif
cRetVal += " " + aMsg[ NTSR_MONTH, Month( dDate ) ] + " " + ;
Str( Year( dDate ), 4 ) + " " + aMsg[ NTSR_YEAR, 2 ]
else
cRetVal := ""
endif
Return cRetVal
STATIC FUNCTION MnyToStrRaw( nValue, nLang, aCur, nMode )
LOCAL aMsg := GetLangMsg( nLang )
LOCAL cRetVal
LOCAL cTemp, nTemp
LOCAL lShort := nMode == 2 .or. nMode == 4
if nMode == nil
nMode := 1
endif
if nMode <= 2
if nValue == 0
cRetVal := aMsg[ NTSR_MALE, 1 ]
else
cRetVal := NumToStrRaw( nValue, aMsg, aCur[ 1 ] )
endif
else
cRetVal := LTrim( if( nValue < 100, StrZero( nValue, 2 ), Str( nValue ) ) )
endif
if ! lShort
nTemp := Int( nValue % 100 )
if nTemp >= 5 .and. nTemp <= 20
cTemp := aCur[ 5 ]
elseif nTemp % 10 == 1
cTemp := aCur[ 3 ]
elseif nTemp % 10 >= 2 .and. nTemp % 10 <= 4
cTemp := aCur[ 4 ]
else
cTemp := aCur[ 5 ]
endif
else
cTemp := aCur[ 2 ]
endif
Return cRetVal + " " + cTemp
STATIC FUNCTION GetLangMsg( nLang )
LOCAL aMsg
if nLang == nil .or. nLang == NTSR_RUS
aMsg := aRus
elseif nLang == NTSR_UKR
aMsg := aUkr
elseif nLang == NTSR_BEL
aMsg := aBel
endif
RETURN aMsg
STATIC FUNCTION NumToStrRaw( nValue, aMsg, nGender, lOrd )
LOCAL nTri := 0, nTemp, nTemp1
LOCAL cRetVal := "", cTemp
LOCAL lLast := .t.
if nGender == Nil
nGender := NTSR_MALE
endif
if lOrd == Nil
lOrd := .f.
endif
while nValue != 0
nTemp := nValue % 1000
if nTemp != 0
cTemp := ""
if nTri > 0
if lOrd .and. lLast
if nTemp > 20 .and. nTemp % 10 != 0
cTemp += " "
endif
if nTri + 37 <= Len( aMsg[ NTSR_CNT ] )
cTemp += OrdToGender( aMsg[ NTSR_CNT, nTri + 37 ], aMsg, nGender )
else
cTemp += "10**" + LTrim( Str( nTri*3 ) )
endif
elseif nTri <= Len( aMsg[ NTSR_1000_1 ] )
cTemp += " "
nTemp1 := ( nValue % 10 )
if nTemp1 == 1 .and. nValue != 11
cTemp += aMsg[ NTSR_1000_1, nTri ]
elseif nTemp1 >= 2 .and. nTemp1 <= 4 .and. ( nValue < 10 .or. nValue > 20 )
cTemp += aMsg[ NTSR_1000_2, nTri ]
else
cTemp += aMsg[ NTSR_1000_3, nTri ]
endif
else
cTemp += "10**" + LTrim( Str( nTri*3 ) ) + " "
endif
endif
cTemp := TriToStr( nTemp, aMsg, iif( nTri==0, nGender, iif(nTri == 1, 2, 1 ) ), lOrd, @lLast, nTri ) + cTemp
if ! Empty( cRetVal )
cRetVal := " " + cRetVal
endif
cRetVal := cTemp + cRetVal
endif
nValue := Int( nValue / 1000)
nTri ++
enddo
RETURN cRetVal
STATIC FUNCTION TriToStr( nValue, aMsg, nGender, lOrd, lLast, nTri )
LOCAL cRetVal, cTemp, nTemp, nIdx
LOCAL l20 := .f.
if nValue >= 100
nTemp := nValue % 100
if lOrd .and. lLast .and. nTemp == 0
nIdx := NTSR_CNT
lLast := .f.
else
nIdx := NTSR_MALE
endif
cRetVal := aMsg[ nIdx, Int( nValue / 100 ) + 28 ]
if nIdx == NTSR_CNT
cRetVal := OrdToGender( cRetVal, aMsg, nGender )
endif
nValue := nTemp
if nValue != 0
cRetVal += " "
endif
l20 := .t.
else
cRetVal := ""
endif
if nValue >= 20
nTemp := nValue % 10
if ! lOrd .or. nTemp # 0 .or. ! lLast
nIdx := NTSR_MALE
elseif lLast .and. nTemp == 0 .and. nTri == 0
nIdx := NTSR_CNT
lLast := .f.
else
nIdx := NTSR_ROD
lLast := .f.
endif
cTemp := aMsg[ nIdx, Int( nValue / 10 ) - 1 + 20 ]
if nIdx == NTSR_CNT
cTemp := OrdToGender( cTemp, aMsg, nGender )
endif
cRetVal += cTemp
nValue := nTemp
if nValue != 0
cRetVal += " "
endif
l20 := .t.
endif
if nValue > 0
if lOrd
if nTri >= 1 .and. lLast .and. ! l20
nIdx := NTSR_ROD
lLast := .f.
else
if lLast .and. nTri == 0
nIdx := NTSR_CNT
lLast := .f.
else
nIdx := if( nValue + 1 <= len( aMsg[ nGender ] ), nGender, NTSR_MALE )
endif
endif
else
nIdx := if( nValue + 1 <= len( aMsg[ nGender ] ), nGender, NTSR_MALE )
endif
cTemp := aMsg[ nIdx, nValue + 1 ]
if nIdx == NTSR_CNT
cTemp := OrdToGender( cTemp, aMsg, nGender )
endif
cRetVal += cTemp
endif
RETURN cRetVal
STATIC FUNCTION OrdToGender( cValue, aMsg, nGender)
LOCAL nTemp := Len( cValue ) - Len( aMsg[ NTSR_ORDG, 1 ] )
if nGender == NTSR_FEMA
cValue := Left( cValue, nTemp ) + if( Substr( cValue, nTemp + 1 ) = aMsg[ NTSR_ORDG, 1 ],;
aMsg[ NTSR_ORDG, 2 ], aMsg[ NTSR_ORDG, 3 ] )
elseif nGender == NTSR_MIDD
cValue := Left( cValue, nTemp ) + if( Substr( cValue, nTemp + 1 ) = aMsg[ NTSR_ORDG, 1 ],;
aMsg[ NTSR_ORDG, 4 ], aMsg[ NTSR_ORDG, 5 ] )
endif
RETURN cValue

163
harbour/tests/testmny.prg Normal file
View File

@@ -0,0 +1,163 @@
/*
* $Id: testmny.prg 18197 2012-10-08 17:39:24Z ptsarenko $
*/
//
// Sample class Money with overloading of arythmetical operations
//
// Written by Pavel Tsarenko <tpe2 at mail.ru>
// www - http://harbour-project.org
//
#include "common.ch"
#include "error.ch"
#include "hbclass.ch"
procedure main
Local m1 := Money():new( 12.2 )
Local m2 := Money():new( 7.8 )
Local m3 := m1 - m2
? "(12.2 - 7.8) == 4.4", (12.2 - 7.8) == 4.4
? m1:value
? m2:value
? (m1 - m2) == 4.4
? m3 == 4.4
? m1:str()
? m3:value
? m3 == 4.4
m3 := 5.5
? (m3 + m1):value
? (m3 + 12.2):value
? (m3 * 2):value
? (m3 / 2):value
? (m3 * m1):value
return
CLASS Money
VAR nValue AS INTEGER INIT 0
VAR nDec AS INTEGER INIT 2
VAR nMul AS INTEGER INIT 100
PROTECTED:
METHOD normalize( xArg )
METHOD set( nValue ) INLINE ::nValue := Int( nValue * ::nMul )
EXPORTED:
METHOD new( nValue, nDec ) CONSTRUCTOR
METHOD value()
METHOD str( nLen, nDec )
METHOD getMoney( oMoney )
OPERATOR ":=" ARG xArg INLINE ( ::nValue := ::normalize( xArg ), Self )
OPERATOR "=" ARG xArg INLINE ( ::nValue = ::normalize( xArg ) )
OPERATOR "==" ARG xArg INLINE ( ::nValue == ::normalize( xArg ) )
OPERATOR "!=" ARG xArg INLINE ( ::nValue != ::normalize( xArg ) )
OPERATOR "<" ARG xArg INLINE ( ::nValue < ::normalize( xArg ) )
OPERATOR "<=" ARG xArg INLINE ( ::nValue <= ::normalize( xArg ) )
OPERATOR ">" ARG xArg INLINE ( ::nValue > ::normalize( xArg ) )
OPERATOR ">=" ARG xArg INLINE ( ::nValue >= ::normalize( xArg ) )
METHOD Equal( xArg ) OPERATOR "=="
METHOD Plus( xArg ) OPERATOR "+"
METHOD Minus( xArg ) OPERATOR "-"
METHOD Multiple( xArg ) OPERATOR "*"
METHOD Divide( xArg ) OPERATOR "/"
ENDCLASS
METHOD new( nValue, nDec ) CLASS Money
DEFAULT nDec TO 2
DEFAULT nValue TO 0
::nDec := nDec
::nMul := Int( 10 ** nDec )
::set( nValue )
RETURN Self
METHOD value( ) CLASS Money
RETURN ::nValue / ::nMul
METHOD getMoney( oMoney ) CLASS Money
LOCAL nValue
IF ::nDec == oMoney:nDec
nValue := oMoney:nValue
ELSE
nValue := Int( oMoney:nValue * ( ::nMul / oMoney:nMul ) )
ENDIF
RETURN nValue
METHOD normalize( xArg ) CLASS Money
LOCAL nValue
IF IsMoney( xArg )
nValue := ::getMoney( xArg )
ELSEIF IsNumber( xArg )
nValue := Int( xArg * ::nMul )
ELSE
nValue := EVAL( ERRORBLOCK(), GenError( xArg ) )
ENDIF
RETURN nValue
METHOD Equal( xArg ) CLASS Money
Return ::nValue == ::normalize( xArg )
METHOD Plus( xArg ) CLASS Money
LOCAL oResult := Money():new( ::nDec )
oResult:nValue := ::nValue + ::normalize( xArg )
Return oResult
METHOD Minus( xArg ) CLASS Money
LOCAL oResult := Money():new( ::nDec )
oResult:nValue := ::nValue - ::normalize( xArg )
Return oResult
METHOD Multiple( xArg ) CLASS Money
LOCAL oResult := Money():new( ::nDec )
IF IsMoney( xArg )
oResult:nValue := Int( ::nValue * xArg:nValue / xArg:nMul )
ELSEIF IsNumber( xArg )
oResult:nValue := Int( ::nValue * xArg )
ELSE
EVAL( ERRORBLOCK(), GenError( xArg ) )
ENDIF
Return oResult
METHOD Divide( xArg ) CLASS Money
LOCAL oResult := Money():new( ::nDec )
IF IsMoney( xArg )
oResult:nValue := Int( ::nValue / xArg:nValue * xArg:nMul )
ELSEIF IsNumber( xArg )
oResult:nValue := Int( ::nValue / xArg )
ELSE
EVAL( ERRORBLOCK(), GenError( xArg ) )
ENDIF
Return oResult
METHOD str( nLen, nDec ) CLASS Money
LOCAL cStr
LOCAL nValue := ::value()
IF nLen == Nil
cStr := Str( nValue )
ELSEIF nDec == Nil
cStr := Str( nValue, nLen )
ELSE
cStr := Str( nValue, nLen, nDec )
ENDIF
Return cStr
STATIC FUNCTION IsMoney( xArg )
RETURN ISOBJECT( xArg ) .and. xArg:className() = "MONEY"
STATIC FUNCTION GenError( xArg )
LOCAL oError := ErrorNew()
oError:description := HB_LANGERRMSG( EG_DATATYPE )
oError:gencode := EG_DATATYPE
oError:severity := ES_ERROR
oError:cansubstitute := .T.
oError:subsystem := "MONEY"
oError:subcode := 0
oError:args := { xArg }
RETURN oError