Юрий Карпов - Пишем программу для создания книг FB2.
- Название:Пишем программу для создания книг FB2.
- Автор:
- Жанр:
- Издательство:неизвестно
- Год:неизвестен
- ISBN:нет данных
- Рейтинг:
- Избранное:Добавить в избранное
-
Ваша оценка:
Юрий Карпов - Пишем программу для создания книг FB2. краткое содержание
Подробный комментарий к исходному коду программы создающей книжку в формате FB2.
Пишем программу для создания книг FB2. - читать онлайн бесплатно полную версию (весь текст целиком)
Шрифт:
Интервал:
Закладка:
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
OnClick = Button12Click
end
object RG: TRadioGroup
Left = 16
Top = 72
Width = 177
Height = 193
Caption = ' Styles '
ItemIndex = 0
Items.Strings = (
'Normal'
'Epigraph'
'Text-author'
'Subtitle'
'Poem'
'Citation'
'None')
TabOrder = 1
end
object GroupBox2: TGroupBox
Left = 16
Top = 0
Width = 177
Height = 65
Caption = ' Heading '
TabOrder = 2
object Button1: TButton
Left = 16
Top = 24
Width = 25
Height = 25
Caption = '-'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 72
Top = 24
Width = 33
Height = 25
Caption = 'H1'
TabOrder = 1
OnClick = Button2Click
end
object Button5: TButton
Left = 128
Top = 24
Width = 25
Height = 25
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(' </'+title+'>');
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;
OutList.Add('
'+s+'
');end; // StyleStucture;
begin
oldStyle:= ZZ; EndNotes_count:= 1;
// if
OutList.Add('
');with Form1.ListBox1 do
for i:= 0 to Count - 1 do // просматриваем текст
begin
S:= Items[i];
Ss:= GetStyle(S, CurStyle); // получаем чистую строку и стиль
s:= '';
if ss <> '' then
for j:= 1 to length(Ss) do
begin // просматриваем строку
case ss[j] of
'~': begin // если это концевая сноска
S:= S + ''
+IntToStr(EndNotes_count)+'
Шрифт:
Интервал:
Закладка: