TWebbrowser Screenshot erstellen u.Zwichenablage kopieren

[blondervolker]

Hab mal wieder eine Frage...

habe einen Sceenshot erstellt, aber sehe zwar die Form und einen
leeren Browser. Was mache ich falsch?

Delphi-Quellcode:

procedure TForm12.Start1Click(Sender: TObject);
var
Bitmap:TBitmap;
begin
Bitmap:=GetFormImage;
try
Clipboard.Assign(Bitmap);
finally
Bitmap.Free;
// MessageBox-Code
//
case messageBox(handle,
            'Eine Hardcopy wurde in die Zwischenablage kopiert.',
            'Info',
            0 OR 0 OR MB_DEFBUTTON1)
            of
 IDOK:
   begin
      // Knopf "Ok" gedrückt
   end;
 end;
// Ende MessageBox - Code
end;
end;

[Bummi]

Delphi-Quellcode:

uses ActiveX;


Function WebBrowserScreenShot(const wb: TWebBrowser):TBitmap ;
var
  viewObject : IViewObject;
  r : TRect;

begin
  Result := TBitmap.Create;
  if wb.Document <> nil then
  begin
    wb.Document.QueryInterface(IViewObject, viewObject) ;
    if Assigned(viewObject) then
    try
        r := Rect(0, 0, wb.Width, wb.Height) ;
        Result.Height := wb.Height;
        Result.Width := wb.Width;
        viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, Result.Canvas.Handle, @r, nil, nil, 0) ;
    finally
      viewObject._Release;
    end;
  end;
end;



procedure TForm2.Button2Click(Sender: TObject);
var

Bitmap,webbmp:TBitmap;
begin
Bitmap:=GetFormImage;
webbmp := WebBrowserScreenShot(webBrowser1);
Bitmap.Canvas.Draw(webBrowser1.Left,WebBrowser1.top,webbmp);
try
Clipboard.Assign(Bitmap);
finally
Bitmap.Free;
webbmp.Free;
// MessageBox-Code
//
case messageBox(handle,
            'Eine Hardcopy wurde in die Zwischenablage kopiert.',
            'Info',
            0 OR 0 OR MB_DEFBUTTON1)
            of
 IDOK:
   begin
      // Knopf "Ok" gedrückt
   end;
 end;
// Ende MessageBox - Code
end;
end;

[DeddyH]

Zitat:

Function WebBrowserScreenShot(const wb: TWebBrowser):TBitmap ;

Das ist irgendwie *bäh*, oder? Ich würde eine Prozedur daraus machen und die Bitmap als Parameter übergeben lassen.

[Bummi]

genauso bäh... wie GetFormImage ...

[DeddyH]

Das stimmt zwar, aber nur weil andere Blödsinn machen muss man das ja nicht auch tun

[Bummi]

Ok, das kommt davon, wenn man neben der Arbeit etwas macht ...

ich denke der Code kommt näher an die Anforderung heran.

Delphi-Quellcode:

function CompleteShot(wnd: HWND; const bmp: TBitmap): Boolean;
var
  rec: TRect;
  dllh: THandle;
  PrintWindow: function(sHandle: HWND; dHandle: HDC; nFlags: UINT): BOOL; stdcall;
begin
  Result := False;
  dllh := GetModuleHandle(user32);
  if dllh <> 0 then
  begin
    @PrintWindow:= GetProcAddress(dllh , 'PrintWindow');
    if @PrintWindow <> nil then
    begin
      GetWindowRect(wnd, rec);
      bmp.Width := rec.Right - rec.Left;
      bmp.Height := rec.Bottom - rec.Top;
      bmp.Canvas.Lock;
      try
        result := PrintWindow(wnd, bmp.Canvas.Handle, 0);
      finally
        bmp.Canvas.Unlock;
      end;
    end;
  end;
end;



procedure TForm2.Button2Click(Sender: TObject);
var

Bitmap:TBitmap;
begin
  Bitmap:= TBitmap.Create;
  CompleteShot(Handle, Bitmap);
  try
    Clipboard.Assign(Bitmap);
  finally
    Bitmap.Free;
  end;
  Showmessage('Eine Hardcopy wurde in die Zwischenablage kopiert.');
end;

[blondervolker]

Hallo und Danke!!!