码迷,mamicode.com
首页 > Windows程序 > 详细

delphi 截取屏幕

时间:2019-02-28 16:42:14      阅读:294      评论:0      收藏:0      [点我收藏+]

标签:ati   dct   mfile   width   sed   tmp   delphi   begin   sign   

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.jpeg, Vcl.StdCtrls, Vcl.ExtCtrls;

type // define an ENUM to describe the possible screenshot types.
  TScreenShotType = (sstActiveWindow, sstActiveClientArea, sstPrimaryMonitor, sstDesktop);

  TForm1 = class(TForm)
    Button1: TButton;
    ComboBox1: TComboBox;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    procedure GetScreenShot(shotType: TScreenShotType; var img: TJpegImage);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.GetScreenShot(shotType: TScreenShotType; var img: TJpegImage);
var
  w, h: integer;
  DC: HDC;
  hWin: Cardinal;
  r: TRect;
  bmp: TBitmap;
begin
  hWin := 0;
  case shotType of
    sstActiveWindow:
      begin
        // only the active window
        hWin := GetForegroundWindow;
        DC := GetWindowDC(hWin);
        GetWindowRect(hWin, r);
        w := r.Right - r.Left;
        h := r.Bottom - r.Top;
      end; // sstActiveWindow
    sstActiveClientArea:
      begin
        // only the active client area (active window minus title bars)
        hWin := GetForegroundWindow;
        DC := GetDC(hWin);
        GetWindowRect(hWin, r);
        w := r.Right - r.Left;
        h := r.Bottom - r.Top;
      end; // sstActiveClientArea
    sstPrimaryMonitor:
      begin
        // only the primary monitor.  If 1 monitor, same as sstDesktop.
        hWin := GetDesktopWindow;
        DC := GetDC(hWin);
        w := GetDeviceCaps(DC, HORZRES);
        h := GetDeviceCaps(DC, VERTRES);
      end; // sstPrimaryMonitor
    sstDesktop:
      begin
        // ENTIRE desktop (all monitors)
        DC := GetDC(GetDesktopWindow);
        w := Screen.DesktopWidth;
        h := Screen.DesktopHeight;
      end; // sstDesktop
  else
    begin
      Exit;
    end; // case else
  end; // case

  // convert to jpg
  bmp := TBitmap.Create;
  try
    bmp.Width := w;
    bmp.Height := h;
    BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, DC, 0, 0, SRCCOPY);
    img.Assign(bmp);
  finally
    ReleaseDC(hWin, DC);
    FreeAndNil(bmp);
  end; // try-finally
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  image: TJPEGImage;
begin
  image := TJpegImage.Create;
  GetScreenShot(TScreenShotType(ComboBox1.ItemIndex), image);
  image.SaveToFile(tmp.jpg);
  Image1.Picture.LoadFromFile(tmp.jpg);
end;

end.
ComboBox1 下拉值:ActiveWindow ActiveClientArea PrimaryMonitor Desktop

delphi 截取屏幕

标签:ati   dct   mfile   width   sed   tmp   delphi   begin   sign   

原文地址:https://www.cnblogs.com/yangxuming/p/10451160.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!