Скриншоты

[Nastya1998]

Сообщение от Smitt&Wesson

Это С++ Builder. А вот из этого кода, можно выдрать преобразование BMP в JPG и Icon.

Мне нужно в формате Delphi!

[Smitt&Wesson]

Ну может дельфинисты переведут. Я в Дельфинах ни бум-бум.

[Nastya1998]

А мне нужен тот кто бум-бум

[ZX Spectrum-128]

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, OleCtrls, SHDocVw, Jpeg, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

function GetScreenShot(const AHandle: THandle; const CompressPercent: Byte;
var AImage: TJPEGImage): Boolean;
  // В качестве параметров передаются:
  // AHandle - хэндл окна, скриншот которого мы хочем получить
  // CompressPercent - процент сжатия картинки
  // AImage - картинка, в которую будет помещено изображение
  // в случае успешного скриншота функция вернет True
  {©Drkb v.3(2007): www.drkb.ru}
var
  fBitmap: TBitmap;
  DC: HDC;
  Rect: TRect;
begin
  Result := False;
  if AImage = nil then Exit;
  DC := GetDC(AHandle);
  if DC <> 0 then
  try
    fBitmap := TBitmap.Create;
    try
      if not GetClientRect(AHandle, Rect) then Exit;
      fBitmap.Width := Rect.Right - Rect.Left;
      fBitmap.Height := Rect.Bottom - Rect.Top;
      fBitmap.PixelFormat := pf32bit;
      Result := BitBlt(fBitmap.Canvas.Handle, 0, 0, fBitmap.Width,
      fBitmap.Height, DC, 0, 0, SRCCOPY);
      if not Result then Exit;
      AImage.Assign(fBitmap);
      AImage.CompressionQuality := CompressPercent;
    finally
      fBitmap.Free;
    end;
  finally
    ReleaseDC(AHandle, DC);
  end;
end;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  keypreview:=true;
  webbrowser1.Navigate('http://programmersforum.ru');
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Image: TJPEGImage;
  s:string;
  dm:tdatetime;
begin
    if key=VK_F1 then
      begin
        // Скриншот нашей формы
        Image := TJPEGImage.Create;
        try
          if GetScreenShot(Handle, 150, Image) then
            begin
              dm:=Now;
              DateTimeToString(s, 'dd.mm.yyyy h.m.s.z', dm);
              image.SaveToFile(s+'.jpg');
            end;
        finally
          Image.Free;
        end;
      end;
end;

end.

[Nastya1998]

Сообщение от ZX Spectrum-128

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, OleCtrls, SHDocVw, Jpeg, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

function GetScreenShot(const AHandle: THandle; const CompressPercent: Byte;
var AImage: TJPEGImage): Boolean;
  // В качестве параметров передаются:
  // AHandle - хэндл окна, скриншот которого мы хочем получить
  // CompressPercent - процент сжатия картинки
  // AImage - картинка, в которую будет помещено изображение
  // в случае успешного скриншота функция вернет True
  {©Drkb v.3(2007): www.drkb.ru}
var
  fBitmap: TBitmap;
  DC: HDC;
  Rect: TRect;
begin
  Result := False;
  if AImage = nil then Exit;
  DC := GetDC(AHandle);
  if DC <> 0 then
  try
    fBitmap := TBitmap.Create;
    try
      if not GetClientRect(AHandle, Rect) then Exit;
      fBitmap.Width := Rect.Right - Rect.Left;
      fBitmap.Height := Rect.Bottom - Rect.Top;
      fBitmap.PixelFormat := pf32bit;
      Result := BitBlt(fBitmap.Canvas.Handle, 0, 0, fBitmap.Width,
      fBitmap.Height, DC, 0, 0, SRCCOPY);
      if not Result then Exit;
      AImage.Assign(fBitmap);
      AImage.CompressionQuality := CompressPercent;
    finally
      fBitmap.Free;
    end;
  finally
    ReleaseDC(AHandle, DC);
  end;
end;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  keypreview:=true;
  webbrowser1.Navigate('http://programmersforum.ru');
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Image: TJPEGImage;
  s:string;
  dm:tdatetime;
begin
    if key=VK_F1 then
      begin
        // Скриншот нашей формы
        Image := TJPEGImage.Create;
        try
          if GetScreenShot(Handle, 150, Image) then
            begin
              dm:=Now;
              DateTimeToString(s, 'dd.mm.yyyy h.m.s.z', dm);
              image.SaveToFile(s+'.jpg');
            end;
        finally
          Image.Free;
        end;
      end;
end;

end.

Спасибо, тему можно удалять, а куда сохраняются скриншоты?

[Simply-Art]

Сохраняются в рабочую папку программы, строчка кода вот эта - image.SaveToFile(s+'.jpg'). Если вместо S указать путь типа 'c:\'+S, то будет на C диск сохранять. Если больше вопросов нет, пишите тему закроем.

[Nastya1998]

Сообщение от Simply-Art

Сохраняются в рабочую папку программы, строчка кода вот эта - image.SaveToFile(s+'.jpg'). Если вместо S указать путь типа 'c:\'+S, то будет на C диск сохранять. Если больше вопросов нет, пишите тему закроем.

А почему фотографируется форма? А не только компонент? Мне нужно что бы только компонент WebBrowser фотографировался. И один раз сфотографировалась и все? Мне нужно что бы не ограниченное количество раз можно было фотографировать!

[Smitt&Wesson]

Сообщение от Nastya1998

А почему фотографируется форма? А не только компонент? Мне нужно что бы только компонент WebBrowser фотографировался. И один раз сфотографировалась и все? Мне нужно что бы не ограниченное количество раз можно было фотографировать!

Потому-что код:

fBitmap.Width := Rect.Right - Rect.Left;
fBitmap.Height := Rect.Bottom - Rect.Top;

Задаёт угловые координаты формы. Поменяйте их на координаты нужного компонента.
Если нужен увтоматический режим, заключите этот код в обработчик таймера.

[Nastya1998]

Сообщение от Smitt&Wesson

Потому-что код:

fBitmap.Width := Rect.Right - Rect.Left;
fBitmap.Height := Rect.Bottom - Rect.Top;

Задаёт угловые координаты формы. Поменяйте их на координаты нужного компонента.
Если нужен увтоматический режим, заключите этот код в обработчик таймера.

Как? У браузера можно изменить размер окна и т.д, как тогда поступить что бы именно браузер фотался?

[Smitt&Wesson]

Сообщение от Nastya1998

Как? У браузера можно изменить размер окна и т.д, как тогда поступить что бы именно браузер фотался?

У любого визуального компонента, есть параметры Width и Height.
В данном случае, используются координаты всей формы. Поменяйте их на координаты компонента cppWebBrowser.
cppWebBrowser.Width и т.д.