Title: Web Page to Image File
Question: 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:
Note: 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.
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.
-Jim McKeeth