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.