Создание скриншотера (Часть1)

Давайте создадим свой скриншотер. Но не такой простой, как в windows, а с большими возможностями, такими, как например у Ashamtoo Snap.

Давайте начнем с о снимка всей области экрана. Создаем новый проект, кидаем на него кнопку Button и компонент для отображения скриншота Image. Также можно добавить компонент ScrollBox, для прокрутки не помещающейся части изображения. Image перенесите на него. Расположить можете по своему желанию, у меня получилось так

Добавляем в код следующую процедуру

procedure ScreenShot(Bild: TBitMap);
 var
   c: TCanvas;
   r: TRect;
 begin
   c := TCanvas.Create;
  // получаем handle рабочего стола
   c.Handle := GetWindowDC(GetDesktopWindow); 
   try
    // запоминаем его размеры
     r := Rect(0, 0, Screen.Width, Screen.Height); 
     Bild.Width := Screen.Width;
     Bild.Height := Screen.Height;
    // и копируем в Bitmap изображение экрана	
     Bild.Canvas.CopyRect(r, c, r);
   finally
     ReleaseDC(0, c.Handle);
     c.Free;
   end;
 end;

И теперь, в событие OnClick кнопки добавляем

procedure TForm1.Button1Click(Sender: TObject);
begin
ScreenShot(Image1.Picture.BitMap);
ScrollBox1.HorzScrollBar.Range:=Image1.Picture.Width;
ScrollBox1.VertScrollBar.Range:=Image1.Picture.Height;
end;

Запускаем и проверяем работу

Как мы видим, все работает, но само приложение также попадает в область снятия скриншота. Чтобы этого не было, приложение можно скрыть на время. Делается это так:

 Form1.Visible := False; // скрываем приложение
 Sleep(750);  // ждем немного, чтобы приложение успело скрыться
// делаем скриншот
ScreenShot(Image1.Picture.BitMap);
ScrollBox1.HorzScrollBar.Range:=Image1.Picture.Width;
ScrollBox1.VertScrollBar.Range:=Image1.Picture.Height;   
//
Form1.Visible := True;  // отображаем приложение

Смотрим-все работает. В следующей части я расскажу, как снять скриншот активного окна.

Создание скриншотера (Часть2)

Следующим шагом будет получение скриншота активного окна. Он не намного отличается от предыдущего. Итак, открываем наш проект и добавляем дополнительную кнопку с названием ‘Активное окно’

Аналогично добавляем процедуру получения скриншота активного окна

procedure ScreenShotActiveWindow(Bild: TBitMap);
var
  c: TCanvas;
  r, t: TRect;
  h: THandle;
begin
  c := TCanvas.Create;
  c.Handle := GetWindowDC(GetDesktopWindow);
  // получаем handle активного окна
  h := GetForeGroundWindow;
  // если есть активное окно, то получаем его координаты-Rect
  if h <> 0 then
    GetWindowRect(h, t);
  try
    r := Rect(0, 0, t.Right - t.Left, t.Bottom - t.Top);
    Bild.Width := t.Right - t.Left;
    Bild.Height := t.Bottom - t.Top;
    Bild.Canvas.CopyRect(r, c, t);
  finally
    ReleaseDC(0, c.Handle);
    c.Free;
  end;
end;

И теперь, в событие OnClick кнопки добавляем

procedure TForm1.Button2Click(Sender: TObject);
begin
  Form1.Visible := False;
  Sleep(750); // прячем форму, при этом активным становится последнее активное окно

  ScreenShotActiveWindow(Image1.Picture.BitMap);
  ScrollBox1.HorzScrollBar.Range := Image1.Picture.Width;
  ScrollBox1.VertScrollBar.Range := Image1.Picture.Height;

  Form1.Visible := true;
end;

Запускаем и проверяем работу

Итак, все работает. Следующая часть будет посвящена снятию произвольной области экрана, аналогу приложению “Ножницы” в Windows7.

Создание скриншотера (Часть3)

Теперь попытаемся получить скриншот произвольной области окна.Добавляем кнопку с названием ‘Произвольная область’.

Добавляем новую форму. Она будет затемнять экран, а так же на ней будет отрисовываться область снимка. Чтобы все это выглядело прилично, меняем её свойства:

• 1)Убираем у нее границы: BorderStyle устанавливаем в bsNone
• 2) Меняем курсор на crCross.
• 3) Устанавливаем свойство AlphaBlend в True, а AlphaBlendValue равным 150. Так форма будет полупрозрачной.
• 4) Устанавливаем свойство TransparentColor в True, а TransparentColorValue в clGreen. Для чего это нужно? Когда мы будем выделять область экрана, зальем её в зеленный цвет. Т.о. она станет прозрачной.

Так же добавляем несколько переменных в private область формы:

•

• isDown:Boolean;

Эта переменная будет флагом, показывающая, нажата ли клавиша мыши или нет.

•

• downX, downY: Integer;

В эти переменные будут запоминаться начальные координаты выделенной области.

•

• Bild: TBitMap;

А сюда мы будем сохранять само изображение области экрана. Эту переменную нужно добавить в public секцию.

Не забудьте добавить в секцию uses первой и второй формы ссылки на другую форму. Итак, приступим к кодированию. Сначала разберемся со второй формой. При её создании мы должны создать обеъект Bild, а при удалении формы освободить его.

procedure TForm2.FormCreate(Sender: TObject);
begin
    //создаем объект Bild
    Bild:=TBitMap.Create;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
    //освобождаем объект Bild
   Bild.Free;
end;

Теперь определяем события при нажатии и отпускании мыши, а также при ведении курсора над формой

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   // устанавливаем флаг нажатия мыши в true
  isDown := true;
  // и запоминаем текущие координаты
  downX := X;
  downY := Y;
end;

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  // если нажата клавиша мыши, то мы рисуем рамку выделения
  if isDown then
  begin
   // перерисовываем форму
   Self.Repaint;

    // тут мы рисуем  пунктирную рамку красного цвета
    Self.Canvas.Pen.Color := clRed;
    Self.Canvas.Pen.Width := 1;

    Self.Canvas.Pen.Style := psDot;
   // вот здесь мы заливаем область зеленым цветом, благодаря чему она становиться прозрачной
    Self.Canvas.Brush.Color := clGreen;
    Self.Canvas.Rectangle(downX, downY, X, Y);


    // а здесь рисуем  маркеры красного цвета в углах и серединах сторон для красоты
    Self.Canvas.Pen.Style := psSolid;
    Self.Canvas.Brush.Color := clRed;

    Self.Canvas.Rectangle(downX - 6, downY - 6, downX + 6, downY + 6);
    Self.Canvas.Rectangle(X - 6, Y - 6, X + 6, Y + 6);
    Self.Canvas.Rectangle(X - 6, downY - 6, X + 6, downY + 6);
    Self.Canvas.Rectangle(downX - 6, Y - 6, downX + 6, Y + 6);

    Self.Canvas.Rectangle(downX - 6, (downY + Y) div 2 - 6, downX + 6,
      (downY + Y) div 2 + 6);
    Self.Canvas.Rectangle(X - 6, (downY + Y) div 2 - 6, X + 6,
      (downY + Y) div 2 + 6);
    Self.Canvas.Rectangle((downX + X) div 2 - 6, downY - 6,
      (downX + X) div 2 + 6, downY + 6);
    Self.Canvas.Rectangle((downX + X) div 2 - 6, Y - 6, (downX + X) div 2 + 6,
      Y + 6);
  end;
end;

procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  r: TRect;
begin
  // сбрасываем флаг
  isDown := false;

  // сохраняем координаты области
  r.Left := downX;
  r.Top := downY;
  r.Right := X;
  r.Bottom := Y;
  
  // в переменную Bild выводим область экрана
  Bild := CaptureScreenRect(r);

  // и закрываем форму
  Self.Close;
end;

Функция CaptureScreenRect выводит область экрана, зная координаты этой области:

function CaptureScreenRect(aRect: TRect): TBitMap;
var
  ScreenDC: HDC;
begin
  Result := TBitMap.Create;
  with Result, aRect do
  begin
     // Устанавливаем размеры выводимого изображения равными выделенной области
    Width := Right - Left;
    Height := Bottom - Top;
    
    // Получаем Хендл рабочего окна
    ScreenDC := GetDC(0);
    try
      // и копируем нужную область экрана
      BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY);
    finally
      ReleaseDC(0, ScreenDC);
    end;
  end;
end;

Тут мы закончили. Теперь переходим к основной форме, и добавляем в OnClick событие нашей кнопки следующий код:

procedure TForm1.Button3Click(Sender: TObject);
var
  ScreenForm: TForm2;
begin
  // создаем нашу полупрозрачную форму
  ScreenForm := TForm2.Create(nil);
  try
    // и растягиваем её на весь экран
    ScreenForm.Width := Screen.DesktopWidth;
    ScreenForm.Height := Screen.DesktopHeight;
    ScreenForm.Left := 0;
    ScreenForm.Top := 0;

    // дальше прячем основную форму
    self.Hide;

    // показываем полупрозрачную ”заливку”
    ScreenForm.ShowModal;

    // и выводим полученную область экрана
    Image1.Picture.BitMap := ScreenForm.Bild;
    ScrollBox1.HorzScrollBar.Range := Image1.Picture.Width;
    ScrollBox1.VertScrollBar.Range := Image1.Picture.Height;

    self.Show;
  finally
    ScreenForm.Free;
  end;

end

И в заключение давайте получим снимок произволного окна Windows. Аналогично предыдущим частям добавляем новую кнопка с заголовком 'Произвольное окно'И в заключение давайте получим снимок произволного окна Windows. Аналогично предыдущим частям добавляем новую кнопка с заголовком 'Произвольное окно'

Итак, что мы должны сделать. Нам нужно определить какое окно находится под курсором мыши, затем получить его положение, и ,зная положение, можно получить скриншот. Чтобы было видно, какое окно мы будем скриншотить, будем выводить вокруг него рамку. Рамку можно рисовать , а можно создать прозрачную форму с рамкой и выводить ее в нужное положение. Добавляем форму. Убираем у нее рамку: BorderStyle = bsNone, цвет делаем белым clWhite и делаем форму прозрачной: TransparentColor =True, TransparentColorValue= clWhite. На форму кладем таймер и 4 панели. Панели будут играть роль рамки. Располагаем их по краем формы с помощью свойства Align, убираем заголовок, цвет делаем красным , убираем рамку(BevelOuter = bvNone) и устанавливаем значения высоты и ширины равными 2.

У таймера устанавливаем время равным 10 мс, enable отключаем. Также аналогично предыдущему уроку, добавляем переменную Bild: TbitMap в public секцию и создаем/уничтожаем её при создании/уничтожении формы. Не забудьте добавить в секцию uses первой формы ссылку на эту форму. Таймер будет выполнять следующие действия:

procedure TForm3.Timer1Timer(Sender: TObject);
var
  hNewWnd: HWnd;
begin
  // получаем дескриптор окна под курсором
  hNewWnd := WindowFromPoint(Mouse.CursorPos);

  // данная процедура показывает рамку вокруг окна
  Frame2Window(hNewWnd);
end;

procedure TForm3.Frame2Window(Wnd: HWnd);
var
  nRect: TRect;
begin
  // получаем размеры и положение окна
  GetWindowRect(Wnd, nRect);

  // устанавливаем для формы соответствующие размеры
  Self.Left := nRect.Left;
  Self.Top := nRect.Top;
  Self.Width := nRect.Right - nRect.Left;
  Self.Height := nRect.Bottom - nRect.Top;
end;

Теперь на основной форме добавляем в OnClick событие нашей кнопки следующий код:

procedure TForm1.Button4Click(Sender: TObject);
var
  borderForm: TForm3;
begin
  // создаем нашу полупрозрачную форму
  borderForm := TForm3.Create(nil);
  try
    // прячем основную форму
    self.Hide;

    // показываем рамку
    borderForm.ShowModal;

    // после получение битмапа выводим его в Image
    Image1.Picture.BitMap := borderForm.Bild;
    ScrollBox1.HorzScrollBar.Range := Image1.Picture.Width;
    ScrollBox1.VertScrollBar.Range := Image1.Picture.Height;

    self.Show;
  finally
    borderForm.Free;
  end;

end;

Теперь можно запустить и проверить, что у нас получилось. Рамка выводится, но как теперь получить нужную область? Для этого нужно при нажатии, например, любой клавиши, скопировать в Bild область экрана с окном. Вернемся к третьей форме:

procedure TForm3.FormKeyPress(Sender: TObject; var Key: Char);
var
  hNewWnd: HWnd;
  r: TRect;
begin
  // получаем дескриптор окна под курсором
  hNewWnd := WindowFromPoint(Mouse.CursorPos);

  GetWindowRect(hNewWnd, r);
  Bild := CaptureScreenRect(r);
  Self.Close;
end;

Тут, мы с помощью процедуры CaptureScreenRect из предыдущего урока получаем область экрана, и заносим ее в Bild;

И еще один момент. Как я уже писал выше, рамку можно отрисовывать самому. Вот пример процедуры

procedure FrameWindow(Wnd: HWnd);
var
  Brush, SaveBrush: hBrush;
  lBrush: tagLOGBRUSH;
  iRect: TRect;
begin

  // Получаем позицию курсора
  GetCursorPos(Pos);
  // Получаем Handle окна под курсором
  Wnd := WindowFromPoint(Pos);

  // создаем кисть
  lBrush.lbColor := clRed;
  lBrush.lbStyle := BS_SOLID;
  Brush := CreateBrushIndirect(lBrush);
  SaveBrush := SelectObject(GetDC(0), Brush);

  GetWindowRect(Wnd, iRect);
  WndDC := GetDC(Wnd);
  // OffsetRect(Rect, -Rect.Left, -Rect.Top);

   // рисуем рамку
  FrameRect(WndDC, iRect, Brush);

  SelectObject(GetDC(0), SaveBrush);
  DeleteObject(Brush);
end;

Но в этом случае нужно перерисовывать окна, иначе рамки так и останутся.

Теперь все что нам осталось – это сохранить полученное изображение. Добавляем кнопку и компонент SavePictureDialog

Теперь настроем его. Сохранять будем в 4х форматах (bmp,jpg,tiff и png). Для поддержки jpg и png нужно в секцию uses добавить модули jpeg и pngimage. Filter =Bitmaps (*.bmp)|*.bmp|JPEG Image File (*.jpg)|*.jpg|TIFF Images (*.tif)|*.tif|Portable Network Graphics (*.png)|*.png Так как по умолчанию в Image у нас тип BMP, для сохранения в другие форматы его нужно преобразовать. Следующая процедура, в зависимости от формата изображения TgraphicClass, преобазует изображение Agraphic и сохраняет под именем AfileName.

procedure SaveGraphicAs(AGraphic: TGraphic; AGraphicClass: TGraphicClass;
  AFileName: String);
var
  vTargetGraphic: TGraphic;
  vBmp: TBitMap;
begin

  if AGraphic is AGraphicClass then
    AGraphic.SaveToFile(AFileName)
  else
  begin
    vBmp := nil;
    vTargetGraphic := AGraphicClass.Create;
    try
      vBmp := TBitMap.Create;
      vBmp.Assign(AGraphic);
      vTargetGraphic.Assign(vBmp);
      vTargetGraphic.SaveToFile(AFileName);
    finally
      vTargetGraphic.Free;
      vBmp.Free;
    end;
  end;
end;

И осталось определить событие на кнопку сохранения. В зависимости от выбранного фильтра определяется расширение и сохраняется процедурой SaveGraphicAs.

procedure TForm1.Button5Click(Sender: TObject);
var
  FileName: string;
  GrType: TGraphicClass;
begin
  if SavePictureDialog1.Execute then
  begin
    case SavePictureDialog1.FilterIndex of
      1:
        GrType := TBitMap;
      2:
        GrType := TJPEGImage;
      3:
        GrType := TWICImage;
      4:
        GrType := TPngImage;
    end;
    FileName := SavePictureDialog1.FileName;
    SaveGraphicAs(Image1.Picture.Graphic, GrType, FileName);
  end;
end;

Наэтом тема программы делающей фотки экрана закончилась.

Скачать исходник

Источник:http://www.cyberforum.ru/

Похожие материалы

• Delphi исходники - игра Морской бой
• Погружение в Indy, редкая книга delphi
• Работа с udp протоколом, передача данных. Delphi исходник
• htmlhelp - Дополнение
• ASPack - Компрессор исполняемых файлов

Последние из рубрики

• Delphi видео урок - генерация QR кода
• Сокращение интернет ссылок с помощью TinyURL
• Определении пинга (ping) в Delphi.