Szoveg.pas

{
    S T R I N G E K K E L   K A P C S O L A T O S
    ---------------------------------------------
            eljárásgyüjtemény
}

UNIT Szoveg;


INTERFACE

Uses SysUtils, WinProcs, Classes, IniFiles;

    { --------  Nagybetűre/kisbetűre konvertálás ----------}
    Function Upper( s : string ):string;
    Function Lower( s : string ):string;

        { ------- Első betűt nagybetűre konvertál -------}
    Function UpperFirst( s : string ):string;
        function UpperFirstName(name: string; mode: integer): string;

    { ------- Egy stringben egy másikat keres =>
    OUT : sorszám, ha talál, egyébként = 0 }
    Function StrSearch( miben,mit:string):word;

        {-------- Megszámolja a substring előfordulásait }
        Function StrCount( miben,mit:string):word;

        { Egy string n. delimiterekkel határolt szavát adja, vagy ''-et}
        Function StrCountD( miben,delimiter:string; n:word):string;

        {Egy sub-string n. előfordulásának pozíciójával tér vissza}
        function CountPos ( miben,mit : string; n:integer ):integer;

        { 1.--------  Részstring Space-ekkel való feltöltése --------
    IN  : i1    = hossz a string ball szélétől
          s = a string }
    Function LSpace(i1 : integer;  s :string) : string;

        { 1.1 ------- SPACE konkatenációja ---------}
    Function Space(i1 : integer) : string;

    { 2.---- Egy stringből a bal oldali Space-eket levágja ----- }
    Function Ltrim(s:string):string;

    { 3.---- Egy stringből a jobb oldali Space-eket levágja ----- }
    Function Rtrim(s:string):string;

    { 4.---- Egy string mindkét végéről a Space-eket levágja ----- }
    Function Alltrim(s:string):string;

        Function LeftString(s:string;poz:integer):string;
        Function RightString(s:string;poz:integer):string;

        {Beszúr egy substringet a p pozíciónál, a string hossza a sub hosszával nő}
        Function InsSub(s,sub:string;p:integer):string;
        {Töröl egy substringet ha talál, a string hossza a sub hosszával csökken}
        Function DelSub(s,sub:string):string;

    { ---- Bevezető 0-k Space-ra cserélése -----
    IN :    s   = sz mstring }
    Function ZeroSpace( s : string ):string;

    Function Hex( dec_szam : Word ):String;

    Function Replicate( kar : String; szor : Integer ):String;

    { Egy num. értéket bevezető '0'-kal stringgé alakit }
    Function ZeroNum( sz,hosz : Word ):String;
        { Lecserél egy részstringet }
    Function Stuff( miben, mit, mire :string ):string;

    Function PadL( mit,mivel : string; hossz:integer ): string;

    Function PadR( mit,mivel : string; hossz:integer ): string;

    Function PadC( mit, mivel : string; hossz:integer ): string;

        { Egy mondat-string n. szavával tér vissza }
        Function Szo( szov : string;n : word ):string;


        Function F_Path(fn:string):string;
        Function F_Name(fn:string):string;
        Function F_Ext(fn:string):string;

        Function CsakBetu(s: String): string;
        { DOS szöveget WINDOWS szöveggé konvertál }
    Function ASCIIToWIN(s: string): string;
        { WINDOWS szöveget DOS szöveggé konvertál }
        Function WINToASCII(s: string): string;
        { A DELPHI.INI-ben regisztrált komponensek listáját adja }
        Function GetComponentsTypes:TStringList;
        Function GetComponentsPages:TStringList;

        function GetSectionNemes(iFile: TInifile):TStringList;
        function GetSectionValues(iFile: TInifile;Section:string):TStringList;

        {Csak számjegyek vizsgálata}
        Function IsNum(s:string):boolean;
        {------- Az egész számot szövegessé alakítja --------}
        FUNCTION SzamBetuvel( sz : Longint ):string;

        function HunUpper(ch: Char): Char;
        function HunLower(ch: Char): Char;

IMPLEMENTATION

Function Upper( s : string ):string;
begin
   Result:=AnsiUpperCase(s);
end;

Function Lower;
begin
   Result:=AnsiLowerCase(s);
end;

{ ------- Első betűt nagybetűre konvertál -------}
Function UpperFirst( s : string ):string;
begin
  s:=Lower(s);
  If Length(s)>0 then s:=AnsiUpperCase(Copy(s,1,1))+Copy(s,2,1000);
  Result := s;
end;

Function LSpace;
Var ix  : Integer;
 Begin
   For ix:=1 to i1  do
     s[ix]:=' ';
   LSpace:=s;
  end;

Function Space;
Var ix  : Integer;
    s: String;
Begin
   s:='';
   For ix:=1 to i1  do
     s:=s+' ';
   Space:=s;
end;

Function StrSearch;
Var  s1,s2 : Array[0..255] of char;
     p  : PChar;
begin
    StrPCopy( s1,miben );
    StrPCopy( s2,mit );
    p := StrPos( s1,s2 );
    IF p<>nil then StrSearch := p-s1+1
    else StrSearch:=0;
end;

{-------- Megszámolja a substring előfordulásait }
Function StrCount( miben,mit:string):word;
var p: integer;
begin
  Result:=0;
  repeat
       p:=Pos(mit,miben);
       If p>0 then begin
          Result:=Result+1;
          miben:=Copy(miben,p+Length(mit),Length(miben)-p);
       end;
  until p=0;
end;

{ A miben string n. delimiterekkel határolt szavát adja, az első és utolsó
 szavaknál nem szükséges az elválasztó}
Function StrCountD( miben,delimiter:string; n:word):string;
var p1,p2: word;
begin
  Result := '';
  If n>0 then begin
     p1:=CountPos(miben,delimiter,n-1);
     p2:=CountPos(miben,delimiter,n);
     If p2>p1 then Result := Copy(miben,p1+1,p2-p1-1)
     else if p1>0 then Result := Copy(miben,p1+1,Length(miben));
  end;
end;

Function Ltrim;
Var i   : integer;
begin
        Ltrim:='';
    For i:=1 to Length(s) do
    begin
        If s[i]>' ' then
                begin
           Ltrim:=Copy(s,i,Length(s)-i+1);
           Exit;
                end;
    end;
end;

Function Rtrim;
Var i   : integer;
begin
        Rtrim:='';
    For i:=Length(s) downto 1 do
    begin
        If s[i]>' ' then
        begin
           Rtrim:=Copy(s,1,i);
           Exit;
                end;
    end;
end;

Function Alltrim;
begin Alltrim := Ltrim(Rtrim(s)); end;

Function LeftString(s:string;poz:integer):string;
begin
  If poz<Length(s) then Result:=Copy(s,1,poz)
  else Result:=s;
end;

Function RightString(s:string;poz:integer):string;
begin
  If poz<Length(s) then begin
     Delete(s,1,poz-1);
     Result:=s;
  end
  else Result:='';
end;

{Beszúr egy substringet a p pozíciónál, a string hossza a sub hosszával nő}
Function InsSub(s,sub:string;p:integer):string;
begin
  result := Copy(result,1,p-1)+sub+Copy(result,p+Length(sub),Length(s));
end;

{Töröl egy substringet ha talál, a string hossza a sub hosszával csökken}
Function DelSub(s,sub:string):string;
var us,usub,r : string;
    n: integer;
begin
   us := UpperCase(s);
   usub := UpperCase(sub);
   n := Pos(usub,us);
   R := s;
   If n>0 then Delete(R,n,Length(usub));
   Delsub := r;
end;

Function ZeroSpace;
Var  i   : integer;
begin
     i := 1;
    While s[i] < '1' do
        begin
                s[i] := ' ';
                Inc(i);
        end;
end;

Function Hex;
Var hmar    : byte;
    hsz     : Word;
    hexszam     : String;
Const hx : String = '0123456789ABCDEF';
begin
        hsz := 100; hexszam := '';
    While hsz <> 0 do
    begin
        hsz := dec_szam div 16;
        hmar := dec_szam mod 16;
        hexszam := hx[ hmar+1 ] + Hexszam;
        dec_szam := hsz;
    end;
        Hex := hexszam;
end;

{
   Replicate = egy karekter megsokszoroz sa
}
Function Replicate;
Var i   : Integer;
    r   : String;
begin
    r := '';
    For i:=1 to szor do r := r + kar;
    Replicate := r;
end;


{
   Zeronum  = Egy num. ‚rt‚ket bevezet” '0'-kal stringg‚ alakit
}
Function ZeroNum;
Var s   : String;
begin
    Str( sz,s );
    ZeroNum := Replicate( '0',hosz-Length(s)) + s;
end;

{
   Stuff    = egy stringben karaktereket cser‚l le
}
Function Stuff;
Var i   : integer;
    szov    : String;
    b   : String;
begin
    szov := '';
    For i:=1 to Length(miben) do
    begin
        b := Copy(miben,i,1);
        If b=mit then b:=mire;
        szov := szov + b;
    end;
    Stuff := szov
end;



{
    PadL        = Egy string ballra igazit sa
    ---------------------------------------------
    mit = a forr s string;
    hossz   = az igazit si hossz;
    mivel   = kieg‚szˇt” karakterek;
}
Function PadL;
Var szo : String;
begin
    szo  := Alltrim(mit);
    If Length( szo ) < hossz then
         PadL := szo + Replicate( mivel,hossz-Length(szo) )
    else     PadL := szo;
end;

{
    PadR        = Egy string jobbra igazitása
    ---------------------------------------------
    mit = a forr s string;
    hossz   = az igazit si hossz;
    mivel   = kieg‚szˇt” karakterek;
}
Function PadR;
Var szov    : String;
    szo : String;
begin
    szov := '';
    szo  := Alltrim(mit);
    If Length( szo ) < hossz then
         PadR := Replicate( mivel,hossz-Length(szo)) + szo
    else     Padr := szo;
end;

{
    PadC        = Egy string kozepre igazit sa
    ----------------------------------------------
    mit = a forrás string;
    hossz   = az igazitási hossz;
    mivel   = kiegészítő karakterek;
}
Function PadC;
Var szov    : String;
    szo : String;
    h   : Integer;
    fel1,fel2   : integer;
begin
    szov := '';
    szo  := Alltrim(mit);
    h    := hossz - Length(szo);
    If Length( szo ) < hossz then
    begin
        fel1 := h div 2;
        fel2 := h-fel1;
        PadC := Replicate( mivel,fel1) + szo + Replicate( mivel,fel2 )
    end
    else    PadC := szo;
end;


{ Egy szov-string n. szav val t‚r vissza }
Function Szo;
Var hossz    : word;
    hanyadik : word;
    i    : word;
    ujszo    : string;
begin
if alltrim(szov)<>'' then begin
    hossz := Length(szov);
    hanyadik := 1;
    i := 0;
    ujszo := '';
    szo := '';
    Repeat
        Inc(i);
        If (szov[i] > #32) and (i<hossz+1) then
        If hanyadik<n then begin
            Inc(hanyadik);
                Repeat Inc(i);
            Until (szov[i]<#33) or (i=hossz+1);
        end
        else begin
        If i<(hossz+1) then begin
                        While (szov[i]<#33) or (i=hossz+1) do Inc(i);
            Repeat
                ujszo := ujszo + szov[i];
                Inc(i);
            Until (szov[i]<#33) or (i=hossz+1);
            szo := ujszo;
            exit;
        end;
        end;
    Until i>hossz;
end;
end;

Function F_Path(fn:string):string;
var s: string;
begin
 s:=ExtractFilePath(fn);
 Result:=Copy(s,1,Length(s)-1);
end;

Function F_Name(fn:string):string;
var s: string;
begin
 s:=ExtractFileName(fn);
 Result:=Copy(s,1,Pos('.',s)-1);
end;

Function F_Ext(fn:string):string;
begin
 Result:=Copy(ExtractFileExt(fn),2,3);
end;

Function CsakBetu(s: String): string;
var ii: integer;
    b: string;
begin
  Result := '';
//  s:=ASCIIToWIN(s);
  For ii:=1 to Length(s) do begin
      b:=Copy(s,ii,1);
      if b=#0 then exit;
      If b>#31 then Result:=Result+b;
  end;
end;

{DOS szöveget WINDOWS szöveggé konvertál}
Function ASCIIToWIN(s: string): string;
var s1: array[0..1000000] of Char;
begin
(*
  OEMToChar(PChar(s),s1);
  Result := String(s1);
*)
end;

{WINDOWS szöveget DOS szöveggé konvertál}
Function WINToASCII(s: string): string;
var s1,s2: Pchar;
begin
(*
  s1:='';s2:='';
  s1:=StrPCopy(s1,s);
  AnsiToOEM(s1,s2);
  Result:=StrPas(s2);
*)
end;

{Egy sub-string n. elüfordulásának pozíciójával tér vissza,
 ha n-nél kevesebbszer fordul elő vagy egyáltalán nem, akkor =0}
function CountPos ( miben,mit : string; n:integer ):integer;
var p,i: integer;
begin
     p:=0; Result:=0;
  If n>0 then begin
     for i:=1 to n do begin
         p := Pos(mit,miben);
         If (p=0) then break;
         Result:=Result+p;
         miben:=Copy(miben,p+Length(mit),Length(miben));
     end;
     If (n>i) or (p=0) then Result:=0
     else Result := Result + (i-1) * (Length(mit)-1);
  end;
end;

Function GetComponentsTypes:TStringList;
var DiFile: TiniFile;
    sts: TStringList;
    i,j,n: integer;
    s,t: string;
begin
  sts := TStringList.Create;
  DiFile:= TiniFile.Create('DELPHI.INI');
  DiFile.ReadSection('COMPLIB.DCL.Palette',sts);
  Result:=TStringList.Create;
  Result.Sorted:=True;
  For i:=0 to sts.Count-1 do begin
      s:=DiFile.ReadString('COMPLIB.DCL.Palette',sts.Strings[i],'');
      If s<>'' then begin
         n:=StrCount(s,';');
         For j:=1 to n+1 do begin
            t:=StrCountD(s,';',j);
            If t<>'' then Result.Add(t);
         end;
      end;
  end;
  DiFile.Free;
  sts.Free;
end;

Function GetComponentsPages:TStringList;
var DiFile: TiniFile;
begin
  Result:=TStringList.Create;
  DiFile:= TiniFile.Create('DELPHI.INI');
  DiFile.ReadSection('COMPLIB.DCL.Palette',Result);
  DiFile.Free;
end;

{ GetSectionNemes(inifilenév)
  Kigyüjti egy stringlistbe a section-k neveit}
function GetSectionNemes(iFile: TInifile):TStringList;
var T:TEXTFILE;
    sor:string;
begin
  Result:=nil;
  If ifile<>nil then begin
     Result:=TStringList.Create;
     Try
     AssignFile(T,iFile.FileName);
     Reset(T);
     While not EOF(T) do begin
       ReadLn(T,sor); sor:=AllTrim(sor);
       If (Pos('[',sor)=1) and (Pos(']',sor)>0) then begin
          Result.Add(Copy(sor,Pos('[',sor)+1,Pos(']',sor)-2));
       end;
     end;
     Finally
       CloseFile(T);
     end;
  end;
end;

function GetSectionValues(iFile: TInifile;Section:string):TStringList;
var sts: TStringList;
    i: integer;
    s: string;
begin
  Result:=TStringList.Create;
  sts := TStringList.Create;
  iFile.ReadSection(Section,sts);
  For i:=0 to sts.Count-1 do begin
      s:=iFile.ReadString(Section,sts.Strings[i],'');
      If s<>'' then begin
         Result.Add(s);
      end;
  end;
  sts.Free;
end;

Function IsNum(s:string):boolean;
var i:integer;
begin
  Result := True;
  For i:=1 to Length(s) do
      If not (s[i] in ['0'..'9']) then begin
         Result := False;
         Break;
      end;
end;

FUNCTION SzamBetuvel( sz: longint ):string;
Var szsz,i  : longint;
    elojel  : string;
Const ns : Array[0..4] of string[9] = ('','ezer ','millió ','milliárd ','billió ');

      (*1000 alatti számok betüvé konvertálása*)
      FUNCTION szaztizenegy( sz : Longint ):string;
      var NumStr: string;
      Const nk : Array[1..2,0..9] of string[10] =
            (('nulla','egy','kettő','három','négy','öt','hat','hét','nyolc','kilenc'),
            ('','tizen','huszon','harminc','negyven','ötven','hatvan','hetven',
         'nyolcvan','kilencven'));
            nr : Array[1..3] of string[4] = ('tiz','száz','ezer');
      begin
        NumStr := ZeroNum(sz,3);
        If sz>0 then result:='' else Result:='nulla';
        IF sz > 99 then
       Result := Result+nk[1][ StrToInt( Copy( NumStr,1,1 ))] +'száz';
        sz := sz MOD 100;
        IF (sz > 9) and (sz <> 10) and (sz <> 20) then
       Result := Result + nk[2][ StrToInt( Copy( NumStr,2,1 ))];
        IF (sz MOD 10)>0 then
       Result := Result + nk[1][ StrToInt( Copy( NumStr,3,1 ))];
        IF sz=10 then Result := Result+'tíz';
        IF sz=20 then Result := Result+'húsz';
      end;

begin
        Result := '';
        i:=0;
        If sz=0 then Result:='nulla';
        If sz<0 then elojel:='- ' else elojel:='';
        While sz<>0 do begin
           szsz := Abs(sz) mod 1000;
           sz   := sz div 1000;
           If szsz<>0 then Result := szaztizenegy(szsz)+ns[i]+Result;
           Inc(i);
        end;
        Result := Stuff(Alltrim(Result),' ','-');
        Result := elojel+Result;
end;

// A személyneveket átalakítja az alábbi formákba:
// mod=0 - végig nagybetűs;
// mod=1 - Csak a nevek első betűi nagybetűsek, a többi kisbetűs
function UpperFirstName(name: string; mode: integer): string;
var s,sz: string;
    i   : integer;
    elsobetu: boolean;
Const kis : string = 'áéíóöőúüű';
      nagy: string = 'ÁÉÍÓÖŐÚÜŰ';
begin
sz := LTrim(name);
Result := sz;
if sz <> '' then begin
Try
   i:=1;
      Result := '';
      elsobetu:= True;
      Case mode of
      0: BEGIN
           Result := UpperCase(sz);
         END;
      1:
         while szo(sz,i)<>'' do begin
                s := szo(sz,i);
                Result := Result + UpperFirst(LowerCase(s))+' ';
                Inc(i);
         end;
      2: Result := UpperFirst(LowerCase(sz));
      end;
finally
  Result := LTrim(Result);
  for i:=1 to Length(Result) do begin
      s:=Result[i];
      if mode=0 then begin
         if (Pos(s,kis)>0) then
            Result[i] := nagy[Pos(s,kis)];
      end;
      if mode=1 then begin
         If (elsobetu) and (Pos(s,kis)>0) then begin
            Result[i] := nagy[Pos(s,kis)];
            elsobetu := False;
         end;
         If (not elsobetu) and (Pos(s,nagy)>0) then begin
            Result[i] := kis[Pos(s,nagy)];
            elsobetu := False;
         end;
         elsobetu := (s=' ');
      end;
      if mode=2 then begin
         If (elsobetu) and (Pos(s,kis)>0) then
            Result[i] := nagy[Pos(s,kis)];
         if (not elsobetu) and (Pos(s,nagy)>0) then
            Result[i] := kis[Pos(s,nagy)];
         elsobetu := False;
      end;
  end;
end;
end;
end;

function HunUpper(ch: Char): Char;
begin
  Result := Upper(Ch)[1];
end;

function HunLower(ch: Char): Char;
begin
  Result := Lower(Ch)[1];
end;

BEGIN
end.