Текст книги "Пишем программу для создания книг FB2 (СИ)"

Автор книги: Юрий Карпов

сообщить о нарушении

Текущая страница: 2 (всего у книги 3 страниц)

Caption = '+'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -19

Font.Name = 'MS Sans Serif'

Font.Style = []

ParentFont = False

TabOrder = 2

OnClick = Button5Click

end

end

end

object ListBox1: TListBox

Left = 265

Top = 41

Width = 441

Height = 348

Align = alClient

Font.Charset = RUSSIAN_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'Courier'

Font.Style = []

ItemHeight = 13

ParentFont = False

TabOrder = 2

OnClick = ListBox1Click

OnDblClick = ListBox1DblClick

end

end

object TabSheet4: TTabSheet

Caption = 'End Notes'

ImageIndex = 4

object Panel4: TPanel

Left = 0

Top = 0

Width = 706

Height = 41

Align = alTop

TabOrder = 0

object Button3: TButton

Left = 8

Top = 8

Width = 105

Height = 25

Caption = 'Load End Notes'

TabOrder = 0

OnClick = Button3Click

end

end

object EndNotesList: TListBox

Left = 0

Top = 41

Width = 706

Height = 348

Align = alClient

ItemHeight = 13

TabOrder = 1

end

end

end

object MainMenu1: TMainMenu

Left = 208

Top = 32

object File1: TMenuItem

Caption = 'File'

object Open1: TMenuItem

Caption = 'Open'

OnClick = Open1Click

end

object SaveasFB21: TMenuItem

Caption = 'Save as FB2'

OnClick = SaveasFB21Click

end

end

end

object OpenDialog1: TOpenDialog

Filter = 'Text|*.txt|Any file|*.*'

FilterIndex = 2

Left = 240

Top = 32

end

object SaveDialog1: TSaveDialog

Filter = 'FB2 |*.fb2'

Left = 272

Top = 32

end

end

// конец кода

Код файла 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

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

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

'^': S:= S + '^'; //

'~': S:= S + '~';

'&': S:= S + '&';

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('');

with form1.Annotation do

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

OutList.Add('

'+Lines[i]+'

');

OutList.Add('');

end;

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

var

i: integer;

Person: TPerson;

begin

with LB do

if Count > 0 then

for i:= 0 to Count – 1 do

begin

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

OutList.Add(' <'+title+'>');

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(' ');

end;

end;

procedure SaveSequence;

var

s: string;

begin

with Form1 do

begin

if sequence.Text = '' then exit;

S:= '

if tome.Text = ''

then S:= S + '/>'

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

end;

OutList.Add(S);

end;

procedure SaveDescription;

const

max = 5;

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

(

'',

'

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

' ',

' '

);

var

i: byte;

S: string;

begin

// head

for i:= 1 to max do

OutList.Add(Mas[i]);

with form1.GenresBox do

if Items.Count > 0 then

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

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

SavePersons('author',Form1.ListBox3);

SavePersons('translator',Form1.ListBox2);

with Form1 do

begin

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

if Annotation.Lines.Count > 0

then SaveAnnotation;

//if _date.text <> '' then

//OutList.Add(''+_date.text+'');

SaveSequence;

OutList.Add(' '+Lang.Text+'');

if SLang.ItemIndex > -1 then

begin

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

if S <> '' then

OutList.Add(' '+S+'');

end;

OutList.Add(' ');

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

OutList.Add(' ');

OutList.Add(' my_Make_FB2');

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

OutList.Add(' '+ DateToStr(now) +'');

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

OutList.Add(' 1.0');

OutList.Add(' ');

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

OutList.Add(' ');

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(' 1.0');

OutList.Add(' ');

end;

OutList.Add(' ');

OutList.Add('');

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 <> 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('');

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

else

begin

OutList.Add('');

while CurStyle <> LastStyle do

begin

SytleStack.Delete(SytleStack.Count-1);

OutList.Add('');

LastStyle:= TmyStyle(SytleStack.Last);

end;

end;

end;// case

end;

OutList.Add('

');

OutList.Add('');

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

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

Poem: OutList.Add('');

Epig: OutList.Add('');

Citat: OutList.Add('');

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

end;

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

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

Norm,Epig,Citat: OutList.Add('

'+S+'

');

H1..H5: StyleStucture; // Heading

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

Poem: begin

if S = ''

then OutList.Add('')

else OutList.Add(''+S+'');

end;

Auth: begin

OutList.Add(''+S+'');

if oldStyle in [Poem, Epig, Citat]

then CurStyle:= oldStyle;

end;

None: continue; //None

end; // case

oldStyle:= CurStyle;

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

if SytleStack.Count > 0 then

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

while SytleStack.Count > 0 do

begin

SytleStack.Delete(SytleStack.Count-1);

OutList.Add('

');

end;

end;

OutList.Add('');

OutList.Add('');

end;

procedure SaveEndnotes;

var

S: string;

i: integer;

begin

if Form1.EndNotesList.Items.Count = 0 then exit; //[1]

OutList.Add('');

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

begin

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

OutList.Add('

'+S+'

');

OutList.Add('

');

end;

OutList.Add('');

end;

Procedure Make_fb2(S: string);

begin //

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

SytleStack.Clear;

OutList.Clear;

SaveDescription;

SaveBodyFB2;

SaveEndnotes;

OutList.Add('');

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

end

object ListBox2: TListBox

Left = 368

Top = 32

Width = 225

Height = 185

ItemHeight = 13

TabOrder = 7

OnDblClick = ListBox2DblClick

end

object ComboBox1: TComboBox

Left = 368

Top = 8

Width = 225

Height = 21

ItemHeight = 13

ItemIndex = 0

TabOrder = 8

Text = #1044#1077#1083#1086#1074#1072#1103' '#1083#1080#1090#1077#1088#1072#1090#1091#1088#1072

OnChange = ComboBox1Change

Items.Strings = (

#1044#1077#1083#1086#1074#1072#1103' '#1083#1080#1090#1077#1088#1072#1090#1091#1088#1072

#1044#1077#1090#1077#1082#1090#1080#1074#1099' '#1080' '#1058#1088#1080#1083#1083#1077#1088#1099

#1044#1077#1090#1089#1082#1086#1077

#1044#1086#1082#1091#1084#1077#1085#1090#1072#1083#1100#1085#1072#1103' '#1083#1080#1090#1077#1088#1072#1090#1091#1088#1072

#1044#1086#1084#1086#1074#1086#1076#1089#1090#1074#1086

#1050#1086#1084#1087#1100#1102#1090#1077#1088#1099' '#1080' '#1048#1085#1090#1077#1088#1085#1077#1090

#1051#1102#1073#1086#1074#1085#1099#1077' '#1088#1086#1084#1072#1085#1099

#1053#1072#1091#1082#1072', '#1054#1073#1088#1072#1079#1086#1074#1072#1085#1080#1077

#1055#1077#1088#1080#1086#1076#1080#1082#1072

#1055#1086#1101#1079#1080#1103', '#1044#1088#1072#1084#1072#1090#1091#1088#1075#1080#1103

#1055#1088#1080#1082#1083#1102#1095#1077#1085#1080#1103

#1055#1088#1086#1079#1072

#1055#1088#1086#1095#1077#1077

#1056#1077#1083#1080#1075#1080#1103' '#1080' '#1076#1091#1093#1086#1074#1085#1086#1089#1090#1100

#1057#1087#1088#1072#1074#1086#1095#1085#1072#1103' '#1083#1080#1090#1077#1088#1072#1090#1091#1088#1072

#1057#1090#1072#1088#1080#1085#1085#1086#1077

#1058#1077#1093#1085#1080#1082#1072

#1060#1072#1085#1090#1072#1089#1090#1080#1082#1072

#1070#1084#1086#1088)

end

end

// конец кода

genres.pas

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

unit genres;

interface

uses

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

Dialogs, Buttons, StdCtrls, dm;

type

TForm3 = class(TForm)

ListBox1: TListBox;

Button1: TButton;

Button2: TButton;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

Button3: TButton;

Button4: TButton;

ListBox2: TListBox;

ComboBox1: TComboBox;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure ComboBox1Change(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure ListBox2DblClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);

var

i: integer;

begin

for i:= 0 to maxg do

ListBox2.Items.Add(gg[i][2]);

ListBox2.ItemIndex:= 0;

end;

procedure TForm3.Button1Click(Sender: TObject);

var

i: integer;

begin

for i:= 0 to ListBox1.Items.Count – 1 do

if ListBox2.Items[ListBox2.ItemIndex] = ListBox1.Items[i]

then exit;

ListBox1.Items.Add(ListBox2.Items[ListBox2.ItemIndex]);

end;

procedure TForm3.Button2Click(Sender: TObject);

begin

if ListBox1.ItemIndex = -1 then exit;

ListBox1.Items.Delete(ListBox1.ItemIndex);

end;

procedure TForm3.ComboBox1Change(Sender: TObject);

begin

ListBox2.ItemIndex:= LI[ComboBox1.ItemIndex];

ListBox2.TopIndex:= ListBox2.ItemIndex;

end;

procedure TForm3.Button3Click(Sender: TObject);

var

k: integer;

begin

k:= ListBox1.ItemIndex;

if k > 0 then

begin

ListBox1.Items.Move(k,k-1);

ListBox1.ItemIndex:= k -1;

end;

end;

procedure TForm3.Button4Click(Sender: TObject);

var

k: integer;

begin

k:= ListBox1.ItemIndex;

if k < ListBox1.Items.Count – 1 then

begin

ListBox1.Items.Move(k,k+1);

ListBox1.ItemIndex:= k+1;

end;

end;

procedure TForm3.ListBox2DblClick(Sender: TObject);

begin

Button1Click(nil);

end;

end.

// конец кода

* * *

EditStr.dfm

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

object EditSt: TEditSt

Left = 175

Top = 164

Width = 692

Height = 303

Caption = 'Edit'

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

PixelsPerInch = 96

TextHeight = 13

object Panel1: TPanel

Left = 0

Top = 240

Width = 684

Height = 36

Align = alBottom

BevelOuter = bvNone

TabOrder = 0

object BitBtn1: TBitBtn

Left = 16

Top = 8

Width = 75

Height = 25

TabOrder = 0

Kind = bkOK

end

object BitBtn2: TBitBtn

Left = 592

Top = 8

Width = 75

Height = 25

TabOrder = 1

Kind = bkCancel

end

object BitBtn3: TBitBtn

Left = 592

Top = 8

Width = 75

Height = 25

TabOrder = 2

Kind = bkAbort

end

object Button1: TButton

Left = 112

Top = 8

Width = 75

Height = 25

Caption = 'Bold'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsBold]

ParentFont = False

TabOrder = 3

OnClick = Button1Click

end

object Button2: TButton

Left = 200

Top = 8

Width = 75

Height = 25

Caption = 'Italic'

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsItalic]

ParentFont = False

TabOrder = 4

OnClick = Button2Click

end

end

object Memo1: TMemo

Left = 0

Top = 0

Width = 684

Height = 240

Align = alClient

ScrollBars = ssVertical

TabOrder = 1

end

end

// конец кода

EditStr.pas

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

unit EditStr;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls;

type

TEditSt = class(TForm)

Panel1: TPanel;

Memo1: TMemo;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

BitBtn3: TBitBtn;

Button1: TButton;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

EditSt: TEditSt;

implementation

{$R *.dfm}

procedure TEditSt.Button1Click(Sender: TObject);

begin

with Memo1 do

if SelLength > 0 then

Memo1.SelText:= ''+ SelText + ''

end;

procedure TEditSt.Button2Click(Sender: TObject);

begin

with Memo1 do

if SelLength > 0 then

Memo1.SelText:= ''+ SelText + ''

end;

end.

// конец кода

* * *

authors.dfm

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

object Form2: TForm2

Left = 359

Top = 204

Width = 502

Height = 285

Caption = 'Person'

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

PixelsPerInch = 96

TextHeight = 13

object GroupBox1: TGroupBox

Left = 296

Top = 8

Width = 185

Height = 193

Caption = 'Author'

TabOrder = 0

object Label2: TLabel

Left = 8

Top = 24

Width = 45

Height = 13

Caption = 'first-name'

end

object Label3: TLabel

Left = 8

Top = 88

Width = 45

Height = 13

Caption = 'last-name'

end

object Label4: TLabel

Left = 8

Top = 120

Width = 46

Height = 13

Caption = 'nickname'

end

object Label5: TLabel

Left = 8

Top = 152

Width = 24

Height = 13

Caption = 'email'

end

object Label8: TLabel

Left = 8

Top = 56

Width = 47

Height = 13

Caption = 'midl-name'

end

object first_name: TEdit

Left = 64

Top = 16

Width = 113

Height = 21

TabOrder = 0

end

object last_name: TEdit

Left = 64

Top = 80

Width = 113

Height = 21

TabOrder = 1

end

object nickname: TEdit

Left = 64

Top = 112

Width = 113

Height = 21

TabOrder = 2

end

object mail: TEdit

Left = 64

Top = 144

Width = 113

Height = 21

TabOrder = 3

end

object mid_name: TEdit

Left = 64

Top = 48

Width = 113

Height = 21

TabOrder = 4

end

end

object Au: TGroupBox

Left = 8

Top = 8

Width = 185

Height = 193

Caption = 'Authors'

TabOrder = 1

object ListBox1: TListBox

Left = 8

Top = 15

Width = 169

Height = 170

ItemHeight = 13

TabOrder = 0

OnClick = ListBox1Click

end

end

object Button1: TButton

Left = 208

Top = 16

Width = 75

Height = 25

Caption = 'new'

TabOrder = 2

OnClick = Button1Click

end

object Button2: TButton

Left = 208

Top = 56

Width = 75

Height = 25

Caption = 'Add'

TabOrder = 3

OnClick = Button2Click

end

object Button3: TButton

Left = 208

Top = 96

Width = 75

Height = 25

Caption = 'Edit'

TabOrder = 4

OnClick = Button3Click

end

object Button4: TButton

Left = 208

Top = 136

Width = 75

Height = 25

Caption = 'Delete'

TabOrder = 5

OnClick = Button4Click

end

object BitBtn1: TBitBtn

Left = 96

Top = 224

Width = 75

Height = 25

TabOrder = 6

Kind = bkOK

end

object BitBtn2: TBitBtn

Left = 328

Top = 224

Width = 75

Height = 25

TabOrder = 7

Kind = bkCancel

end

end

// конец кода

authors.pas

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

unit authors;

interface

uses

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

Dialogs, StdCtrls, Buttons;

type

TPerson = class

fName: string;

mName: string;

lName: string;

nick: string;

email: string;

constructor Create;

end;

TForm2 = class(TForm)

GroupBox1: TGroupBox;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label8: TLabel;

first_name: TEdit;

last_name: TEdit;

nickname: TEdit;

mail: TEdit;

mid_name: TEdit;

Au: TGroupBox;

ListBox1: TListBox;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

{$R *.dfm}

constructor TPerson.Create;

begin

fName:= '';

mName:= '';

lName:= '';

nick:= '';

email:= '';

end;

procedure TForm2.Button1Click(Sender: TObject);

begin // New

first_name.Text:= '';

mid_name.Text:= '';

last_name.Text:= '';

nickname.Text:= '';

mail.Text:= '';

end;

procedure TForm2.Button2Click(Sender: TObject);

var

Person: TPerson;

begin // Add

Person:= TPerson.Create;

with Person do

begin

fName:= first_name.Text;

mName:= mid_name.Text;

lName:= last_name.Text;

nick:= nickname.Text;

email:= mail.Text;

ListBox1.Items.AddObject(lName+' '+fName,Person);

end;

end;

procedure TForm2.ListBox1Click(Sender: TObject);

var

Person: TPerson;

begin

with ListBox1 do

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

with Person do

begin

first_name.Text:= fName;

mid_name.Text:= mName;

last_name.Text:= lName;

nickname.Text:= nick;

mail.Text:= email;

end;

end;

procedure TForm2.Button3Click(Sender: TObject);

var

Person: TPerson;

begin // Edit

with ListBox1 do

begin

if ItemIndex = – 1 then exit;

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

end;

with Person do

begin

fName:= first_name.Text;

mName:= mid_name.Text;

lName:= last_name.Text;

nick:= nickname.Text;

email:= mail.Text;

with ListBox1 do

Items[ItemIndex]:=lName+' '+fName;

end;

end;

procedure TForm2.Button4Click(Sender: TObject);

var

Person: TPerson;

begin // Delete

with ListBox1 do

begin

if ItemIndex = – 1 then exit;

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

Person.Free;

Items.Delete(ItemIndex);

end;

end;

end.

// конец кода

dm.pas

Это просто текстовый файл, без формы.

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

unit dm;

interface

type

gr = array[1..2] of string;

const

maxg = 151;

gg: array[0..maxg] of gr = (// Список жанров

// Деловая литература

('banking', 'Банковское дело'),

('accounting', 'Бухучет, налогообложение, аудит'),

('global_economy', 'Внешнеэкономическая деятельность'),

('paper_work', 'Делопроизводство'),

('org_behavior', 'Корпоративная культура'),

('personal_finance', 'Личные финансы'),

('small_business', 'Малый бизнес'),

('marketing', 'Маркетинг, PR, реклама'),

('real_estate', 'Недвижимость'),

('popular_business', 'О бизнесе популярно'),

('industries', 'Отраслевые издания'),

('job_hunting', 'Поиск работы, карьера'),

('economics_ref', 'Справочники'),

('management', 'Управление, подбор персонала'),

('stock', 'Ценные бумаги, инвестиции'),

('economics', 'Экономика'),

// Детективы и Триллеры

('det_action', 'Боевик'),

('detective', 'Детектив'),

('det_irony', 'Иронический детектив'),

('det_history', 'Исторический детектив'),

('det_classic', 'Классический детектив'),

('det_crime', 'Криминальный детектив'),

('det_hard', 'Крутой детектив'),

('det_maniac', 'Маньяки'),

('det_political', 'Политический детектив'),

('det_police', 'Полицейский детектив'),

('thriller', 'Триллер'),

('det_espionage', 'Шпионский детектив'),

// Детское

('children', 'Детская литература'),

('child_education', 'Детская образовательная литература'),

('child_prose', 'Детская проза'),

('child_sf', 'Детская фантастика'),

('child_det', 'Детские остросюжетные'),

('child_adv', 'Детские приключения'),

('child_verse', 'Детские стихи'),

('child_tale', 'Сказка'),

// Документальная литература

('nonf_biography', 'Биографии и Мемуары'),

('nonfiction', 'Документальная литература'),

('design', 'Искусство и Дизайн'),

('nonf_criticism', 'Критика'),

('music', 'Музыка'),

('nonf_publicism', 'Публицистика'),

//Домоводство

('home_pets', 'Домашние животные'),

('home', 'Домоводство'),

('home_health', 'Здоровье'),

('home_cooking', 'Кулинария'),

('home_entertain', 'Развлечения'),

('home_garden', 'Сад и огород'),

('home_diy', 'Сделай сам'),

('home_sport', 'Спорт'),

('home_crafts', 'Хобби и ремесла'),

('home_sex', 'Эротика, Секс'),

// Компьютеры и Интернет

('comp_db', 'Базы данных'),

('comp_www', 'Интернет'),

('comp_hard', 'Компьютерное "железо"'),

('computers', 'Околокомпьютерная литература'),

('comp_osnet', 'ОС и Сети'),

('comp_programming', 'Программирование'),

('comp_soft', 'Программы'),

('comp_dsp', 'Цифровая обработка сигналов'),

// Любовные романы

('love_history', 'Исторические любовные романы'),

('love_short', 'Короткие любовные романы'),

('love_sf', 'Любовно-фантастические романы'),

('love', 'О любви'),

('love_detective', 'Остросюжетные любовные романы'),

('love_contemporary', 'Современные любовные романы'),

('love_erotica', 'Эротика'),

// Наука, Образование

('sci_medicine_alternative', 'Альтернативная медицина'),

('sci_cosmos', 'Астрономия и Космос'),

('sci_biology', 'Биология'),

('sci_biophys', 'Биофизика'),

('sci_biochem', 'Биохимия'),

('sci_geo', 'Геология и география'),

('sci_state', 'Государство и право'),

('sci_business', 'Деловая литература'),

('sci_history', 'История'),

('sci_culture', 'Культурология'),

('sci_philology', 'Литературоведение'),

('sci_math', 'Математика'),

('sci_medicine', 'Медицина'),

('science', 'Научная литература'),

('sci_orgchem', 'Органическая химия'),

('sci_politics', 'Политика'),

('sci_psychology', 'Психология'),

('sci_religion', 'Религиоведение'),

('sci_tech', 'Технические науки'),

('sci_phys', 'Физика'),

('sci_physchem', 'Физическая химия'),

('sci_philosophy', 'Философия'),

('sci_chem', 'Химия'),

('sci_economy', 'Экономика'),

('sci_juris', 'Юриспруденция'),

('sci_linguistic', 'Языкознание'),