Пишем программу для создания книг FB2 (СИ) - Карпов Юрий Страница 8

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

SytleStack.Clear;

OutList.Clear;

SaveDescription;

SaveBodyFB2;

SaveEndnotes;

OutList.Add('</FictionBook>');

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

showMessage('Done.');

end;

function BookHaveName: boolean;

begin

with Form1 do

result:= (book_title.Text <> '') and

(FB2_file.Text <> '') and

(GenresBox.Count > 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 < 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 < H5 then ChangeStyle(Succ(LStyle));

end;

procedure TForm1.Button1Click(Sender: TObject);

var

LStyle: TmyStyle;

begin

LStyle:= TmyStyle(Button2.Tag);

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

end;

end.

// конец кода

* * *

genres.dfm

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

object Form3: TForm3

Left = 214

Top = 121

BorderIcons = [biSystemMenu, biMinimize]

BorderStyle = bsSingle

Caption = 'Genre'

ClientHeight = 294

ClientWidth = 603

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

OnCreate = FormCreate

PixelsPerInch = 96

TextHeight = 13

object ListBox1: TListBox

Left = 8

Top = 8

Width = 241

Height = 209

ItemHeight = 13

TabOrder = 0

end

object Button1: TButton

Left = 272

Top = 32

Width = 75

Height = 25

Caption = 'Add'

TabOrder = 1

OnClick = Button1Click

end

object Button2: TButton

Left = 272

Top = 64

Width = 75

Height = 25

Caption = 'Delete'

TabOrder = 2

OnClick = Button2Click

end

object BitBtn1: TBitBtn

Left = 80

Top = 248

Width = 75

Height = 25

TabOrder = 3

Kind = bkOK

end

object BitBtn2: TBitBtn

Left = 448

Top = 240

Width = 75

Height = 25

TabOrder = 4

Kind = bkCancel

end

object Button3: TButton

Left = 272

Top = 112

Width = 75

Height = 25

Caption = 'Up'

TabOrder = 5

OnClick = Button3Click

end

object Button4: TButton

Left = 272

Top = 152

Width = 75

Height = 25

Caption = 'Down'

TabOrder = 6

OnClick = Button4Click