Hallo dpler,

ich stehe mal wieder vor einen Problem, undzwar moechte ich mehrere Strings auf gleiche Bloecke testen.
Die Strings die ich bekomme stehen in der form in einem memo:

markieren

Code:

aaaaaabbbbbbbb
aaaabbbbbbaaaa
aaabbbaabbbaaa

Also am Ende des tages moechte ich soetwas haben:

markieren

Code:

aaa aaabb bb bbbb
aaa abbbb bb aaaa
aaa bbbaa bb baaa

So das immer alle gleichen Bloecke mit einem leerzeichen abgegrenzt werden.

Hier habe ich mal angefangen das Ganze zu realisieren:

zusammenfalten · markieren

Delphi-Quellcode:

function MinValue: Integer;
var
  i: Integer;
begin
  result := 0;
  for i := 0 to form1.memo1.Lines.Count - 1 do
    if length(form1.memo1.Lines[i]) > result then
      result := length(form1.memo1.Lines[i]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i, y: Integer;
  jmp: Boolean;
  s: string;
  count: integer;
  aoi: array of integer;
begin
  setlength(aoi, 0);
  for y := 1 to MinValue do
  begin
    jmp := true;
    for i := 0 to memo1.Lines.Count - 1 do
      if memo1.Lines[0][y] <> memo1.Lines[i][y] then
        jmp := false;
    if jmp then
    begin
      showmessage('gleich : ' + inttostr(y));
      setlength(aoi, length(aoi) + 1);
      aoi[high(aoi)] := y;
    end;
  end;
  count := 0;
  for y := 0 to high(aoi) do
  begin
    inc(count);
    for i := 0 to memo1.Lines.Count - 1 do
    begin
      s := memo1.Lines[i];
      insert(' ', s, aoi[y] + count);
      memo1.Lines[i] := s;
    end;
  end;
end;

Nur leider bekomme ich als ergebniss soetwas:

markieren

Code:

a a a aaabbb b bbbb
a a a abbbbb b aaaa
a a a bbbaab b baaa

Was nicht ganz dem entspricht was ich haben wollte.

Waere sehr dankbar, wenn sich das mal jemand angucken koennte.

grueße win32

das ist jetzt nur schnell hingeklatscht, als kleiner Ansatz, wie ich's lösen würde. Natürlich kann man auch eine Funktion schreiben und den einzufügenden String sowie die ABstände als Array übergeben:

zusammenfalten · markieren

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  tmp: string;
begin
  for i := 0 to Memo1.Lines.Count - 1 do
  begin
    tmp := Memo1.Lines[i];
    Insert(' ', tmp, 4);
    Insert(' ', tmp, 10);
    Insert(' ', tmp, 13);
    Memo1.Lines[i] := tmp;
  end;
end;

Edit: Ach Mist, habe dich wohl falsch verstanden, ignoriere das bitte.

Ehrlich gesagt habe ich mir deins nicht sehr intensiv angesehen. Vielleicht gefällt dir ja meine Lösung. Hier sind sind die benötigten Routinen:

zusammenfalten · markieren

Delphi-Quellcode:

{ Diese Funktion prüft, ob eine "Spalte" (alle 1., 2., 3.,...
Zeichen) gleich ist und gibt in diesem Fall True zurück, sonst
False. }
function ColumnEquals(const ColIndex: Integer; const CmpChar: Char; const Strings: TStrings): Boolean;
var
  Index: Integer;
begin
  Index:=Strings.Count-1;
  Result:=Index <> -1;
  while Result and (Index > -1) do
  begin
    Result:=Strings[Index][ColIndex] = CmpChar;
    Dec(Index);
  end;
end;

{ Folgende Routine hat die selbe Funktionalität wie die
Prozedur aus der System-Unit, gibt den geänderten String
jedoch als Funktionsergebnis zurück. }
function Insert(const InsertStr, Str: String; Pos: Integer): String;
begin
  Result:=Str;
  System.Insert(InsertStr,Result,Pos);
end;

{ InsertChar fügt ein bestimmtes Zeichen Ch in jeden String
von Strings an der Position Pos ein. }
procedure InsertChar(const Strings: TStrings; const Pos: Integer; Ch: Char = ' ');
var
  Index: Integer;
begin
  for Index:= 0 to Strings.Count-1
    do Strings[Index]:=Insert(Ch,Strings[Index],Pos);
end;

{ Die eigentlich gewünschte Funktion: Das erzeugen der
"Textspalten". }
procedure DoColumns(const Strings: TStrings);
var
  ColIndex: Integer;
  ColEqual, ColEqualStage: Boolean;
begin
  if Strings.Count = 0 then Exit;
  ColEqualStage:=ColumnEquals(Length(Strings[0]),Strings[0][Length(Strings[0])],Strings);
  for ColIndex:= Length(Strings[0]) downto 0 do
  begin
    ColEqual:=ColumnEquals(ColIndex,Strings[0][ColIndex],Strings);
    { Im Folgenden wird nichts anderes gemacht als auf den
    Wechsel von Folgen von Spalten mit nur einem gleichen
    Zeichen und Folgen von Spalten mit unterschiedlichen
    Zeichen gewartet und jeweils die "Leerzeichen-Spalte"
    eingefügt. }
    if ColEqual xor ColEqualStage then
    begin
      InsertChar(Strings,ColIndex+1);
      ColEqualStage:=ColEqual;
    end;
  end;
end;

Und hier noch ein Besipeilaufruf:DoColumns(Memo1.Lines); Das Delphi-Projekt habe ich auch angehangen. Alles in allem ist darin aber nichts Neues.

Gruß,
Panthrax.

genau so habe ich mir das vorgestellt vielen vielen danke .

Hallo,

mit der folgenden Funktion berechne ich eine String-Kongruenz. Die Strings müssen gleich lang sein und dürfen das Maskierungszeichen nicht enthalten.

zusammenfalten · markieren

Delphi-Quellcode:

function CongruenceStr(s: TStrings; mask: Char): String;
var
  i, iPos: Integer;
  t: String;
begin
  if s.Count = 0 then
    Result := '' else
  begin
    Result := s[0];
    for i := 1 to Pred(s.Count) do
    begin
      t := s[i];
      for iPos := 1 to Length(Result) do
        if (Result[iPos] <> mask) and (t[iPos] <> Result[iPos]) then
          Result[iPos] := mask;
    end;
  end;
end;

Der Vorteil ist, dass jede Zeile nur einmal extrahiert wird - die Kongruenz wird zeilenweise bestimmt und nicht spaltenweise. Das Ergebnis ist ein String, der für übereinstimmende Spaltenwerte das entsprechende Zeichen aufweist oder im anderen Fall das Maskierungszeichen.

Grüße vom marabu

Um die Vorteile von Marabus Funktion nutzen zu können, einfach einbauen. Das Anpassen der Bezeichner, damit sie auch in der neuen Situation einen sinnvollen Namen, hat mehr Arbeit gemacht.

Das ist die neue Prozedur DoColumns:

zusammenfalten · markieren

Delphi-Quellcode:

{ Die eigentlich gewünschte Funktion: Das Erzeugen der
"Textspalten". }
procedure DoColumns(const Strings: TStrings; const MaskCh: Char = '#');
var
  ColIndex: Integer;
  MaskMatch, MaskMatchStage: Boolean;
  CongrStr: String;
begin
  if Strings.Count = 0 then Exit;
  CongrStr:=CongruenceStr(Strings,MaskCh);
  MaskMatchStage:=CongrStr[Length(CongrStr)] = MaskCh;
  for ColIndex:= Length(CongrStr) downto 0 do
  begin
    MaskMatch:=CongrStr[ColIndex] = MaskCh;
    { Im Folgenden wird nichts anderes gemacht als auf den
    Wechsel von Folgen von Spalten mit nur einem gleichen
    Zeichen und Folgen von Spalten mit unterschiedlichen
    Zeichen gewartet und jeweils die "Leerzeichen-Spalte"
    eingefügt. }
    if MaskMatch xor MaskMatchStage then
    begin
      InsertChar(Strings,ColIndex+1);
      MaskMatchStage:=MaskMatch;
    end;
  end;
end;

Gruß,
Panthrax.

[edit=Panthrax]Fähler korrigird[/edit]