Re[2]: Размеры IHTMLWindow2
От: Aniskin  
Дата: 07.10.07 14:59
Оценка:
Здравствуйте, Flamer, Вы писали:


F>Юзать IViewObject::Draw.


Спасибо за совет. Провел эксперименты с WebBroser, получая IViewObject у WebBrowser1.Document – все работает прекрасно. Но в случае, когда я имею только хендл окна, не получается. Пожалуйста, укажите на ошибку.

procedure SaveExplorerCaptureFile(AWin: THandle; const AFileName: string);
var Doc: IHTMLDocument2;
    Body: IHTMLElement;
    Body2: IHTMLElement2;
    BodyElement: IHTMLBodyElement;
    W, H: Integer;
    ViewObject: IViewObject;
    DC: HDC;
    R: TRect;
    SaveBorderStyle: WideString;
    SaveScroll: WideString;
    B: TBitmap;
begin
  OleCheck(GetIDocFromHWND(AWin, Doc));
  Body := Doc.body;
  if not Assigned(Body) then raise Exception.Create('Empty body');
  OleCheck(Body.QueryInterface(IHTMLElement2, Body2));
  W := Body2.scrollWidth;
  H := Body2.scrollHeight;
  if (W = 0) or (H = 0) then raise Exception.Create('Empty content');
  OleCheck(Body.QueryInterface(IHTMLBodyElement, BodyElement));
  // Там ли я беру IViewObject?
  OleCheck(Doc.QueryInterface(IViewObject, ViewObject));
  SaveBorderStyle := Body.style.borderStyle;
  Body.style.borderStyle := 'none';
  SaveScroll := BodyElement.scroll;
  BodyElement.scroll := 'no';
  // Еще не плохо было бы установить
  // WebBrowser.Width := Body2.scrollWidth;
  // WebBrowser.Height := Body2.scrollHeight;
  // но где взять IWebBrowser?
  // Или использовать SetWindowPos(AWin, 0, 0, 0, W, H, SWP_NOZORDER or SWP_NOMOVE or
  //   SWP_NOACTIVATE or SWP_NOCOPYBITS or SWP_NOREDRAW or SWP_NOSENDCHANGING or SWP_NOOWNERZORDER)
  B := TBitmap.Create;
  try
    B.Width := W;
    B.Height := H;
    DC := GetDC(0);
    try
      R := Rect(0, 0, B.Width, B.Height);
      OleCheck(ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil,
        DC, B.Canvas.Handle, @R, nil, nil, 0));
      B.SaveToFile(AFileName);
    finally
      ReleaseDC(0, DC);
    end;
  finally
    B.Free;
    Body.style.borderStyle := SaveBorderStyle;
    BodyElement.scroll := SaveScroll;
  end;
end
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.