Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/nastroje/RTF2HTML.ZIP/MDFUNCS.PAS

Pascal/Delphi Source File | 1998-06-25 | 5.6 KB | 200 lines

unit Mdfuncs;

interface

uses
  Classes, StdCtrls;

function Uml_In(const Word: String): boolean;
function ReplaceIn(SearchFor, ReplaceStr, Str : String) : String;
function WcReplaceIn(SearchFor, ReplaceStr, Str : String; wcrange: integer) : String;
function ReplaceAll(const SearchFor: array of String; const ReplaceStr: array of String; Str: String) : String;
procedure ReplaceAllStringlist(const SearchFor: array of String; const ReplaceStr: array of String; Text: TStringlist);
procedure StringToWords(const str: String; Words: TStringlist);
procedure MemoToWords(const Memo: TMemo; Words: TStringlist);

implementation

function Uml_In(const Word: String): boolean;
{ untersucht einen String auf vorkommende Umlaute und retourniert das entsprechende Boolean }
begin
    if (Pos('─',Word) <> 0)
    or (Pos('Σ',Word) <> 0)
    or (Pos('╓',Word) <> 0)
    or (Pos('÷',Word) <> 0)
    or (Pos('▄',Word) <> 0)
    or (Pos('ⁿ',Word) <> 0)
    then
        Result := true
    else
        Result := false;
end;

function wcStr(wcSearchStr: string; str: string; wcrange: integer) : string;
{ sucht einen Suchstring mit wildcard in einem anderen String und liefert den tatsΣchlichen Suchstring       }
{ (ohne wildcard) zurⁿck, wenn der an Stelle der wildcard hinzugefⁿgte String nicht lΣnger als wcrange ist   }
var
    i, j, wcpos, wcstrlen : integer;
    st, st2 : string;

begin
    st := str;
    wcpos := Pos('*',wcSearchStr);
    if (wcpos > 1) and (wcpos < length(wcSearchStr)) then    { wildcards nur innerhalb des Wortes }
    begin
        i := Pos(Copy(wcSearchStr, 1, wcpos-1), st);
        st2 := Copy(st, i+wcpos-1, length(st)-i-wcpos+2);
        j := Pos(Copy(wcSearchStr, wcpos+1, length(wcSearchStr)-wcpos), st2);

        wcstrlen := length(wcSearchStr)+j-2;
        if (j > 0) and (i > 0) and (wcstrlen <= length(wcSearchStr)+wcrange-1) then
            Result := Copy(St, i, wcstrlen)
        else
            Result := '';
    end
    else
        Result := '';
end;

function ReplaceIn(SearchFor, ReplaceStr, Str : String) : String;
{ ersetzt alle Vorkommen EINES Teilstrings in einem String }
var
  Dummy : String;
  i : integer;
  st : String;
begin
  st := Str;
  i := Pos(SearchFor, St);
  Dummy := '';
    while i <> 0 do
    begin
      Dummy := Dummy + Copy(St, 0, i - 1) + ReplaceStr;
      st := copy(st, i + length(SearchFor), length(st)+1);
      i := Pos(SearchFor, St);
    end;
  Result := Dummy + st;
end;


function WcReplaceIn(SearchFor, ReplaceStr, Str : String; wcrange: integer) : String;
{ ersetzt alle Vorkommen EINES Teilstrings in einem String }
var
  Dummy : String;
  i : integer;
  St, St2 : String;
  wildcard : boolean;

begin
  st := Str;
  wildcard := false;

  if Pos('*',SearchFor) > 0 then
  begin
      wildcard := true;
      St2 := wcstr(SearchFor, Str, wcrange);
      if St2 <> '' then
          i := Pos(St2, St)
      else
          i := 0;
  end
  else
      i := Pos(SearchFor, St);

  Dummy := '';
  while i <> 0 do
  begin
      Dummy := Dummy + Copy(St, 0, i - 1) + ReplaceStr;

      if wildcard then
      begin
          st := copy(St, i + length(St2), length(st)+1);
          St2 := wcstr(SearchFor, Str, wcrange);
          if St2 <> '' then
              i := Pos(St2, St)
          else
              i := 0;
      end
      else
      begin
          St := copy(St, i + length(SearchFor), length(st)+1);
          i := Pos(SearchFor, St);
      end;
  end;
  Result := Dummy + st;
end;


function ReplaceAll(const SearchFor: array of String; const ReplaceStr: array of String; Str: String) : String;
{ ersetzt alle Vorkommen ALLER im array angegebenen Teilstrings in einem String }
var
    i, submax: integer;
    st: String;
begin
    st := Str;
    submax := High(SearchFor);
    if (submax = High(ReplaceStr)) then
        for i := 0 to submax do
            st := ReplaceIn (SearchFor[i], ReplaceStr[i], st);
    Result := st;
end;


procedure ReplaceAllStringlist(const SearchFor: array of String; const ReplaceStr: array of String; Text: TStringlist);
{ ersetzt alle Vorkommen ALLER im array angegebenen Teilstrings in einer TStringList }
var
    i, j, submax: integer;
begin
    submax := High(SearchFor);
    if (Text.Count > 0) and (submax = High(ReplaceStr)) then
    for i := 0 to (Text.Count-1) do
        for j := 0 to submax do
            Text[i] := ReplaceIn (SearchFor[j], ReplaceStr[j], Text[i]);
end;

procedure StringToWords(const str: String; Words: TStringlist);
{ zerlegt ein TMemo in Strings(gespeichert in TStringList), die nur Buchstaben bzw. Zahlen enthalten }
var
    i: integer;
    w: String;
begin
    i := 0;
    w := '';
    while i < length(str) do
    begin
        while (str[i] in ['0'..'9','a'..'z','A'..'Z','─','╓','▄','Σ','÷','ⁿ','▀']) do
        begin
            w := w + str[i];
            Inc(i);
        end;
        if length(w) > 0 then Words.Add(w);
        w := '';
        Inc(i);
    end;
end;

procedure MemoToWords(const Memo: TMemo; Words: TStringlist);
{ zerlegt ein TMemo in Strings(gespeichert in TStringList), die nur Buchstaben bzw. Zahlen enthalten }
var
    i, meml: integer;
    w: String;
begin
    Memo.SelectAll;
    meml := Memo.SelLength;
    i := 0;
    w := '';
    while i <= meml do
    begin
        while (Memo.Text[i] in ['0'..'9','a'..'z','A'..'Z','─','╓','▄','Σ','÷','ⁿ','▀']) do
        begin
            w := w + Memo.Text[i];
            Inc(i);
        end;
        if length(w) > 0 then Words.Add(w);
        w := '';
        Inc(i);
    end;
end;


end.