Добавил:
rn Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
8
Добавлен:
16.12.2017
Размер:
6 Кб
Скачать
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.20178 Кб9curse.dfm
  • #
    16.12.20176 Кб8curse.pas
  • #
    16.12.2017234 б9Project1.dpr
  • #
    16.12.201729 Кб8Project1.dproj
  • #
    16.12.20174 Кб8Project1.dproj.local
  • #
    16.12.2017225 б8Project1.identcache
  • #
    16.12.201759 Кб9Project1.res