root/trunk/Forms/frm_book_info.pas

Show revision log
 
353464
1
(* *****************************************************************************



2
  *



3
  * MyHomeLib



4
  *



5
  * Copyright (C) 2008-2010 Aleksey Penkov



6
  *



7
  * Authors Aleksey Penkov   alex.penkov@gmail.com



8
  *         Nick Rymanov     nrymanov@gmail.com



9
  *



10
  ****************************************************************************** *)



1
11



2
{******************************************************************************}



3
{                                                                              }



4
{                                 MyHomeLib                                    }



5
{                                                                              }



6
{                                Version 0.9                                   }



7
{                                20.08.2008                                    }



8
{                    Copyright (c) Aleksey Penkov  alex.penkov@gmail.com       }



9
{                                                                              }



10
{******************************************************************************}



11



12



13
unit frm_book_info;
12
unit frm_book_info;



14
13



15
interface
14
interface



16
15



17
uses
16
uses



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



19
  Dialogs, xmldom, XMLIntf, msxmldom, XMLDoc, ExtCtrls, RzPanel, RzButton,
18
  Messages,



20
  StdCtrls, RzLabel, RzEdit, ComCtrls, RzTabs;
19
  SysUtils,



20
  Variants,



21
  Classes,



22
  Graphics,



23
  Controls,



24
  Forms,



25
  Dialogs,



26
  xmldom,



27
  XMLIntf,



28
  msxmldom,



29
  XMLDoc,



30
  ExtCtrls,



31
  StdCtrls,



32
  ComCtrls,



33
  unit_Globals;



21
34



22
type
35
type



23
  TfrmBookDetails = class(TForm)
36
  TfrmBookDetails = class(TForm)



24
    RzPageControl1: TRzPageControl;
37
    RzPageControl1: TPageControl;



25
    TabSheet1: TRzTabSheet;
38
    tsInfo: TTabSheet;



26
    TabSheet2: TRzTabSheet;
39
    tsReview: TTabSheet;



27
    mmShort: TMemo;
40
    mmShort: TMemo;



28
    Img: TImage;
41
    imgCover: TImage;



29
    RzPanel1: TRzPanel;
42
    pnButtons: TPanel;



30
    RzBitBtn1: TRzBitBtn;
43
    btnClose: TButton;



31
    btnLoadReview: TRzBitBtn;
44
    btnLoadReview: TButton;



32
    mmReview: TRzMemo;
45
    mmReview: TMemo;



33
    btnClearReview: TRzBitBtn;
46
    btnClearReview: TButton;



34
    mmInfo: TRzRichEdit;
47
    pnTitle: TPanel;



35
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
48
    lblAuthors: TLabel;



36
    procedure RzBitBtn1Click(Sender: TObject);
49
    lvInfo: TListView;



50
    lblTitle: TLabel;



51
    pnReviewButtons: TPanel;



52
    procedure FormCreate(Sender: TObject);



53
    procedure FormShow(Sender: TObject);



37
    procedure mmReviewChange(Sender: TObject);
54
    procedure mmReviewChange(Sender: TObject);



38
    procedure btnLoadReviewClick(Sender: TObject);
55
    procedure btnLoadReviewClick(Sender: TObject);



39
    procedure btnClearReviewClick(Sender: TObject);
56
    procedure btnClearReviewClick(Sender: TObject);



57



40
  private
58
  private



41
    { Private declarations }



42
    FUrl: string;
59
    FUrl: string;



43
60



44
    FReviewChanged : boolean;
61
    FReviewChanged: Boolean;



62
    //FBookRecord: TBookRecord;



45
    function GetReview: string;
63
    function GetReview: string;



46
    procedure Setreview(const Value: string);
64
    procedure SetReview(const Value: string);



65
    //procedure SetBookRecord(const Value: TBookRecord);



47
66



48
  public
67
  public



49
    procedure AllowOnlineReview(URL: string);
68
    procedure AllowOnlineReview(URL: string);



50
    procedure Download;
69
    procedure Download;



51
70



52
    procedure ShowBookInfo(FS: TMemoryStream);
71
    procedure FillBookInfo(bookInfo: TBookRecord; bookStream: TMemoryStream);



53
    property Review: string read GetReview write Setreview;
72



54
    property ReviewChanged: boolean read FReviewChanged write FReviewChanged;
73
    property Review: string read GetReview write SetReview;



55
    property URL: string write FURL;
74
    property ReviewChanged: Boolean read FReviewChanged write FReviewChanged;



56
    { Public declarations }
75
    property URL: string read FUrl write FUrl;



76
    //property Book: TBookRecord read FBookRecord write SetBookRecord;



57
  end;
77
  end;



58
78



59
  TReviewDownloadThread = class(TThread)
79
  TReviewDownloadThread = class(TThread)



60
  private
80
  private



61
    { Private declarations }



62
    FForm: TfrmBookDetails;
81
    FForm: TfrmBookDetails;



63
    FReview : TStringList;
82
    FReview: TStringList;



64
    FURL : string;
83
    FUrl: string;



65
84



66
    procedure StartDownload;
85
    procedure StartDownload;



67
    procedure Finish;
86
    procedure Finish;


...
...
69
    procedure Execute; override;
88
    procedure Execute; override;



70
    property Form: TfrmBookDetails read FForm write FForm;
89
    property Form: TfrmBookDetails read FForm write FForm;



71
  public
90
  public



72
    property URL: string write FURL;
91
    property URL: string write FUrl;



73
  end;
92
  end;



74
93



75
  procedure DownloadReview(Form: TfrmBookDetails; URL: string);
94
procedure DownloadReview(Form: TfrmBookDetails; URL: string);



76
95



77
var
96
var



78
  frmBookDetails: TfrmBookDetails;
97
  frmBookDetails: TfrmBookDetails;


...
...
81
100



82
uses
101
uses



83
  FictionBook_21,
102
  FictionBook_21,



84
  unit_globals,



85
  unit_Settings,
103
  unit_Settings,



86
  unit_MHLHelpers,



87
  unit_ReviewParser,
104
  unit_ReviewParser,



88
  dm_user,
105
  dm_user,



89
  jpeg,
106
  CommCtrl,



90
  pngimage,
107
  StrUtils,



91
  strutils;
108
  unit_MHLHelpers,



109
  unit_FB2Utils;



92
110



93



94
{$R *.dfm}
111
{$R *.dfm}



95
112



113
procedure TfrmBookDetails.FormCreate(Sender: TObject);



114
begin



115
  lvInfo.ShowColumnHeaders := False;



116
  FReviewChanged := False;



117
end;



118



96
procedure TfrmBookDetails.AllowOnlineReview(URL: string);
119
procedure TfrmBookDetails.AllowOnlineReview(URL: string);



97
begin
120
begin



98
  FUrl := URL;
121
  FUrl := URL;



99
122



100
  btnLoadReview.Visible := True;
123
  pnReviewButtons.Visible := True;



101
  btnClearReview.Visible := True;



102
end;
124
end;



103
125



104
procedure TfrmBookDetails.FormKeyDown(Sender: TObject; var Key: Word;



105
  Shift: TShiftState);



106
begin



107
  if key=27 then Close;



108
end;



109



110
procedure TfrmBookDetails.Download;
126
procedure TfrmBookDetails.Download;



111
var
127
var



112
  reviewParser : TReviewParser;
128
  reviewParser: TReviewParser;



113
  review : TStringList;
129
  Review: TStringList;



114
begin
130
begin



115
  btnLoadReview.Enabled := False;
131
  btnLoadReview.Enabled := False;



116
  reviewParser := TReviewParser.Create;



117
  review := TStringList.Create;



118
  Screen.Cursor := crHourGlass;
132
  Screen.Cursor := crHourGlass;



119
  try
133
  try



120
    reviewParser.Parse(FURL, review);
134
    reviewParser := TReviewParser.Create;



121
    mmReview.Clear;
135
    try



122
    mmReview.Lines.AddStrings(review);
136
      Review := TStringList.Create;



123
    FReviewChanged := True;
137
      try



138
        reviewParser.Parse(FUrl, Review);



139
        mmReview.Lines.Assign(Review);



140



141
        FReviewChanged := True;



142
      finally



143
        Review.Free;



144
      end;



145
    finally



146
      reviewParser.Free;



147
    end;



124
  finally
148
  finally



125
    review.Free;



126
    reviewParser.Free;



127
    Screen.Cursor := crDefault;
149
    Screen.Cursor := crDefault;



128
    btnLoadReview.Enabled := True;
150
    btnLoadReview.Enabled := True;



129
  end;
151
  end;



130
end;
152
end;



131
153



154
procedure TfrmBookDetails.FormShow(Sender: TObject);



155
begin



156
  // TODO перенести под конец заполнения ?



157
  ListView_SetColumnWidth(lvInfo.Handle, 0, LVSCW_AUTOSIZE);



158
  ListView_SetColumnWidth(lvInfo.Handle, 1, LVSCW_AUTOSIZE);



159
end;



160



132
function TfrmBookDetails.GetReview: string;
161
function TfrmBookDetails.GetReview: string;



133
begin
162
begin



134
  Result := mmReview.Lines.Text;
163
  Result := mmReview.Lines.Text;


...
...
139
  FReviewChanged := True;
168
  FReviewChanged := True;



140
end;
169
end;



141
170



142
procedure TfrmBookDetails.RzBitBtn1Click(Sender: TObject);



143
begin



144
  Close;



145
end;



146



147
procedure TfrmBookDetails.btnClearReviewClick(Sender: TObject);
171
procedure TfrmBookDetails.btnClearReviewClick(Sender: TObject);



148
begin
172
begin



149
  mmReview.Clear;
173
  mmReview.Clear;


...
...
155
  Download;
179
  Download;



156
end;
180
end;



157
181



158
procedure TfrmBookDetails.Setreview(const Value: string);
182
//procedure TfrmBookDetails.SetBookRecord(const Value: TBookRecord);



183
//begin



184
//  FBookRecord := Value;



185
//  lblTitle.Caption := FBookRecord.Title;



186
  { TODO -oNickR -cUsability : может стоит показывать всех авторов? и формировать имя автора более сложным алгоритмом }



187
//  lblAuthors.Caption := FBookRecord.Authors[0].GetFullName;



188
//end;



189



190
procedure TfrmBookDetails.SetReview(const Value: string);



159
begin
191
begin



160
  mmReview.Lines.Text := Value;
192
  mmReview.Lines.Text := Value;



161
end;
193
end;



162
194



163
procedure TfrmBookDetails.ShowBookInfo(FS: TMemoryStream);
195
procedure TfrmBookDetails.FillBookInfo(bookInfo: TBookRecord; bookStream: TMemoryStream);



164
var
196
var



165
  book:IXMLFictionBook;
197
  book: IXMLFictionBook;



166
  i,p:integer;
198
  i: integer;



167
  S, outStr: AnsiString;
199
  imgBookCover: TGraphic;



168
  CoverID:String;
200
  tmpStr: string;



169
  Ext: string;



170
201



171
  ImgVisible : boolean;
202
  procedure AddItem(const Field: string; const Value: string; GroupID: integer = -1);



172
  MS : TMemoryStream;
203
  var



204
    item: TListItem;



205
  begin



206
    item := lvInfo.Items.Add;



207
    item.Caption := Field;



208
    item.SubItems.Add(Value);



209
    item.GroupID := GroupID;



210
  end;



173
211



174
  TmpImg: TGraphic;
212
begin



213
  //



214
  // Покажем информацию из TBookRecord



215
  //



216
  lblTitle.Caption := bookInfo.Title;



217
  lblAuthors.Caption := bookInfo.Authors[0].GetFullName;



175
218



176
  StrLen : integer;
219
  with lvInfo.Groups.Add do



177
  ImageType: TCoverImageType;
220
  begin



221
    Header := 'Информация о файле';



222
    AddItem('Папка', bookInfo.Folder, GroupID);



223
    AddItem('Файл', bookInfo.FileName, GroupID);



224
    AddItem('Размер', GetFormattedSize(bookInfo.Size, True), GroupID);



225
    AddItem('Добавлен', DateToStr(bookInfo.Date), GroupID);



226
  end;



227
  { TODO -oNickR -cUsability : для онлайн коллекций необходимо показывать следующие поля }



228
  // libID: Integer;    ???



229
  // LibRate: Integer;  ???



230
  // URI: string;       ???



178
231



179
232
  //



180
  procedure WriteString(Title, Text: string);
233
  // Покажем информацию из файла
  //



234
  if not Assigned(bookStream) or (bookStream.Size = 0) then



181
  begin
235
  begin



182
    mmInfo.SelAttributes.Style := [fsBold];
236
    imgCover.Visible := False;



183
    mmInfo.SetSelText(Title + ': ' + #9);
237
    mmShort.Visible := False;



184
    mmInfo.SelAttributes.Style := [];
238
    Exit;



185
    if Text <> '' then mmInfo.SetSelText(Text);



186
    mmInfo.SetSelText(#13#10)



187
  end;
239
  end;



188
240



189
241
  //FS.SaveToFile('C:\temp\book.xml');



190
begin



191
  FReviewChanged := False;



192



193
  Img.Picture.Bitmap.Canvas.FrameRect(Img.ClientRect);



194
  mmInfo.Lines.Clear;



195
  mmShort.Lines.Clear;



196
  try
242
  try



197
    book := LoadFictionbook(FS);
243
    book := LoadFictionbook(bookStream);



198
    try



199
      MS := TMemoryStream.Create;



200
      CoverID := Book.Description.Titleinfo.Coverpage.XML;



201
      p := pos('"#', CoverID);



202
      if p <> 0 then



203
      begin



204
        Delete(CoverId, 1, p + 1);



205
        p := pos('"', CoverID);



206
        CoverID := Copy(CoverID, 1, p - 1);



207
        for i := 0 to Book.Binary.Count - 1 do



208
        begin



209
          if Book.Binary.Items[i].Id = CoverID then



210
          begin



211
            S := Book.Binary.Items[i].Text;



212
            outStr := DecodeBase64(S);



213
244



214
            StrLen := Length(outStr);
245
    //



215
            MS.Write(PAnsiChar(outStr)^, StrLen);
246
    // покажем обложку (если есть)



216
            ImgVisible := True;
247
    //



217
          end;
248
    imgBookCover := GetBookCover(book);



218
        end;
249
    if Assigned(imgBookCover) then



219
        //MS.SaveToFile('E:\temp\' + CoverID);
250
    begin



251
      try



252
        imgCover.Picture.Assign(imgBookCover);



253
        imgCover.Visible := True;



254
      finally



255
        imgBookCover.Free;



220
      end;
256
      end;



257
    end



258
    else



259
      imgCover.Visible := False;



221
260



222
      if ImgVisible then
261
    with book.Description.Titleinfo do



262
    begin



263
      // ---------------------------------------------



264
      with lvInfo.Groups.Add do



223
      begin
265
      begin



224
        CreateImage(ExtractFileExt(CoverID), TmpImg, ImageType);
266
        Header := 'Общая информация';



225
        if Assigned(TmpImg) then



226
        begin



227
          MS.Seek(0,soFromBeginning);



228
          TmpImg.LoadFromStream(MS);



229
          IMG.Picture.Assign(TmpImg);



230
          IMG.Invalidate;



231
          TmpImg.Free;



232
        end;



233
      end



234
      else



235
        IMG.Picture := nil;



236
    finally



237
      MS.Free;



238
    end;



239
267



240
    with Book.Description.Titleinfo do
268
        { TODO -oNickR -cUsability : может стоит показывать всех авторов? и формировать имя автора более сложным алгоритмом }



241
    begin
269
        //if Author.Count > 0 then



270
        //  lblAuthors.Caption := Author[0].Lastname.Text + ' ' + Author[0].Firstname.Text + ' ' + Author[0].MiddleName.Text;



242
271



243
      mmInfo.SelAttributes.Size := 10;
272
        { TODO -oNickR -cUsability : показывать все серии + номер в серии }



244
      mmInfo.SelAttributes.Style := [fsBold];
273
        if Sequence.Count > 0 then



274
          AddItem('Серия', Sequence[0].Name, GroupID);



245
275



246
      if Author.Count>0 then
276
        { TODO -oNickR -cUsability : показывать все жанры + Алиасы вместо внутренних имен }



247
        mmInfo.SetSelText(Author[0].Lastname.Text+' '+Author[0].Firstname.Text+' '+Author[0].MiddleName.Text+#13#10);
277
        if Genre.Count > 0 then



278
          AddItem('Жанр', Genre[0], GroupID);



279
      end;



248
280



249
      mmInfo.SelAttributes.Size := 12;
281
      // ---------------------------------------------



250
      mmInfo.SelAttributes.Color := clNavy;
282
      with lvInfo.Groups.Add, book.Description.Publishinfo do



251
      mmInfo.SetSelText(Booktitle.Text+#13#10);
283
      begin



284
        Header := 'Издательская информация';



285
        AddItem('Издательство', Publisher.Text, GroupID);



286
        AddItem('Город', City.Text, GroupID);



287
        AddItem('Год', Year, GroupID);



288
        AddItem('ISBN', Isbn.Text, GroupID);



289
      end;



252
290



253
      if Sequence.Count > 0 then
291
      // ---------------------------------------------



254
        WriteString('Серия',Sequence[0].Name);
292
      with lvInfo.Groups.Add, book.Description.Documentinfo do



293
      begin



294
        Header := 'Информация о документе (OCR)';



295
        for i := 0 to Author.Count - 1 do



296
        begin



297
          { TODO -oNickR -cUsability : может стоит формировать имя автора более сложным алгоритмом }



298
          tmpStr := Author[i].Firstname.Text + ' ' + Author[i].Lastname.Text + '(' + Author[i].NickName.Text + ')';



299
          AddItem(IfThen(i = 0, 'Авторы'), tmpStr, GroupID);



300
        end;



255
301



256
      mmInfo.SetSelText(#13#10);
302
        AddItem('Программа', Programused.Text, GroupID);



257
      WriteString('Жанр',IfThen(Genre.Count > 0, Genre[0], ''));
303
        AddItem('Дата', Date.Text, GroupID);



258
      mmInfo.SetSelText(#13#10);
304
        AddItem('ID', Id, GroupID);



305
        AddItem('Версия', Version, GroupID);



259
306



260
      WriteString('PublishInfo','');
307
        for i := 0 to History.p.Count - 1 do



261
      mmInfo.SetSelText('Изд-во: '+ #9 + Book.Description.Publishinfo.Publisher.Text+#13#10);
308
          AddItem(IfThen(i = 0, 'История'), History.p[i].OnlyText, GroupID);



262
      mmInfo.SetSelText('Город: '+ #9 + Book.Description.Publishinfo.City.Text+#13#10);
309
      end;



263
      mmInfo.SetSelText('Год: '+ #9 + Book.Description.Publishinfo.Year+#13#10);



264
      mmInfo.SetSelText('ISBN: '+ #9 + Book.Description.Publishinfo.Isbn.Text+#13#10);



265
      mmInfo.SetSelText(#13#10);



266
310



267
311
      // ---------------------------------------------



268
      WriteString('DocumentInfo (OCR)','');
312
      { TODO -oNickR -cUsability : может стоит добавлять параграфы как есть? }
      for i := 0 to Annotation.p.Count - 1 do



269
      mmInfo.SetSelText('Авторы: '+#13#10);
313
        mmShort.Lines.Add(Annotation.p[i].OnlyText);



270
      for I := 0 to Book.Description.Documentinfo.Author.Count - 1 do



271
        with Book.Description.Documentinfo.Author.Items[i] do



272
            mmInfo.SetSelText(Firstname.Text + ' ' +Lastname.Text + '(' + NickName.Text + ')' + #13#10);



273
      mmInfo.SetSelText('');



274
      mmInfo.SetSelText('Программа: '+ Book.Description.Documentinfo.Programused.Text + #13#10);



275
      mmInfo.SetSelText('Дата: '+ #9 + Book.Description.Documentinfo.Date.Text + #13#10);



276
      mmInfo.SetSelText('ID: '+ #9 + Book.Description.Documentinfo.ID + #13#10);



277
      mmInfo.SetSelText('Version: '+ #9 + Book.Description.Documentinfo.Version + #13#10);



278
      mmInfo.SetSelText('History: '+ #9 + Book.Description.Documentinfo.History.P.Text + #13#10);



279



280
      for I := 0 to Annotation.P.Count - 1 do



281
              mmShort.SetSelText(Annotation.P.Items[i].OnlyText);



282



283
    end;
314
    end;



284
  except
315
  except



316
    //



317
    Assert(False);



285
  end;
318
  end;



286
end;
319
end;



287
320



288
{-------------------- TReviewDownloadThread -----------------------------------}
321
{-------------------- TReviewDownloadThread ----------------------------------- }



289
322



290
procedure TReviewDownloadThread.Execute;
323
procedure TReviewDownloadThread.Execute;



291
var
324
var



292
  reviewParser : TReviewParser;
325
  reviewParser: TReviewParser;



293
begin
326
begin



294
  Synchronize(StartDownload);
327
  Synchronize(StartDownload);



295
  Freview := TStringList.Create;
328
  FReview := TStringList.Create;



296
  try
329
  try



297
    reviewParser := TReviewParser.Create;
330
    reviewParser := TReviewParser.Create;



298
    try
331
    try



299
      reviewParser.Parse(FURL, Freview);
332
      reviewParser.Parse(FUrl, FReview);



300
    finally
333
    finally



301
      reviewParser.Free;
334
      reviewParser.Free;



302
    end;
335
    end;


...
...
306
  end;
341
  end;



307
end;
342
end;



308
343



344
procedure TReviewDownloadThread.StartDownload;



345
begin



346
  FForm.btnLoadReview.Enabled := False;



347
end;



348



309
procedure TReviewDownloadThread.Finish;
349
procedure TReviewDownloadThread.Finish;



310
begin
350
begin



311
  if FForm.mmReview = Nil then Exit; // FForm почему-то не равно nil после уничтожения.
351
  if FForm.mmReview = nil then



312
                                     // зато компоненты обнуляются, поэтому проверям по ним

352
    Exit; // FForm почему-то не равно nil после уничтожения.



353
  // зато компоненты обнуляются, поэтому проверям по ним




313
354



314
  FForm.mmReview.Clear;
355
  FForm.mmReview.Lines := FReview;



315
  FForm.mmReview.Lines.AddStrings(Freview);



316
  FForm.btnLoadReview.Enabled := True;
356
  FForm.btnLoadReview.Enabled := True;



317
  FForm.ReviewChanged := True;
357
  FForm.ReviewChanged := True;



318
  FForm.RzPageControl1.ActivePageIndex := 1;
358
  //FForm.RzPageControl1.ActivePageIndex := 1;



319
end;
359
end;



320
360



321
procedure TReviewDownloadThread.StartDownload;
361
// ------------------------------------------------------------------------------



322
begin



323
  FForm.btnLoadReview.Enabled := False;



324
end;



325
362



326
//------------------------------------------------------------------------------
363
procedure DownloadReview(Form: TfrmBookDetails; URL: string);



327



328
procedure DownloadReview (Form: TfrmBookDetails; URL: string) ;



329
var
364
var



330
  Worker : TReviewDownloadThread;
365
  Worker: TReviewDownloadThread;



331
begin
366
begin



332
  Worker := TReviewDownloadThread.Create(True);
367
  Worker := TReviewDownloadThread.Create(True);



333
  Worker.Form := Form;
368
  Worker.Form := Form;