unit CaptureScreen;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TCaptureMode = (CMWindow, CMRect);

  TCaptureForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDeactivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    DrawIng: Boolean;
    StartPoint: TPoint;
    EndPoint: TPoint;

    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    { Public declarations }
    CaptureMode: TCaptureMode;
    CaptureStream: TMemoryStream;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CaptureWindow(WindowsPos: TPoint);
    procedure CaptureRect(R: TRect);
  end;

var
  CaptureForm: TCaptureForm;

function WBCaptureScreen(Mode: TCaptureMode): TStream;

implementation

{$R *.dfm}

{ TCaptureForm }

function WBCaptureScreen(Mode: TCaptureMode): TStream;
begin
  Result := TMemoryStream.Create;
  with TCaptureForm.Create(Application) do
  try
    CaptureMode := Mode;
    Showmodal;
    CaptureStream.Seek(0, 0);
    Result.CopyFrom(CaptureStream, CaptureStream.Size);
  finally
    Free;
  end;
end;

procedure TCaptureForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TCaptureForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  SetBkMode(handle, TRANSPARENT);
  Message.Result := 1;
end;

procedure TCaptureForm.FormCreate(Sender: TObject);
begin
  CaptureMode := CMWindow;
  DrawIng := False;
  CaptureStream := TMemoryStream.Create;
end;

procedure TCaptureForm.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if CaptureMode <> CMRect then
    Exit;
  if DrawIng then
  begin
    if not drawing then exit;
    canvas.Pen.Style := psDash;
    canvas.Pen.Mode := pmNotXor;
    canvas.Brush.Style := bsClear;
    canvas.Rectangle(Rect(StartPoint, EndPoint));
    EndPoint := Point(X, Y);
    canvas.Rectangle(Rect(StartPoint, EndPoint));
  end;
end;

procedure TCaptureForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case CaptureMode of
    CMWindow:
      begin
        CaptureWindow(Point(x, y));
      end;
    CMRect:
      begin
        DrawIng := True;
        StartPoint := Point(x, y);
        EndPoint := StartPoint;
      end;
  end;
end;

procedure TCaptureForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  L, T, R, B: Integer;
begin
  if CaptureMode <> CMRect then
    Exit;
  if DrawIng then
  begin
    canvas.Pen.Style := psDash;
    canvas.Pen.Mode := pmNotXor;
    canvas.Brush.Style := bsClear;
    canvas.Rectangle(Rect(StartPoint, EndPoint));

    if StartPoint.X > X then
    begin
      L := X;
      R := StartPoint.X;
    end
    else
    begin
      R := X;
      L := StartPoint.X;
    end;

    if StartPoint.Y > Y then
    begin
      T := Y;
      B := StartPoint.Y;
    end
    else
    begin
      B := Y;
      T := StartPoint.Y;
    end;

    CaptureRect(Rect(L, T, R, B));
  end;
end;

procedure TCaptureForm.CaptureRect(R: TRect);
var
  bmp: TBitmap;
  dc: HDC;
begin
  bmp := TBitmap.Create;
  bmp.Width := R.Right - R.Left;
  bmp.Height := R.Bottom - R.Top;

  BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, Canvas.Handle,
    R.Left, R.Top, SRCCOPY);
  bmp.SaveToStream(CaptureStream);
  bmp.Free;
  drawing := false;
  Close;
end;

procedure TCaptureForm.CaptureWindow(WindowsPos: TPoint);
var
  bmpscr: TBitmap;
  bmp: TBitmap;
  dc: HDC;
  R: Trect;
  H: THandle;
begin
  bmpScr := TBitmap.Create;
  bmpScr.Width := Width;
  bmpScr.Height := Height;
  BitBlt(BmpScr.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle,
    0, 0, SRCCOPY); {}

  hide;
  H := WindowFromPoint(WindowsPos);
  while GetParent(H) > 0 do
    H := GetParent(H);
  GetWindowRect(H, R);
  if R.Left < 0 then R.Left := 0;
  if R.Top < 0 then R.Top := 0;
  if R.Right > Screen.Width then R.Right := Screen.Width;
  if R.Bottom > Screen.Height then R.Bottom := Screen.Height;

  bmp := TBitmap.Create;
  bmp.Width := r.Right - r.Left;
  bmp.Height := r.Bottom - r.Top;

  BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, BmpScr.Canvas.Handle,
    r.Left, r.Top, SRCCOPY); {}
  Bmp.SaveToStream(CaptureStream);
  bmp.Free;
  bmpscr.Free;
  DrawIng := False;
  Close;
end;

procedure TCaptureForm.FormDeactivate(Sender: TObject);
begin
  DrawIng := False;
  Close;
end;

procedure TCaptureForm.FormDestroy(Sender: TObject);
begin
  CaptureStream.Free;
end;

procedure TCaptureForm.FormShow(Sender: TObject);
begin
  SetWindowPos(handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

end.
