TLama

Untitled

Jul 15th, 2013
946
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 2.97 KB | None | 0 0
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ExtDlgs, IdHTTP, cefvcl, ceflib;
  8.  
  9. const
  10.   MENU_ID_SAVE_IMAGE_AS = Ord(MENU_ID_USER_FIRST) + 1;
  11.  
  12. type
  13.   TDownloader = class(TThread)
  14.   private
  15.     FURL: string;
  16.     FFileName: string;
  17.   protected
  18.     procedure Execute; override;
  19.   public
  20.     constructor Create(const URL, FileName: string); reintroduce;
  21.   end;
  22.  
  23. type
  24.   TForm1 = class(TForm)
  25.     Button1: TButton;
  26.     Chromium1: TChromium;
  27.     SavePictureDialog1: TSavePictureDialog;
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure Chromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser;
  30.       const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
  31.     procedure Chromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser;
  32.       const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer;
  33.       eventFlags: TCefEventFlags; out Result: Boolean);
  34.   private
  35.     { Private declarations }
  36.   public
  37.     { Public declarations }
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.  
  43. implementation
  44.  
  45. {$R *.dfm}
  46.  
  47. { TDownloader }
  48.  
  49. constructor TDownloader.Create(const URL, FileName: string);
  50. begin
  51.   inherited Create(False);
  52.   FreeOnTerminate := True;
  53.   FURL := URL;
  54.   FFileName := FileName;
  55. end;
  56.  
  57. procedure TDownloader.Execute;
  58. var
  59.   HTTPClient: TIdHTTP;
  60.   FileStream: TFileStream;
  61. begin
  62.   try
  63.     HTTPClient := TIdHTTP.Create;
  64.     try
  65.       FileStream := TFileStream.Create(FFileName, fmCreate);
  66.       try
  67.         HTTPClient.Get(FURL, FileStream);
  68.       finally
  69.         FileStream.Free;
  70.       end;
  71.     finally
  72.       HTTPClient.Free;
  73.     end;
  74.   except
  75.     // error handling ignored for this example
  76.   end;
  77. end;
  78.  
  79. { TForm1 }
  80.  
  81. procedure TForm1.FormCreate(Sender: TObject);
  82. begin
  83.   Chromium1.Load('http://www.google.com/');
  84. end;
  85.  
  86. procedure TForm1.Chromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser;
  87.   const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
  88. begin
  89.   if (CM_TYPEFLAG_MEDIA in params.TypeFlags) and (params.MediaType = CM_MEDIATYPE_IMAGE) then
  90.     model.AddItem(MENU_ID_SAVE_IMAGE_AS, 'Save image as...');
  91. end;
  92.  
  93. procedure TForm1.Chromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser;
  94.   const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer;
  95.   eventFlags: TCefEventFlags; out Result: Boolean);
  96. var
  97.   SaveDialog: TSavePictureDialog;
  98. begin
  99.   if (commandId = MENU_ID_SAVE_IMAGE_AS) then
  100.   begin
  101.     SaveDialog := TSavePictureDialog.Create(nil);
  102.     try
  103.       // SaveDialog.FileName := <here you can extract file name from params.SourceUrl>;
  104.       // SaveDialog.DefaultExt := <here you can extract file ext from params.SourceUrl>;
  105.       if SaveDialog.Execute then
  106.         TDownloader.Create(params.SourceUrl, SaveDialog.FileName);
  107.     finally
  108.       SaveDialog.Free;
  109.     end;
  110.   end;
  111. end;
  112.  
  113. end.
Advertisement
Add Comment
Please, Sign In to add comment