Форум: "Сети";
Текущий архив: 2007.05.27;
Скачать: [xml.tar.bz2];

Вниз

Сохранить веб страничку как jpeg   Найти похожие ветки 

← →
Pack   (2006-11-20 16:50) [0]

На многих форумах в нете есть процедурка:

procedure Tform1.generatejpegfrombrowser(browser: iwebbrowser2; jpegfqfilename: string;
srcheight: integer; srcwidth: integer; tarheight: integer; tarwidth: integer);
var
sourcedrawrect : trect;
targetdrawrect: trect;
sourcebitmap: tbitmap;
targetbitmap: tbitmap;
jpeg: tjpegimage;
viewobject: iviewobject;
begin
sourcebitmap := tbitmap.create ;
targetbitmap := tbitmap.create ;
jpeg := tjpegimage.create ;
try
try
sourcedrawrect := rect(0,0, srcwidth , srcheight );
sourcebitmap.width := srcwidth ;
sourcebitmap.height := srcheight ;

viewobject := browser as iviewobject;

if viewobject = nil then
exit;

olecheck(viewobject.draw(dvaspect_content, 1, nil, nil, self.handle,
sourcebitmap.canvas.handle, @sourcedrawrect, nil, nil, 0));

// resize bitmap
targetdrawrect := rect(0,0, tarwidth, tarheight);
targetbitmap.height := tarheight;
targetbitmap.width := tarwidth;
targetbitmap.canvas.stretchdraw(targetdrawrect, sourcebitmap);

// create jpeg from bitmap and save it
jpeg.assign(targetbitmap) ;
makefilewriteable(jpegfqfilename);
jpeg.savetofile (jpegfqfilename);
finally
jpeg.free;
sourcebitmap.free ;
targetbitmap.free;
end;
except
// errors
end;
end;

Но у меня матёжытся на
makefilewriteable(jpegfqfilename)

Подскажите, кто уже её юзал, какой модуль надо подключить?

---

← →
clickmaker ©   (2006-11-20 16:51) [1]

> makefilewriteable(jpegfqfilename);

зачем? почему это он не writeable вдруг?

---

← →
Pack   (2006-11-21 09:24) [2]

аналогично...
Undeclared identifier: "writeable"

---

← →
Плохиш ©   (2006-11-21 11:33) [3]

Странно, сделал поиск по "generatejpegfrombrowser", в первой же найденой ссылке ничего похожего на "makefilewriteable" не обнаружено.

---

← →
clickmaker ©   (2006-11-21 12:28) [4]

> [1] clickmaker ©   (20.11.06 16:51)
>
> > makefilewriteable(jpegfqfilename);
>
> зачем? почему это он не writeable вдруг?
>
>
>
>  [2] Pack   (21.11.06 09:24)
> аналогично...
> Undeclared identifier: "writeable"


- Который час?
- Извините, не курю.
(с) бородатый анекдот

---

← →
Pack   (2006-11-21 13:23) [5]

-> clickmaker

>зачем?
я не знаю зачем ...
но не writeable, не makefilewriteable - не работает!

-> Плохиш
кинь ссылку

---

← →
Pack   (2006-11-21 13:26) [6]

а без makefilewriteable видает ошибку на етапе выполнения программы...

---

← →
Pack   (2006-11-21 13:38) [7]

Всем пасиба...
Рабочий код

uses
 MSHTML_TLB, JPEG, ActiveX, ComObj;

procedure generateJPEGfromBrowser(browser: iWebBrowser2; jpegFQFilename: string;
 srcHeight: Integer; srcWidth: Integer; tarHeight: Integer; tarWidth: Integer);
var
 sourceDrawRect: TRect;
 targetDrawRect: TRect;
 sourceBitmap: TBitmap;
 targetBitmap: TBitmap;
 jpeg: TJPEGImage;
 viewObject: IViewObject;
begin
 sourceBitmap := TBitmap.Create;
 targetBitmap := TBitmap.Create;
 jpeg := TJPEGImage.Create;
 try
   try
     sourceDrawRect := Rect(0, 0, srcWidth, srcHeight);
     sourceBitmap.Width  := srcWidth;
     sourceBitmap.Height := srcHeight;

     viewObject := browser as IViewObject;

     if viewObject = nil then
       Exit;

     OleCheck(viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Form1.Handle,
       sourceBitmap.Canvas.Handle, @sourceDrawRect, nil, nil, 0));

     // Resize the src bitmap to the target bitmap
     targetDrawRect := Rect(0, 0, tarWidth, tarHeight);
     targetBitmap.Height := tarHeight;
     targetBitmap.Width  := tarWidth;
     targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);

     // Create a JPEG from the Bitmap and save it
     jpeg.Assign(targetBitmap);

     jpeg.SaveToFile(jpegFQFilename);
   finally
     jpeg.Free;
     sourceBitmap.Free;
     targetBitmap.Free;
   end;
 except
   // Error Code
 end;
end;

procedure TForm1.btnButton1Click(Sender: TObject);
var
 IDoc1: IHTMLDocument2;
 Web: ShDocVW_TLB.IWebBrowser2;
 tmpX, tmpY: Integer;
begin
 with WebBrowser1 do
 begin
   Document.QueryInterface(IHTMLDocument2, iDoc1);
   Web := ControlInterface;
   tmpX := Height;
   tmpY := Width;
   TControl(WebBrowser1).Visible := Boolean(0);
   Height := OleObject.Document.ParentWindow.Screen.Height;
   Width := OleObject.Document.ParentWindow.Screen.Width;
   generateJPEGfromBrowser(Web,"c:\test.jpg",Height, Width, Height, Width);
   Height := tmpX;
   Width := tmpY;
   TControl(WebBrowser1).Visible := Boolean(1);
 end;
end;

---

← →
Плохиш ©   (2006-11-21 13:43) [8]

Обалдеть, сам ссылку нашёл :-))

---

Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2007.05.27;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.04 c