Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
Топик располагается на нескольких страницах: [1] 2 3   вперед  Ctrl      все
 Открыть 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]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: [1] 2 3   вперед  Ctrl      все
Все форумы / Delphi Ответить