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

Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

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.