Category : Pascal Source Code
Archive   : FORM.ZIP
Filename : _FORM.PAS
{ Written to take the place of the FORM FUNCTION in Turbo 3.0 with BCD covers }
{ most of the 3.0 Function - November 1987 - Paul Mayer CIS [70040,645] }
INTERFACE
USES CRT;
FUNCTION Form(Picture : STRING; Number : Real) : STRING;
{ Pseudo form function }
IMPLEMENTATION
FUNCTION Form;
{ Pseudo form function }
VAR
Position, Dollar, Comma, Comma2, Start_Length, Picture_Length : Word;
Temp_Picture, Temp_Number : STRING[80];
FUNCTION RealToString(Num : Real; Len, Places : Word) : STRING;
{ Changes a real to a string }
VAR
S : STRING[80];
BEGIN
Str(Num:Len:Places, S);
RealToString := S;
END; { RealToString }
FUNCTION Strip(S : STRING) : STRING;
{ Strips our number of spaces so we know how big it is }
VAR
I : Word;
Store : STRING;
BEGIN
Store := '';
FOR I := 1 TO Length(S) DO
IF S[I] <> ' ' THEN Store := Store+S[I];
Strip := Store;
END; { Strip }
FUNCTION Add_Dollar(S : STRING) : STRING;
{ Puts dollar sign in figure }
VAR
I, Count : Word;
Store : STRING;
BEGIN
Store := '';
Count := 0;
FOR I := 1 TO Length(S) DO
IF S[I] = ' ' THEN Store := Store+S[I];
Store := Store+'$'+Copy(S, Length(Store)+1,
Length(S)-Length(Store));
Add_Dollar := Copy(Store, 2, Length(Store));
END; { Add_Dollar }
BEGIN
Dollar := 0;
Position := 0;
Position := Pos('#', Picture);
Temp_Picture := Copy(Picture, 1, Position-1);
Dollar := Pos('$', Temp_Picture);
Delete(Picture, 1, Position-1);
Picture_Length := Length(Picture);
IF Dollar = Length(Temp_Picture) THEN
Delete(Temp_Picture, Dollar, 1);
Comma := Pos(',', Picture);
Comma2 := Pos(',', Copy(Picture, Comma+1, 5));
Position := Pos('.', Picture);
IF Dollar > 0 THEN
BEGIN
Picture_Length := Picture_Length+1;
Position := Position+1;
END;
Start_Length := Picture_Length;
IF Position <> 0 THEN
Temp_Number := RealToString(Number, Picture_Length,
Picture_Length-Position)
ELSE
BEGIN
Temp_Number := RealToString(Number, Picture_Length, 0)
END;
IF Picture_Length < 11 THEN
BEGIN
IF ((Comma <> 0) AND (Length(Strip(Temp_Number)) > 6)) THEN
Insert(',', Temp_Number, Pos('.', Temp_Number)-3);
END
ELSE IF Picture_Length > 10 THEN
BEGIN
IF ((Comma <> 0) AND (Dollar <> 0) AND
(Length(Strip(Temp_Number)) > 6)) THEN
Insert(',', Temp_Number, Pos('.', Temp_Number)-3);
IF ((Comma2 <> 0) AND (Dollar = 0) AND
(Length(Strip(Temp_Number)) > 6)) THEN
Insert(',', Temp_Number, Pos('.', Temp_Number)-3);
IF ((Comma2 <> 0) AND (Dollar <> 0) AND
(Length(Strip(Temp_Number)) > 10)) THEN
Insert(',', Temp_Number, Pos('.', Temp_Number)-7);
IF ((Comma <> 0) AND (Dollar = 0) AND
(Length(Strip(Temp_Number)) > 10)) THEN
Insert(',', Temp_Number, Pos('.', Temp_Number)-7);
IF ((Comma <> 0) AND (Length(Strip(Temp_Number)) < 12)) THEN
Insert(' ', Temp_Number, 1);
IF ((Comma > 0) AND (Length(Strip(Temp_Number)) < 8)) THEN
Delete(Temp_Number, 1, 1);
END;
IF Dollar > 0 THEN Temp_Number := Add_Dollar(Temp_Number);
IF ((Comma > 0) AND (Dollar > 0) AND (Copy(Temp_Number, 1, 1) = ' '))
THEN Delete(Temp_Number, 1, 1);
IF ((Comma > 0) AND (Copy(Temp_Number, 1, 1) = ' '))
THEN Delete(Temp_Number, 1, 1);
IF ((Comma2 > 0) AND (Copy(Temp_Number, 1, 1) = ' '))
THEN Delete(Temp_Number, 1, 1);
IF (Comma > 0) AND (Pos(',', Temp_Number) < 1) THEN
Insert(' ', Temp_Number, 1);
IF (Comma2 > 0) AND (Comma > 0) AND (Pos(',', Temp_Number) < 1) THEN
Insert(' ', Temp_Number, 1);
IF ((Dollar > 0) AND (Copy(Temp_Number, 1, 1) = ' ')) THEN
BEGIN
Start_Length := Start_Length+1;
END;
Form := Temp_Picture+Temp_Number;
IF Length(Temp_Number) > Start_Length THEN
FORM := Temp_Picture+Copy('********************************',
1, Start_Length);
END; { Pseudo form function }
END.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/