Aus einem TMemo doppelte Strings zählen und dann löschen?

[smart]

Ich möchte aus einem TMemo doppelte Strings zählen und dann löschen.

Delphi-Quellcode:

Pos1
Pos1
Pos1
Pos9
Pos9
Pos4 
Pos4
Pos4
Pos4
Pos4

Rauskommen soll so etwas

Delphi-Quellcode:

Pos1 = 3
Pos9 = 2
Pos4 = 5

Hat Einer von Euch einen Vorschlag wie man so was machen kann?

[Luckie]

Wie würdest du es denn mit Papier und Bleistift lösen? Ich würde den Text durchgehen und eine Strichliste führen und immer aufaddieren.

Stichwörter für Delphi: pos, posex, copy, delete, ...

Zufällig hatte ich gerade so was mal selber gebraucht:

Delphi-Quellcode:

type
  TWordDelimiter = set of Char;

var
  WordDelimiter: TWordDelimiter = [#1..#64, #91..#96, #123..#127];

function CountWord(const Text, Word: string): Cardinal;
var
  cnt: Cardinal;
  i: Integer;
begin
  cnt := 0;
  i := 0;
  i := NextPos(Word, Text, i);
  while i > 0 do
  begin
    // Wort wenn Zeichen nach Zeichenkette...
    if (Text[i + length(Word)] in WordDelimiter) then
      Inc(cnt);
    i := NextPos(Word, Text, i);
  end;
  result := cnt;
end;

Nachtrag: NextPos sieht so aus:

Delphi-Quellcode:

function NextPos(SubStr: AnsiString; Str: AnsiString; LastPos: DWORD
  = 0): DWORD;
type
  StrRec = packed record
    allocSiz: Longint;
    refCnt: Longint;
    length: Longint;
  end;

const
  skew = sizeof(StrRec);

asm
  // Search-String passed?
  TEST    EAX,EAX
  JE      @@noWork

  // Sub-String passed?
  TEST    EDX,EDX
  JE      @@stringEmpty

  // Save registers affected
  PUSH    ECX
  PUSH    EBX
  PUSH    ESI
  PUSH    EDI

  // Load Sub-String pointer
  MOV     ESI,EAX
  // Load Search-String pointer
  MOV     EDI,EDX
  // Save Last Position in EBX
  MOV     EBX,ECX

  // Get Search-String Length
  MOV     ECX,[EDI-skew].StrRec.length
  // subtract Start Position
  SUB     ECX,EBX
  // Save Start Position of Search String to return
  PUSH    EDI
  // Adjust Start Position of Search String
  ADD     EDI,EBX

  // Get Sub-String Length
  MOV     EDX,[ESI-skew].StrRec.length
  // Adjust
  DEC     EDX
  // Failed if Sub-String Length was zero
  JS      @@fail
  // Pull first character of Sub-String for SCASB function
  MOV     AL,[ESI]
  // Point to second character for CMPSB function
  INC     ESI

  // Load character count to be scanned
  SUB     ECX,EDX
  // Failed if Sub-String was equal or longer than Search-String
  JLE     @@fail
@@loop:
  // Scan for first matching character
  REPNE   SCASB
  // Failed, if none are matching
  JNE     @@fail
  // Save counter
  MOV     EBX,ECX
  PUSH    ESI
  PUSH    EDI
  // load Sub-String length
  MOV     ECX,EDX
  // compare all bytes until one is not equal
  REPE    CMPSB
  // restore counter
  POP     EDI
  POP     ESI
  // all byte were equal, search is completed
  JE      @@found
  // restore counter
  MOV     ECX,EBX
  // continue search
  JMP     @@loop
@@fail:
  // saved pointer is not needed
  POP     EDX
  XOR     EAX,EAX
  JMP     @@exit
@@stringEmpty:
  // return zero - no match
  XOR     EAX,EAX
  JMP     @@noWork
@@found:
  // restore pointer to start position of Search-String
  POP     EDX
  // load position of match
  MOV     EAX,EDI
  // difference between position and start in memory is
  //   position of Sub
  SUB     EAX,EDX
@@exit:
  // restore registers
  POP     EDI
  POP     ESI
  POP     EBX
  POP     ECX
@@noWork:
end;

[Kedariodakon]

Memo inhalt ist ja nichts anderes als eine StringList...

1. Kopierst den Inhalt vom Memo in eine StringList
2. Sortierst die StringList
3. nimmst den letzten Eintrag in nen TempString, löschst diesen und setzt den Temp Count auf 1
4. nimmst den TempString und überprüfst diesen mit dem Letzten der Liste, Wenn gleich inc( count ) und löschst ihn und beginnst wieder bei 4 wenn ungleich schreibst ins memo Tempstring + ' = ' InttoStr( Count ) und beginnst mit punkt 3, wenn kein eintrag mehr da = Ende...


Bye

[bigg]

Quick & Slow, so:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var i, f: Integer;
begin
Memo1.Visible := False;

for i := Memo1.Lines.Count -1 downto 0 do
for f := Memo1.Lines.Count -1 downto 0 do
if f <> i then
if Memo1.Lines[f] = Memo1.Lines[i] then
Memo1.Lines.Delete(f);


Memo1.Visible := true;
end;

[smart]

Zitat:

Zitat von Luckie

Wie würdest du es denn mit Papier und Bleistift lösen? Ich würde den Text durchgehen und eine Strichliste führen und immer aufaddieren.

Stichwörter für Delphi: pos, posex, copy, delete, ...

Vielen Dank Luckie! Und dann noch gleich fix und fertig. Die Idee mit der Strichliste ist mir auch gekommen, dachte aber wäre zu simpel.

[Kedariodakon]

Ich hatte grad Langeweile: :zwinker:

Is vielleicht nicht das Optimum aber sie Tut ihren Zweck =)

Delphi-Quellcode:

Procedure CountMyMemoLines( Const Memo:   TMemo );
Var   SL:      TStringList;
      tS:      String;
      cS:      Integer;
      i:      Integer;
      act:   Boolean;
Begin
   SL         := TStringList.Create;
   SL.Text   := Memo.Lines.Text;
   Memo.Clear;
   SL.Sort;
   act         := False;
   If SL.Count   > 0 Then Begin
      While SL.Count > 0   Do Begin
         If act   Then Begin
            If SL[ SL.Count - 1 ] = tS   Then Begin
               Inc( cS );
               SL.Delete( SL.Count - 1 );
            End   Else Begin
               Memo.Lines.Append( tS + ' = ' + IntToStr( cS ) );
               act   := False;
            End;
         End Else Begin
            act   := True;
            tS   := SL[ SL.Count - 1 ];
            cS   := 1;
            SL.Delete( SL.Count - 1 );
         End;
      End;
      Memo.Lines.Append( tS + ' = ' + IntToStr( cS ) );
   End;
   FreeAndNil( SL );
End;

Bye

[smart]

Zitat:

Zitat von Kedariodakon

Ich hatte grad Langeweile: :zwinker:

Is vielleicht nicht das Optimum aber sie Tut ihren Zweck =)

Klappt gut, vielen Dank.

[Jasocul]

Die Sache mit der StringList ist noch viel einfacher.
Sorted auf True setzen, dazu die Eigenschaft Duplicate setzen und fertig.
EDIT:
Mist, gerade gesehen, dass du auch die Anzahl brauchst.