Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
Топик располагается на нескольких страницах: Ctrl  назад   1 [2] 3   вперед  Ctrl      все
 Re: Открыть PDF из MemoryStream  [new]
Товарищ младший сержант
Member [заблокирован]

Откуда:
Сообщений: 5122
Квейд,

где ты раньше был.
22 дек 16, 17:39    [20037954]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5120
код неоптимален, если в документе тысячи страниц, нужно переделывать метод Paint и бежать не по всем Pages, а только по видимым на экране

но для показа рекламного буклета или какого-нибудь пользовательского документа страниц на 100 - покатит даже без пива
22 дек 16, 18:15    [20038124]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
__Avenger__
Member

Откуда:
Сообщений: 1975
Оказывается, для просмотра и печати pdf прекрасно подходит FastReport 4 и 5-й версий (4 с минимальным допиливанием).

+
--- frxClass.pas.def	Fri Oct 21 13:58:08 2016
+++ frxClass.pas Thu Jan 05 17:15:38 2017
@@ -2003,6 +2003,7 @@
FParentReport: String;
FParentReportObject: TfrxReport;
FPreviewPages: TfrxCustomPreviewPages;
+ FPreviewPagesBase: TfrxCustomPreviewPages;
FPreview: TfrxCustomPreview;
FPreviewForm: TForm;
FPreviewOptions: TfrxPreviewOptions;
@@ -2098,6 +2099,7 @@
procedure WriteVariables(Writer: TWriter);
procedure SetPreview(const Value: TfrxCustomPreview);
procedure SetVersion(const Value: String);
+ procedure SetPreviewPages(const Value: TfrxCustomPreviewPages);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure DefineProperties(Filer: TFiler); override;
@@ -2173,7 +2175,7 @@
property Errors: TStrings read FErrors;
property FileName: String read FFileName write FFileName;
property Modified: Boolean read FModified write FModified;
- property PreviewPages: TfrxCustomPreviewPages read FPreviewPages;
+ property PreviewPages: TfrxCustomPreviewPages read FPreviewPages write SetPreviewPages;
property Pages[Index: Integer]: TfrxPage read GetPages;
property PagesCount: Integer read GetPagesCount;
property Script: TfsScript read FScript;
@@ -8252,7 +8254,8 @@
FStoreInDFM := True;

FEngine := TfrxEngine.Create(Self);
- FPreviewPages := TfrxPreviewPages.Create(Self);
+ FPreviewPagesBase := TfrxPreviewPages.Create(Self);
+ FPreviewPages := FPreviewPagesBase;
FEngine.FPreviewPages := FPreviewPages;
FPreviewPages.FEngine := FEngine;
FDrawText := TfrxDrawText.Create;
@@ -8280,7 +8283,7 @@
FFakeScriptText.Free;
FVariables.Free;
FEngine.Free;
- FPreviewPages.Free;
+ FPreviewPagesBase.Free;
FErrors.Free;
FStyles.Free;
FSysVariables.Free;
@@ -8297,6 +8300,13 @@
FParentForm := nil;
end;

+end;
+
+procedure TfrxReport.SetPreviewPages(const Value: TfrxCustomPreviewPages);
+begin
+ FPreviewPages := Value;
+ FEngine.FPreviewPages := FPreviewPages;
+ FPreviewPages.FEngine := FEngine;
end;

class function TfrxReport.GetDescription: String;
{******************************************}
{                                          }
{             FastReport v4.0              }
{              Preview Pages               }
{                                          }
{         Copyright (c) 1998-2008          }
{         by Alexander Tzyganenko,         }
{            Fast Reports Inc.             }
{                                          }
{******************************************}

unit frxPDFPreviewPages;

interface

{$I frx.inc}

uses
  frxClass, PdfiumCore,
  Windows, Messages, Variants, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TfrxPDFPreviewPages = class(TfrxCustomPreviewPages)
  private
    FPDFDoc: TPdfDocument;
  protected
    function GetCount: Integer; override;
    function GetPage(Index: Integer): TfrxReportPage; override;
    function GetPageSize(Index: Integer): TPoint; override;
  public
    constructor Create(AReport: TfrxReport); override;
    destructor Destroy; override;
    procedure Clear; override;
    procedure Initialize; override;

    procedure DrawPage(Index: Integer; Canvas: TCanvas; ScaleX, ScaleY,
      OffsetX, OffsetY: Extended); override;
    procedure ObjectOver(Index: Integer; X, Y: Integer; Button: TMouseButton;
      Shift: TShiftState; Scale, OffsetX, OffsetY: Extended;
      Click: Boolean; var Cursor: TCursor; DBClick: Boolean = False); override;

    procedure LoadFromStream(Stream: TStream;
      AllowPartialLoading: Boolean = False); override;
    procedure SaveToStream(Stream: TStream); override;
    function LoadFromFile(const FileName: String;
      ExceptionIfNotFound: Boolean = False): Boolean; override;
    procedure SaveToFile(const FileName: String); override;
    function Print: Boolean; override;
    function Export(Filter: TfrxCustomExportFilter): Boolean; override;
  end;

implementation

uses
  Printers,
  frxPrinter,
  frxPrintDialog,
  frxUtils,
  frxRes;

{ TfrxPDFPreviewPages }

constructor TfrxPDFPreviewPages.Create(AReport: TfrxReport);
begin
  inherited;
  FPDFDoc := TPdfDocument.Create;
end;

destructor TfrxPDFPreviewPages.Destroy;
begin
  FPDFDoc.Free;
  inherited;
end;

function TfrxPDFPreviewPages.GetCount: Integer;
begin
  Result := FPDFDoc.PageCount;
end;

function TfrxPDFPreviewPages.GetPage(Index: Integer): TfrxReportPage;
begin
  Result := nil;
end;

function TfrxPDFPreviewPages.GetPageSize(Index: Integer): TPoint;
begin
  if FPDFDoc.Active and (Index < FPDFDoc.PageCount) then
    with FPDFDoc.Pages[Index] do
      Result := Point(Round(Width), Round(Height))
  else
    Result := Point(0, 0);
end;

procedure TfrxPDFPreviewPages.Clear;
begin
  FPDFDoc.Close;
end;

procedure TfrxPDFPreviewPages.Initialize;
begin
  // TODO?
end;

procedure TfrxPDFPreviewPages.LoadFromStream(Stream: TStream;
  AllowPartialLoading: Boolean = False);
begin
  Clear;
  FPDFDoc.LoadFromStream(Stream);
end;

procedure TfrxPDFPreviewPages.SaveToStream(Stream: TStream);
begin
  FPDFDoc.SaveToStream(Stream);
end;

function TfrxPDFPreviewPages.LoadFromFile(const FileName: String;
  ExceptionIfNotFound: Boolean): Boolean;
var
  Stream: TFileStream;
begin
  Result := FileExists(FileName);
  if Result or ExceptionIfNotFound then
  begin
    Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
    try
      LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
  end;
end;

procedure TfrxPDFPreviewPages.SaveToFile(const FileName: String);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TfrxPDFPreviewPages.DrawPage(Index: Integer; Canvas: TCanvas;
  ScaleX, ScaleY, OffsetX, OffsetY: Extended);
var
  APage: TPdfPage;
begin
  if (not FPDFDoc.Active) or (Index >= FPDFDoc.PageCount) then
    Exit;
  APage := FPDFDoc.Pages[Index];
  Canvas.Lock;
  try
    APage.Draw(Canvas.Handle,
      Round(OffsetX),
      Round(OffsetY),
      Round(APage.Width  * ScaleX) - 1,
      Round(APage.Height * ScaleY) - 1
    );
  finally
    Canvas.Unlock;
  end;
end;

procedure TfrxPDFPreviewPages.ObjectOver(Index: Integer; X, Y: Integer; Button: TMouseButton;
  Shift: TShiftState; Scale, OffsetX, OffsetY: Extended;
  Click: Boolean; var Cursor: TCursor; DBClick: Boolean);
begin
  // TODO?
end;

function TfrxPDFPreviewPages.Print: Boolean;
begin
end;

function TfrxPDFPreviewPages.Export(Filter: TfrxCustomExportFilter): Boolean;
begin
  Result := False;
end;

end.



Осталось только печать допилить. На днях проверю и ее.

К сообщению приложен файл. Размер - 122Kb
5 янв 17, 23:43    [20076308]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
__Avenger__
Member

Откуда:
Сообщений: 1975
Тестовый проект, может кому пригодится.

К сообщению приложен файл (PdfiumFrxTest.rar - 51Kb) cкачать
8 янв 17, 02:21    [20081262]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Гаджимурадов Рустам
Member

Откуда:
Сообщений: 59461
Спасибо.
8 янв 17, 02:57    [20081293]     Ответить | Цитировать Сообщить модератору
Между сообщениями интервал более 1 года.
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
коллеги

а есть исходники под делфи-7?
а то моих знаний чтобы портировать на д7 из современной версии недостаточно
19 ноя 18, 10:12    [21737831]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5120
andreymx
коллеги

а есть исходники под делфи-7?
а то моих знаний чтобы портировать на д7 из современной версии недостаточно


исходники чего именно?
19 ноя 18, 11:37    [21737936]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
Квейд
andreymx
коллеги

а есть исходники под делфи-7?
а то моих знаний чтобы портировать на д7 из современной версии недостаточно


исходники чего именно?
приведенные в этом топике примеры использования PDFium используют набор юнитов (PdfiumCore PdfiumLib etc), которые очень далеко ушли от Д7
20081262
20037900

Хочу узнать - вдруг где-то есть что-то под Д7
19 ноя 18, 23:11    [21738613]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
andreymx
Квейд
пропущено...


исходники чего именно?
приведенные в этом топике примеры использования PDFium используют набор юнитов (PdfiumCore PdfiumLib etc), которые очень далеко ушли от Д7
20081262
20037900

Хочу узнать - вдруг где-то есть что-то под Д7
сорри
апну
вдруг кто появился, у кого есть :)
23 ноя 18, 09:23    [21742359]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Гаджимурадов Рустам
Member

Откуда:
Сообщений: 59461
https://github.com/ahausladen/PdfiumLib не подходит?

Posted via ActualForum NNTP Server 1.5

23 ноя 18, 09:32    [21742376]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
Гаджимурадов Рустам
https://github.com/ahausladen/PdfiumLib не подходит?
не хватает знаний для портирования на Д7

{$A8,B-,E-,F-,G+,H+,I+,J-,K-,M-,N-,P+,Q-,R-,S-,T-,U-,V+,X+,Z1}
{$STRINGCHECKS OFF}

unit PdfiumCore;

interface

uses
  Windows, Types, SysUtils, Classes, Contnrs, PdfiumLib;

type
  EPdfException = class(Exception);
  EPdfUnsupportedFeatureException = class(EPdfException);
  EPdfArgumentOutOfRange = class(EPdfException);

  TPdfDocument = class;
  TPdfPage = class;

  TPdfPoint = record
    X, Y: Double;
    procedure Offset(XOffset, YOffset: Double);
    class function Empty: TPdfPoint; static;
  end;

  TPdfRect = record
  private
    function GetHeight: Double; inline;
    function GetWidth: Double; inline;
    procedure SetHeight(const Value: Double); inline;
    procedure SetWidth(const Value: Double); inline;
  public
    property Width: Double read GetWidth write SetWidth;
    property Height: Double read GetHeight write SetHeight;
    procedure Offset(XOffset, YOffset: Double);

    class function Empty: TPdfRect; static;
  public
23 ноя 18, 10:33    [21742467]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Василий 2
Member

Откуда:
Сообщений: 309
А чего там знать, приводишь к старому виду все участки, которые отказываются компилиться
23 ноя 18, 11:08    [21742533]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
Коллеги, все получилось! Но

Ыыыыыы

Ни у кого не завалялась pdfium.dll под Windows XP?
27 ноя 18, 18:21    [21746478]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Василий 2
Member

Откуда:
Сообщений: 309
https://github.com/bblanchon/pdfium-binaries тут нету?
27 ноя 18, 18:42    [21746497]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Кроик Семён
Member

Откуда: СПб --> Dortmund
Сообщений: 6281
https://assendelft.webathome.org/Pdfium/
infos: https://github.com/pvginkel/PdfiumBuild
27 ноя 18, 18:45    [21746498]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Гаджимурадов Рустам
Member

Откуда:
Сообщений: 59461
andreymx> Коллеги, все получилось! Но

Если ты что-то менял в модулях - выложи тут
(ну и автору можешь послать, на всякий).

Posted via ActualForum NNTP Server 1.5

27 ноя 18, 19:22    [21746527]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Василий 2
Member

Откуда:
Сообщений: 309
Автору едва ли интересно возвращать поддержку старых дельфей. Разве что отдельным бранчем добавит
28 ноя 18, 10:17    [21746910]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Гаджимурадов Рустам
Member

Откуда:
Сообщений: 59461
В зависимости от количества и типа изменений, там
может быть (или не быть) достаточно пары директив.

Posted via ActualForum NNTP Server 1.5

28 ноя 18, 10:36    [21746935]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
Василий 2
https://github.com/bblanchon/pdfium-binaries тут нету?
туцт какие то вообще другие длльки, там нет нужных методов вызова, или делфи их не видит
28 ноя 18, 11:12    [21746977]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
все спасибо за ссылки

Кроик Семён
https://assendelft.webathome.org/Pdfium/
infos: https://github.com/pvginkel/PdfiumBuild
с билдом пока не разобрался, не нашел внутри описаний параметров вызова сбилдиной экзешки

а в первой ссылке дллек куча, но ни одна не подходит :(
28 ноя 18, 11:13    [21746982]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
andreymx
Василий 2
https://github.com/bblanchon/pdfium-binaries тут нету?
туцт какие то вообще другие длльки, там нет нужных методов вызова, или делфи их не видит


из ридми:
Introduction
Pdfium.NET SDK it's a class library based on the PDFium project for viewing, navigating, editing and extracting texts from PDF files in your .NET projects.
28 ноя 18, 15:32    [21747528]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Кроик Семён
Member

Откуда: СПб --> Dortmund
Сообщений: 6281
andreymx
ссылке дллек куча, но ни одна не подходит :(


а эта?
https://assendelft.webathome.org/Pdfium/2018-03-04/PdfiumViewer-x86-no_v8-no_xfa
28 ноя 18, 15:36    [21747531]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
Кроик Семён,

спасибо большое, не подходит :(

К сообщению приложен файл. Размер - 6Kb
28 ноя 18, 18:34    [21747781]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
выдрал отсюда, вроде подходит
https://libraries.io/nuget/PdfiumViewer/2.9.0

всем большое спасибо!
Код чуть позже, пусть лежит навсякий
28 ноя 18, 18:46    [21747798]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49159
Квейд
MaratIsk
Квейд,

буду признателен за пример кода


Я обернул вьювер в наследник от TGraphicControl (T24NSPDFViewer = class(TGraphicControl))
Подключаешь его к форме, инициализируешь контрол, вызываешь LoadFromXXX, страницы крутятся через вызов ScrollBy.
Модуль используется в реальном проекте. Код мой, делайте что угодно.

Необходимо наличие вышеуказанной DLL, она есть в свободном доступе.

+

unit vcl24NSPDFViewer;

interface

uses
  System.SysUtils, System.Variants,
  System.Classes, System.Types,
  System.SyncObjs,
  Winapi.Windows, Winapi.Messages,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms,
  Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Generics.Collections,

  IdComponent, IdHTTP;

const
  WM_DONETHREAD = WM_USER + 1;
  WM_RENDERBITMAP = WM_USER + 2;
  WM_RELEASEBITMAP = WM_USER + 3;
  WM_DOWNLOADFILE = WM_USER + 4;

type
  TPDFPointer = record end;
  TPDFDocument = ^TPDFPointer;
  TPDFPage = ^TPDFPointer;

const
  PDF_LIBRARY_NAME = 'PDFIUM.DLL';

type
  TPDFClosePage = procedure(APage: Pointer); stdcall;
  TPDFInitLibrary = procedure; stdcall;
  TPDFDestroyLibrary = procedure; stdcall;
  TPDFGetPageCount = function(ADocument: Pointer): Integer; stdcall;
  TPDFCloseDocument = procedure(ADocument: Pointer); stdcall;
  TPDFLoadMemDocument = function(ABuffer: Pointer; ASize: Integer;
    APassword: PAnsiChar): Pointer; stdcall;
  TPDFGetPageSizeByIndex = function(ADocument: Pointer; APage: Integer;
    var AWidth, AHeight: Double): Integer; stdcall;
  TPDFGetPageWidth = function(APage: Pointer): Double; stdcall;
  TPDFGetPageHeight = function(APage: Pointer): Double; stdcall;
  TPDFRenderPage = procedure(ADC: HDC; APage: Pointer;
    ALeft, ATop, AWidth, AHeight, ARotate, AFlags: Integer); stdcall;
  TPDFLoadPage = function(ADocument: Pointer; APage: Integer): TPDFPage; stdcall;

  T24NSDocumentPage = class;
  T24NSPDFViewer = class;


  T24NSDownloader = class(TIdHTTP);

  T24NSHelperThread = class(TThread)
  private
    FViewer: T24NSPDFViewer;
    FMessageLoop: Boolean;
  protected
    procedure Execute; override;
    procedure Invalidate;
    procedure RenderBitmap(const AMsg: TMsg);
    procedure ReleaseBitmap(const AMsg: TMsg);
  public
    constructor Create(AViewer: T24NSPDFViewer);
    procedure Done;
    procedure WaitLooping;
  end;

  TPDFLibrary = packed record
  public
    ClosePage: TPDFClosePage;
    InitLibrary: TPDFInitLibrary;
    RenderPage: TPDFRenderPage;
    LoadPage: TPDFLoadPage;
    DestroyLibrary: TPDFDestroyLibrary;
    GetPageSizeByIndex: TPDFGetPageSizeByIndex;
    GetPageCount: TPDFGetPageCount;
    CloseDocument: TPDFCloseDocument;
    GetPageWidth: TPDFGetPageWidth;
    GetPageHeight: TPDFGetPageHeight;
    LoadMemDocument: TPDFLoadMemDocument;
  end;

  T24NSDocumentEngine = class(TObject)
  strict private
    FPDFLibrary: TPDFLibrary;
    FDocument: TPDFDocument;
    FMemoryBuffer: TMemoryStream;
    FModule: HMODULE;
    procedure FreeDocument;
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadFromStream(AStream: TStream);
    function Initialized: Boolean; inline;
    function PageCount: Integer; inline;
    property PDFLibrary: TPDFLibrary read FPDFLibrary;
    property Document: TPDFDocument read FDocument;
  end;

  T24NSDocumentPage = class(TObject)
  strict private
    FEngine: T24NSDocumentEngine;
    FBitmap: TBitmap;
    FIndex: Integer;
    FWidth: Double;
    FHeight: Double;
    FBitmapRendered: Boolean;
    FTimer: TTimer;
    FViewer: T24NSPDFViewer;
    FBlendValue: Integer;
    procedure TimerTick(Sender: TObject);
    procedure UpdatePage;
  public
    constructor Create(AViewer: T24NSPDFViewer; AIndex: Integer);
    destructor Destroy; override;
    function RenderedHeight(AWidth: Integer): Integer;
    procedure ReleaseBitmap;
    procedure RenderBitmap(AWidth: Integer);
    procedure ResetTimer; inline;
    procedure PrereleaseBitmap; inline;
    property BlendValue: Integer read FBlendValue;
    property Timer: TTimer read FTimer;
    property BitmapRendered: Boolean read FBitmapRendered;
    property Width: Double read FWidth;
    property Height: Double read FHeight;
    property Bitmap: TBitmap read FBitmap;
  end;

  T24NSDocumentPages = class(TObject)
  strict private
    FPages: TObjectList<T24NSDocumentPage>;
    FEngine: T24NSDocumentEngine;
    FPagesHeight: Integer;
    FViewer: T24NSPDFViewer;
  protected
    function GetCount: Integer; inline;
    procedure PreparePages;
  public
    constructor Create(AViewer: T24NSPDFViewer);
    destructor Destroy; override;
    function Page(AIndex: Integer): T24NSDocumentPage; inline;
    function First: T24NSDocumentPage; inline;
    function Last: T24NSDocumentPage; inline;
    property Count: Integer read GetCount;
    property PagesHeight: Integer read FPagesHeight;
  end;

  T24NSPDFViewer = class(TGraphicControl)
  strict private
    FEngine: T24NSDocumentEngine;
    FPages: T24NSDocumentPages;
    FDownloader: T24NSDownloader;
    FHelperThread: T24NSHelperThread;
    FViewOffset: Integer;
    FBlendFunction: TBlendFunction;
    FOnReady: TNotifyEvent;
    FDocumentLoaded: Boolean;
    FDocumentLoading: Boolean;
    FDocumentProgress: Integer;
    FBeginDocument: Boolean;
    FEndDocument: Boolean;
    FPainting: Boolean;
  protected
    procedure ReleaseBitmap(APageIndex: Integer; ABitmap: TBitmap); inline;
    procedure RenderBitmap(APageIndex: Integer; ABitmap: TBitmap); inline;
    procedure DownloadWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure Paint; override;
    property Engine: T24NSDocumentEngine read FEngine;
    property Pages: T24NSDocumentPages read FPages;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure ScrollBy(ADelta: Integer);
    procedure Ready;
    procedure LoadFromFile(const AFileName: string);
    procedure LoadFromURL(const AURL: string);
    procedure LoadFromStream(AStream: TStream);
    property OnReady: TNotifyEvent read FOnReady write FOnReady;
    property Painting: Boolean read FPainting;
    property EndDocument: Boolean read FEndDocument;
    property BeginDocument: Boolean read FBeginDocument;
  end;

implementation

resourcestring
  RST_PDFIUMNOTLOADED = 'PDFIUM.DLL IS NOT LOADED CORRECTLY';


const
  DEF_FONT_SIZE = 38;
  DEF_FONT_NAME = 'Impact';
  DEF_FONT_COLOR = $DADADA;
  DEF_BLENDING_STEP = 32;
  DEF_BLENDING_INTERVAL = 32;

{ T24NSDocumentEngine }

constructor T24NSDocumentEngine.Create;
begin
  inherited Create;
  FMemoryBuffer := nil;
  FModule := SafeLoadLibrary(PDF_LIBRARY_NAME);
  with FPDFLibrary do
  begin
    if FModule = 0 then
      raise Exception.CreateRes(@RST_PDFIUMNOTLOADED);
    InitLibrary := GetProcAddress(FModule, '_FPDF_InitLibrary@0');
    DestroyLibrary := GetProcAddress(FModule, '_FPDF_DestroyLibrary@0');
    RenderPage := GetProcAddress(FModule, '_FPDF_RenderPage@32');
    LoadPage := GetProcAddress(FModule, '_FPDF_LoadPage@8');
    GetPageWidth := GetProcAddress(FModule, '_FPDF_GetPageWidth@4');
    GetPageHeight := GetProcAddress(FModule, '_FPDF_GetPageHeight@4');
    GetPageCount := GetProcAddress(FModule, '_FPDF_GetPageCount@4');
    LoadMemDocument := GetProcAddress(FModule, '_FPDF_LoadMemDocument@12');
    CloseDocument := GetProcAddress(FModule, '_FPDF_CloseDocument@4');
    ClosePage := GetProcAddress(FModule, '_FPDF_ClosePage@4');
    GetPageSizeByIndex := GetProcAddress(FModule, '_FPDF_GetPageSizeByIndex@16');
    InitLibrary
  end
end;

destructor T24NSDocumentEngine.Destroy;
begin
  if Initialized then
  begin
    FreeDocument;
    FreeAndNil(FMemoryBuffer);
    FPDFLibrary.DestroyLibrary;
    FreeLibrary(FModule)
  end;
  inherited Destroy
end;

procedure T24NSDocumentEngine.FreeDocument;
begin
  if FDocument <> nil then
    FPDFLibrary.CloseDocument(FDocument);
  FDocument := nil;
  FreeAndNil(FMemoryBuffer);
  FMemoryBuffer := TMemoryStream.Create
end;

function T24NSDocumentEngine.Initialized: Boolean;
begin
  Result := FModule <> 0
end;

procedure T24NSDocumentEngine.LoadFromStream(AStream: TStream);
begin
  if Initialized then
  begin
    FreeDocument;
    if AStream.Size > 0 then
      try
        FMemoryBuffer.LoadFromStream(AStream);
        with FMemoryBuffer, FPDFLibrary do
          FDocument := LoadMemDocument(Memory, Size, nil)
      except
        FreeDocument
      end
  end
end;

function T24NSDocumentEngine.PageCount: Integer;
begin
  Result := 0;
  if Initialized and (FDocument <> nil) then
    Result := FPDFLibrary.GetPageCount(FDocument)
end;

{ T24NSPDFViewer }

procedure T24NSPDFViewer.AfterConstruction;
begin
  inherited AfterConstruction;
  FHelperThread.WaitLooping
end;

constructor T24NSPDFViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FViewOffset := 0;
  FBeginDocument := False;
  FEndDocument := False;
  FDocumentLoaded := False;
  FDocumentLoading := False;
  FPainting := False;
  FDocumentProgress := 0;
  FBlendFunction.BlendOp := AC_SRC_OVER;
  FBlendFunction.BlendFlags := 0;
  FBlendFunction.SourceConstantAlpha := 255;
  FBlendFunction.AlphaFormat := 0;
  Color := clWhite;
  FEngine := T24NSDocumentEngine.Create;
  FPages := T24NSDocumentPages.Create(Self);
  FHelperThread := T24NSHelperThread.Create(Self);

  FDownloader := T24NSDownloader.Create(Self);
  FDownloader.AllowCookies := True;
  FDownloader.HandleRedirects := True
end;

destructor T24NSPDFViewer.Destroy;
begin
  FHelperThread.Done;
  FreeAndNil(FHelperThread);
  FreeAndNil(FPages);
  FreeAndNil(FEngine);
  inherited Destroy
end;


procedure T24NSPDFViewer.DownloadWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
  ContentLength: Int64;
begin
  ContentLength := FDownloader.Response.ContentLength;
  FDocumentProgress := 100 * AWorkCount div ContentLength;
  TWinControl(Owner).Repaint
end;

procedure T24NSPDFViewer.LoadFromFile(const AFileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream)
  finally
    FreeAndNil(Stream)
  end
end;

procedure T24NSPDFViewer.LoadFromStream(AStream: TStream);
begin
  try
    if AStream.Size = 0 then
      Abort;
    AStream.Position := 0;
    FEngine.LoadFromStream(AStream);
    FPages.PreparePages;
    Ready;
    Repaint
  except
    FDocumentLoaded := False
  end
end;


procedure T24NSPDFViewer.LoadFromURL(const AURL: string);
var
  Stream: TStream;
begin
  Stream := TMemoryStream.Create;
  FDocumentLoading := True;
  try
    FDownloader.OnWork := DownloadWork;
    FDocumentLoaded := False;
    TWinControl(Owner).Repaint;
    try
      FDownloader.Get(AURL, Stream);
      FDocumentLoading := False;
      LoadFromStream(Stream)
    except
      Ready
    end
  finally
    FDownloader.OnWork := nil;
    FDocumentProgress := 0;
    FreeAndNil(Stream)
  end
end;

procedure T24NSPDFViewer.Paint;
var
  X, Y: Integer;
  R: TRect;
  RealHeight: Integer;
  I: Integer;
  Progress: string;
  Size: TSize;
begin
  FPainting := True;
  try
    with Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := Color;
      FillRect(ClientRect)
    end;
    if FDocumentLoading then
    begin
      Progress := Concat(FDocumentProgress.ToString, '%');
      with Canvas.Font do
      begin
        Name := DEF_FONT_NAME;
        Size := DEF_FONT_SIZE;
        Color := DEF_FONT_COLOR
      end;
      Size := Canvas.TextExtent(Progress);
      X := (ClientWidth - Size.Width) div 2;
      Y := (ClientHeight - Size.Height) div 2;
      Canvas.TextOut(X, Y, Progress)
    end;
    if FDocumentLoaded then
    begin
      X := 0;
      Y := 0;
      Dec(Y, FViewOffset);
      for I := 0 to Pred(FPages.Count) do
      begin
        RealHeight := FPages.Page(I).RenderedHeight(ClientWidth);
        if ((Y + RealHeight) > 0) and (Y < ClientHeight) then
        begin
          if not FPages.Page(I).BitmapRendered then
            RenderBitmap(I, nil)
          else
          begin
            R := Rect(X, Y, ClientWidth, Y + RealHeight);
            if FPages.Page(I).Timer.Enabled then
            begin
              FBlendFunction.SourceConstantAlpha := FPages.Page(I).BlendValue;
              AlphaBlend(Canvas.Handle, X, Y, ClientWidth, RealHeight,
                FPages.Page(I).Bitmap.Canvas.Handle,
                0, 0, ClientWidth, RealHeight, FBlendFunction)
            end
            else
              BitBlt(Canvas.Handle, X, Y, ClientWidth, RealHeight,
                FPages.Page(I).Bitmap.Canvas.Handle, 0, 0, SRCCOPY)
          end
        end
        else
        begin
          if FPages.Page(I).BitmapRendered then
          begin
            FPages.Page(I).PrereleaseBitmap;
            ReleaseBitmap(I, FPages.Page(I).Bitmap)
          end;
        end;
        Inc(Y, RealHeight)
      end;
{$IFDEF 24NSDEBUG}
      Canvas.TextOut(0, 0, FViewOffset.ToString)
{$ENDIF}
    end
  finally
    FPainting := False
  end
end;

procedure T24NSPDFViewer.Ready;
begin
  FDocumentLoading := False;
  FDocumentLoaded := True;
  FBeginDocument := True;
  FEndDocument := False;
  FViewOffset := 0;
  if Assigned(FOnReady) then
    FOnReady(Self);
  Invalidate
end;

procedure T24NSPDFViewer.ReleaseBitmap(APageIndex: Integer; ABitmap: TBitmap);
begin
  PostThreadMessage(FHelperThread.ThreadID, WM_RELEASEBITMAP, WPARAM(APageIndex), LPARAM(ABitmap))
end;

procedure T24NSPDFViewer.RenderBitmap(APageIndex: Integer; ABitmap: TBitmap);
begin
  PostThreadMessage(FHelperThread.ThreadID, WM_RENDERBITMAP, WPARAM(APageIndex), LPARAM(ClientWidth))
end;

procedure T24NSPDFViewer.ScrollBy(ADelta: Integer);
var
  Y: Integer;
begin
  FBeginDocument := False;
  FEndDocument := False;
  if FDocumentLoaded then
  begin
    Inc(FViewOffset, ADelta);
    if FViewOffset <= 0 then
      FViewOffset := 0;
    Y := Pages.PagesHeight - ClientHeight;
    if Y < 0 then
      Y := 0;
    if FViewOffset > Y then
      FViewOffset := Y;
    FBeginDocument := FViewOffset = 0;
    FEndDocument := FViewOffset = Y;
    Invalidate
  end
end;

{ T24NSDocumentPages }

constructor T24NSDocumentPages.Create(AViewer: T24NSPDFViewer);
begin
  inherited Create;
  FViewer := AViewer;
  FEngine := AViewer.Engine;
  FPagesHeight := 0;
  FPages := TObjectList<T24NSDocumentPage>.Create(True)
end;

destructor T24NSDocumentPages.Destroy;
begin
  FreeAndNil(FPages);
  inherited Destroy
end;

function T24NSDocumentPages.GetCount: Integer;
begin
  Result := FPages.Count
end;

function T24NSDocumentPages.First: T24NSDocumentPage;
begin
  if Count = 0 then
    Exit(nil);
  Exit(Page(0))
end;

function T24NSDocumentPages.Last: T24NSDocumentPage;
begin
  if Count = 0 then
    Exit(nil);
  Exit(Page(Pred(Count)))
end;

procedure T24NSDocumentPages.PreparePages;
var
  Page: T24NSDocumentPage;
  I: Integer;
  X: Integer;
begin
  FPagesHeight := 0;
  FPages.Clear;
  X := FViewer.ClientWidth;
  for I := 0 to Pred(FEngine.PageCount) do
  begin
    Page := T24NSDocumentPage.Create(FViewer, I);
    FPages.Add(Page);
    FPagesHeight := FPagesHeight + Page.RenderedHeight(X)
  end
end;

function T24NSDocumentPages.Page(AIndex: Integer): T24NSDocumentPage;
begin
  Result := FPages.List[AIndex]
end;

{ T24NSDocumentPage }

constructor T24NSDocumentPage.Create(AViewer: T24NSPDFViewer; AIndex: Integer);
begin
  inherited Create;
  FBitmap := nil;
  FViewer := AViewer;
  FIndex := AIndex;
  FBitmapRendered := False;
  FBlendValue := 0;
  FEngine := AViewer.Engine;
  FTimer := TTimer.Create(nil);
  FTimer.OnTimer := TimerTick;
  FTimer.Enabled := False;
  FTimer.Interval := DEF_BLENDING_INTERVAL;
  UpdatePage;
  ReleaseBitmap
end;

destructor T24NSDocumentPage.Destroy;
begin
  FreeAndNil(FTimer);
  FreeAndNil(FBitmap);
  inherited Destroy
end;

procedure T24NSDocumentPage.PrereleaseBitmap;
begin
  ResetTimer;
  FBitmapRendered := False
end;

procedure T24NSDocumentPage.UpdatePage;
begin
  with FEngine, FEngine.PDFLibrary do
    GetPageSizeByIndex(Document, FIndex, FWidth, FHeight)
end;

procedure T24NSDocumentPage.ReleaseBitmap;
begin
  FBitmapRendered := False;
  FreeAndNil(FBitmap);
  FBitmap := TBitmap.Create
end;

procedure T24NSDocumentPage.RenderBitmap(AWidth: Integer);
var
  DisplayWidth: Integer;
  DisplayHeight: Integer;
  Page: TPDFPage;
begin
  if not FBitmapRendered then
  begin
    Page := FEngine.PDFLibrary.LoadPage(FEngine.Document, FIndex);
    try
      FBitmap.Canvas.Lock;
      try
        DisplayWidth := AWidth;
        DisplayHeight := RenderedHeight(DisplayWidth);
        FBitmap.SetSize(DisplayWidth, DisplayHeight);
        FEngine.PDFLibrary.RenderPage(FBitmap.Canvas.Handle,
          Page, 0, 0, DisplayWidth, DisplayHeight, 0, 0)
      finally
        FBitmap.Canvas.Unlock
      end;
      FBlendValue := 0;
      FBitmapRendered := True;
      Timer.Enabled := True
    finally
      FEngine.PDFLibrary.ClosePage(Page)
    end
  end
end;

function T24NSDocumentPage.RenderedHeight(AWidth: Integer): Integer;
begin
  Result := Round(Height * (AWidth / Width))
end;

procedure T24NSDocumentPage.ResetTimer;
begin
  FTimer.Enabled := False;
  FBlendValue := 0
end;

procedure T24NSDocumentPage.TimerTick(Sender: TObject);
begin
  Inc(FBlendValue, DEF_BLENDING_STEP);
  if FBlendValue >= 255 then
    ResetTimer;
  FViewer.Invalidate
end;

{ T24NSHelperThread }

constructor T24NSHelperThread.Create(AViewer: T24NSPDFViewer);
begin
  inherited Create(False);
  Priority := tpLowest;
  FViewer := AViewer;
  FreeOnTerminate := False
end;

procedure T24NSHelperThread.WaitLooping;
begin
  while not FMessageLoop do
    SwitchToThread
end;

procedure T24NSHelperThread.Execute;
var
  Msg: TMsg;

  function HandleMessage: Boolean; near;

    function NeedHandleMessage: Boolean; near;
    begin
      Result := (Msg.Message >= WM_DONETHREAD)
        and (Msg.Message <= WM_DOWNLOADFILE)
    end;

  begin
    Result := NeedHandleMessage;
    if Result then
      case Msg.Message of
        WM_DONETHREAD:
          Terminate;
        WM_RELEASEBITMAP:
          ReleaseBitmap(Msg);
        WM_RENDERBITMAP:
          RenderBitmap(Msg)
      end
  end;

  function ProcessMessage: Boolean; near;
  begin
    if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then
    begin
      Result := PeekMessage(Msg, 0, 0, 0, PM_REMOVE);
      if Result then
      begin
        if not HandleMessage then
          if not Terminated then
          begin
            TranslateMessage(Msg);
            DispatchMessage(Msg)
          end
      end
    end
    else
      Result := False
  end;

begin
  FMessageLoop := True;
  try
    while not Terminated do
      if not ProcessMessage then
        WaitMessage
  finally
    FMessageLoop := False
  end
end;

procedure T24NSHelperThread.Invalidate;
begin
  if FViewer.Owner is TWinControl then
    TWinControl(FViewer.Owner).Invalidate
end;

procedure T24NSHelperThread.ReleaseBitmap;
begin
  FViewer.Pages.Page(AMsg.wParam).ReleaseBitmap
end;

procedure T24NSHelperThread.RenderBitmap;
begin
  while FViewer.Painting do
    SwitchToThread;
  FViewer.Pages.Page(AMsg.wParam).RenderBitmap(AMsg.lParam)
end;

procedure T24NSHelperThread.Done;
begin
  if not Suspended and not Terminated then
    PostThreadMessage(ThreadID, WM_DONETHREAD, 0, 0)
end;

end.







вот что получилось для Д7
+
unit vcl24NSPDFViewer;

interface

uses
  SysUtils, Variants,
  Classes, Types,
  SyncObjs,
  Windows, Messages,
  Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
//  ,  Collections,

  IdComponent, IdHTTP;

const
  WM_DONETHREAD = WM_USER + 1;
  WM_RENDERBITMAP = WM_USER + 2;
  WM_RELEASEBITMAP = WM_USER + 3;
  WM_DOWNLOADFILE = WM_USER + 4;

type
  TPDFPointer = record end;
  TPDFDocument = ^TPDFPointer;
  TPDFPage = ^TPDFPointer;

const
  PDF_LIBRARY_NAME = 'PDFIUM.DLL';

type
  TPDFClosePage = procedure(APage: Pointer); stdcall;
  TPDFInitLibrary = procedure; stdcall;
  TPDFDestroyLibrary = procedure; stdcall;
  TPDFGetPageCount = function(ADocument: Pointer): Integer; stdcall;
  TPDFCloseDocument = procedure(ADocument: Pointer); stdcall;
  TPDFLoadMemDocument = function(ABuffer: Pointer; ASize: Integer;
    APassword: PAnsiChar): Pointer; stdcall;
  TPDFGetPageSizeByIndex = function(ADocument: Pointer; APage: Integer;
    var AWidth, AHeight: Double): Integer; stdcall;
  TPDFGetPageWidth = function(APage: Pointer): Double; stdcall;
  TPDFGetPageHeight = function(APage: Pointer): Double; stdcall;
  TPDFRenderPage = procedure(ADC: HDC; APage: Pointer;
    ALeft, ATop, AWidth, AHeight, ARotate, AFlags: Integer); stdcall;
  TPDFLoadPage = function(ADocument: Pointer; APage: Integer): TPDFPage; stdcall;

  T24NSDocumentPage = class;
  T24NSPDFViewer = class;
  TArr24NSDocumentPage = array of T24NSDocumentPage;



  T24NSDownloader = class(TIdHTTP);

  T24NSHelperThread = class(TThread)
  private
    FViewer: T24NSPDFViewer;
    FMessageLoop: Boolean;
  protected
    procedure Execute; override;
    procedure Invalidate;
    procedure RenderBitmap(const AMsg: TMsg);
    procedure ReleaseBitmap(const AMsg: TMsg);
  public
    constructor Create(AViewer: T24NSPDFViewer);
    procedure Done;
    procedure WaitLooping;
  end;

  TPDFLibrary = class
  public
    ClosePage: TPDFClosePage;
    InitLibrary: TPDFInitLibrary;
    RenderPage: TPDFRenderPage;
    LoadPage: TPDFLoadPage;
    DestroyLibrary: TPDFDestroyLibrary;
    GetPageSizeByIndex: TPDFGetPageSizeByIndex;
    GetPageCount: TPDFGetPageCount;
    CloseDocument: TPDFCloseDocument;
    GetPageWidth: TPDFGetPageWidth;
    GetPageHeight: TPDFGetPageHeight;
    LoadMemDocument: TPDFLoadMemDocument;
  end;

  T24NSDocumentEngine = class(TObject)
  private
    FPDFLibrary: TPDFLibrary;
    FDocument: TPDFDocument;
    FMemoryBuffer: TMemoryStream;
    FModule: HMODULE;
    procedure FreeDocument;
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadFromStream(AStream: TStream);
    function Initialized: Boolean;
    function PageCount: Integer;
    property PDFLibrary: TPDFLibrary read FPDFLibrary;
    property Document: TPDFDocument read FDocument;
  end;

  T24NSDocumentPage = class(TObject)
  private
    FEngine: T24NSDocumentEngine;
    FBitmap: TBitmap;
    FIndex: Integer;
    FWidth: Double;
    FHeight: Double;
    FBitmapRendered: Boolean;
    FTimer: TTimer;
    FViewer: T24NSPDFViewer;
    FBlendValue: Integer;
    procedure TimerTick(Sender: TObject);
    procedure UpdatePage;
  public
    constructor Create(AViewer: T24NSPDFViewer; AIndex: Integer);
    destructor Destroy; override;
    function RenderedHeight(AWidth: Integer): Integer;
    procedure ReleaseBitmap;
    procedure RenderBitmap(AWidth: Integer);
    procedure ResetTimer;
    procedure PrereleaseBitmap;
    property BlendValue: Integer read FBlendValue;
    property Timer: TTimer read FTimer;
    property BitmapRendered: Boolean read FBitmapRendered;
    property Width: Double read FWidth;
    property Height: Double read FHeight;
    property Bitmap: TBitmap read FBitmap;
  end;

  T24NSDocumentPages = class(TObject)
  private
    //FPages: TObjectList<T24NSDocumentPage>;
    FPages: TArr24NSDocumentPage;
    FEngine: T24NSDocumentEngine;
    FPagesHeight: Integer;
    FViewer: T24NSPDFViewer;
  protected
    function GetCount: Integer;
    procedure PreparePages;
  public
    constructor Create(AViewer: T24NSPDFViewer);
    destructor Destroy; override;
    function Page(AIndex: Integer): T24NSDocumentPage;
    function First: T24NSDocumentPage;
    function Last: T24NSDocumentPage;
    property Count: Integer read GetCount;
    property PagesHeight: Integer read FPagesHeight;
  end;

  T24NSPDFViewer = class(TGraphicControl)
  private
    FEngine: T24NSDocumentEngine;
    FPages: T24NSDocumentPages;
    FDownloader: T24NSDownloader;
    FHelperThread: T24NSHelperThread;
    FViewOffset: Integer;
    FBlendFunction: TBlendFunction;
    FOnReady: TNotifyEvent;
    FDocumentLoaded: Boolean;
    FDocumentLoading: Boolean;
    FDocumentProgress: Integer;
    FBeginDocument: Boolean;
    FEndDocument: Boolean;
    FPainting: Boolean;
  protected
    procedure ReleaseBitmap(APageIndex: Integer; ABitmap: TBitmap);
    procedure RenderBitmap(APageIndex: Integer; ABitmap: TBitmap);
    procedure DownloadWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure Paint; override;
    property Engine: T24NSDocumentEngine read FEngine;
    property Pages: T24NSDocumentPages read FPages;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure ScrollBy(ADelta: Integer);
    procedure Ready;
    procedure LoadFromFile(const AFileName: string);
    procedure LoadFromURL(const AURL: string);
    procedure LoadFromStream(AStream: TStream);
    property OnReady: TNotifyEvent read FOnReady write FOnReady;
    property Painting: Boolean read FPainting;
    property EndDocument: Boolean read FEndDocument;
    property BeginDocument: Boolean read FBeginDocument;
  end;

implementation

resourcestring
  RST_PDFIUMNOTLOADED = 'PDFIUM.DLL IS NOT LOADED CORRECTLY';


const
  DEF_FONT_SIZE = 38;
  DEF_FONT_NAME = 'Impact';
  DEF_FONT_COLOR = $DADADA;
  DEF_BLENDING_STEP = 32;
  DEF_BLENDING_INTERVAL = 32;

{ T24NSDocumentEngine }

constructor T24NSDocumentEngine.Create;
begin
  inherited Create;
  FMemoryBuffer := nil;
  FModule := SafeLoadLibrary(PDF_LIBRARY_NAME);
  FPDFLibrary := TPDFLibrary.Create; // 27-11-2018
  with FPDFLibrary do
  begin
    if FModule = 0 then
      raise Exception.CreateRes(@RST_PDFIUMNOTLOADED);
    InitLibrary := GetProcAddress(FModule, '_FPDF_InitLibrary@0');
    DestroyLibrary := GetProcAddress(FModule, '_FPDF_DestroyLibrary@0');
    RenderPage := GetProcAddress(FModule, '_FPDF_RenderPage@32');
    LoadPage := GetProcAddress(FModule, '_FPDF_LoadPage@8');
    GetPageWidth := GetProcAddress(FModule, '_FPDF_GetPageWidth@4');
    GetPageHeight := GetProcAddress(FModule, '_FPDF_GetPageHeight@4');
    GetPageCount := GetProcAddress(FModule, '_FPDF_GetPageCount@4');
    LoadMemDocument := GetProcAddress(FModule, '_FPDF_LoadMemDocument@12');
    CloseDocument := GetProcAddress(FModule, '_FPDF_CloseDocument@4');
    ClosePage := GetProcAddress(FModule, '_FPDF_ClosePage@4');
    GetPageSizeByIndex := GetProcAddress(FModule, '_FPDF_GetPageSizeByIndex@16');
    InitLibrary;
  end
end;

destructor T24NSDocumentEngine.Destroy;
begin
  if Initialized then
  begin
    FreeDocument;
    FreeAndNil(FMemoryBuffer);
    FPDFLibrary.DestroyLibrary;
    FreeLibrary(FModule)
  end;
  inherited Destroy
end;

procedure T24NSDocumentEngine.FreeDocument;
begin
  if FDocument <> nil then
    FPDFLibrary.CloseDocument(FDocument);
  FDocument := nil;
  FreeAndNil(FMemoryBuffer);
  FMemoryBuffer := TMemoryStream.Create
end;

function T24NSDocumentEngine.Initialized: Boolean;
begin
  Result := FModule <> 0
end;

procedure T24NSDocumentEngine.LoadFromStream(AStream: TStream);
begin
  if Initialized then
  begin
    FreeDocument;
    if AStream.Size > 0 then
      try
        FMemoryBuffer.LoadFromStream(AStream);
        with FMemoryBuffer, FPDFLibrary do
          FDocument := LoadMemDocument(Memory, Size, nil)
      except
        FreeDocument
      end
  end
end;

function T24NSDocumentEngine.PageCount: Integer;
begin
  Result := 0;
  if Initialized and (FDocument <> nil) then
    Result := FPDFLibrary.GetPageCount(FDocument)
end;

{ T24NSPDFViewer }

procedure T24NSPDFViewer.AfterConstruction;
begin
  inherited AfterConstruction;
  FHelperThread.WaitLooping
end;

constructor T24NSPDFViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FViewOffset := 0;
  FBeginDocument := False;
  FEndDocument := False;
  FDocumentLoaded := False;
  FDocumentLoading := False;
  FPainting := False;
  FDocumentProgress := 0;
  FBlendFunction.BlendOp := AC_SRC_OVER;
  FBlendFunction.BlendFlags := 0;
  FBlendFunction.SourceConstantAlpha := 255;
  FBlendFunction.AlphaFormat := 0;
  Color := clWhite;
  FEngine := T24NSDocumentEngine.Create;
  FPages := T24NSDocumentPages.Create(Self);
  FHelperThread := T24NSHelperThread.Create(Self);

  FDownloader := T24NSDownloader.Create(Self);
  FDownloader.AllowCookies := True;
  FDownloader.HandleRedirects := True
end;

destructor T24NSPDFViewer.Destroy;
begin
  FHelperThread.Done;
  FreeAndNil(FHelperThread);
  FreeAndNil(FPages);
  FreeAndNil(FEngine);
  inherited Destroy
end;


procedure T24NSPDFViewer.DownloadWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
  ContentLength: Int64;
begin
  ContentLength := FDownloader.Response.ContentLength;
  FDocumentProgress := 100 * AWorkCount div ContentLength;
  TWinControl(Owner).Repaint;
end;

procedure T24NSPDFViewer.LoadFromFile(const AFileName: string);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream)
  finally
    FreeAndNil(Stream)
  end
end;

procedure T24NSPDFViewer.LoadFromStream(AStream: TStream);
begin
  try
    if AStream.Size = 0 then
      Abort;
    AStream.Position := 0;
    FEngine.LoadFromStream(AStream);
    FPages.PreparePages;
    Ready;
    Repaint
  except
    FDocumentLoaded := False
  end
end;


procedure T24NSPDFViewer.LoadFromURL(const AURL: string);
var
  Stream: TStream;
begin
  Stream := TMemoryStream.Create;
  FDocumentLoading := True;
  try
    FDownloader.OnWork := DownloadWork;
    FDocumentLoaded := False;
    TWinControl(Owner).Repaint;
    try
      FDownloader.Get(AURL, Stream);
      FDocumentLoading := False;
      LoadFromStream(Stream)
    except
      Ready
    end
  finally
    FDownloader.OnWork := nil;
    FDocumentProgress := 0;
    FreeAndNil(Stream)
  end
end;

procedure T24NSPDFViewer.Paint;
var
  X, Y: Integer;
  R: TRect;
  RealHeight: Integer;
  I: Integer;
  Progress: string;
  Size: TSize;
begin
  FPainting := True;
  try
    with Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := Color;
      FillRect(ClientRect)
    end;
    if FDocumentLoading then
    begin
      //Progress := Concat(FDocumentProgress.ToString, '%');
      Progress := INttostr(FDocumentProgress) +  '%';
      with Canvas.Font do
      begin
        Name := DEF_FONT_NAME;
        Size := DEF_FONT_SIZE;
        Color := DEF_FONT_COLOR
      end;
      Size := Canvas.TextExtent(Progress);
      //X := (ClientWidth - Size.Width) div 2;
      //Y := (ClientHeight - Size.Height) div 2;
      X := (ClientWidth - Size.cx) div 2;
      Y := (ClientHeight - Size.cy) div 2;
      Canvas.TextOut(X, Y, Progress)
    end;
    if FDocumentLoaded then
    begin
      X := 0;
      Y := 0;
      Dec(Y, FViewOffset);
      for I := 0 to Pred(FPages.Count) do
      begin
        RealHeight := FPages.Page(I).RenderedHeight(ClientWidth);
        if ((Y + RealHeight) > 0) and (Y < ClientHeight) then
        begin
          if not FPages.Page(I).BitmapRendered then
            RenderBitmap(I, nil)
          else
          begin
            R := Rect(X, Y, ClientWidth, Y + RealHeight);
            if FPages.Page(I).Timer.Enabled then
            begin
              FBlendFunction.SourceConstantAlpha := FPages.Page(I).BlendValue;
              AlphaBlend(Canvas.Handle, X, Y, ClientWidth, RealHeight,
                FPages.Page(I).Bitmap.Canvas.Handle,
                0, 0, ClientWidth, RealHeight, FBlendFunction)
            end
            else
              BitBlt(Canvas.Handle, X, Y, ClientWidth, RealHeight,
                FPages.Page(I).Bitmap.Canvas.Handle, 0, 0, SRCCOPY)
          end
        end
        else
        begin
          if FPages.Page(I).BitmapRendered then
          begin
            FPages.Page(I).PrereleaseBitmap;
            ReleaseBitmap(I, FPages.Page(I).Bitmap)
          end;
        end;
        Inc(Y, RealHeight)
      end;
{$IFDEF 24NSDEBUG}
      Canvas.TextOut(0, 0, FViewOffset.ToString)
{$ENDIF}
    end
  finally
    FPainting := False
  end
end;

procedure T24NSPDFViewer.Ready;
begin
  FDocumentLoading := False;
  FDocumentLoaded := True;
  FBeginDocument := True;
  FEndDocument := False;
  FViewOffset := 0;
  if Assigned(FOnReady) then
    FOnReady(Self);
  Invalidate
end;

procedure T24NSPDFViewer.ReleaseBitmap(APageIndex: Integer; ABitmap: TBitmap);
begin
  PostThreadMessage(FHelperThread.ThreadID, WM_RELEASEBITMAP, WPARAM(APageIndex), LPARAM(ABitmap))
end;

procedure T24NSPDFViewer.RenderBitmap(APageIndex: Integer; ABitmap: TBitmap);
begin
  PostThreadMessage(FHelperThread.ThreadID, WM_RENDERBITMAP, WPARAM(APageIndex), LPARAM(ClientWidth))
end;

procedure T24NSPDFViewer.ScrollBy(ADelta: Integer);
var
  Y: Integer;
begin
  FBeginDocument := False;
  FEndDocument := False;
  if FDocumentLoaded then
  begin
    Inc(FViewOffset, ADelta);
    if FViewOffset <= 0 then
      FViewOffset := 0;
    Y := Pages.PagesHeight - ClientHeight;
    if Y < 0 then
      Y := 0;
    if FViewOffset > Y then
      FViewOffset := Y;
    FBeginDocument := FViewOffset = 0;
    FEndDocument := FViewOffset = Y;
    Invalidate
  end
end;

{ T24NSDocumentPages }

constructor T24NSDocumentPages.Create(AViewer: T24NSPDFViewer);
begin
  inherited Create;
  FViewer := AViewer;
  FEngine := AViewer.Engine;
  FPagesHeight := 0;
  //FPages := TObjectList<T24NSDocumentPage>.Create(True)
  SetLength(FPages, 0);

end;

destructor T24NSDocumentPages.Destroy;
begin
  SetLength(FPages, 0); // &#228;&#238;&#240;&#224;&#225;&#238;&#242;&#224;&#242;&#252; &#238;&#247;&#232;&#241;&#242;&#234;&#243; &#241;&#242;&#240;&#224;&#237;&#232;&#246;
  // FreeAndNil(FPages);
  inherited Destroy
end;

function T24NSDocumentPages.GetCount: Integer;
begin
  //Result := FPages.Count
  Result := length(FPages);
end;

function T24NSDocumentPages.First: T24NSDocumentPage;
begin
  if Count = 0 then
  begin
    result := nil;
  end else
  begin
    result := FPages[0];
  end;
end;

function T24NSDocumentPages.Last: T24NSDocumentPage;
begin
  if Count = 0 then
  begin
    result := nil;
  end else
  begin
    result := FPages[length(FPages)-1];
  end;
end;

procedure T24NSDocumentPages.PreparePages;
var
  Page: T24NSDocumentPage;
  I: Integer;
  X: Integer;
begin
  FPagesHeight := 0;
  //FPages.Clear;
  SetLength(FPages, 0);
  SetLength(FPages, Pred(FEngine.PageCount)+1);
  X := FViewer.ClientWidth;
  for I := 0 to Pred(FEngine.PageCount) do
  begin
    Page := T24NSDocumentPage.Create(FViewer, I);
    //FPages.Add(Page);
    FPages[i] := Page;
    FPagesHeight := FPagesHeight + Page.RenderedHeight(X)
  end
end;

function T24NSDocumentPages.Page(AIndex: Integer): T24NSDocumentPage;
begin
  //Result := FPages.List[AIndex]
  Result := FPages[AIndex];
end;

{ T24NSDocumentPage }

constructor T24NSDocumentPage.Create(AViewer: T24NSPDFViewer; AIndex: Integer);
begin
  inherited Create;
  FBitmap := nil;
  FViewer := AViewer;
  FIndex := AIndex;
  FBitmapRendered := False;
  FBlendValue := 0;
  FEngine := AViewer.Engine;
  FTimer := TTimer.Create(nil);
  FTimer.OnTimer := TimerTick;
  FTimer.Enabled := False;
  FTimer.Interval := DEF_BLENDING_INTERVAL;
  UpdatePage;
  ReleaseBitmap
end;

destructor T24NSDocumentPage.Destroy;
begin
  FreeAndNil(FTimer);
  FreeAndNil(FBitmap);
  inherited Destroy
end;

procedure T24NSDocumentPage.PrereleaseBitmap;
begin
  ResetTimer;
  FBitmapRendered := False
end;

procedure T24NSDocumentPage.UpdatePage;
begin
  with FEngine, FEngine.PDFLibrary do
    GetPageSizeByIndex(Document, FIndex, FWidth, FHeight)
end;

procedure T24NSDocumentPage.ReleaseBitmap;
begin
  FBitmapRendered := False;
  FreeAndNil(FBitmap);
  FBitmap := TBitmap.Create
end;

procedure T24NSDocumentPage.RenderBitmap(AWidth: Integer);
var
  DisplayWidth: Integer;
  DisplayHeight: Integer;
  Page: TPDFPage;
begin
  if not FBitmapRendered then
  begin
    Page := FEngine.PDFLibrary.LoadPage(FEngine.Document, FIndex);
    try
      FBitmap.Canvas.Lock;
      try
        DisplayWidth := AWidth;
        DisplayHeight := RenderedHeight(DisplayWidth);
        //FBitmap.SetSize(DisplayWidth, DisplayHeight);
        FBitmap.Width := DisplayWidth;
        FBitmap.Height := DisplayHeight;
        FEngine.PDFLibrary.RenderPage(FBitmap.Canvas.Handle,
          Page, 0, 0, DisplayWidth, DisplayHeight, 0, 0)
      finally
        FBitmap.Canvas.Unlock
      end;
      FBlendValue := 0;
      FBitmapRendered := True;
      Timer.Enabled := True
    finally
      FEngine.PDFLibrary.ClosePage(Page)
    end
  end
end;

function T24NSDocumentPage.RenderedHeight(AWidth: Integer): Integer;
begin
  Result := Round(Height * (AWidth / Width))
end;

procedure T24NSDocumentPage.ResetTimer;
begin
  FTimer.Enabled := False;
  FBlendValue := 0
end;

procedure T24NSDocumentPage.TimerTick(Sender: TObject);
begin
  Inc(FBlendValue, DEF_BLENDING_STEP);
  if FBlendValue >= 255 then
    ResetTimer;
  FViewer.Invalidate
end;

{ T24NSHelperThread }

constructor T24NSHelperThread.Create(AViewer: T24NSPDFViewer);
begin
  inherited Create(False);
  Priority := tpLowest;
  FViewer := AViewer;
  FreeOnTerminate := False
end;

procedure T24NSHelperThread.WaitLooping;
begin
  while not FMessageLoop do
    SwitchToThread
end;

procedure T24NSHelperThread.Execute;
var
  Msg: TMsg;

  function HandleMessage: Boolean; near;

    function NeedHandleMessage: Boolean; near;
    begin
      Result := (Msg.Message >= WM_DONETHREAD)
        and (Msg.Message <= WM_DOWNLOADFILE)
    end;

  begin
    Result := NeedHandleMessage;
    if Result then
      case Msg.Message of
        WM_DONETHREAD:
          Terminate;
        WM_RELEASEBITMAP:
          ReleaseBitmap(Msg);
        WM_RENDERBITMAP:
          RenderBitmap(Msg)
      end
  end;

  function ProcessMessage: Boolean; near;
  begin
    if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then
    begin
      Result := PeekMessage(Msg, 0, 0, 0, PM_REMOVE);
      if Result then
      begin
        if not HandleMessage then
          if not Terminated then
          begin
            TranslateMessage(Msg);
            DispatchMessage(Msg)
          end
      end
    end
    else
      Result := False
  end;

begin
  FMessageLoop := True;
  try
    while not Terminated do
      if not ProcessMessage then
        WaitMessage
  finally
    FMessageLoop := False
  end
end;

procedure T24NSHelperThread.Invalidate;
begin
  if FViewer.Owner is TWinControl then
    TWinControl(FViewer.Owner).Invalidate
end;

procedure T24NSHelperThread.ReleaseBitmap;
begin
  FViewer.Pages.Page(AMsg.wParam).ReleaseBitmap
end;

procedure T24NSHelperThread.RenderBitmap;
begin
  while FViewer.Painting do
    SwitchToThread;
  FViewer.Pages.Page(AMsg.wParam).RenderBitmap(AMsg.lParam)
end;

procedure T24NSHelperThread.Done;
begin
  if not Suspended and not Terminated then
    PostThreadMessage(ThreadID, WM_DONETHREAD, 0, 0)
end;

end.
28 ноя 18, 19:14    [21747822]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: Ctrl  назад   1 [2] 3   вперед  Ctrl      все
Все форумы / Delphi Ответить