Optælling af ord i Memo

The-Freak:
Jeg prøvde å telle ordene i denne teksten. 7 ord?

Kode 

This
    is a
 test

Her er en annen simpel funksjon som også kan utvides. Jeg håper du kan bruke den

Kode 

function CountWords(S: String): Integer;
var
  I: Integer;
  IsWord: Boolean;
begin
  IsWord := False;

  if S <> '' then
    Result := 1
  else
    Result := 0;

  for I := 1 to Length(S) do
  begin
    if IsWord and
      (S[I] <> ' ') and
      (S[I] <> #13) and
      (S[I] <> #10) then
      Inc(Result);

    IsWord := (S[I] = ' ') or
              (S[I] = #13) or
              (S[I] = #10);
  end;
end;

-------------------------------------
I am AGAINST TCPA!!
[ http://www.againsttcpa.com/ ]
-------------------------------------
Mvh
DiZpel

Kode 

function CountWords(Text: String): Integer;
type
  TExplodedString = array of String;
  function Explode(Text: String; Seperator: String; DiscardNoneText: Boolean = False): TExplodedString;
  var
    I: Integer;
    Tmp: String;
  begin
    if (Length(Text) or Length(Seperator)) = 0 then Exit;
    if Length(Seperator) = 1 then begin
      if Copy(Text, Length(Text)-Length(Seperator), Length(Seperator)) <> Seperator then
           Text := Text + Seperator + Seperator;
    end else begin
      if Copy(Text, Length(Text)-Length(Seperator), Length(Seperator)) <> Seperator then
           Text := Text + Seperator;
    end;
    I := 1;
    while I < Length(Text) do begin
      if Copy(Text, I, Length(Seperator)) = Seperator then begin
        if DiscardNoneText then begin
          if Tmp <> '' then begin
            SetLength(Result, High(Result)+2);
            Result[High(Result)] := Tmp;
            Tmp := '';
            Inc(I, Length(Seperator));
          end;
          Inc(I);
        end else begin
          SetLength(Result, High(Result)+2);
          Result[High(Result)] := Tmp;
          Tmp := '';
          Inc(I, Length(Seperator));
        end;
      end else begin
        Tmp := Tmp + Text[I];
        Inc(I);
      end;
    end;
  end;
var
  Tmp: TExplodedString;
begin
  Tmp := Explode(Text, ' ', True);
  Result := Length(Tmp);
end;

Kode 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Memo1: TMemo;
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses StrUtils;

{$R *.dfm}

procedure ExtractWords(S: String; Output: TStrings);
var
  I: Integer;
  sTemp: String;
  IsWord: Boolean;
begin
  IsWord := False;
  Output.Clear;

  for I := 1 to Length(S) do
  begin
    if IsWord and
      (S[I] = ' ') or
      (S[I] = #13) or
      (S[I] = #10) then
    begin
      sTemp := Trim(sTemp);
      if sTemp <> '' then
      begin
        Output.Add(sTemp);
        sTemp := '';
      end;
    end
    else
      sTemp := sTemp + S[I];

    IsWord := (S[I] <> ' ') and
              (S[I] <> #13) and
              (S[I] <> #10);
  end;

  sTemp := Trim(sTemp);
  if sTemp <> '' then
    Output.Add(sTemp);
end;

function CountWords(S: String): Integer;
var
  I: Integer;
  IsWord: Boolean;
begin
  IsWord := False;

  if S <> '' then
    Result := 1
  else
    Result := 0;

  for I := 1 to Length(S) do
  begin
    if IsWord and
      (S[I] <> ' ') and
      (S[I] <> #13) and
      (S[I] <> #10) then
      Inc(Result);

    IsWord := (S[I] = ' ') or
              (S[I] = #13) or
              (S[I] = #10);
  end;
end;

procedure RemoveDuplicateWords(S: String; Output: TStrings; CaseSensitive: Boolean);
var
  iCount,
  iCount2: Integer;
  slExtractedWords,
  slWordsLeft: TStringList;
  IsDupeWord: Boolean;
begin
  slExtractedWords := TStringList.Create;
  slWordsLeft := TStringList.Create;
  Output.Clear;

  ExtractWords(S, slExtractedWords);
  for iCount := 0 to slExtractedWords.Count - 1 do
  begin
    IsDupeWord := False;
    if slWordsLeft.Count > 0 then
      for iCount2 := 0 to slWordsLeft.Count - 1 do
      begin
        if CaseSensitive then
          IsDupeWord := slWordsLeft.Strings[iCount2] = slExtractedWords.Strings[iCount]
        else
          IsDupeWord := LowerCase(slWordsLeft.Strings[iCount2]) = LowerCase(slExtractedWords.Strings[iCount]);

          if IsDupeWord then
            Break;
      end
    else
      IsDupeWord := False;

    if not IsDupeWord then
      slWordsLeft.Add(slExtractedWords.Strings[iCount]);
  end;
  Output.AddStrings(slWordsLeft);

  slWordsLeft.Free;
  slExtractedWords.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  iWords: Integer;
begin
  iWords := CountWords(Memo1.Text);
  ShowMessage(Format('%d word(s)!', [iWords]));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  RemoveDuplicateWords(Memo1.Text, ListBox1.Items, CheckBox1.Checked);
end;

end.

Hej alle,

Det er efterhånden længe siden jeg har været herinde, og samtidig længe siden jeg har rodet med Delphi. Nu har jeg så et lille projekt i engelsk, og skal til dette bruge et lille program, men har vist efterhånden glemt hvordan det fungerer

Hvis vi siger jeg har en Memo komponent på min form, og en ListBox.

Nu vil jeg gerne scanne min Memo's indhold igennem for alle de ord som står skrevet mere end én gang, og de ord som nu engang gør det, skal skrives ind i ListBox'en.

Hvordan dælen gøres dette?

Håber en eller anden vil hjælpe mig lidt på rette vej, da dette gerne skal være klart inden en uges tid

På forhånd tak!

saBA-no-densetsu
"The fate of Destruction, is also the Joy of Rebirth"

Kode 

function CountWords(Text: String): Integer;
type
  TExplodedString = array of String;
  function Explode(Text: String; Seperator: String): TExplodedString;
  var
    I: Integer;
    Tmp: String;
  begin
    if (Length(Text) or Length(Seperator)) = 0 then Exit;
    if Length(Seperator) = 1 then begin
      if Copy(Text, Length(Text)-Length(Seperator), Length(Seperator)) <> Seperator then
           Text := Text + Seperator + Seperator;
    end else begin
      if Copy(Text, Length(Text)-Length(Seperator), Length(Seperator)) <> Seperator then
           Text := Text + Seperator;
    end;
    I := 1;
    while I < Length(Text) do begin
      if Copy(Text, I, Length(Seperator)) = Seperator then begin
        SetLength(Result, High(Result)+2);
        Result[High(Result)] := Tmp;
        Tmp := '';
        Inc(I, Length(Seperator));
      end else begin
        Tmp := Tmp + Text[I];
        Inc(I);
      end;
    end;
  end;
var
  Tmp: TExplodedString;
begin
  Tmp := Explode(Text, ' ');
  Result := Length(Tmp);
end;

Kode 

This
    is a
 test

Kode 

function CountWords(S: String): Integer;
var
  I: Integer;
  IsWord: Boolean;
begin
  IsWord := False;

  if S <> '' then
    Result := 1
  else
    Result := 0;

  for I := 1 to Length(S) do
  begin
    if IsWord and
      (S[I] <> ' ') and
      (S[I] <> #13) and
      (S[I] <> #10) then
      Inc(Result);

    IsWord := (S[I] = ' ') or
              (S[I] = #13) or
              (S[I] = #10);
  end;
end;

The-Freak:
Jeg prøvde å sammenligne hurtigheten på min og din funksjon =)
Jeg kjørte "I := CountWords(<artikkelen http://udvikleren.dk/article.php?aid=167&techid=2 >;" 10000 ganger i en for-loop, og her er resultatet:
Min: ~4750ms
Din: ~278906ms (~5min)

Mvh
DiZpel

[Redigeret d. 02/11-04 22:57:14 af DiZpel]