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

Откуда: Astana, Kazakhstan
Сообщений: 2426
Есть ли умеющий это просмотровщик ?
22 дек 16, 08:44    [20035053]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Евгений, Екатеринбург
Member

Откуда:
Сообщений: 633
MaratIsk,
Есть, но чуть платный
www.gnostice.com
22 дек 16, 08:57    [20035075]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
white_nigger
Member

Откуда: Тула
Сообщений: 1944
Наш тоже умеет
22 дек 16, 09:53    [20035232]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
defecator_
Guest
white_nigger
Наш тоже умеет


вот только формат 1.6 не понимает, а так-то да Картинка с другого сайта.
22 дек 16, 11:32    [20035697]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Евгений, Екатеринбург
Member

Откуда:
Сообщений: 633
defecator_,
PDF TollKit тоже не безгрешен - позволяет наносить дополнительные текстовые и графические метки, но текст меток не поддерживает юникод.
автор
Currently PDFToolkit supports only the following encoding. If the russian font is encoded as Unicode, it is currently not supported by PDFToolkit.
...
We have plans to support unicode encoding and it will be implemented in one of the future release. We will notify you as soon as we support Unicode in PDFToolkit.

Хотя на сайте говорится о поддержке юникода.
Но это было пару лет назад, может с тех пор что и изменилось.
22 дек 16, 12:01    [20035833]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
white_nigger
Member

Откуда: Тула
Сообщений: 1944
defecator_
вот только формат 1.6 не понимает, а так-то да
И много видел документов в этом формате?
22 дек 16, 12:10    [20035899]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
defecator_
Guest
white_nigger
defecator_
вот только формат 1.6 не понимает, а так-то да
И много видел документов в этом формате?


у меня таких документов море разливанное.
Кроме родного Adobe Reader и компонентов от Gnostice никто не умеет 1.6 открывать.
22 дек 16, 12:21    [20035948]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
white_nigger
Member

Откуда: Тула
Сообщений: 1944
defecator_
у меня таких документов море разливанное.
Кроме родного Adobe Reader и компонентов от Gnostice никто не умеет 1.6 открывать.
В 1.6 добавилось внедренное мультимедиа, 3D, XML-формы, AES-шифрование. Ни разу не встречал такой PDF :) Можешь кинуть какой-нить для примера?
22 дек 16, 13:19    [20036329]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
defecator_
Guest
white_nigger
defecator_
у меня таких документов море разливанное.
Кроме родного Adobe Reader и компонентов от Gnostice никто не умеет 1.6 открывать.
В 1.6 добавилось внедренное мультимедиа, 3D, XML-формы, AES-шифрование. Ни разу не встречал такой PDF :) Можешь кинуть какой-нить для примера?


Вот, самый простой в формате 1.6:
http://rgho.st/8PrgW27Gw
22 дек 16, 13:24    [20036373]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5118
pdfium.dll
бесплатный
есть дельфовая обертка
22 дек 16, 13:28    [20036403]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
white_nigger
Member

Откуда: Тула
Сообщений: 1944
defecator_
Вот, самый простой в формате 1.6:
http://rgho.st/8PrgW27Gw
Нормально он открывается у нас. Единственно мы аннотации пока не поддерживаем, суг есть на это.
22 дек 16, 13:38    [20036469]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
defecator_
Guest
white_nigger
defecator_
Вот, самый простой в формате 1.6:
http://rgho.st/8PrgW27Gw
Нормально он открывается у нас. Единственно мы аннотации пока не поддерживаем, суг есть на это.

это простой, без XML и медиа, но у меня на DevExp 16.1 не открывается, просто белое поле без ничего.
при этом 1.5 версия открывается
22 дек 16, 13:46    [20036515]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
white_nigger
Member

Откуда: Тула
Сообщений: 1944
defecator_
без XML и медиа
Да это не поддерживается, но повторюсь, наверно 99% имеющихся PDF не содержат в себе ни 3Д, ни медиа, ни XML-форм. Большинству эти новомодности нужны. Кстати шифрование поддерживается. Плюс, как написал разработчик "по сравнению 16.1 в 16.2 были серьезные изменения в плане рендеринга" - правда я не в курсе, что скрывается за этой фразой :) Продукт новый и активно развивается.
22 дек 16, 14:20    [20036739]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
defecator_
Guest
white_nigger
defecator_
без XML и медиа
Да это не поддерживается, но повторюсь, наверно 99% имеющихся PDF не содержат в себе ни 3Д, ни медиа, ни XML-форм. Большинству эти новомодности нужны. Кстати шифрование поддерживается. Плюс, как написал разработчик "по сравнению 16.1 в 16.2 были серьезные изменения в плане рендеринга" - правда я не в курсе, что скрывается за этой фразой :) Продукт новый и активно развивается.


ну, посмотрим.
Я пока пользуюсь Gnostice, ничего лучшего и мощного из нативного для Delphi (пока ещё ?) нет.
22 дек 16, 14:23    [20036752]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Гаджимурадов Рустам
Member

Откуда:
Сообщений: 59449
Дефекатор,

А зачем эта игра в догонялки, если есть
бесплатный вьювер от производителя?

Posted via ActualForum NNTP Server 1.5

22 дек 16, 14:29    [20036779]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Товарищ младший сержант
Member [заблокирован]

Откуда:
Сообщений: 5122
Квейд
pdfium.dll
бесплатный
есть дельфовая обертка

Класс, спасибо.
22 дек 16, 14:49    [20036874]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5118
Товарищ младший сержант
Квейд
pdfium.dll
бесплатный
есть дельфовая обертка

Класс, спасибо.


Обертка от Andreas Hausladen

https://github.com/ahausladen/PdfiumLib

У меня в проекте взлетело
22 дек 16, 14:55    [20036914]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
makhaon
Member

Откуда: A galaxy far far away
Сообщений: 2963
Гаджимурадов Рустам,

Лишние зависимости. Мы тоже используем гностис.
22 дек 16, 15:46    [20037196]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
defecator_
Guest
Гаджимурадов Рустам
Дефекатор,

А зачем эта игра в догонялки, если есть
бесплатный вьювер от производителя?


вьювер в свою программу не встроишь, да много зависимостей получается.
и нельзя через него оперировать страницами, как угодно - вытащить текст, добавить что-то, удалить страницу и т.д.
22 дек 16, 16:15    [20037389]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
MaratIsk
Member

Откуда: Astana, Kazakhstan
Сообщений: 2426
господа-товарищи,
речь не о бесплатных вьюерах
а о возможности просматривать мемористрем
без необходимости сохранять предварительно в файл
22 дек 16, 16:35    [20037537]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Товарищ младший сержант
Member [заблокирован]

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

а в чем проблема? Что-то из предложенного заставляет предварительно в файл сохранять?
22 дек 16, 16:49    [20037634]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5118
MaratIsk
господа-товарищи,
речь не о бесплатных вьюерах
а о возможности просматривать мемористрем
без необходимости сохранять предварительно в файл


pdfium.dll

функция LoadMemDocument

для просмотра нужной страницы вызываешь RenderPage с параметрами, работает с Canvas

я эту библиотеку юзаю в своем приложении, косяков нет
22 дек 16, 16:53    [20037665]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
MaratIsk
Member

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

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

Откуда: Kyiv, Ukraine
Сообщений: 5118
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.


22 дек 16, 17:30    [20037900]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5118
Пример

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

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

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

Откуда: Kyiv, Ukraine
Сообщений: 5118
код неоптимален, если в документе тысячи страниц, нужно переделывать метод 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

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

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

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

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

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


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

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

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


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

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

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


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

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

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

Posted via ActualForum NNTP Server 1.5

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

Откуда: Запорожье
Сообщений: 49121
Гаджимурадов Рустам
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

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

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

Ыыыыыы

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

Откуда:
Сообщений: 303
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

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

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

Posted via ActualForum NNTP Server 1.5

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

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

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

Posted via ActualForum NNTP Server 1.5

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

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

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

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

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

Откуда: Запорожье
Сообщений: 49121
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

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

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

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

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

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

Откуда: Запорожье
Сообщений: 49121
Квейд
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]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

Откуда: Запорожье
Сообщений: 49121
почистил все утечки памяти
и вроде бы всё
кроме инди, там течет
+
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);
    FreeAndNil(FPDFLibrary);
  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);
  FreeAndNil(FDownloader);
  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;
var
  i : integer;
begin
  for i := 0 to length(FPages)-1 do
  begin
    FPages[i].Free;
  end;
  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;
  for i := 0 to Length(FPages)-1 do
  begin
    FPages[i].free;
  end;
  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:39    [21747841]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

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

---------------------------
Project1.exe: Memory Leak Detected
---------------------------
This application has leaked memory. The small block leaks are (excluding expected leaks registered by pointer):



1 - 12 bytes: TIdThreadSafeInteger x 1

21 - 28 bytes: TIdCriticalSection x 2
28 ноя 18, 19:39    [21747843]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Гаджимурадов Рустам
Member

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

Почему именно 2.90, из более поздних (2.12, например) не подходит?

Posted via ActualForum NNTP Server 1.5

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

Откуда: Запорожье
Сообщений: 49121
Гаджимурадов Рустам,

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

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

спасибо :)
29 ноя 18, 15:17    [21748715]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
andreymx
Member

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

спасибо :)
спасибо нашему форуму :)

1. У себя ещё сделал возможность настройки пути к длл
2. Отключил инди, т.к. пока не используем, а память течёт и фастмм гавкает
29 ноя 18, 15:27    [21748737]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Квейд
Member

Откуда: Kyiv, Ukraine
Сообщений: 5118
andreymx
Indy10_5160

---------------------------
Project1.exe: Memory Leak Detected
---------------------------
This application has leaked memory. The small block leaks are (excluding expected leaks registered by pointer):



1 - 12 bytes: TIdThreadSafeInteger x 1

21 - 28 bytes: TIdCriticalSection x 2


Я пробовал делать так. Помогает.

program Project1;

uses
  IdThread,
  System.SysUtils,
  Vcl.Forms,
  Unit3 in 'Unit3.pas' {Form3};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm3, Form3);
  Application.Run;
  FreeAndNil(GThreadCount)
end.
29 ноя 18, 15:38    [21748756]     Ответить | Цитировать Сообщить модератору
 Re: Открыть PDF из MemoryStream  [new]
Гаджимурадов Рустам
Member

Откуда:
Сообщений: 59449
andreymx> 2. Отключил инди, т.к. пока не используем

Я, конечно, дико извиняюсь, но нафига там инди?
Чтобы таскать из сети "ресурсы" по ссылкам?
Или чтобы переходить в сеть по ссылкам?

Posted via ActualForum NNTP Server 1.5

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

Откуда: Запорожье
Сообщений: 49121
Пдф из сети тянуть
29 ноя 18, 17:46    [21748922]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: 1 2 3      [все]
Все форумы / Delphi Ответить