Mam's WebSite
建築CGパース住宅CGパース

Mamの覚書Q&A検索

トップページMamの覚書Q&A検索Delphi(いろいろ)⇒Q&A


大項目:「 Delphi 」 - 中項目:「 いろいろ 」

「 WebBrowerで拡大縮小 」

WebBrowerで拡大縮小、全体をビットマップに保存


回答

ソース

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, ExtCtrls, ComCtrls,ActiveX, UIWebBrowser;
 
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    ScrollBar1: TScrollBar;
    Edit1: TEdit;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    WebBrowser1: TUIWebBrowser;
    Label2: TLabel;
    Button3: TButton;
    SaveDialog1: TSaveDialog;
    procedure Button3Click(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure WebBrowser1StatusTextChange(ASender: TObject;
      const Text: WideString);
    procedure WebBrowser1DocumentComplete(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Refresh;
 
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var a:OleVariant;
 
begin
  ScrollBar1.Position:=100;
 
//  WebBrowser1.OleObject.document.body.style.setAttribute(
//      'zoom',IntToStr(ScrollBar1.position)+'%',0);
 
end;
 
{
Elements
OLECMDID_OPEN
File menu, Open command
OLECMDID_NEW
File menu, New command
OLECMDID_SAVE
File menu, Save command
OLECMDID_SAVEAS
File menu, Save As command
OLECMDID_SAVECOPYAS
File menu, Save Copy As command
OLECMDID_PRINT
File menu, Print command
OLECMDID_PRINTPREVIEW
File menu, Print Preview command
OLECMDID_PAGESETUP
File menu, Page Setup command
OLECMDID_SPELL
Tools menu, Spelling command
OLECMDID_PROPERTIES
File menu, Properties command
OLECMDID_CUT
Edit menu, Cut command
OLECMDID_COPY
Edit menu, Copy command
OLECMDID_PASTE
Edit menu, Paste command
OLECMDID_PASTESPECIAL
Edit menu, Paste Special command
OLECMDID_UNDO
Edit menu, Undo command
OLECMDID_REDO
Edit menu, Redo command
OLECMDID_SELECTALL
Edit menu, Select All command
OLECMDID_CLEARSELECTION
Edit menu, Clear command
OLECMDID_ZOOM
View menu, Zoom command (see below for details)
 
OLECMDID_GETZOOMRANGE
Retrieves zoom range applicable to View Zoom. (See below for details.)
 
OLECMDID_UPDATECOMMANDS
Informs the receiver, usually a frame, of state changes. The receiver can then query the status of the commands whenever convenient.
OLECMDID_REFRESH
Asks the receiver to refresh its display. Implemented by the document/object.
OLECMDID_STOP
Stops all current processing. Implemented by the document/object.
OLECMDID_HIDETOOLBARS
View Menu, Toolbars command. Implemented by the document/object to hide its toolbars.
OLECMDID_SETPROGRESSMAX
Sets the maximum value of a progress indicator if one is owned by the receiving object, usually a frame. The minimum value is always zero.
OLECMDID_SETPROGRESSPOS
Sets the current value of a progress indicator if one is owned by the receiving object, usually a frame.
OLECMDID_SETPROGRESSTEXT
Sets the text contained in a progress indicator if one is owned by the receiving object, usually a frame. If the receiver currently has no progress indicator, this text should be displayed in the status bar (if one exists) as with IOleInPlaceFrame::SetStatusText.
OLECMDID_SETTITLE
Sets the title bar text of the receiving object, usually a frame.
OLECMDID_SETDOWNLOADSTATE
Called by the object when downloading state changes. Takes a VT_BOOL parameter, which is TRUE if the object is downloading data and FALSE if it not. Primarily implemented by the frame.
OLECMDID_STOPDOWNLOAD
Stops the download when executed. Typically, this command is propagated to all contained objects. When queried, sets MSOCMDF_ENABLED. Implemented by the document/object.
}
 

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  Edit1.Text:=WebBrowser1.LocationURL;
  WebBrowser1.OleObject.document.body.style.setAttribute(
      'zoom',IntToStr(ScrollBar1.position)+'%',0);
 

end;
 
procedure TForm1.WebBrowser1StatusTextChange(ASender: TObject;
  const Text: WideString);
begin
  StatusBar1.SimpleText:=Text;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
  WebBrowser1.Navigate(Edit1.Text);
end;
 
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key=#13 then
    WebBrowser1.Navigate(Edit1.Text);
end;
 
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
  WebBrowser1.OleObject.document.body.style.setAttribute(
      'zoom',IntToStr(ScrollBar1.position)+'%',0);
  Label1.Caption:=inttostr(ScrollBar1.Position);
end;
 
procedure TForm1.Button3Click(Sender: TObject);
var vBmp: TBitmap;
  X, Y: Integer;
  P, Q: Integer;
  KeepAlign: TAlign;
  OrgWidth, OrgHeight:integer;
begin
  if Not SaveDialog1.Execute() then exit;
 
  KeepAlign := WebBrowser1.Align;
  WebBrowser1.Align := alNone;
    OrgWidth := WebBrowser1.Width;
    OrgHeight := WebBrowser1.Height;
 
  vBmp:=TBitmap.Create;
  try
    X := GetSystemMetrics(SM_CXVSCROLL)*ScrollBar1.Position div 100;
    Y := GetSystemMetrics(SM_CYHSCROLL)*ScrollBar1.Position div 100;
 
    P := 0;
    Q := 0;
 
    if (WebBrowser1.IeNO3DBORDER=false) then
    begin
      P := GetSystemMetrics(SM_CXEDGE)*ScrollBar1.Position div 100;
      Q := GetSystemMetrics(SM_CYEDGE)*ScrollBar1.Position div 100;
    end;
 
    vBmp.Width := WebBrowser1.OleObject.document.body.scrollwidth*ScrollBar1.Position div 100 + X + P * 2;
    vBmp.Height := WebBrowser1.OleObject.document.body.scrollHeight*ScrollBar1.Position div 100 + Y + Q * 2;
 
    WebBrowser1.SetBounds(WebBrowser1.Left,
       WebBrowser1.Top, vBmp.Width, vBmp.Height);
 
    OleDraw(WebBrowser1.ControlInterface,
        DVASPECT_DOCPRINT,
        vBmp.Canvas.Handle,
        Rect(0, 0, vBmp.Width, vBmp.Height));
    vBmp.SaveToFile(SaveDialog1.FileName);
  finally
    vBmp.Free;
    WebBrowser1.SetBounds(WebBrowser1.Left,
             WebBrowser1.Top, OrgWidth, OrgHeight);
    WebBrowser1.Align := KeepAlign;
 
  end;
 
end;
 
initialization
  OleInitialize(nil);
 
 finalization
  OleUninitialize
 
end.


Mam's WebSite