AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Wörter zählen

Ein Thema von Lisa.99 · begonnen am 27. Feb 2017 · letzter Beitrag vom 6. Mär 2017
 
t.roller
(Gast)

n/a Beiträge
 
#11

AW: Wörter zählen

  Alt 2. Mär 2017, 13:17
Das Beispiel TOKENCOUNT (648 Wörter) von awk und das Beispiel von hier
http://www.swissdelphicenter.com/de/showcode.php?id=806
(680 Wörter)
sind unterschiedlich zu MS WORD (660 Wörter).
Textprobe im Anhang.

Delphi-Quellcode:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtDlgs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    OpenTextFileDialog1: TOpenTextFileDialog;
    Button2: TButton;
    Label1: TLabel;
    Button3: TButton;
    SaveTextFileDialog1: TSaveTextFileDialog;
    Button4: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function Seps(As_Arg: ANSIChar): Boolean;
begin
  Seps := As_Arg in
    [#0..#$1F, ' ', '.', ',', '?', ':', ';', '(', ')', '/', '\', '-'];
end;

function WordCount(CText: ANSIstring): Longint;
var
  Ix: Word;
  Work_Count: Longint;
begin
  Work_Count := 0;
  Ix := 1;
  while Ix <= Length(CText) do
  begin
    while (Ix <= Length(CText)) and (Seps(CText[Ix])) do
      Inc(Ix);
    if Ix <= Length(CText) then
    begin
      Inc(Work_Count);

      while (Ix <= Length(CText)) and (not Seps(CText[Ix])) do
        Inc(Ix);
    end;
  end;
  WordCount := Work_Count;
end;
//------------------------------------------------------------------------------
function TokenCount(const cText: String): integer;
    var s: string;
        nPos: integer;
    begin
     result:=0;

     s:=trimright(cText);

     nPos:=Pos(#32,s);

     if (nPos=0) and (length(s)>0) then inc(result);

     while nPos>0 do
     begin
      inc(Result);
      System.Delete(s,1,nPos);
      s:=trimleft(trimright(s));

      nPos:=Pos(#32,s);
     end;

    end;

//------------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
if OpenTextFileDialog1.execute then
      Memo1.Lines.loadfromfile(OpenTextFileDialog1.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Label1.Caption:= INTTOSTR(WORDCOUNT(Memo1.Text));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if SaveTextFileDialog1.execute then
  Memo1.Lines.SaveTofile(SaveTextFileDialog1.FileName);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Label2.Caption:= INTTOSTR(TOKENCOUNT(Memo1.Text));
end;

procedure TForm1.FormShow(Sender: TObject);
begin
Label1.Caption:= INTTOSTR(WORDCOUNT(Memo1.Text));
end;

end.
Angehängte Dateien
Dateityp: txt Von 14 auf 20 Millionen.txt (4,8 KB, 3x aufgerufen)

Geändert von t.roller ( 2. Mär 2017 um 14:44 Uhr)
  Mit Zitat antworten Zitat
 

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:24 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz