Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
8
Добавлен:
16.12.2017
Размер:
5.56 Кб
Скачать
unit curse;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.Buttons, Vcl.ExtCtrls,
Vcl.StdCtrls, Vcl.OleCtrls, SHDocVw, Math;

type
TForm1 = class(TForm)
SB_Exit: TSpeedButton;
SB_Open: TSpeedButton;
SB_Save: TSpeedButton;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
OD: TOpenDialog;
CBChar: TCheckBox;
SD: TSaveDialog;
M: TMemo;
MCheck: TShape;
CBJustify: TCheckBox;
sub: TMemo;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
procedure SB_ExitClick(Sender: TObject);
procedure SB_OpenClick(Sender: TObject);
procedure SB_SaveClick(Sender: TObject);
procedure MKeyPress(Sender: TObject; var Key: Char);
procedure FormResize(Sender: TObject);
procedure CBSubClick(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure CBJustifyClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn2Click(Sender: TObject);
var
I:integer;
str:string;
Flag:bool;
begin
str:=M.Text;
i:=1;
Flag:=false;
while(str[i] in [' ',',','.','!','?']) do
inc(i);
while(i<length(str)) do
begin
//if (str[i] in ['0'..'9','A'..'Z','a'..'z','А'..'Я','а'..'я']) then
if not (str[i] in [' ','.',',',':',';','(',')','?','!', '[',']','{','}']) then
begin
inc(i);
Flag:=true;
end
else
begin
inc(i);
if Flag then
while not (str[i] in [' ','.',',',':',';','(',')','?','!', '[',']','{','}']) and (i<length(str)) do
begin
delete(str, i, 1);
Flag:=false;
end;
if (str[i-1]=' ') and (str[i]=str[i-1]) then delete(str, i, 1);
end;
M.Text:=str;

end;
end;

procedure TForm1.CBJustifyClick(Sender: TObject);
var
i, j, lines, maxLen, k,p, l,x, nl:integer;
SpaceIds:array[0..100] of integer;
str:string;
Len,vari: double;
begin
maxLen:=0;
k:=0;
p:=0;
lines:=M.Lines.Count;

for I := 0 to lines-1 do
if (length(m.Lines[i])>maxLen) then
maxLen:=length(m.Lines[i]);
ShowMessage(IntToStr(lines));

if CBJustify.Checked then
begin
M.Lines.SaveToFile('ttoo', TEncoding.UTF8);
for I := 0 to lines-1 do
begin
str:=M.Lines[i];
if pos(' ', str)=0 then
break;
for J := 1 to length(str)-1 do
if(str[j]=' ') then
begin
SpaceIds[k]:=j;
inc(k);
end;

p:=0;
while(length(str)<MaxLen) do
begin
if (p=k) then
p:=0;
insert(' ',str, SpaceIds[p]);
for l := p to K-1 do
inc(SpaceIds[l]);
inc(p);
end;
k:=0;
M.Lines[i]:=str;
ShowMessage(intToStr(M.Lines.Count));
if not (lines=M.Lines.Count) then
begin
M.Lines.Delete(M.Lines.Count-1);
ShowMessage('!');
x:=pos(' ', str);
delete(str, x, 1);
end;
M.Lines[i]:=str;
end;
end
else
M.Lines.LoadFromFile('ttoo', TEncoding.UTF8);
end;

procedure TForm1.CBSubClick(Sender: TObject);
var
I, counter:integer;
subString: string;
begin
counter:=M.Lines.Count;
subString:=sub.lines[0];
for I := counter downto 0 do
if (AnsiPos(subString, M.Lines[i])=0) then
M.Lines.Delete(i);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
MCheck.Left:=Form1.ClientWidth-36;
M.Height:=Form1.ClientHeight-130;
end;

procedure TForm1.MKeyPress(Sender: TObject; var Key: Char);
begin
//CBJustify.Checked:=False;
MCheck.Brush.Color:=ClRed;
MCheck.Hint:='Файл не сохранен';
end;

procedure TForm1.SB_ExitClick(Sender: TObject);
begin
Close
end;

procedure TForm1.SB_OpenClick(Sender: TObject);
var
F: TextFile;
C: Char;
W: Word;
begin
if OD.Execute then
begin
M.Clear;
AssignFile(F, OD.FileName);
{$I-}
reset(F);
{$I+}
if IOResult = 0 then
begin
Form1.Caption:=OD.FileName;
W:=0;
If CBChar.Checked then
begin
while Not EOF(F) do
begin
M.Lines.Add('');
While Not EOLn(F) do
begin
read(F,C);
M.Lines[W]:=M.Lines[W]+C;
end;
Inc(W);
readln(F);
end;
end
else
begin
M.Lines.LoadFromFile(OD.FileName, TEncoding.UTF8);
end;
CloseFile(F);
MCheck.Brush.Color:=ClLime;
MCheck.Hint:='Файл сохранен';
end
else
ShowMessage('Ошибка открытия файла '+OD.FileName);
end;
end;

procedure TForm1.SB_SaveClick(Sender: TObject);
var
StringList:TStringList;
begin
If SD.Execute
then
begin
M.Lines.SaveToFile(SD.FileName, TEncoding.UTF8);
Form1.Caption := SD.FileName;
MCheck.Brush.Color:=ClLime;
ShowMessage('Сохранен файл: '+SD.FileName);
MCheck.Hint:='Файл сохранен';
end
else
begin
ShowMessage('Сохранение отменено');
MCheck.Brush.Color:=ClRed;
MCheck.Hint:='Файл не сохранен';
end;
end;
end.
Соседние файлы в папке Курсовая (текстовый редактор)
  • #
    16.12.20177.71 Кб9curse.dfm
  • #
    16.12.20175.56 Кб8curse.pas
  • #
    16.12.2017234 б9Project1.dpr
  • #
    16.12.201729.31 Кб8Project1.dproj
  • #
    16.12.20174.16 Кб8Project1.dproj.local
  • #
    16.12.2017225 б8Project1.identcache
  • #
    16.12.201759.41 Кб9Project1.res