Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2007.05.27;
Скачать: CL | DM;

Вниз

Сохранить веб страничку как 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;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.047 c
3-1173306371
databaser
2007-03-08 01:26
2007.05.27
Сравнение запросов


1-1175191667
Kolan
2007-03-29 22:07
2007.05.27
Как сделать Wizzard?


8-1158306298
megasecure
2006-09-15 11:44
2007.05.27
Графика в Delphi


15-1177416368
alex_***
2007-04-24 16:06
2007.05.27
Транзакции для распределенных систем. Кто использовал?


1-1174310573
kodov
2007-03-19 16:22
2007.05.27
Поиск в ListBox