Buchstabenhäufigkeit

[t.roller]

Aus Spass neue Version gemacht:

Delphi-Quellcode:

unit Unit1;  //20170213

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Memo11: TMemo;
    OpenTextFileDialog1: TOpenTextFileDialog;
    bnOpenTextfileDialog: TButton;
    bnCLEAR: TButton;
    Edit1: TEdit;
    bnRUN: TButton;
    bnCLOSE: TButton;
    procedure FormCreate(Sender: TObject);
    procedure bnOpenTextfileDialogClick(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
              Rect: TRect; State: TGridDrawState);
    procedure bnCLEARClick(Sender: TObject);
    procedure bnRUNClick(Sender: TObject);
    procedure bnCLOSEClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  cArray = array of ANSIchar;

var
  Form1: TForm1;
  nextLetter : Integer;
  LOT : Integer;
  CA : cArray;

implementation

{$R *.dfm}

function StrToCharArray(s: ANSIstring): cArray;
var x: integer;
begin
  setlength(result,length(s));
  for x:=length(s) downto 1 do result[x-1]:=s[x];
end;

function RemoveChars(const str: string; const ch: ANSIchar): string;
var i, Count: Integer; InvalidChars : set of ANSIChar;
begin
  InvalidChars := [ch, UPCASE(ch)];
  SetLength(Result, Length(str));
  Count := 0;
  for i := 1 to Length(str) do
  if not (str[i] in InvalidChars) then begin inc(Count); Result[Count] := str[i]; end;
  SetLength(Result, Count);
end;
//------------------------------------------------------------------------------
procedure TForm1.bnCLEARClick(Sender: TObject);
var I: Integer;
begin
  for I := 0 to StringGrid1.RowCount - 1 do StringGrid1.Rows[I].Clear();
end;

procedure TForm1.bnCLOSEClick(Sender: TObject); begin Application.Terminate; end;

procedure TForm1.bnRUNClick(Sender: TObject);
var Text3 : String; iResult, iText, I : Integer;
    Ticks: DWord; Res, Proz : Single;
begin
    StringGrid1.Cells[0,0]:= 'Buchstabe';
    StringGrid1.Cells[1,0]:= 'Häufigkeit';
    StringGrid1.Cells[2,0]:= 'Prozent';
Ticks := timeGetTime;

for I := Low(CA) to High(CA) do
BEGIN
  iText:= Length(Memo11.Text);
  inc(nextLetter);
  Text3:= RemoveChars(Memo11.text, CA[I]);
  Application.ProcessMessages;
  iResult := iText - Length(Text3);
  Memo11.text:= Text3;
  StringGrid1.Cells[0,nextLetter]:= CA[I];
  StringGrid1.Cells[1,nextLetter]:= INTTOSTR(iResult);
  Proz:= iResult / (LOT/100);
  StringGrid1.Cells[2,nextLetter]:= Format(' %.3f %',[Proz]);
END;
  Res := 0.001 * (timeGetTime - Ticks);
  Edit1.Text:= Format('Time for creating : '+' %.3f  sec',[Res]);
end;

procedure TForm1.bnOpenTextfileDialogClick(Sender: TObject);
begin
  Memo11.Clear; bnCLEAR.Click;
if OpenTextfileDialog1.Execute then
BEGIN
  Memo11.Lines.LoadFromFile(OpenTextfileDialog1.FileName);
  nextLetter:=0;
  Application.ProcessMessages;
  LOT:= Length(Memo11.text);
END;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Height:= Screen.Height-40;
  nextLetter:=0;
  Memo11.Lines.LoadFromFile(ExtractFilePath(Application.ExeName)+'\schtasks.txt');
  Application.ProcessMessages;
  LOT:= Length(Memo11.text);
  CA:= StrToCharArray('enisratdhulcgmobwfkzpvßjyxqäöü0123456789'); //40
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var s: string;
begin
  s := StringGrid1.Cells[ACol, ARow];
  StringGrid1.Canvas.FillRect(Rect);
  DrawText(StringGrid1.Canvas.Handle, PChar(s), Length(s), Rect,
  DT_SINGLELINE or DT_Center or DT_VCENTER);
end;

end.