metademounit.pas

查看html文件的控件

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

 MetaFiles generated by ThtmlViewer.MakeMetaFile 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 MetaFiles.  The first MetaFile will be displayed.
   Use Next and Prev buttons to view the remainder.

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

unit MetaDemoUnit;

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
    MetaList: TList;    {holds MetaFiles for display}
    Index: integer;     {index to above}
    procedure wmDropFiles(var Message: TMessage);  message wm_DropFiles;
    procedure ClearMetaList;
    { 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}
MetaList := TList.Create;     {a list of MetaFiles}
end;

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

procedure TForm1.FormDestroy(Sender: TObject);
begin
ClearMetaList;
MetaList.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 MetaFiles}
var
  Size: TSize;
  ATop, N, Ht: integer;
  MetaFile: TMetaFile;
begin
ClearMetaList;
{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 MetaFile}
while (ATop < Size.cy) and (N < 10) do    //Limit of 10 MetaFiles in this demo
  begin
  MetaFile := Viewer.MakeMetaFile(ATop, ScrollBox.ClientWidth, PaintBox.Width, Ht);
  MetaList.Add(MetaFile);
  (*MetaFile.SaveToFile('Meta'+IntToStr(N)+'.emf'); *)  {save it if you want}
  Inc(ATop, Ht);      {find the top for next MetaFile}
  Inc(N);             {keep the count reasonable}
  end;
Index := 0;           {will draw the first MetaFile to start}
NextButton.Enabled := MetaList.Count > 1;
PrevButton.Enabled := False;
PaintBox.Invalidate;  {force a draw}
end;

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

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

end.