Canvas Problems

[jfreak53]

Ok so I have this Timage control on the board, and I am taking a screenshot of a tbrowser component, and that works fine. The problem is that if I go to another web page the old image stays in the image control and the new one doesn't load. How do I clear this canvas and re-load something new onto it?

This is the code I use to take the browser screenshot:

procedure TForm1.wbNavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
ViewObject: IViewObject;
sourceDrawRect: TRect;
begin

if wb.Document <> nil then
try
wb.Document.QueryInterface(IViewObject, ViewObject);
if ViewObject <> nil then
try
sourceDrawRect := Rect(-1, -1, wb.Width, wb.Height);
ViewObject.Draw(DVASPECT_CONTENT {DVASPECT_THUMBNAIL}, 1, nil, nil, Self.Handle,
Image1.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
finally
ViewObject._Release;
end;
except
end;

image1.Enabled := true;

end;

 

[whosrdaddy]

use the DocumentComplete event:

procedure TFrm_browser.BrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);

var CurrentBrowser: IWebBrowser;
    TopBrowser: IWebBrowser;
    Document: OleVariant;
    WindowName: string;
    Doc :  IHTMLDocument2;

begin
 try
  CurrentBrowser := pDisp as IWebBrowser;
  TopBrowser := (ASender as TWebBrowser).DefaultInterface;
  if Assigned(CurrentBrowser) and Assigned(TopBrowser) then
   begin
    Doc := CurrentBrowser.Document as IHTMLDocument2;
    if CurrentBrowser = TopBrowser then
     begin
      if Assigned(Doc) then
       Output(Self, 'BrowserDocumentComplete', 'Found URL: ' + Doc.url);
      Timer_detectdlg.Enabled := False;
      if Assigned(FOnCompleteDocLoaded) then
       FOnCompleteDocLoaded(Self, Doc);
      Output(Self, 'BrowserDocumentComplete', 'Complete document was loaded');
      if Visible then
        Browser.SetFocus;
     end
    else
     begin
      Document := CurrentBrowser.Document;
      WindowName := Document.ParentWindow.Name;
      if Assigned(FOnFrameSetLoaded) then
       FOnFrameSetLoaded(Self, Doc);
      Output(Self, 'BrowserDocumentComplete', Format('Frame "%s" was loaded', [WindowName]));
     end;
   end;
 except
  on E: Exception do
   if Assigned(Debug) then
    Debug.ExceptionOutput(Self, 'BrowserDocumentComplete', E);
 end;
end;

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[jfreak53]

Ok after finding out I needed MSHTML in my uses clause I now get these errors:

[Error] Unit1.pas(1126): Missing operator or semicolon
[Error] Unit1.pas(1126): Statement expected, but expression of type 'Text' found
[Error] Unit1.pas(1127): Undeclared identifier: 'Timer_detectdlg'
[Error] Unit1.pas(1127): Missing operator or semicolon
[Error] Unit1.pas(1128): Undeclared identifier: 'FOnCompleteDocLoaded'
[Error] Unit1.pas(1128): Incompatible types
[Error] Unit1.pas(1130): Missing operator or semicolon
[Error] Unit1.pas(1130): Statement expected, but expression of type 'Text' found
[Error] Unit1.pas(1132): Undeclared identifier: 'Browser'
[Error] Unit1.pas(1138): Undeclared identifier: 'FOnFrameSetLoaded'
[Error] Unit1.pas(1138): Incompatible types
[Error] Unit1.pas(1140): Missing operator or semicolon
[Error] Unit1.pas(1140): Statement expected, but expression of type 'Text' found
[Error] Unit1.pas(1145): Undeclared identifier: 'Debug'
[Error] Unit1.pas(1146): Missing operator or semicolon

The first error starts on this command:

Output(Self, 'BrowserDocumentComplete', 'Found URL: ' + Doc.url);

I'm sorry I forgot to mention I was using Delphi 6.

Thanks for all your help.

 

[whosrdaddy]

sorry,

but I just pasted some code from a project of mine and contains indeed code that won't compile, I thought you would figure out where to plugin your code.

here's a hint:

if CurrentBrowser = TopBrowser then     
 begin      
  if Assigned(Doc) then       
   begin
    TakeBrowserScreenShot; // <--- your code
   end
 end;

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[jfreak53]

Ok still no go, it navigates just again doesn't clear the canvas of the TImage component.

Ok maybe I didn't explain what was happening right. The program I have browses, no problem. And on the first time it takes the screen shot just fine, no problem. What it doesn't do is if I try to navigate to another page, after the first a second one, it doesn't clear off the first page screen shot from the TImage component and put the new one there. So in short, it works, but the second time the TImage canvas still has the first page on it.

But it is browsing just fine.

Thanks for the help.

 

[whosrdaddy]

this works for me:

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleCtrls, SHDocVw, MSHTML, ACtiveX;

type
  TForm4 = class(TForm)
    WebBrowser: TWebBrowser;
    Image: TImage;
    Edit1: TEdit;
    btn_navigate: TButton;
    procedure WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
    procedure btn_navigateClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

procedure TakeBrowserScreenShot(doc : IHTMLDocument2; Image : TImage);

var  ViewObject: IViewObject;
     sourceDrawRect: TRect;

begin
 Doc.QueryInterface(IViewObject, ViewObject);
 if Assigned(ViewObject) then
  begin
   sourceDrawRect := Rect(-1, -1, Doc.parentWindow.screen.Width, Doc.parentwindow.screen.Height);
   Image.Canvas.FillRect(sourceDrawRect);
   ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, Image.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
  end;
end;

procedure TForm4.btn_navigateClick(Sender: TObject);
begin
 WebBrowser.Navigate(Edit1.Text);
end;

procedure TForm4.WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
var CurrentBrowser: IWebBrowser;
    TopBrowser: IWebBrowser;
    Document: OleVariant;    WindowName: string;
    Doc :  IHTMLDocument2;
begin
 try
  CurrentBrowser := pDisp as IWebBrowser;
  TopBrowser := (ASender as TWebBrowser).DefaultInterface;
  if Assigned(CurrentBrowser) and Assigned(TopBrowser) then
   begin
    Doc := CurrentBrowser.Document as IHTMLDocument2;
    if CurrentBrowser = TopBrowser then
     begin
      if Assigned(Doc) then
       begin
        TakeBrowserScreenShot(Doc, Image); 
       end
     end;
   end;
 except
 end;
end;

end.

Don't use navigatecomplete2 event, this event will fire but at that moment the complete document is still not loaded (images and so on)

I needed to add the line "Image.Canvas.FillRect(sourceDrawRect);" to refresh the TImage canvas

/Daddy




-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[jfreak53]

Hmmm, ok I am attaching two pictures so you can see what it is doing to me. It works the first time, loads google just fine. But when I put in another address, it still comes up with a blank image on the canvas. Is there another way, like destroying it and then recreating? Or is this just an error with my IE?

http://www.microtronix-tech.com/blogs/1.jpg

http://www.microtronix-tech.com/blogs/2.jpg

 

[whosrdaddy]

what OS/IE version are you using?
what is your actual code now??

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[jfreak53]

OS is XP SP2, and IE is 8. But I did try it on another XP install, brand new one, with IE7, still same.

procedure TakeBrowserScreenShot(doc : IHTMLDocument2; Image : TCropImage);

var ViewObject: IViewObject;
sourceDrawRect: TRect;

begin
Doc.QueryInterface(IViewObject, ViewObject);
if Assigned(ViewObject) then
begin
sourceDrawRect := Rect(-1, -1, form1.wb.Width, form1.wb.Height);
Image.Canvas.FillRect(sourceDrawRect);
ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, Image.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
end;

image.Enabled := true;

end;

procedure TForm1.wbDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var CurrentBrowser: IWebBrowser;
TopBrowser: IWebBrowser;
Document: OleVariant; WindowName: string;
Doc : IHTMLDocument2;
begin
try
CurrentBrowser := pDisp as IWebBrowser;
TopBrowser := (Sender as TWebBrowser).DefaultInterface;
if Assigned(CurrentBrowser) and Assigned(TopBrowser) then
begin
Doc := CurrentBrowser.Document as IHTMLDocument2;
if CurrentBrowser = TopBrowser then
begin
if Assigned(Doc) then
begin
TakeBrowserScreenShot(Doc, Image1);
end
end;
end;
except
end;
end;

 

[whosrdaddy]

what is TCropImage?

I used a standard TImage...

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[jfreak53]

It's an image cropping component, it's exactly like TImage component in the way it works, it just allows for cropping. And before I installed this component I had the same problem with the tImage component.

 

[roo0047]

Using XP SP3 w/ IE-8, your code ran just fine for me under D7 (with TImage). I tried several URLs. All of them worked as desired except for

http://www.msn.com/

which consistently raises an invalid floating point error. Go figure!

Have you tried installing SP3?

Roo
Delphi Rules!

 

[jfreak53]

Hmm interesting, maybe it is something with my IE. Hmm, I will try a couple of things with it then. So msn with errors, who would guess Microsoft had errors ha ha ha.

Thanks for the help.

 

[whosrdaddy]

I have W7 / IE8 works without any problem

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!