Форум программистов
 
О проблемах с регистрацией пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Вернуться   Форум программистов > Delphi программирование > Компоненты Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail


Ответ
 
Опции темы
Старый 01.04.2017, 11:34   #1
arriah
Пользователь
 
Регистрация: 09.08.2015
Сообщений: 61
По умолчанию TChromium

Подскажите как в компоненте TChromium (CEF3) сохранять изображения, например из контекстного меню
Завидую крокодилам! Они даже ходят лежа!
arriah вне форума Ответить с цитированием
Старый 08.04.2017, 19:49   #2
pas2
Пользователь
 
Регистрация: 02.01.2016
Сообщений: 42
По умолчанию

Цитата:
Сообщение от arriah Посмотреть сообщение
Подскажите как в компоненте TChromium (CEF3) сохранять изображения, например из контекстного меню
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtDlgs, IdHTTP, cefvcl, ceflib;

const
  MENU_ID_SAVE_IMAGE_AS = Ord(MENU_ID_USER_FIRST) + 1;

type
  TDownloader = class(TThread)
  private
    FURL: string;
    FFileName: string;
  protected
    procedure Execute; override;
  public
    constructor Create(const URL, FileName: string); reintroduce;
  end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Chromium1: TChromium;
    SavePictureDialog1: TSavePictureDialog;
    procedure FormCreate(Sender: TObject);
    procedure Chromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser;
      const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
    procedure Chromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser;
      const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer;
      eventFlags: TCefEventFlags; out Result: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TDownloader }

constructor TDownloader.Create(const URL, FileName: string);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  FURL := URL;
  FFileName := FileName;
end;

procedure TDownloader.Execute;
var
  HTTPClient: TIdHTTP;
  FileStream: TFileStream;
begin
  try
    HTTPClient := TIdHTTP.Create;
    try
      FileStream := TFileStream.Create(FFileName, fmCreate);
      try
        HTTPClient.Get(FURL, FileStream);
      finally
        FileStream.Free;
      end;
    finally
      HTTPClient.Free;
    end;
  except
    // error 
  end;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Chromium1.Load('http://www.google.com/');
end;

procedure TForm1.Chromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
begin
  if (CM_TYPEFLAG_MEDIA in params.TypeFlags) and (params.MediaType = CM_MEDIATYPE_IMAGE) then
    model.AddItem(MENU_ID_SAVE_IMAGE_AS, 'Сохранить изображение как...');
end;

procedure TForm1.Chromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer;
  eventFlags: TCefEventFlags; out Result: Boolean);
var
  SaveDialog: TSavePictureDialog;
begin
  if (commandId = MENU_ID_SAVE_IMAGE_AS) then
  begin
    SaveDialog := TSavePictureDialog.Create(nil);
    try;
      if SaveDialog.Execute then
        TDownloader.Create(params.SourceUrl, SaveDialog.FileName);
    finally
      SaveDialog.Free;
    end;
  end;
end;

end.

Последний раз редактировалось pas2; 08.04.2017 в 19:51.
pas2 вне форума Ответить с цитированием
Ответ
Купить рекламу на форуме 20000 рублей в месяц
Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
TChromium НоМеР Работа с сетью в Delphi 5 12.03.2016 15:55
TChromium _ZixeL_ Общие вопросы Delphi 0 24.09.2015 17:43
TChromium Cruzel Работа с сетью в Delphi 8 20.11.2013 14:02
TChromium docc Общие вопросы Delphi 0 16.08.2013 22:13
Tchromium не работает DmitryVisuals Компоненты Delphi 0 08.06.2013 19:03


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS