home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
clarion
/
chkstr.zip
/
CHKSTR.CLA
next >
Wrap
Text File
|
1989-09-14
|
9KB
|
280 lines
TITLE('Demo Program for Check_String FUNCTION.')
!Program : Chkstr
!Module : Chkstr.CLA
!Function : Test Check_String Function
!Version : 1.0
!Author : David Drake
! : Double-D Software
! : 4924 Chantilly
! : Las Vegas, Nv 89110
! : (702) 438-2173
!Date : September 14, 1989
!Notice : Copyright (c) 1989 David Drake. All Rights Reserved.
!
!INSTRUCTIONS:
!This test program demonstrates the Check_String Function.
!Input the number to string (assumes 2 decimal places)
! (ie. 12345 assumes 123.45)
!Input the maximum allowable return string length
!The function will return the amount spelled out.
!If the spelled out amount will not fit within the specified
!maximum length, the function will attempt to compact the string
!by not expanding some of the digits into words.
!First it will compact the hundreds, then the thousands and finally
!the millions as necessary. Within each group (hundred,thousand,
!million), the fucntion will first compact the amount less than
!one hundred then the hundreds amount.
!To see this compaction work, input a large number (12312312)
!and a max length of 80, then decrease the maximum length.
!
!This function was converted from a basic routine that was part
!of the check printing program for Accounts Payable. It has NOT
!been exhaustively tested after the conversion to Clarion, but I
!believe it is relatively bug-free. I would appreciate hearing
!of any bugs found.
!
CHKSTR PROGRAM
MAP
PROC(MAIN)
FUNC(Check_String),STRING
END
Amount LONG
Outstr STRING(132)
Length BYTE
CODE
SETHUE(3,0)
BLANK()
MAIN
MAIN PROCEDURE
CODE
LOOP
SHOW(1,20,'Amount:')
SHOW(2,20,'Maxlen:')
ASK(1,28,Amount,@n_12)
ASK(2,28,Length,@n_3)
IF AMOUNT = 0 THEN BREAK.
Outstr=Check_String(Amount,Length)
SHOW(4,1,Outstr)
.
!*************************************************
! Function CheckString
!**************************************************
Check_String FUNCTION(ChkAmt,MaxLen)
ChkAmt EXTERNAL !Amount to Convert
MaxLen EXTERNAL !Max Length of return String
String STRING(132)
RetStr STRING(132) !Return String
WrkAmt LONG !Temp Amt for Processing
Compact BYTE
Level_1 SHORT !First Level Compaction
Level_2 SHORT !Second Level Compaction
Dollars BYTE !Flag to output 'DOLLARS'
Yes BYTE(1) !logical YES
No BYTE(0) !Logical NO
TmpStr STRING(10) !Used by ones/tens routines
TmpAmt SHORT !Used to Hold 3-digit group
Work LONG !Used in Group Processing
Temp LONG !Used in Group Processing
Word STRING(10)
CODE
! Start with Compacting Levels At Minimum
Level_1 = 0
Level_2 = 0
!
!Main Processing Loop
!
! Generates full string and checks length
! If too long, Increments Compacting Level and tries again
! If still too long after max compaction, returns 'ERROR'
!
LOOP
WrkAmt=ChkAmt !Set to Passed Amount
DO String_it !Convert to String
IF LEN(CLIP(String)) > MaxLen !Too Long, Start Compaction
IF Level_1 = 0 THEN Level_1 = 1. ! Turn Compaction Lvl1 on
Level_2 += 1 ! Bump Level2 Setting
IF Level_2 > 2 ! Hit Max Leel 2?
Level_1 += 1 ! Yes, Bump Level 1
Level_2 = 1 ! Reset Level 2
IF Level_1 > 3 ! Hit Max Compaction?
String='ERROR' ! Yes, error
BREAK !
END
END
ELSE
BREAK !All ok, done
END
.
RETURN(LEFT(CLIP(string) & ALL('*',132),MaxLen))
!
!Do Actual conversion of amount to String
! Will Respond to compaction levels as Follows
! Level_1 controls Which Groups of 3 digits will be compacted
! Level_2 Controls which Digits in a group will be compacted
!
! Level_1 = 0 - No Compaction
! 1 - Compact 100's
! 2 - Compact 1000's and 100's
! 3 - Compact 1000000's, 1000's and 100'
!
! Level_2 = 0 - No Compaction
! 1 - Compact 1-99 of group
! 2 - Compact 100's of group
!
String_it ROUTINE
String='' !Start with Null string
Dollars=No ! no Dollars
Compact=No ! Compaction off
!
! Process Millions, if any
!
IF WrkAmt > 99999999 !millions
TmpAmt=INT(WrkAmt/100000000) !Get Millions
Word = 'MILLION' !set temp string
If Level_1 = 3 THEN Compact=Yes. !level3 = compact millions
DO String_Group !String a 3 digit Group
Compact = No !Turn off Compacting
String = CLIP(String) & ' ' & CLIP(Word) !Build String
WrkAmt = WrkAmt - (TmpAmt*100000000) !Reduce by Millions
Dollars = YES ! Yes, we have some dollars
END
!
! Process Thousands, if any
!
IF WrkAmt > 99999 !thousands
TmpAmt=INT(WrkAmt/100000) !Get Thousands
Word='THOUSAND' !set temp string
If Level_1 = 3 THEN Compact=Yes. !level3 = compact millions
DO String_Group !String a 3 digit Group
Compact = No !Turn off Compacting
String = CLIP(String) & ' ' & CLIP(Word) !Build String
WrkAmt = WrkAmt - (TmpAmt*100000) !Reduce by thousands
Dollars = Yes ! Ye, we have some dollars
END
!
! Process Hundreds, if any
!
IF WrkAmt > 99 !dollars
TmpAmt=INT(WrkAmt/100) !Get Thousands
If Level_1 = 3 THEN Compact=Yes. !level3 = compact millions
DO String_Group !String a 3 digit Group
Compact = No !Turn off Compacting
WrkAmt = WrkAmt - (TmpAmt*100) !Reduce by dollars
Dollars = Yes !Yes, Dollars
END
!
! If there were no dollars, output 'ZERO'
!
IF Dollars = No
String = 'ZERO'
END
!
! Do cents processing
!
String = CLIP(String) & ' AND ' ! xxxxx DOLLARS AND
IF WrkAmt = 0 THEN ! How many Cents?
String = CLIP(String) & ' ' & 'ZERO' ! None!
ELSIF WrkAmt < 10 !
String = CLIP(String) & ' ' & FORMAT(WrkAmt,@n_1)
ELSE
String = CLIP(String) & ' ' & FORMAT(WrkAmt,@n_2)
END
String = CLIP(String) & '/100 DOLLARS' !Finish it
EXIT
!
! Routine to run a 3-digit group (nnn) into a string
!
String_Group ROUTINE
Work = TmpAmt !temp
IF Work > 99 ! hundreds?
IF Compact = YES and Level_2 > 1 !yes, but compact?
String = CLIP(String) & ' ' & CLIP(FORMAT(Work,@s3))& ' ' !Compact
EXIT
ELSE
Temp = INT(Work/100) !get Hundreds
DO Ones !string it
String = CLIP(String) & ' HUNDRED ' !HUNDREDS
Work = Work - (Temp*100) !Reduce Work
END
END
!
!now only 1 - 99 possible
!
IF Compact = YES and Level_2 > 0
String = CLIP(String) & ' ' & CLIP(FORMAT(Work,@s3))
EXIT
END
!do teens
IF Work > 9 and Work < 20
Temp = Work
DO Tens
Temp = 0
ELSE
!tens if any
Temp = INT(Work/10)
IF Temp ~= 0
DO Tens
Work = Work - (Temp*10)
END
!ones if any
IF Work ~= 0
Temp = Work
DO Ones
END
END
EXIT
!
! routine to do a single digit
!
Ones ROUTINE
IF Temp = 1 THEN TmpStr = 'ONE'.
IF Temp = 2 THEN TmpStr = 'TWO'.
IF Temp = 3 THEN TmpStr = 'THREE'.
IF Temp = 4 THEN TmpStr = 'FOUR'.
IF Temp = 5 THEN TmpStr = 'FIVE'.
IF Temp = 6 THEN TmpStr = 'SIX'.
IF Temp = 7 THEN TmpStr = 'SEVEN'.
IF Temp = 8 THEN TmpStr = 'EIGHT'.
IF Temp = 9 THEN TmpStr = 'NINE'.
String = CLIP(String) & ' ' & CLIP(TmpStr)
EXIT
!
! Routine to do from 10 to 19
!
Tens ROUTINE
IF Temp = 10 THEN TmpStr = 'TEN'.
IF Temp = 11 THEN TmpStr = 'ELEVEN'.
IF Temp = 12 THEN TmpStr = 'TWELVE'.
IF Temp = 13 THEN TmpStr = 'THIRTEEN'.
IF Temp = 14 THEN TmpStr = 'FOURTEEN'.
IF Temp = 15 THEN TmpStr = 'FIFTEEN'.
IF Temp = 16 THEN TmpStr = 'SIXTEEN'.
IF Temp = 17 THEN TmpStr = 'SEENTEEN'.
IF Temp = 18 THEN TmpStr = 'EIGHTEEN'.
IF Temp = 19 THEN TmpStr = 'NINETEEN'.
IF Temp = 2 THEN TmpStr = 'TWENTY'.
IF Temp = 3 THEN TmpStr = 'THIRTY'.
IF Temp = 4 THEN TmpStr = 'FOURTY '.
IF Temp = 5 THEN TmpStr = 'FIFTY'.
IF Temp = 6 THEN TmpStr = 'SIXTY'.
IF Temp = 7 THEN TmpStr = 'SEVENTY'.
IF Temp = 8 THEN TmpStr = 'EIGHTY'.
IF Temp = 9 THEN TmpStr = 'NINETY'.
String = CLIP(String) & ' ' & CLIP(TmpStr)
EXIT