Путь к истине

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.

Вы здесь » Путь к истине » Программирование » Редактор ТКФ для писателей

Редактор ТКФ для писателей

Страница: 1

Сообщений 1 страница 9 из 9

1

  • Автор: megalyrik
  • Администратор
  • megalyrik
  • Зарегистрирован: 2010-03-13
  • Приглашений: 0
  • Сообщений: 572
  • Уважение: [+1/-0]
  • Позитив: [+6/-0]
  • Пол: Мужской
  • Провел на форуме:
    4 дня 23 часа
  • Последний визит:
    2024-11-11 18:19:42

Начинаю обсуждение программы для писателей.
https://disk.yandex.co.il/d/be9g8MsO1fkTCA

0

2

  • Автор: megalyrik
  • Администратор
  • megalyrik
  • Зарегистрирован: 2010-03-13
  • Приглашений: 0
  • Сообщений: 572
  • Уважение: [+1/-0]
  • Позитив: [+6/-0]
  • Пол: Мужской
  • Провел на форуме:
    4 дня 23 часа
  • Последний визит:
    2024-11-11 18:19:42

TKF- Творец Крупных Форм .
Программа для написания повестей и романов.
Программа абсолютно бесплатная !!!
программа выполнена в минималистическом стиле,
чтобы не отвлекать внимание автора от работы над
произведением.

Как пользоваться программой:
Программа представляет из себя простой редактор с тремя
вкладками.
На главной вкладке нужно писать основной текст.
На вкладке структура нужно описывать сюжетные линии.
На вкладке персонажей надо описывать персонажей,
например их краткую характеристику, в какой главе
появляются впервые и т.д.

Главная вкладка сохраняется с расширением .txt !!!

На каждой вкладке можно независимо установить фонт и цвет.

Сервис работает только с главной вкладкой.

В разделе справки  будут находиться таблицы со
знаками препинания.

Перед выходом из программы не забывайте сохранять проект!!!

P.S.
Над улучшением программы идёт постоянная работа.
Очень важны ваши отклики.

0

3

  • Автор: megalyrik
  • Администратор
  • megalyrik
  • Зарегистрирован: 2010-03-13
  • Приглашений: 0
  • Сообщений: 572
  • Уважение: [+1/-0]
  • Позитив: [+6/-0]
  • Пол: Мужской
  • Провел на форуме:
    4 дня 23 часа
  • Последний визит:
    2024-11-11 18:19:42

Весь код приводить нет смысла.
Вот процедура подсчёта слов :

Код:
procedure TForm2.N12Click(Sender: TObject);
var
str :TStringList;
s :string;
begin
s:=Memo1.Text;
str := TStringList.create;
 s:=StringReplace(s,'.',' ',[rfReplaceAll]);   // заменяем разделители на пробелы
 s:=StringReplace(s,',',' ',[rfReplaceAll]);
 s:=StringReplace(s,'!',' ',[rfReplaceAll]);
 s:=StringReplace(s,'?',' ',[rfReplaceAll]);
 s:=StringReplace(s,'(',' ',[rfReplaceAll]);
 s:=StringReplace(s,')',' ',[rfReplaceAll]);
 s:=StringReplace(s,'[',' ',[rfReplaceAll]);
 s:=StringReplace(s,']',' ',[rfReplaceAll]);
 s:=StringReplace(s,'{',' ',[rfReplaceAll]);
 s:=StringReplace(s,'}',' ',[rfReplaceAll]);
 s:=StringReplace(s,'-',' ',[rfReplaceAll]);
 s:=StringReplace(s,'_',' ',[rfReplaceAll]);
 while(pos('  ',s)<>0) do s:=StringReplace(s,'  ',' ',[rfreplaceall]); //убираем лишние пробелы

str.text :=StringReplace(s, ' ', #13#10, [rfReplaceAll]); //Заменяем пробелы на перевод строки
  ShowMessage('Число слов в тексте '+ IntToStr(str.Count));
str.free;
end;

А вот таким образом осуществляется выбор вкладки

Код:
procedure TForm2.N14Click(Sender: TObject); {undo}
begin
   case PageControl1.ActivePageIndex of
   0 : Memo1.Undo;
   1 : Memo2.Undo;
   2 : Memo3.Undo;
  end;
end;

procedure TForm2.N15Click(Sender: TObject);
begin
  case PageControl1.ActivePageIndex of  {delete}
   0 : Memo1.ClearSelection;
   1 : Memo2.ClearSelection;
   2 : Memo3.ClearSelection;
  end;
end;

А вот процедура открытия файлов с проверкой на их присутствие.

Код:
procedure TForm2.N6Click(Sender: TObject); {open}
begin
 if OpenDialog1.Execute then
begin
  FileWork:=OpenDialog1.FileName;
    if Pos('.',FileWork)<> 0 then
 FileWork:= Copy(OpenDialog1.FileName, 1, Length(OpenDialog1.FileName)-4);
 Memo1.Lines.LoadFromFile(FileWork+'.txt');
 if FileExists(FileWork+'.dbs') then
 Memo2.Lines.LoadFromFile(FileWork+'.dbs');
 if FileExists(FileWork+'.dbp') then
 Memo3.Lines.LoadFromFile(FileWork+'.dbp');
 Memo1.Modified:= false;
end;
end;

0

4

  • Автор: megalyrik
  • Администратор
  • megalyrik
  • Зарегистрирован: 2010-03-13
  • Приглашений: 0
  • Сообщений: 572
  • Уважение: [+1/-0]
  • Позитив: [+6/-0]
  • Пол: Мужской
  • Провел на форуме:
    4 дня 23 часа
  • Последний визит:
    2024-11-11 18:19:42

Процедура поиска

Код:
procedure TForm2.FindDialog1Find(Sender: TObject);
  var
   Found, StartPos: Integer;
begin
  if PageControl1.ActivePageIndex = 0 then
   begin
   if Memo1.SelLength <> 0 then
      StartPos := Memo1.SelStart + Memo1.SelLength
   else
      StartPos := 0;


   Found := PosEx(FindDialog1.FindText, Memo1.Text, StartPos + 1);
   if Found <> 0 then
   begin
      Memo1.HideSelection := False;
      Memo1.SelStart := Found - 1;
      Memo1.SelLength := Length(FindDialog1.FindText);
   end
   else
    ShowMessage('Строка '+FindDialog1.FindText+' не найдена!');
   end;

    if PageControl1.ActivePageIndex = 1 then
   begin
   if Memo2.SelLength <> 0 then
      StartPos := Memo2.SelStart + Memo2.SelLength
   else
      StartPos := 0;


   Found := PosEx(FindDialog1.FindText, Memo2.Text, StartPos + 1);
   if Found <> 0 then
   begin
      Memo2.HideSelection := False;
      Memo2.SelStart := Found - 1;
      Memo2.SelLength := Length(FindDialog1.FindText);
   end
   else
    ShowMessage('Строка '+FindDialog1.FindText+' не найдена!');
   end;

    if PageControl1.ActivePageIndex = 2 then
   begin
   if Memo3.SelLength <> 0 then
      StartPos := Memo3.SelStart + Memo3.SelLength
   else
      StartPos := 0;


   Found := PosEx(FindDialog1.FindText, Memo3.Text, StartPos + 1);
   if Found <> 0 then
   begin
      Memo3.HideSelection := False;
      Memo3.SelStart := Found - 1;
      Memo3.SelLength := Length(FindDialog1.FindText);
   end
   else
    ShowMessage('Строка '+FindDialog1.FindText+' не найдена!');
   end;
end;

Для PosEx надо подключить StrUtils

0

5

  • Автор: megalyrik
  • Администратор
  • megalyrik
  • Зарегистрирован: 2010-03-13
  • Приглашений: 0
  • Сообщений: 572
  • Уважение: [+1/-0]
  • Позитив: [+6/-0]
  • Пол: Мужской
  • Провел на форуме:
    4 дня 23 часа
  • Последний визит:
    2024-11-11 18:19:42

Ну вот основные процедуры показал, всё остальное не сложно сделать. ещё обсуждалось по этой программе здесь:
множественное открытие-сохранение

Я хочу обсудить дальнейшее улучшение программы, какие нужны дополнительные возможности.

Изначально писал программу для себя, так как занимаюсь написанием длинных текстов и
знаю, что мне надо. Но люди разные, у всех есть свои потребности.

0

6

  • Автор: megalyrik
  • Администратор
  • megalyrik
  • Зарегистрирован: 2010-03-13
  • Приглашений: 0
  • Сообщений: 572
  • Уважение: [+1/-0]
  • Позитив: [+6/-0]
  • Пол: Мужской
  • Провел на форуме:
    4 дня 23 часа
  • Последний визит:
    2024-11-11 18:19:42

Программу писал на Delphi 10.2 Tokyo Starter ! Это бесплатная урезанная версия.
Также тестировал на старенькой бесплатной Turbo Delphi
Lazarus не корректно работает с кириллицей, надо вносить изменения. И убрать процедуру поиска.
Главное изменение для Lazarus :
Добавить в uses LazUTF8
Form2.Memo1.Lines.SaveToFile(Utf8ToSys(FileWork+'.txt')) и т.д.

Процедура

Код:

procedure TForm1.FindDialog1Find(Sender: TObject);
begin
   if UTF8Pos(FindDialog1.FindText, memo1.Text)<>0 then
        begin
          with Memo1 do begin
          HideSelection := False;
          SelStart := UTF8Pos(FindDialog1.FindText, Text)-1;
          SelLength := UTF8Length(FindDialog1.FindText);
          end;
         end
         else
      ShowMessage('Строка '+FindDialog1.FindText+' не найдена!');
end;

         
Эта процедура будет искать только первое вхождение. Чтобы был дальнейший поиск надо вводить переменные и дублировать строку для поиска отрезая всё что было в предыдущем поиске. Я не стал писать эту процедуру, она значительно медлительнее, и в принципе в программе можно и без неё обойтись.

0

7

  • Автор: megalyrik
  • Администратор
  • megalyrik
  • Зарегистрирован: 2010-03-13
  • Приглашений: 0
  • Сообщений: 572
  • Уважение: [+1/-0]
  • Позитив: [+6/-0]
  • Пол: Мужской
  • Провел на форуме:
    4 дня 23 часа
  • Последний визит:
    2024-11-11 18:19:42

Переписал код, убрав глюки и недоделки! 
Во первых добавил процедуру сохранения

Код:
procedure ddd;  {save}
begin
 If FileWork='' then SaveAs else   begin
 Form2.Memo1.Lines.SaveToFile(FileWork+'.txt');
  Form2.Memo2.Lines.SaveToFile(FileWork+'.dbs');
  Form2.Memo3.Lines.SaveToFile(FileWork+'.dbp');
 end;
end;

Также ввёл проверку модификации во все процедуры открытия  и выхода.

Код:
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Memo1.Modified or Memo2.Modified or Memo3.Modified then ddd;
end;
Код:
procedure TForm2.N5Click(Sender: TObject);  {sozdat'}
begin

  if Memo1.Modified or Memo2.Modified or Memo3.Modified then begin
            ddd;
  end;
  Memo1.Clear;
  Memo2.Clear;
  Memo3.Clear;
  Memo1.Modified:= false;
  SaveDialog1.FileName:= '';
  FileWork:= '';
end;

procedure TForm2.N6Click(Sender: TObject); {open}
begin
if Memo1.Modified or Memo2.Modified or Memo3.Modified then ddd;
 if OpenDialog1.Execute then
begin
  FileWork:=OpenDialog1.FileName;
    if Pos('.',FileWork)<> 0 then
 FileWork:= Copy(OpenDialog1.FileName, 1, Length(OpenDialog1.FileName)-4);
 Memo1.Lines.LoadFromFile(FileWork+'.txt');
 if FileExists(FileWork+'.dbs') then
 Memo2.Lines.LoadFromFile(FileWork+'.dbs');
 if FileExists(FileWork+'.dbp') then
 Memo3.Lines.LoadFromFile(FileWork+'.dbp');
 Memo1.Modified:= false;
end;
end;

Тестирование прошло успешно.

0

8

  • Автор: megalyrik
  • Администратор
  • megalyrik
  • Зарегистрирован: 2010-03-13
  • Приглашений: 0
  • Сообщений: 572
  • Уважение: [+1/-0]
  • Позитив: [+6/-0]
  • Пол: Мужской
  • Провел на форуме:
    4 дня 23 часа
  • Последний визит:
    2024-11-11 18:19:42

Доработал открытием недавнего файла, использовал INI файл.
Вот изменения в процедурах сохранения.

Код:
Procedure SaveAs;
begin
 If Form2.SaveDialog1.Execute then
 begin
   FileWork:=Form2.SaveDialog1.FileName;
    if Pos('.',FileWork)<> 0 then
  FileWork:= Copy(Form2.SaveDialog1.FileName, 1, Length(Form2.SaveDialog1.FileName)-4);
  Form2.Memo1.Lines.SaveToFile(FileWork+'.txt');
  Form2.Memo2.Lines.SaveToFile(FileWork+'.dbs');
  Form2.Memo3.Lines.SaveToFile(FileWork+'.dbp');
  oldfile:= FileWork;
  sIniFile.WriteString('TEST', 'EditVal', oldfile);
 end;
end;

procedure ddd;  {save}
begin
 If FileWork='' then SaveAs else   begin
          oldfile:= FileWork;
           sIniFile.WriteString('TEST', 'EditVal', oldfile);
 Form2.Memo1.Lines.SaveToFile(FileWork+'.txt');
  Form2.Memo2.Lines.SaveToFile(FileWork+'.dbs');
  Form2.Memo3.Lines.SaveToFile(FileWork+'.dbp');
 end;
end;

Инициализация

Код:
procedure TForm2.FormCreate(Sender: TObject);
begin
 pathINI:=extractfilepath(application.ExeName)+'\example.ini';
   sIniFile := TIniFile.Create(pathINI);
  Memo1.Clear;
  Memo2.Clear;
  Memo3.Clear;
end;

Ну и процедура открытия

Код:
procedure TForm2.N22Click(Sender: TObject);
begin
if Memo1.Modified or Memo2.Modified or Memo3.Modified then ddd;

     if FileExists(pathINI) then //проверяем есть ли файл INI
   begin
      FileWork:=sIniFile.ReadString('TEST', 'EditVal', 'Раздел не найден!');
 if FileExists(FileWork+'.txt') then
 Memo1.Lines.LoadFromFile(FileWork+'.txt');
 if FileExists(FileWork+'.dbs') then
 Memo2.Lines.LoadFromFile(FileWork+'.dbs');
 if FileExists(FileWork+'.dbp') then
 Memo3.Lines.LoadFromFile(FileWork+'.dbp');
 Memo1.Modified:= false;
   end else
            ShowMessage('Нет недавних файлов, сначала сохраните');
end;

0

9

  • Автор: megalyrik
  • Администратор
  • megalyrik
  • Зарегистрирован: 2010-03-13
  • Приглашений: 0
  • Сообщений: 572
  • Уважение: [+1/-0]
  • Позитив: [+6/-0]
  • Пол: Мужской
  • Провел на форуме:
    4 дня 23 часа
  • Последний визит:
    2024-11-11 18:19:42

Я перезалил на  https://disk.yandex.co.il/d/be9g8MsO1fkTCA самую свежую версию в архиве вместе с исходниками.
Буду ещё некоторое время тестировать и фиксить при обнаружении проблем. А потом приступлю к серьёзным обновлениям функционала, уже есть несколько идей.

0

Страница: 1

Вы здесь » Путь к истине » Программирование » Редактор ТКФ для писателей