如何将静态的html代码转换成图片？

[zzn007]

我有一个静态的html的代码字符串，显示的内容就是表单里面有些内容，我想把这个内容保存成图片，如何保存？使用webbroswer控件好像只能显示内容，没办法保存成图片。
项目比较紧急，请大侠们指点下，或者有好的思路什么的

[zzn007]

补充一下，是将html的页面保存成图片，不是html的字符

[frtrnr]

Problem/Question/Abstract:

It was asked how one might save a webpage to disk as a image file from IE. I did not see an obvious way to do with with IE below is a way to get the URL from IE and then open it with PBear's THTMLViewer and save it as a image file.

Answer:

This is written in Delphi 5 but with a little modification, most if not all of it could be used in Delphi 3 or higher, Kylix and maybe C++Builder.

First of all, you need Dave Baldwin's PBear THTMLView or THTMLLite. It is available here:

http://www.pbear.com/htmlviewers.html

Get the Indy demo application since it supports actually downloading web pages and images from the web via http.

Open up the Demo application and add two buttons to the tool bar. The caption on the first is "DDE URL" and the second is "As Image". For the click event of the "DDE URL" button should look like this:

procedure THTTPForm.btnDDEURLClick(Sender: TObject);
begin
UrlComboBox.Text := GetDDEUrl; // get the URL
GetButtonClick(nil); // Navigate to the URL
end;

GetDDEUrl calls the following function which you will need to above the method:

// using DDE gets the URL from the active browser

function GetDDEUrl: string;
function GetUrl(sService: string): string;
var
Dde: TDdeClientConv;
begin
Dde := TDdeClientConv.Create(nil);
try
Dde.ConnectMode := ddeManual;
Dde.SetLink(sService, 'WWW_GetWindowInfo');
if Dde.OpenLink then
try
Result := string(Dde.RequestData('0xFFFFFFFF'));
if Length(Result) > 0 then
begin // trim up the results
Delete(Result, 1, 1);
Delete(Result, Pos('",', Result), Length(Result));
end;
finally
Dde.CloseLink;
end;
finally
dde.Free;
end;
end;
begin
// try a few browsers until we get one
Result := GetUrl('Netscape');
if Result = '' then
Result := GetUrl('IExplore');
if Result = '' then
Result := GetUrl('Opera');
if Result = '' then
Result := GetUrl('Mosaic');
end;

The click event of the As Image button should look like this:

procedure THTTPForm.btnSaveImageClick(Sender: TObject);
var
img: TBitmap;
{$IFDEF GIF}
gif: TGifImage;
{$ENDIF}
Jpg: TJPEGImage;
ext: string;
begin
if SavePictureDialog.Execute then
begin
Img := TBitmap.Create;
try
img.Height := FrameBrowser.ClientHeight;
img.Width := FrameBrowser.ClientWidth;
img.Canvas.Brush := FrameBrowser.Brush;
img.Canvas.FillRect(FrameBrowser.ClientRect);
img.Canvas.Lock;
FrameBrowser.PaintTo(img.Canvas.Handle, 0, 0);
img.Canvas.Unlock;
ext := UpperCase(ExtractFileExt(SavePictureDialog.FileName));
if SameText(ext, '.JPEG') or SameText(ext, '.JPG') then
begin
Jpg := TJPEGImage.Create;
try
Jpg.CompressionQuality := 100;
Jpg.Assign(img);
Jpg.SaveToFile(SavePictureDialog.FileName);
finally
Jpg.Free;
end;
end
else
{$IFDEF GIF}if SameText(ext, '.GIF') then
begin
gif := TGIFImage.Create;
try
gif.Assign(img);
gif.SaveToFile(SavePictureDialog.FileName);
finally
gif.Free;
end;
end
else
{$ENDIF}
img.SaveToFile(SavePictureDialog.FileName);
finally
img.free;
end;
end;
end;

You will need to add "Jpeg, DDEMan, RXGif" to the uses clause of the unit you are in. If you don't have RXLib ( http://einstein.fet.uni-hannover.de/~od/rxlib/ ) then you will need to use some other GIF library. If you don't have a Gif library then add the line {$UNDEF GIF} at the top of the unit. If you do have a gif library then add the line {$DEFINE GIF} at the top of the unit. 需要的单元：Jpeg，DDEMAN， RXGIF。

You will also need to add a TSavePictureDialog named SavePictureDialog. Set the DefaultExt property to .JPEG or .BMP. You may also want to clean up the filter to only show supported image formats.

Now run your program. Click the "DDE URL" button and it will navigate to the page currently open in your active browser. Then resize the page for maximum efficency and click "As Image" then name the image and save it. You could modify this to have no user interaction if you like.
现在点击"DDE URL" 按钮，就会在活跃浏览器中打开URL

[CCC的]

uses SHDOCvW,mshtml;

procedure GenerateJPEGfromBrowserEx(browser: iWebBrowser2;
BitmapFQFilename: string;
srcHeight: integer; srcWidth: integer;
tarHeight: integer; tarWidth: integer;
hdl: THandle);
var
sourceDrawRect: TRect;
targetDrawRect: TRect;
sourceBitmap: TBitmap;
targetBitmap: TBitmap;
aBitmap: TBitmap;
aViewObject: IViewObject;
begin
sourceBitmap := TBitmap.Create;
targetBitmap := TBitmap.Create;
aBitmap := TBitmap.Create;
try
try
sourceDrawRect := Rect(-1, -1, srcWidth , srcHeight );
sourceBitmap.Width := srcWidth;
sourceBitmap.Height := srcHeight;

aViewObject := browser as IViewObject;

if aViewObject = nil then
Exit;

OleCheck(aViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil,
hdl,
sourceBitmap.Canvas.Handle,
@sourceDrawRect, nil, nil, 0));

// Resize the src bitmap to the target bitmap
// Need to make thumbnails instead of full size?
// set the target size here..
targetDrawRect := Rect(0, 0, tarWidth, tarHeight);
targetBitmap.Height := tarHeight;
targetBitmap.Width := tarWidth;
targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);

// Create the Bitmap and save it
aBitmap.Assign(targetBitmap);

if FileExists(BitmapFQFilename) then
DeleteFile(BitmapFQFilename);
aBitmap.SaveToFile(BitmapFQFilename);
except
// error handler code
end; { try }
finally
aBitmap.Free;
sourceBitmap.Free;
targetBitmap.Free;
end; { try }
end;

procedure TForm1.Button2Click(Sender: TObject);
var
IDoc1: IHTMLDocument2;
Web : iWebBrowser2;
filename: string;
begin
filename := Format('.\%s.bmp',[FormatDateTime('yyyymmdd',now)]);
with WebBrowser do
begin
Document.QueryInterface(IHTMLDocument2, IDoc1);
Web := ControlInterface;
GenerateJPEGfromBrowserEx(Web, filename,
97, 377,
97, 377,
self.Handle);
RzToolbarButton1.Glyph.LoadFromFile(filename);
end;
end;

[zzn007]

非常感谢楼上两位的方法，我优先考虑hnlg81004的方法，毕竟没有使用第三方控件。但是有个问题，我的webbroswer控件有滚动条啊，这个能都存储的图片吗？我试一下再回复

[zzn007]

现在使用了THTMLView这个空间，根据例子可以保存成图片，我的编码选择的是GB2312，
但是使用FullDisplaySize之后，保存图片之前，有些编辑框会变长和变短，和第一次开始加载的时候不一样。多次执行之后，有些编辑框变得很窄，当然窄到一定程度就不变化了，应该是有一个最小数值吧。

这个很是奇怪，为什么不是一开始加载进来的模样呢？