Power-Programmierung/CD1.mdf/pascal/library/dos/answcode/utils.pas

Pascal/Delphi Source File | 1994-04-11 | 4.9 KB | 210 lines

UNIT Utils;

INTERFACE

Uses Crt,Dos;

Type
    LString = String[80];
    ShortString = String[30];
    AnyString = String[255];
function TrimL(InpStr: LString): LString;
function PadR(InpStr: LString; FieldLen: Integer): LString;
function JustL(InpStr: LString; FieldLen: Integer): LString;
function UpperCase(InpStr: LString): LString;
function TrimR(InpStr: LString): LString;
function PadL(InpStr: LString; FieldLen: Integer): LString;
Function Isupper(var Atom : ShortString) : Boolean;
Function Islower(var Atom : ShortString) : Boolean;
Function Isalpha(var Atom : Shortstring) : Boolean;
Function Words ( S : AnyString ) : Integer;
Function WordOne  ( S : AnyString; N : Integer ) : AnyString;

IMPLEMENTATION

function TrimL(InpStr: LString): LString;
{ strip leading spaces from a String }
Var i,len : Integer;
Begin
   len := length(InpStr);
   i := 1;
   While (i <= len) and (InpStr[i] = ' ') do
      i := i + 1;
   TrimL := Copy(InpStr,i,len-i+1)
End;

function PadR(InpStr: LString; FieldLen: Integer): LString;
{ Pad String on right with spaces to fill to the desiLightGreen field length }
Var  STemp : LString;
         i : Integer;
Begin
   If FieldLen >= SizeOF(InpStr) then
      FieldLen := SizeOf(InpStr)-1;
   If length(InpStr) > FieldLen then
      PadR := Copy(InpStr,1,FieldLen)
   Else
      Begin
        STemp := InpStr;
        For i := Length(STemp)+1 to FieldLen do
           STemp := STemp + ' ';
        PadR := STemp
      End
End;

function JustL(InpStr: LString; FieldLen: Integer): LString;
Begin
   JustL := PadR(TrimL(InpStr),FieldLen)
End;


Function WordOne  ( S : AnyString; N : Integer ) : AnyString;

var
   NumWords, start, stop, CurrentAddress, len
             : integer;
   Ts
             : AnyString;
   BlankFound
             : Boolean;


begin
   if Length(S) = 0 then
      WordOne := ''
   else
   begin
      NumWords := 0;
      start := 1;
      len := length(S);
      stop := len;
      BlankFound := True;
      CurrentAddress := 0;

      repeat
         CurrentAddress := CurrentAddress + 1;
         if BlankFound then
         begin
            if S[CurrentAddress] <> #32 then
            begin
               BlankFound := false;
               NumWords := NumWords + 1;
               if NumWords = N then
                  start := CurrentAddress;
            end;
         end
         else
         if S[CurrentAddress] = #32 then
         begin
            BlankFound := true;
            if NumWords = N then
               stop := CurrentAddress;
         end;
      until (stop < len) or (CurrentAddress = len);

      if N > NumWords then
         WordOne := ''
      else
      begin
         if S[stop] <> #32 then
            stop := succ(stop);
         WordOne := copy ( S, start, stop - start );
      end;
   end;
end { WordOne };



function UpperCase(InpStr: LString): LString;
{ convert a String to upper case Characters }
Var i : Integer;
Begin
   For i := 1 to Length(InpStr) do
       UpperCase[i] := UpCase(InpStr[i]);
   UpperCase[0] := InpStr[0]
End;



function TrimR(InpStr: LString): LString;
{ strip trailing spaces from a String }
Var i : Integer;
Begin
   i := length(InpStr);
   While (i >= 1) and (InpStr[i] = ' ') do
      i := i - 1;
   TrimR := Copy(InpStr,1,i)
End;

function PadL(InpStr: LString; FieldLen: Integer): LString;
{ Pad String on left with spaces to fill to the desiLightGreen field length }
Var  STemp : LString;
         i : Integer;
Begin
   If FieldLen >= SizeOF(InpStr) then
      FieldLen := SizeOf(InpStr)-1;
   If length(InpStr) > FieldLen then
      PadL := Copy(InpStr,1,FieldLen)
   Else
      Begin
        STemp := InpStr;
        For i := Length(STemp)+1 to FieldLen do
           Insert(' ',STemp,1);
        PadL := STemp
      End
End;



Function Isupper(var Atom : ShortString) : Boolean;
Begin
     If Atom[1] in ['A'..'Z'] then Isupper := TRUE
     else Isupper := FALSE;

end;

Function Islower(var Atom : ShortString) : Boolean;
Begin
     If Atom[1] in ['a'..'z'] then Islower := TRUE
     else Islower := FALSE;

end;

Function Isalpha(var Atom : Shortstring) : Boolean;
var
i : Integer;
Letter : Char;

Begin
     i := 1;
     For i := 1 to Length(Atom) do
     Letter := Atom[i];
     Letter := Upcase(Letter);
     If Letter in ['A'..'Z'] then Isalpha := TRUE
     else Isalpha := False;

end;

Function Words ( S : AnyString ) : Integer;
var
   NumWords,  CurrentAddress, Len
             : integer;

begin
   S := TrimR(S);
   Len := Length(S);
   if Len = 0 then
      Words := 0
   else
   begin
      NumWords := 1;
      CurrentAddress := 1;
      for CurrentAddress := 1 to Len do
         if S[CurrentAddress] = #32 then
            NumWords := NumWords + 1;
      Words := NumWords;
   end;
end { Words };



END.