Zeichen in Memo finden

[horst]

Hallo
Hiermit kann ich das erste Zeichen durch andere ersetzen.
Memo1.Text := StringReplace(memo1.Text, ';', ';;', []); Wie kann ich das dritte vorkommende ; in einem Memo ersetzen?

Grüße
Horst

[SirThornberry]

indem du mit pos/posex das dritte vorkommen findest. Dazu ist es jedoch empfehlendwert den memotext auf eine Zwischenvariable zu zuweisen da sonst für jedes pos der Memostring neuer erzeugt/zusammengesetzt werden muss.

[horst]

Hallo....
Danke.
Ich habe auf deinen Tip hin nach Beispielen gesucht und folgendes gefunden:

Delphi-Quellcode:

procedure TForm1.Button5Click(Sender: TObject);
const
  Search_Text = ';';

var
  i: Integer;
  Position: Integer;
  S: String;

begin
  Position  := 1;
  S         := Memo1.Text;

  for i := 1 to length(S) do
    begin
      Position := PosEx(Search_Text, S, Position);
      Delete(S, Position, length(Search_Text));
    end;

  Memo1.Text := S;
end;

Aber so richtig verstanden hab ich das nicht.
Hast du ein Beispiel für mich?

[horst]

hat sich erledigt, habs rausgefunden.
Danke nochmal für deine Antwort

[horst]

Also doch nicht, habs immer noch nicht raus.
Hat jemand ein praktisches Beispiel für mich, wäre echt wahnsinnig gut.

Grüße
Horst

[SirThornberry]

praktich würde das ganze so aussehen (mit Verwendung von PosEx):

Delphi-Quellcode:

function GetPosNumX(const ASubStr, AFullStr: String; AFoundCnt: Word): Integer;
var LFoundCnt : Word;
    LStartPos : Integer;
begin
  if AFoundCnt = 0 then
    result := 0
  else begin
    LStartPos := 1;
    LStartPos := PosEx(ASubStr, AFullStr, LStartPos);
    if (LStartPos > 0) then
    begin
      LFoundCnt := 1;
      while (LFoundCnt < AFoundCnt) and (LStartPos > 0) do
      begin
        LStartPos := PosEx(ASubStr, AFullStr, LStartPos + 1);
        inc(LFoundCnt);
      end;
      result := LStartPos;
    end else
      result := 0;
  end;
end;

für ältere Versionen wo posex noch nicht verfügbar ist würde das so aussehen:

Delphi-Quellcode:

function GetPosNumX(const ASubStr, AFullStr: String; AFoundCnt: Word): Integer;
var LFoundCnt : Word;
    LGiveback : Integer;
    LMax,
    LPos,
    LSubLen   : Integer;
    LPtr1,
    LPtr2     : Pointer;
begin
  LGiveback := 0;
  LFoundCnt := 0;
  LSubLen   := Length(ASubStr);
  LMax      := Length(AFullStr) - LSubLen + 1;
  LPtr1 := PChar(AFullStr);
  LPtr2 := PChar(ASubStr);
  for LPos := 1 to LMax do
  begin
    if CompareMem(LPtr1, LPtr2, LSubLen) then
    begin
      inc(LFoundCnt);
      if LFoundCnt = AFoundCnt then
      begin
        LGiveback := LPos;
        Break;
      end;
    end;
    inc(Cardinal(LPtr1));
  end;
  result := LGiveback;
end;

Diese Variante würde ich bevorzugen selbst wenn PosEx verfügbar ist da bei dieser Variante die Funktionsaufrufe (von PosEx) weg fallen und das ganze schneller sein müsste.
[Edit]Durch tests musste ich feststellen das die funktion mit PosEx schneller ist[/Edit]

[SirThornberry]

Nach ein bischen suchen hab ich heraus gefunden woran es lag. Und zwar daran das ich die Funktion CompareMem aufgerufen hab. Wie im vorhergehenden post bereits geschrieben hatte ich vermutet das meine Funktion schneller ist weil die Funktionsaufrufe von PosEx weg fallen. Durch den Aufruf von CompareMem hab ich aber eben Funktionsaufrufe eingebaut. Nachdem jetzt diese Funktionsaufrufe auch noch weg sind (quelltext direkt eingebaut) ist das ganze fast doppelt so schnell wie die PosEx-Variante (zuvor war die PosEx-Variante ca. doppelt so schnell).

Und hier jetzt das optimierte Prachtstück:

Delphi-Quellcode:

function GetPosNumX(const ASubStr, AFullStr: String; AFoundCnt: Word): Integer;
var LFoundCnt : Word;
    LGiveback : Integer;
    LCompCnt,
    LMax,
    LPos,
    LSubLen   : Integer;
    LPtr1,
    LPtr2     : PChar;
begin
  LGiveback := 0;
  LFoundCnt := 0;
  LSubLen   := Length(ASubStr);
  LMax      := Length(AFullStr) - LSubLen + 2;
  LPtr1 := PChar(AFullStr);
  LPtr2 := PChar(ASubStr);
  for LPos := 0 to LMax do
  begin
    LCompCnt := 0;
    while (LCompCnt < LSubLen) and (LPtr1[LCompCnt] = LPtr2[LCompCnt]) do
     inc(LCompCnt);
    if LCompCnt = LSubLen then
    begin
      inc(LFoundCnt);
      if LFoundCnt = AFoundCnt then
      begin
        LGiveback := LPos + 1;
        Break;
      end;
    end;
    inc(Cardinal(LPtr1));
  end;
  result := LGiveback;
end;

Anzumerken ist natürlich das diese Funktion nur das Xte Vorkommen sucht. Das ersetzen musst du dann natürlich selbst noch übernehmen. Aber das sollte nicht all zu schwer sein. Einfach mit copy den Teil bis zur Fundstelle + den neuen String + (mit copy) den Teil hinter der Fundstelle und schon ist's fertig.

Ergänzung:
Ich hab die Funktion jetzt nochmal erweitert so das man angeben kann ab welcher Position das Xte Vorkommen gesucht werden soll. Es ist jetzt also gleich zu setzen mit PosEx mit dem Zusatzfeature das man sagen kann das wievielte Vorkommen man haben will (wenn man in der Praxis wohl auch nur eines von beiden braucht - entweder angabe der Startsuchposition oder die Angabe das wievielte Vorkommen man sucht).

Delphi-Quellcode:

function GetPosNumX(const ASubStr, AFullStr: String; AFoundCnt: Word; AStartPos: Integer=1): Integer;
var LFoundCnt : Word;
    LCompCnt,
    LFullLen,
    LGiveback,
    LMax,
    LPos,
    LSubLen   : Integer;
    LPtr1,
    LPtr2     : PChar;
begin
  LFullLen  := Length(AFullStr);
  LSubLen   := Length(ASubStr);
  if (AStartPos < LFullLen - LSubLen + 2) then
  begin
    //An dieser Stelle incrementieren da wir sonst an 2 anderen Stelle incrementieren müssten
    dec(AStartPos);
    LGiveback := 0;
    LFoundCnt := 0;
    LMax      := LFullLen - LSubLen + 2;
    LPtr1 := PChar(AFullStr) + AStartPos;
    LPtr2 := PChar(ASubStr);
    for LPos := AStartPos to LMax do
    begin
      LCompCnt := 0;
      while (LCompCnt < LSubLen) and (LPtr1[LCompCnt] = LPtr2[LCompCnt]) do
       inc(LCompCnt);
      if LCompCnt = LSubLen then
      begin
        inc(LFoundCnt);
        if LFoundCnt = AFoundCnt then
        begin
          LGiveback := LPos + 1;
          Break;
        end;
      end;
      inc(Cardinal(LPtr1));
    end;
    result := LGiveback;
  end else
    result := 0;
end;

[horst]

Wow...vielen Dank.
Das hätte ich so schnell nicht hinbekommen.
Danke.