bmpdemounit.pas

查看html文件的控件

{This demo program illustrates the use of the ThtmlViewer.MakeBitmap Method.
 This method allows HTML formated Bitmaps to be constructed for use elsewhere
 in the application or in other applications.

 Bitmaps generated by ThtmlViewer.MakeBitmap are limited to 4000 pixel height
 so some kind of paging is required for most documents.

 To run this demo.
   Load an HTML document in the ThtmlViewer on the left.
   Press Make Bitmaps.  The first Bitmap will be displayed.
   Use Next and Prev buttons to view the remainder.

 This demo is limited to 10 Bitmaps just because there should be some limit.
}

unit BmpDemoUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ShellAPI, Htmlview;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    ScrollBox: TScrollBox;
    Viewer: THTMLViewer;
    Button1: TButton;
    MakeButton: TButton;
    PrevButton: TButton;
    NextButton: TButton;
    PaintBox: TPaintBox;
    OpenDialog: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure MakeButtonClick(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure NextButtonClick(Sender: TObject);
    procedure PrevButtonClick(Sender: TObject);
  private
    BitmapList: TList;    {holds Bitmaps for display}
    Index: integer;     {index to above}
    procedure wmDropFiles(var Message: TMessage);  message wm_DropFiles;
    procedure ClearBitmapList;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
if Viewer.CurrentFile <> '' then
  OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
if OpenDialog.Execute then
  begin
  Viewer.LoadFromFile(OpenDialog.Filename);
  MakeButton.Enabled := True;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
DragAcceptFiles(Handle, True);  {allow files to be draged in}
BitmapList := TList.Create;     {a list of Bitmaps}
end;

procedure TForm1.ClearBitmapList;
var
  I: integer;
begin
with BitmapList do
  for I := Count-1 downto 0 do
    begin
    TBitmap(BitmapList[I]).Free;
    Delete(I);
    end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ClearBitmapList;
BitmapList.Free;
end;

procedure TForm1.wmDropFiles(var Message: TMessage);
{allow dropping of files on ThtmlViewer}
var
  S: string[200];
  Ext: string;
  Count: integer;
begin
Count := DragQueryFile(Message.WParam, 0, @S[1], 200);
Length(S) := Count;
DragFinish(Message.WParam);
if Count >0 then
  begin
  Ext := LowerCase(ExtractFileExt(S));
  if (Ext = '.htm') or (Ext = '.html') then
    Viewer.LoadFromFile(S);
  end;
Message.Result := 0;
end;

procedure TForm1.MakeButtonClick(Sender: TObject);
{Make the Bitmaps}
var
  Size: TSize;
  ATop, N, Ht: integer;
  Bitmap: TBitmap;
begin
ClearBitmapList;
{Find the size formatted to the ScrollBox width}
ScrollBox.HorzScrollBar.Range := 0;
Size := Viewer.FullDisplaySize(ScrollBox.ClientWidth);
{The actual width may be wider if some items can't wrap. Make sure PaintBox width corresponds}
if Size.cx > ScrollBox.ClientWidth then
  begin
  PaintBox.Width := Size.cx;
  ScrollBox.HorzScrollBar.Range := PaintBox.Width;
  end
else
  begin
  PaintBox.Width := ScrollBox.ClientWidth;
  end;
PaintBox.Height := ScrollBox.ClientHeight;

ATop := 0;  {start at top of document}
N := 0;
Ht := ScrollBox.ClientHeight;  {This is height of each Bitmap}
while (ATop < Size.cy) and (N < 10) do    //Limit of 10 Bitmaps in this demo
  begin
  Bitmap := Viewer.MakeBitmap(ATop, ScrollBox.ClientWidth, PaintBox.Width, Ht);
  BitmapList.Add(Bitmap);
  (*Bitmap.SaveToFile('BMP'+IntToStr(N)+'.bmp'); *)  {save it if you want} 
  Inc(ATop, Ht);      {find the top for next Bitmap}
  Inc(N);             {keep the count reasonable}
  end;
Index := 0;           {will draw the first Bitmap to start}
NextButton.Enabled := BitmapList.Count > 1;
PrevButton.Enabled := False;
PaintBox.Invalidate;  {force a draw}
end;

procedure TForm1.PaintBoxPaint(Sender: TObject);
{OnPaint handler paints the current Bitmap}
begin
if Index < BitmapList.Count then
  PaintBox.Canvas.Draw(0, 0, TBitmap(BitmapList.Items[Index]));
end;

procedure TForm1.NextButtonClick(Sender: TObject);
{Next Button}
begin
if Index < BitmapList.Count-1 then
  begin
  Inc(Index);
  PaintBox.Invalidate;
  end;
NextButton.Enabled := Index < BitmapList.Count-1;
PrevButton.Enabled := Index > 0;
end;

procedure TForm1.PrevButtonClick(Sender: TObject);
{Prev Button}
begin
if Index > 0 then
  begin
  Dec(Index);
  PaintBox.Invalidate;
  end;
NextButton.Enabled := Index < BitmapList.Count-1;
PrevButton.Enabled := Index > 0;
end;

end.