Получить изображение контрола созданного в рантайм

[Celestia]

Здравствуйте!
У меня такой вопрос. Возможно ли каким то образом получить изображение визуального контрола, созданного в рантайм режиме, и не отображаемого ни на одной форме?
Издеваюсь над веб браузером EmbeddedWB от BSalsa, нужно получить его изображение в битмап.. Если я просто кладу его на форму, то проблем с получением изображения нет.. а вот если я создаю его в рантайме, то ни в какую не хочет, и ошибки не выдаёт..

[eduard93]

Можно разместить форму с ним за пределами экрана.

[Celestia]

Да, вот код, может кому тоже поможет, если кто будет копаться с этим компонентом

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB, ActiveX, MSHTML_EWB, StdCtrls,
  AppEvnts, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ApplicationEvents1: TApplicationEvents;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  EmbeddedWB1: TEmbeddedWB;
  GDIBuffer: TBitmap;
implementation

{$R *.dfm}

function KeysFromShift(Shift: TShiftState): cardinal;
begin
  Result := 0;
  if ssCtrl in Shift then
    Result := Result or MK_CONTROL;
  if ssShift in Shift then
    Result := Result or MK_SHIFT;
  if ssAlt in Shift then
    Result := Result or MK_ALT;
  if ssLeft in Shift then
    Result := Result or MK_LBUTTON;
  if ssRight in Shift then
    Result := Result or MK_RBUTTON;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  EmbeddedWB1:= TEmbeddedWB.Create(EmbeddedWB1);
  EmbeddedWB1.Parent:=Form1;
  EmbeddedWB1.Left:=-10000;
  EmbeddedWB1.Width:=640;
  EmbeddedWB1.Height:=480;
  EmbeddedWB1.Navigate('http://g-net.local');
  // Create GDI Buffer - because IE only can draw to DC
  GDIBuffer := TBitmap.Create;
  GDIBuffer.PixelFormat := pf32bit;
  // disable control update
  SendMessage(EmbeddedWB1.Handle, WM_SETREDRAW, 0, 0);
 
end;


procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Msg: TWMMouse;
  R: LRESULT;
begin
  case Button of
    mbLeft: Msg.Msg := WM_LBUTTONDOWN;
    mbRight: Msg.Msg := WM_RBUTTONDOWN;
  end;
  Msg.Keys := KeysFromShift(Shift);
  Msg.XPos := round(X);
  Msg.YPos := round(Y);
  with TMessage(Msg) do
    SendMessage(EmbeddedWB1.HWND, Msg, wParam, lParam);

end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Msg: TWMMouse;
  R: LRESULT;
begin
  Msg.Msg := WM_MOUSEMOVE;
  Msg.Keys := KeysFromShift(Shift);
  Msg.XPos := round(X);
  Msg.YPos := round(Y);
  with TMessage(Msg) do
    SendMessage(EmbeddedWB1.HWND, Msg, wParam, lParam);
end;

procedure UpdateBuffer;
var
  View: IViewObject2;
  Doc: IHTMLDocument2;
  DS: IDisplayServices;
  C: IHTMLCaret;
  r: TRect;
  V: integer;
  P: TPoint;
begin
  (* Get WB Document *)
  Doc := IHTMLDocument2(EmbeddedWB1.Document);
  if not Assigned(Doc) then Exit;

  (* Make screenshot *)
  view := EmbeddedWB1.controlinterface as IViewObject2;
  r := rect(0, 0, 640, 480);
  (* Resize buffer (if need) *)
  GDIBuffer.Width := 640;
  GDIBuffer.Height := 480;
  (* Draw to GDI buffer *)
  view.Draw(DVASPECT_CONTENT, 1, nil, nil, 0, GDIBuffer.canvas.Handle, @r, nil, nil, 0);
  (* Draw Caret *)
  Doc.QueryInterface(IDisplayServices, DS);
  if Assigned(DS) then
  begin
    DS.GetCaret(C);
    if Assigned(C) then
    begin
      C.IsVisible(V);
      if V > 0 then
      begin
        C.GetLocation(P, 1);
        GDIBuffer.Canvas.Brush.Color := clBlack;
        GDIBuffer.Canvas.FillRect(Rect(P.x, P.y, P.x + 2, P.y + 18));
      end;
    end;
  end;
end;


procedure TForm1.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
UpdateBuffer;
  BlendBitmap_GDI(Form1.Canvas,GDIBuffer,0,0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
UpdateBuffer;
  BlendBitmap_GDI(Image1.Canvas,GDIBuffer,0,0);
//  GDIBuffer.SaveToFile('sfdsdf.bmp');
end;

end.

Правда есть одна трабла- битмапу буфферному (GDIBuffer) надо заполнять альфу $FF, потому что сам браузер это не делает

[Celestia]

и ещё одна процедурка отрисовки на канвасе 32bpp битмапа.

procedure BlendBitmap_GDI(ACanvas: TCanvas; BT:Tbitmap; x,y:integer);
const
 MaxPixelCountA = MaxInt div SizeOf(TRGBQuad);
type
 PRGBAArray = ^TRGBAArray;
 TRGBAArray = array[0..MaxPixelCountA-1] of TRGBQuad;
var xTo,sx,YTo,ddx,ddy,sy,w,h,dstw,dsth: integer;
   bt_buff:Tbitmap; i,ii,itemp:integer; RSource,RDest:PRGBAArray; dd:double;
begin
 w:=BT.Width;
 h:=bt.Height;
 dstw:=ACanvas.ClipRect.Right-ACanvas.ClipRect.Left;
 dsth:=ACanvas.ClipRect.Bottom-ACanvas.ClipRect.Top;
 XTo:=x+W-1; YTo:=y+H-1;
 if (y>=dstH) or (x>=dstW) or (YTo<0) or (XTo<0) then exit;
 ddx:=0; ddy:=0;
 sx:=W; sy:=H;
 if X<0 then begin
     ddx:=-X;
     inc(sx,X);
     x:=0;
 end;
 if Y<0 then begin
     ddy:=-Y;
     inc(sy,Y);
     y:=0;
 end;
 if XTo>=dstw then dec(sx,XTo-dstw+1);
 if YTo>=dsth then dec(sy,YTo-dsth+1);
 if (sx<=0) or (sy<=0) then exit;
 if(BT.PixelFormat<>pf32bit) then exit;

 bt_buff:=Tbitmap.Create;
 try
   bt_buff.Width:=sx;
   bt_buff.Height:=sy;
   bt_buff.canvas.CopyRect( rect(0,0,bt_buff.Width,bt_buff.Height), ACanvas ,rect(x,y,x+sx,y+sy) );
   bt_buff.PixelFormat:=pf32bit;
   for i:=0 to sy-1 do begin
     RSource:=BT.ScanLine[i+ddy];
     RDest:=bt_buff.ScanLine[i];
     for ii:=0 to sx-1 do begin
       dd:=((100/255)/100)*RSource[ii+ddx].rgbReserved;

       itemp:=round(RDest[ii].rgbRed+(RSource[ii+ddx].rgbRed-RDest[ii].rgbRed)*dd);
       if itemp>255 then itemp:=255 else if itemp<0 then itemp:=0;
       RDest[ii].rgbRed:=itemp;

       itemp:=round(RDest[ii].rgbGreen+(RSource[ii+ddx].rgbGreen-RDest[ii].rgbGreen)*dd);
       if itemp>255 then itemp:=255 else if itemp<0 then itemp:=0;
       RDest[ii].rgbGreen:=itemp;

       itemp:=round(RDest[ii].rgbBlue+(RSource[ii+ddx].rgbBlue-RDest[ii].rgbBlue)*dd);
       if itemp>255 then itemp:=255 else if itemp<0 then itemp:=0;
       RDest[ii].rgbBlue:=itemp;
     end;
   end;
   ACanvas.CopyRect( rect(x,y,x+sx,y+sy), bt_buff.canvas ,rect(0,0,bt_buff.Width,bt_buff.Height) );
 finally
   bt_buff.Free;
 end;
end;