Strings unit! - Programmers Heaven

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

Strings unit!

BlackWolfBlackWolf Posts: 7Member
Unit ZStrings;

{************************************
* BLACKWOLF's STRINGS *
************************************}


Interface

Procedure InsSep(Var s : String);
{Insert '.' in larger numbers (ex: 1000000 -> 1.000.000)}
Function UCase(s : String) : String;
{Uppercase an entire string}
Function DCase(s : String) : String;
{Lowercase an entire string}
Function RTrim(s : String) : String;
{Delete blank spaces on the right side}
Function LTrim(s : String) : String;
{Delete blank spaces on the left side}
Function FillStr(nc : Byte; ch : Char) : String;
{Give you a string nc chars long, and filled with ch chars (ex: fillstr(5, 'a') -> 'aaaaa')}
Function IntToStr(x : LongInt) : String;
{From integer to string}
Function IntToBin(x : Integer) : String;
{From integer to binary string ('1010' etc.)}
Function StrToInt(x : String) : LongInt;
{String to integer}
Function CountChar(s : String; c : Char) : Byte;
{Counts c chars on s (ex: countchar('test', 't') --> 2)}
Function SubString(s : String; c : Char; num : Byte) : String;
{Give you the substring number num, between c and next in s}

Function DirToFileName(s : String) : String;
{s = full directory string. Give you only the filename}
Function DirectoryMinus(s : String) : String;
{Ex: directoryminus('c:documents est est1') --> 'c:documents est' ...}
Function Extension(s : String) : String;
{Ex: extension('c: est.txt') --> 'txt'}
Function WithoutExtension(s : String) : String;
{Ex: withoutextension('c: est.txt') --> 'test'}


Implementation

Procedure InsSep(Var s : String);
Var
cont : Byte;
Begin
cont := Length(s);
While (cont < 250) And (Cont > 0) Do
Begin
Dec(Cont,3);
If (Cont = 0) Or (Cont > 250) Then Break;
s := Copy(s,1,cont)+'.'+Copy(s,cont+1,Length(s)-cont)
End
End;

Function UCase(s : String) : String;
Var
k : Byte;
Begin
For k := 1 To Length(s) Do
s[k] := UpCase(s[k]);
UCase := s
End;

Function DCase(s : String) : String;
Var
k : Byte;
Begin
For k := 1 To Length(s) Do
If (s[k] In ['A'..'Z']) Then
s[k] := Chr(Ord(s[k])+32);
DCase := s
End;

Function RTrim(s : String) : String;
Var
k : Byte;
Begin
RTrim := '';
k := Length(s);
If k = 0 Then Exit;
While (s[k] = ' ') And (k > 0) Do Dec(k);
RTrim := Copy(s,1,k)
End;

Function LTrim(s : String) : String;
Var
k : Byte;
Begin
LTrim := '';
k := 1;
If Length(s) = 0 Then Exit;
While (s[k] = ' ') And (k <= Length(s)) Do Inc(k);
If k > Length(s) Then Exit;
LTrim := Copy(s,k,Length(s)-k+1)
End;

Function FillStr(nc : Byte; ch : Char) : String;
Var
s : String;
Begin
s[0] := Chr(nc);
FillChar(s[1], nc, ch);
FillStr := s
End;

Function IntToStr(x : LongInt) : String;
Var
s : String;
Begin
Str(x, s);
IntToStr := s
End;

Function IntToBin(x : Integer) : String;
Var
s : String;
b, k : Byte;
w : Word;
Begin
w := 1;
s := '';
For k := 1 To 16 Do
Begin
If x And w > 0 Then
s := '1'+s
Else
s := '0'+s;
w := w * 2
End;
IntToBin := s
End;

Function StrToInt(x : String) : LongInt;
Var
s : LongInt;
code : Integer;
Begin
x := LTrim(RTrim(x));
Val(x, s, code);
StrToInt := s
End;

Function CountChar(s : String; c : Char) : Byte;
Var
k, Count : Byte;
Begin
Count := 0;
For k := 1 To Length(s) Do
If s[k] = c Then Inc(Count);
CountChar := Count
End;

Function SubString(s : String; c : Char; num : Byte) : String;
Var
Start, Stop, k : Byte;
Begin
SubString := '';
If CountChar(s, c) < num-1 Then Exit;
Start := 1;
For k := 1 To num-1 Do
Begin
While s[Start] <> c Do Inc(Start);
Inc(Start)
End;
Stop := Start;
While (s[Stop] <> c) And (Stop < Length(s)) Do
Inc(Stop);
If Stop = Length(s) Then Inc(Stop);
If Stop = Start Then Exit;
SubString := Copy(s, Start, Stop-Start)
End;

Function DirToFileName(s : String) : String;
Var
Start, Stop : Byte;
Begin
DirToFileName := '';
Stop := Length(s);
While (s[Stop] = '') And (Stop > 1) Do Dec(Stop);
If Stop = 1 Then Exit;
Start := Stop;
While (s[Start] <> '') And (Start > 1) Do Dec(Start);
DirToFilename := s;
If (Start = 1) And (Stop = Length(s)) Then Exit;
If Start = Stop Then Exit;
Inc(Start);
DirToFileName := Copy(s, Start, Stop-Start+1)
End;

Function DirectoryMinus(s : String) : String;
Var
Stop : Byte;
Begin
DirectoryMinus := '';
Stop := Length(s);
If s[Stop] = '' Then Dec(Stop);
While (s[Stop] <> '') And (Stop > 1) Do Dec(Stop);
DirectoryMinus := s;
If Stop = 1 Then Exit;
DirectoryMinus := Copy(s, 1, Stop-1)
End;

Function Extension(s : String) : String;
Begin
Extension := '';
s := DirToFileName(s);
If Pos('.', s) = 0 Then Exit;
Extension := UCase(Copy(s, Length(s)-2, 3))
End;

Function WithoutExtension(s : String) : String;
Begin
WithoutExtension := '';
s := DirToFileName(s);
If Pos('.', s) = 0 Then Exit;
WithoutExtension := UCase(Copy(s, 1, Pos('.', s)-1))
End;

End.


Enjoy!
BlackWolf

Sign In or Register to comment.