These procedure displays numbers in short form, that is with nomination as Thousand, Millions, Miliards etc.
There are two procedures, one that formats for bytes (1024 based) and for for standard numbers (1000 based).
For a tool of mine, I needed a routine that can format the size of objects as max 3 digits and the nomination of its size (Kb, Mb, Gb, Tb). To do that, I wrote Num2BPre() (Number To Byte Presentation). Preparing the sources here, I added the procedure Num2SPre() (Number To Standard Presentation). The difference between the is is, that the string formated by Num2BPre() is 1024 based where as Num”sPre() is 1000 based. The procedures is written in Totally Free RPG.
Download:
- Source members as text files: NumPre
The zip file contains the source members. Extract the source files and transfer them to your IBM i.
To format a number, call display a popup menu to the user, and manage it, you must call the PopupMenu() procedure with the parameters:
Num2BPre(number: decimalpoint);
Num2SPre(number: decimalpoint);
Where the parameters are:
- number
A 20 digit integer field that must be set to the value to format. - decimalpoint
Indicator that controls is the returned string is to contain the whole number plus one decimal.
Set to *On to return string with one decimal.
Set to *Off to return string with no decimal.
The procedures return a formatted string. In case of returning the string with a decimal point, the decimal separator is taken from the job settings.
The suffixes added to the numbers returned by Num2BPre() and Num2SPre() can be changed by calling the two suffix override procedures:
Num2BSuff(suffixes);
Num2SSuff(suffixes);
Where the parameter is:
- suffix
A 50 character long string containing the suffixes for the size of the number.
See the source code for format.
Listing 1, member NUMPRE_PR, type RPGLE:
**Free
// NumPre_Pr
// ---------
// Functions to represent numbers expressed in a short form.
//
// Jesper Wachs, Version 1, April 2019.
//
// The source member are delivered 'as is'.
//
// Neither Jesper Wachs nor anyone else who has been involved in
// the creation, production or delivery of this product shall be
// liable for any direct, indirect, consequential or incidental
// damages (including damages for loss of business profits,
// business interruption, loss of business information, and the
// like) arising out of the use or inability to use such product
// even if Jesper Wachs has been advised of the possibility of
// such damages.
//
Dcl-PR Nbr2BPre VarChar(19);
iNumber Int(20:0) Const;
iDecimal Ind Value;
End-PR;
Dcl-PR Num2BSuff;
iMask Char(50);
End-PR;
Dcl-PR Nbr2SPre VarChar(19);
iNumber Int(20:0) Const;
iDecimal Ind Value;
End-PR;
Dcl-PR Num2SSuff;
iMask Char(50);
End-PR;
Listing 2, member NUMPRE, type RPGLE:
**Free
Ctl-Opt NoMain DecEdit(JobRun);
//
// NumPre
// ------
// Functions to represent numbers expressed in a short form.
//
// E.g.: 10000: 10 T
// 1024: 1 KB
//
// Jesper Wachs, Version 1, April 2019.
//
// The source member are delivered 'as is'.
//
// Neither Jesper Wachs nor anyone else who has been involved in
// the creation, production or delivery of this product shall be
// liable for any direct, indirect, consequential or incidental
// damages (including damages for loss of business profits,
// business interruption, loss of business information, and the
// like) arising out of the use or inability to use such product
// even if Jesper Wachs has been advised of the possibility of
// such damages.
//
// Copymember for exported functions.
// ----------------------------------
/copy qrpglesrc,numpre_pr
// Global work fields.
// -------------------
// Default suffix for 1024 based numbers.
Dcl-S SuffixesByte Char(50) Inz('B KB +
MB GB TB ');
// Default suffix for stand 1000 based numbers.
Dcl-S SuffixesStd Char(50) Inz(' T +
Mil Mia Bil ');
// Global constants.
// -----------------
Dcl-C CEDITCODEP Const('P');
// Exported funtions.
// ------------------
// Nbr2BPre
// ---------
// Byte representation (1024 based)
Dcl-Proc Nbr2BPre Export;
Dcl-PI Nbr2BPre VarChar(19);
iNumber Int(20:0) Const;
iDecimal Ind Value;
End-PI;
Dcl-C LIMITBYTEK Const(1024);
Dcl-C LIMITBYTEM Const(1048576);
Dcl-C LIMITBYTEG Const(1073741824);
Dcl-C LIMITBYTET Const(1099511627776);
Dcl-S CalcValue Packed(11:1);
Dcl-S IntValue Packed(9:0);
Dcl-S Offset Packed(3:0);
Dcl-S oResult VarChar(20);
Dcl-S wNumber Like(iNumber);
// Handle negative numbers. Done to have comparisons work as xpected.
If iNumber < *Zeros;
wNumber = iNumber * -1;
Else;
wNumber = iNumber;
EndIf;
Select;
When wNumber < LimitByteK;
Offset = 1;
CalcValue = iNumber;
// Force to no decimal as this is the 1's.
iDecimal = *Off;
When wNumber < LimitByteM;
Offset = 11;
Eval(H) CalcValue = iNumber / LimitByteK;
When wNumber < LimitByteG;
Offset = 21;
Eval(H) CalcValue = iNumber / LimitByteM;
When wNumber < LimitByteT;
Offset = 31;
Eval(H) CalcValue = iNumber / LimitByteG;
Other;
Offset = 41;
Eval(H) CalcValue = iNumber / LimitByteT;
EndSl;
// Format with or without one decimal.
If iDecimal = *On;
oResult = %TrimL(%EditC(CalcValue: cEditCodeP));
Else;
Eval(H) IntValue = CalcValue;
oResult = %TrimL(%EditC(IntValue: cEditCodeP));
EndIf;
oResult = oResult + ' ' + %SubSt(SuffixesByte: Offset: 10);
Return oResult;
End-Proc Nbr2BPre;
//
// Num2BSuff
// ---------
// Set the suffixes for 1024-based calculation routine.
Dcl-Proc Num2BSuff Export;
Dcl-PI Num2BSuff;
iMask Char(50);
End-PI;
SuffixesByte = iMask;
Return;
End-Proc Num2BSuff;
//
// Nbr2SPre
// --------
// Standard representation (1000 based).
Dcl-Proc Nbr2SPre Export;
Dcl-PI Nbr2SPre VarChar(19);
iNumber Int(20:0) Const;
iDecimal Ind Value;
End-PI;
Dcl-C LIMITSTDT Const(1000);
Dcl-C LIMITSTDM Const(1000000);
Dcl-C LIMITSTDMI Const(1000000000);
Dcl-C LIMITSTDB Const(1000000000000);
Dcl-S CalcValue Packed(11:1);
Dcl-S IntValue Packed(9:0);
Dcl-S Offset Packed(3:0);
Dcl-S oResult VarChar(20);
Dcl-S wNumber Like(iNumber);
// Handle negative numbers. Done to have comparisons work as xpected.
If iNumber < *Zeros;
wNumber = iNumber * -1;
Else;
wNumber = iNumber;
EndIf;
Select;
When wNumber < LimitStdT;
Offset = 1;
CalcValue = iNumber;
// Force to no decimal as this is the 1's.
iDecimal = *Off;
When wNumber < LimitStdM;
Offset = 11;
Eval(H) CalcValue = iNumber / LimitStdT;
When wNumber < LimitStdMi;
Offset = 21;
Eval(H) CalcValue = iNumber / LimitStdM;
When wNumber < LimitStdB;
Offset = 31;
Eval(H) CalcValue = iNumber / LimitStdMi;
Other;
Offset = 41;
Eval(H) CalcValue = iNumber / LimitStdB;
EndSl;
// Format with or without one decimal.
If iDecimal = *On;
oResult = %TrimL(%EditC(CalcValue: cEditCodeP));
Else;
Eval(H) IntValue = CalcValue;
oResult = %TrimL(%EditC(IntValue: cEditCodeP));
EndIf;
oResult = oResult + ' ' + %SubSt(SuffixesStd: Offset: 10);
Return oResult;
End-Proc Nbr2SPre;
//
// Num2SSuff
// ---------
// Set the suffixes for 1000-based calculation routine.
Dcl-Proc Num2SSuff Export;
Dcl-PI Num2SSuff;
iMask Char(50);
End-PI;
SuffixesStd = iMask;
Return;
End-Proc Num2SSuff;
Listing 3, member NUMPRE_EX, type RPGLE:
**Free
// NumPre_Ex
// ----------
// Example program for use of Num2BPre() and Num2SPre() functions.
//
// Jesper Wachs, Version 1, April 2019.
//
// The source member are delivered 'as is'.
//
// Neither Jesper Wachs nor anyone else who has been involved in
// the creation, production or delivery of this product shall be
// liable for any direct, indirect, consequential or incidental
// damages (including damages for loss of business profits,
// business interruption, loss of business information, and the
// like) arising out of the use or inability to use such product
// even if Jesper Wachs has been advised of the possibility of
// such damages.
//
Dcl-F NUMPREDF WORKSTN ;
// Copymember for imported functions.
// ----------------------------------
/copy qrpglesrc,numpre_pr
// Global work fields.
// -------------------
// Default suffixes for the 1000 and 1024 based numbers.
Dcl-S SuffixesByte Char(50) Inz('B KB +
MB GB TB ');
Dcl-S SuffixesStd Char(50) Inz(' T +
Mil Mia Bil ');
// Set for 'Standard'.
SType = 1;
// Set the suffixes.
SStdMask = SuffixesStd;
SBytMask = SuffixesByte;
Exfmt Screen;
// Calculate as long as the user have not pressed F3.
DoW *InKC = *Off;
CallP Num2BSuff(SBytMask);
CallP Num2SSuff(SStdMask);
Select;
When SType = 1;
SResult = Nbr2SPre(SNumber: *Off);
When SType = 2;
SResult = Nbr2SPre(SNumber: *On);
When SType = 3;
SResult = Nbr2BPre(SNumber: *Off);
When SType = 4;
SResult = Nbr2BPre(SNumber: *On);
EndSl;
Exfmt Screen;
EndDo;
// Bye for now.
*InLR = *On;
Return;
Listing 4, member NUMPREDF, type DSPF:
A DSPSIZ(24 80 *DS3)
A R SCREEN
A CF03
A 1 19'Example program for Num2BPre() and-
A Num2SPre()'
A DSPATR(HI)
A 7 5'Key in a number ......:'
A SNUMBER 19Y 0B 7 30EDTCDE(P)
A CHECK(RB)
A 9 5'Type of number .......:'
A STYPE 2Y 0B 9 30SNGCHCFLD
A CHOICE(1 '>Standard')
A CHOICE(2 'S>tandard, 1
decimal') A CHOICE(3 '>Byte')
A CHOICE(4 'B>yte, 1
decimal') A 14 5'Suffixes for Standard :'
A SSTDMASK 50A B 14 30CHECK(LC)
A 15 5'Suffixes for Byte ....:'
A SBYTMASK 50A B 15 30CHECK(LC)
A 17 5'Formatted number .....:'
A SRESULT 22A O 17 30
A 24 2'F3=Exit'
A COLOR(BLU)
Listing 5, member NUMPRE_MK, type TXT:
;
; NumPre_Mk
; ---------
; MAKE member for Num2BPre() and Num2SPre() and example program.
;
; Jesper Wachs, April 2019.
;
;
; Variables defined once and used though out make member.
;
v &lib jwtoolssrc
v &srclib jwtoolssrc
v &debug *source
v &proto NumPre_Pr
;
; Check and possibly build NumPre module.
;
v &mod numpre
o &srclib &mod *module
u &srclib qrpglesrc *file &mod
u &srclib qrpglesrc *file &proto
ci dltmod &srclib/&mod
c crtrpgmod &srclib/&mod srcfile(&srclib/qrpglesrc) dbgview(&debug)
;
; Check and possibly build Num2*Pre() example module.
;
v &dfile numpredf
o &srclib &dfile *file
u &srclib qrpglesrc *file &dfile
u &srclib numpre *module
ci dltf &srclib/&file
c crtdspf &lib/&dfile srcfile(&srclib/qrpglesrc) rstdsp(yes) + chrid(chridctl)
;
v &mod numpre_ex
o &srclib &mod *module
u &srclib &dfile *file
u &srclib qrpglesrc *file &mod
u &srclib qrpglesrc *file &proto
u &srclib numpre *module
ci dltmod &srclib/&mod
c crtrpgmod &srclib/&mod srcfile(&srclib/qrpglesrc) dbgview(&debug)
;
; Build example program.
;
v &pgm numpre_ex
o &lib &pgm *pgm
u &srclib &pgm *module
u &srclib numpre *module
u &srclib &dfile *file
ci DltPgm &lib/&pgm
c CrtPgm &lib/&pgm module(&srclib/&pgm &srclib/numpre)