Leerzeichen in String einfügen

[majornudelholz]

Hallo,

ich brauche unbedingt Hilfe, im Internet habe ich sonst nichts gescheites gefunden...
Derzeit versuche ich vergeblich Unterstriche in ein String einzufügen, natürlich in bestimmter Reihenfolge!
Aber erst einmal zur Problemstellung:
Nach Eingabe einer Zeichenkette von max. 128 Zeichen soll nach Betätigung des Buttons alle 4 Zeichen ein Unterstrich eingefügt werden!

Meine bisherige Lösung sieht wie folgt aus:

Code:

procedure TForm1.unterstrich(text:string);
var i:integer; var textn:string;
begin
  textn:=text;
   for i:=1 to length(textn) do
      begin
         if ((i mod 3) = 0) then
        begin
          insert('_', textn, i);
        end;
      end;
  label2.caption:=textn;
end;

Wie ihr sicher unschwer erkennen könnt habe ich das Hauptproblem, dass er durch das einfügen der Unterstriche die Zeichenkette verschiebt & die Zählschleife nicht mehr bis an die letzten Zeichen 'heranreicht'... Hatte überlegt, ob das evtl. iterativ lösbar ist. Habe nur keine Idee wie..

Wäre für jegliche Hilfe hierbei dankbar!

[blawen]

Wie wäre es mit einer Repeat...Until Schleife?

[majornudelholz]

Zitat von blawen:

Wie wäre es mit einer Repeat...Until Schleife?

Hatte ich auch schon versucht. Nur habe ich wie gesagt leider keine weiteren Ideen.

[Luckie]

Zitat von majornudelholz:

Zitat von blawen:

Wie wäre es mit einer Repeat...Until Schleife?

Hatte ich auch schon versucht.

Und was war das Ergebnis?

[majornudelholz]

Zitat von Luckie:

Zitat von majornudelholz:

Zitat von blawen:

Wie wäre es mit einer Repeat...Until Schleife?

Hatte ich auch schon versucht.

Und was war das Ergebnis?

Naja, hatte damals keins, weil ich nicht wusste, wie... Habe nun aber eine Idee bzw. es klappt auch schon!
Trotzdem danke für die Mühen! ... und die schnellen Antworten!

Code:

procedure TForm1.leerzeichen(text:string);
var i:integer;
begin
  for i:=1 to 192 do 
         if ((i mod 3) = 0) then begin
        //delete(text, i, 1);
        insert(' ', text, i);
        end;
  trimright(text);
  label2.caption:=text;
end;

... so hat's jetzt geklappt!

[Mavarik]

Zitat von majornudelholz:

Code:

procedure TForm1.leerzeichen(text:string);
var i:integer;
begin
  for i:=1 to 192 do 
         if ((i mod 3) = 0) then begin
        //delete(text, i, 1);
        insert(' ', text, i);
        end;
  trimright(text);
  label2.caption:=text;
end;

... so hat's jetzt geklappt!

Wie wäre es mit

Delphi-Quellcode:

procedure TForm1.leerzeichen(Const Text:string);
var
  _Result : String;
  PSource,PDest,PEnd : PChar;
  Count : Integer;
begin
  Setlength(_Result,length(Text)+Length(Text) div 4);
  PSource := @Text[Low(Text)];
  PDest   := @_Result[Low(_Result)];
  PEnd    := @Text[High(Text)];
  Count   := 0;

  while PSource <= PEnd do
    begin
      PDest^ := PSource^;
      inc(PDest);
      inc(PSource);
      inc(Count);
      if Count = 4 then
        begin
          Count := 0;
          PDest^ := ' ';
          inc(PDest);
        end;
    end;
  label2.caption:=_Result;
end;

"Bisschen" schneller...

[Dejan Vu]

Bei 192 Zeichen dürften das 'schneller' weit jenseits der Messbarkeit sein.

Delphi-Quellcode:

var
  i : Integer;
  
begin
  i := 4; // Erste Einfügeposition hinter der 4 Stelle.
  while i < Length(Text) do begin
    insert (Text, i,'_');
    inc(i,5); // weil man ja nun 5 Zeichen weiter rutschen muss
  end;
End;

Getippt und nicht getestet. Sollte aber so oder ähnlich gehen.

Übrigens: Bisschen kleiner, leichter zu verstehen, geradliniger.

[HolgerX]

Hmm..

Oder mach es doch einfach mit einer rückwärts laufenden Schleife

Delphi-Quellcode:

function InsertUnderLine(AText : string; aPos : byte):string;
var
  i : integer;
begin
  result := AText;
  for i := length(AText)-1 downto 1 do begin
    if ((i mod aPos) = 0) then
      insert('_',result,i+1);
  end;
end;

Mit 'for' kann man nicht nur 'hochzählen' sondern auch 'runterzählen'

[Sir Rufo]

Oder mit ganz wenigen String-Kopierorgien und einem wahlfreien String den man dort einschieben kann:

Delphi-Quellcode:

function StrInsertEveryNthPos( const AStr, AInsertStr: string; APos: integer ): string;
var
  OffSet                        : integer;
  ResLen, ResIdx, StrIdx, InsIdx: integer;
begin
  // OffSet for ZEROBASED STRINGS
  OffSet := 1 - low( string );

  // Calculate result length

  ResLen := ( Length( AStr ) div APos );
  if Length( AStr ) mod APos = 0
  then
    Dec( ResLen );
  ResLen := Length( AInsertStr ) * ResLen;
  ResLen := ResLen + Length( AStr );

  SetLength( Result, ResLen );

  // Build result

  ResIdx := 1;

  for StrIdx := 1 to Length( AStr ) do
    begin
      Result[ ResIdx - OffSet ] := AStr[ StrIdx - OffSet ];
      Inc( ResIdx );

      // Insert the AInsertStr

      if ( StrIdx mod APos = 0 ) and ( StrIdx < Length( AStr ) )
      then
        for InsIdx := 1 to Length( AInsertStr ) do
          begin
            Result[ ResIdx - OffSet ] := AInsertStr[ InsIdx - OffSet ];
            Inc( ResIdx );
          end;
    end;
end;

[EgonHugeist]

Da es sich explizit um Quad Folgen handelt..

@Maverik ungetestet aus dem Handgelenk geschüttelt:
edit:
Hab's nun doch getestet und da hat noch das mod gefehlt, sonst hängt man auch noch '_' and den letzten quad an

Code:

function leerzeichen(Const Text: String): String;
type PMyQuadMover = {$IFDEF UNICODE}PUInt64{$ELSE}PLongWord{$ENDIF};
var
  Src, Dest, PEnd: PChar;
begin
  if Text = '' then
    Result :=''
  else begin
    SetLength(Result,length(Text)+(Length(Text) div 4)-Ord(Length(Text) mod 4 = 0));
    PEnd := PChar(@Text[Length(Text)])-4;
    Dest := Pointer(Result);
    Src := Pointer(Text);
    while (Src <= PEnd) do begin//making a quad processing loop
      PMyQuadMover(Dest)^ := PMyQuadMover(Src)^;
      (Dest+4)^ := '_';
      Inc(Dest, 5);
      Inc(Src, 4);
    end;
    Inc(PEnd, 4);
    while Src < PEnd do //processing final chars
    begin
      Dest^ := Src^;
      Inc(Src);
      Inc(Dest);
    end;
    Dest^ := Src^; //null term save
  end;
end;

Das wäre schnell.. man könnte die Loops auch nach auf octets erhöhen, auf RefCount und Length vorher testen usw ..