"Пишем программу для создания книг FB2." - читать интересную книгу автора (Карпов Юрий)

Код файла Unit1.pas соответствующего Form1

// начало кода

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, Menus, CheckLst, ComCtrls,

genres, UmFB2, dm, authors;

type

TForm1 = class(TForm)

MainMenu1: TMainMenu;

File1: TMenuItem;

Open1: TMenuItem;

SaveasFB21: TMenuItem;

PageControl1: TPageControl;

TabSheet1: TTabSheet;

Annotation: TMemo;

TabSheet3: TTabSheet;

Lurl: TLabel;

LID: TLabel;

Lversion: TLabel;

url: TEdit;

id: TEdit;

version: TEdit;

TabSheet6: TTabSheet;

LISBN: TLabel;

LBook_name: TLabel;

Lpublisher: TLabel;

Lcity: TLabel;

Lyear: TLabel;

isbn: TEdit;

Book_name: TEdit;

publisher: TEdit;

year: TEdit;

city: TEdit;

TabSheet2: TTabSheet;

Panel1: TPanel;

Panel2: TPanel;

Button12: TButton;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

ListBox1: TListBox;

TabSheet4: TTabSheet;

Panel4: TPanel;

Button3: TButton;

EndNotesList: TListBox;

RG: TRadioGroup;

Panel3: TPanel;

Lbook_title: TLabel;

LProject: TLabel;

LAnnotation: TLabel;

Lsequence: TLabel;

LLang: TLabel;

Lsrc_lang: TLabel;

LTome: TLabel;

book_title: TEdit;

FB2_file: TEdit;

Au: TGroupBox;

ListBox3: TListBox;

Button10: TButton;

GroupBox1: TGroupBox;

GenresBox: TListBox;

Button4: TButton;

GroupBox3: TGroupBox;

ListBox2: TListBox;

Button7: TButton;

sequence: TEdit;

tome: TEdit;

Lang: TComboBox;

SLang: TComboBox;

Button9: TButton;

GroupBox2: TGroupBox;

Button1: TButton;

Button2: TButton;

Button5: TButton;

procedure Open1Click(Sender: TObject);

procedure SaveasFB21Click(Sender: TObject);

procedure Button12Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button10Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button9Click(Sender: TObject);

procedure ListBox1DblClick(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

Path: ANSIstring;

implementation

uses EditStr;

{$R *.dfm}

procedure LoadTXT(FName: string);

var

L: TStringList;

i, j: integer;

s, ss: string;

begin

L:= TStringList.Create;

L.LoadFromFile(fname);

for i:= 0 to L.Count - 1 do

begin

s:= ''; ss:= L[i];

for j:= 1 to length(Ss) do

begin // просматриваем строку

case ss[j] of

'lt;': S:= S + 'amp;#60;'; // знак lt; вызывает сбой в читалке

'gt;': S:= S + 'amp;#62;'; // заменяем, на всякий случай

'^': S:= S + 'amp;#94;'; //

'~': S:= S + 'amp;#126;';

'amp;': S:= S + 'amp;#38;';

else S:= S + ss[j];

end; // case

end;

L[i]:= ' N| ' + S;

end;

Form1.ListBox1.Items.Assign(L);

L.Free;

end;

procedure NameFB2_File(S: string);

begin //

S:= ExtractFileName(S);

Form1.Caption:= S;

Form1.FB2_file.Text:= ChangeFileExt(S,'.fb2');

end;

procedure TForm1.Open1Click(Sender: TObject);

begin

with OpenDialog1 do

if Execute then

begin

NameFB2_File(FileName);

ListBox1.Clear;

LoadTXT(FileName); // txt

end;

end;

function GetGaner(S: string):string;

var

i: integer;

begin

for i:= 0 to maxg do

if gg[i][2] = S then

begin

result:= gg[i][1];

exit;

end;

result:= s;

end;

procedure SaveAnnotation;

var

i: integer;

begin

OutList.Add('lt;annotationgt;');

with form1.Annotation do

for i:= 0 to Lines.Count - 1 do

OutList.Add('lt;pgt;'+Lines[i]+'lt;/pgt;');

OutList.Add('lt;/annotationgt;');

end;

procedure SavePersons(title: string; LB: TListBox);

var

i: integer;

Person: TPerson;

begin

with LB do

if Count gt; 0 then

for i:= 0 to Count - 1 do

begin

Person:= TPerson(Items.Objects[i]);

OutList.Add(' lt;'+title+'gt;');

with Person do

begin

PrintString('first-name',fname);

PrintString('last-name',lname);

PrintString('middle-name',mname);

PrintString('nick',nick);

PrintString('email',email);

end;

OutList.Add(' lt;/'+title+'gt;');

end;

end;

procedure SaveSequence;

var

s: string;

begin

with Form1 do

begin

if sequence.Text = '' then exit;

S:= 'lt;sequence name="' +sequence.Text+'"';

if tome.Text = ''

then S:= S + '/gt;'

else S:= S + ' number="'+tome.Text+'"/gt;';

end;

OutList.Add(S);

end;

procedure SaveDescription;

const

max = 5;

mas: array[1..max] of string =

(

'lt;?xml version="1.0" encoding="windows-1251"?gt;',

'lt;FictionBook xmlns="http://www.gribuser.ru/xml/fictionbook/2.0"',

' xmlns: l="http://www.w3.org/1999/xlink"gt;',

' lt;descriptiongt;',

' lt;title-infogt;'

);

var

i: byte;

S: string;

begin

// head

for i:= 1 to max do

OutList.Add(Mas[i]);

with form1.GenresBox do

if Items.Count gt; 0 then

for i:= 0 to Items.Count - 1 do

OutList.Add('lt;genregt;'+GetGaner(Items[i])+'lt;/genregt;');

SavePersons('author',Form1.ListBox3);

SavePersons('translator',Form1.ListBox2);

with Form1 do

begin

PrintString('book-title',book_title.text);

if Annotation.Lines.Count gt; 0

then SaveAnnotation;

//if _date.text lt;gt; '' then

//OutList.Add('lt;date value="'+_date.text+'-01-01"gt;'+_date.text+'lt;/dategt;');

SaveSequence;

OutList.Add(' lt;langgt;'+Lang.Text+'lt;/langgt;');

if SLang.ItemIndex gt; -1 then

begin

S:= Lg[SLang.ItemIndex][1];

if S lt;gt; '' then

OutList.Add(' lt;src-langgt;'+S+'lt;/src-langgt;');

end;

OutList.Add(' lt;/title-infogt;');

// **** document-info ****

OutList.Add(' lt;document-infogt;');

OutList.Add(' lt;program-usedgt;my_Make_FB2lt;/program-usedgt;');

PrintString('src-url', url.Text); //??

OutList.Add(' lt;date value="'+FormatDateTime('yyyy-mm-dd', Now)+'"gt;'+ DateToStr(now) +'lt;/dategt;');

PrintString('id', id.Text); //??

OutList.Add(' lt;versiongt;1.0lt;/versiongt;');

OutList.Add(' lt;/document-infogt;');

// **** publish-info ****

OutList.Add(' lt;publish-infogt;');

if Book_name.Text = ''

then PrintString('book-name', book_title.Text)

else PrintString('book-name', Book_name.Text);

PrintString('publisher', publisher.Text); //

PrintString('city', city.Text); //

PrintString('year', year.Text); //

PrintString('isbn', isbn.Text); //

//OutList.Add(' lt;versiongt;1.0lt;/versiongt;');

OutList.Add(' lt;/publish-infogt;');

end;

OutList.Add(' lt;/descriptiongt;');

OutList.Add('lt;bodygt;');

end;

function SubStyle(m,w: TmyStyle):integer;

begin

result:= integer(m) - integer(w);

end;

procedure SaveBodyFB2;

var

i, j: integer;

S, ss: string;

oldStyle,

LastStyle, CurStyle: TmyStyle; // style

procedure StyleStucture;

begin

if CurStyle lt;gt; oldStyle then

begin

if SytleStack.Count = 0 then

begin

SytleStack.Add(TObject(CurStyle))

end

else

begin

LastStyle:= TmyStyle(SytleStack.Last);

case SubStyle(CurStyle,LastStyle) of

0: OutList.Add('lt;/sectiongt;');

1: SytleStack.Add(TObject(CurStyle));

else

begin

OutList.Add('lt;/sectiongt;');

while CurStyle lt;gt; LastStyle do

begin

SytleStack.Delete(SytleStack.Count-1);

OutList.Add('lt;/sectiongt;');

LastStyle:= TmyStyle(SytleStack.Last);

end;

end;

end;// case

end;

OutList.Add('lt;sectiongt;');

OutList.Add('lt;titlegt;');

end;

OutList.Add('lt;pgt;'+s+'lt;/pgt;');

end; // StyleStucture;

begin

oldStyle:= ZZ; EndNotes_count:= 1;

// if

OutList.Add('lt;sectiongt;');

with Form1.ListBox1 do

for i:= 0 to Count - 1 do // просматриваем текст

begin

S:= Items[i];

Ss:= GetStyle(S, CurStyle); // получаем чистую строку и стиль

s:= '';

if ss lt;gt; '' then

for j:= 1 to length(Ss) do

begin // просматриваем строку

case ss[j] of

'~': begin // если это концевая сноска

S:= S + 'lt;a l: href="#n_'+IntToStr(EndNotes_count)+'" type="note"gt;'

+IntToStr(EndNotes_count)+'lt;/agt;';

inc(EndNotes_count); // увеличиваем счетчик сносок

end;

'^': S:= S + 'amp;#769;'; // ставим ударение

else S:= S + ss[j];

end; // case

end;

if (S = '') and (CurStyle lt;gt; Poem)

then

begin

OutList.Add('lt;empty-line/gt;');

continue;

end;

if (CurStyle lt;gt; oldStyle) and (CurStyle lt;gt; Auth) then

begin

case oldStyle of // завершение предыдущего блока

Poem: OutList.Add('lt;/stanzagt;lt;/poemgt;');

Epig: OutList.Add('lt;/epigraphgt;');

Citat: OutList.Add('lt;/citegt;');

H1..H5: OutList.Add('lt;/titlegt;');

end; // case завершение предыдущего блока

case CurStyle of // начало блока

Poem: OutList.Add('lt;poemgt;lt;stanzagt;');

Epig: OutList.Add('lt;epigraphgt;');

Citat: OutList.Add('lt;citegt;');

end; // case начало блока

end;

// анализ стилей

case CurStyle of // в зависимости от стиля абзаца

Norm,Epig,Citat: OutList.Add('lt;pgt;'+S+'lt;/pgt;');

H1..H5: StyleStucture; // Heading

Sub: OutList.Add('lt;subtitlegt;'+s+'lt;/subtitlegt;'); // Subtitle

Poem: begin

if S = ''

then OutList.Add('lt;/stanzagt;lt;stanzagt;')

else OutList.Add('lt;vgt;'+S+'lt;/vgt;');

end;

Auth: begin

OutList.Add('lt;text-authorgt;'+S+'lt;/text-authorgt;');

if oldStyle in [Poem, Epig, Citat]

then CurStyle:= oldStyle;

end;

None: continue; //None

end; // case

oldStyle:= CurStyle;

end; // for просмотр текста

if SytleStack.Count gt; 0 then

begin // закрываем все открытые секции

while SytleStack.Count gt; 0 do

begin

SytleStack.Delete(SytleStack.Count-1);

OutList.Add('lt;/sectiongt;');

end;

end;

OutList.Add('lt;/sectiongt;');

OutList.Add('lt;/bodygt;');

end;

procedure SaveEndnotes;

var

S: string;

i: integer;

begin

if Form1.EndNotesList.Items.Count = 0 then exit; //lt;a type="note" l: href="#n_1"gt;[1]lt;/agt;

OutList.Add('lt;body name="notes"gt;lt;titlegt;lt;pgt;Примечанияlt;/pgt;lt;/titlegt;');

for i:= 0 to Form1.EndNotesList.Items.Count - 1 do

begin

S:= Form1.EndNotesList.Items[i];

OutList.Add('lt;section id="n_'+IntToStr(i+1)+'"gt;lt;titlegt;lt;pgt;'+IntToStr(i+1)+'lt;/pgt;');

OutList.Add('lt;/titlegt;lt;pgt;'+S+'lt;/pgt;');

OutList.Add('lt;/sectiongt;');

end;

OutList.Add('lt;/bodygt;');

end;

Procedure Make_fb2(S: string);

begin //

if Form1.ListBox1.Items.Count = 0 then exit;

SytleStack.Clear;

OutList.Clear;

SaveDescription;

SaveBodyFB2;

SaveEndnotes;

OutList.Add('lt;/FictionBookgt;');

OutList.SaveToFile(S); //++ +

showMessage('Done.');

end;

function BookHaveName: boolean;

begin

with Form1 do

result:= (book_title.Text lt;gt; '') and

(FB2_file.Text lt;gt; '') and

(GenresBox.Count gt; 0);

end;

procedure TForm1.SaveasFB21Click(Sender: TObject);

begin

if not BookHaveName then

begin

PageControl1.ActivePageIndex:= 0;

ShowMessage('Fill the form.');

exit;

end;

SaveDialog1.FileName:= form1.FB2_file.Text;

if SaveDialog1.Execute then

Make_fb2(SaveDialog1.FileName);

end;

function SetStyle(n: TmyStyle):string;

begin

case n of

Norm: result:= ' N';

Epig: result:= ' E';

Auth: result:= ' A';

H1: result:= 'H1';

H2: result:= 'H2';

H3: result:= 'H3';

H4: result:= 'H4';

H5: result:= 'H5';

Sub: result:= ' S';

Poem: result:= ' P';

Citat: result:= ' C';

None: result:= '-';

end; // case

end;

function SetStyle1(n: TmyStyle):string;

begin

result:= ' '+ SetStyle(n)+'| ';

end;

procedure ChangeStyle(LStyle: TmyStyle);

var

n, curIndex: integer;

S: string;

begin

with Form1.ListBox1 do

begin

curIndex:= ItemIndex;

if curIndex = -1 then exit;

S:= Items[curIndex];

n:= pos('|', s);

delete(S, 1, n+1);

Items[curIndex]:= SetStyle1(LStyle)+ S;

if ItemIndex lt; Items.Count - 1

then ItemIndex:= ItemIndex+1;

SetFocus;

end;

end;

procedure TForm1.Button12Click(Sender: TObject);

begin

ChangeStyle(TmyStyle(RG.itemindex));

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

Form3.ListBox1.Items.Assign(GenresBox.Items);

Form3.ShowModal;

if Form3.ModalResult = mrOK then

begin

GenresBox.Items.Assign(Form3.ListBox1.Items);

end;

end;

procedure TForm1.Button10Click(Sender: TObject);

begin

Form2.ListBox1.Items.Assign(ListBox3.Items);

Form2.Button1Click(nil);

Form2.ShowModal;

if Form2.ModalResult = mrOK then

begin

ListBox3.Items.Assign(Form2.ListBox1.Items);

end;

end;

procedure TForm1.Button7Click(Sender: TObject);

begin

Form2.ListBox1.Items.Assign(ListBox2.Items);

Form2.Button1Click(nil);

Form2.ShowModal;

if Form2.ModalResult = mrOK then

begin

ListBox2.Items.Assign(Form2.ListBox1.Items);

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

i: integer;

begin

Path:= ExtractFileDir(ParamStr(0)) + '\';

OpenDialog1.InitialDir:= Path;

for i:= 0 to maxL do

SLang.Items.Add(Lg[i][2]);

SLang.ItemIndex:= 0;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

if FileExists(Path + 'EndNotes.txt')

then EndNotesList.Items.LoadFromFile(Path + 'EndNotes.txt');

end;

procedure TForm1.Button9Click(Sender: TObject);

begin

if FileExists(Path + 'Annotation.txt') then

Annotation.Lines.LoadFromFile(Path + 'Annotation.txt');

end;

function ScanUpStyle(n: integer):TmyStyle;

var

i: integer;

LStyle: TmyStyle;

begin

with Form1.ListBox1 do

for i:= n downto 0 do

begin

GetStyle(Items[i], LStyle);

if LStyle in [H1..H5] then

begin

result:= LStyle;

exit;

end;

end;

result:= H1;

end;

procedure ShowHeadStyle(n: integer);

var

LStyle: TmyStyle;

begin

LStyle:= ScanUpStyle(n);

Form1.Button2.Caption:= SetStyle(LStyle);

Form1.Button2.Tag:= integer(LStyle);

end;

procedure TForm1.ListBox1DblClick(Sender: TObject);

var

S: string;

CurStyle: TmyStyle;

i, st: integer;

begin

st:= ListBox1.itemIndex;

S:= GetStyle(ListBox1.Items[st], CurStyle);

with EditSt do

begin

Memo1.WordWrap:= true;

Memo1.Clear;

Memo1.Lines.Add(S);

ShowModal;

if ModalResult = mrOK then

begin

ListBox1.Items.Delete(st);

Memo1.WordWrap:= false;

for i:= Memo1.Lines.Count - 1 downto 0 do

ListBox1.Items.Insert(st, SetStyle1(CurStyle)+Memo1.Lines[i]);

end;

end;

end;

procedure TForm1.ListBox1Click(Sender: TObject);

begin

ShowHeadStyle(ListBox1.itemIndex);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

ChangeStyle(TmyStyle(Button2.Tag));

end;

procedure TForm1.Button5Click(Sender: TObject);

var

LStyle: TmyStyle;

begin

LStyle:= TmyStyle(Button2.Tag);

if LStyle lt; H5 then ChangeStyle(Succ(LStyle));

end;

procedure TForm1.Button1Click(Sender: TObject);

var

LStyle: TmyStyle;

begin

LStyle:= TmyStyle(Button2.Tag);

if LStyle gt; H1 then ChangeStyle(Pred(LStyle));

end;

end.

// конец кода