unit2.pas

delphi 编写的屏幕抓图软件 可以进行处理保存

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Image1: TImage;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    Drag: Boolean;
    StartPT, OldPT: TPoint;
    SelectRect: TRect;
  end;

var
  Form2: TForm2;

implementation
uses Unit1;
{$R *.dfm}

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Form1.WindowState := wsNormal;
  Form1.Show;
end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  CurrentPT: TPoint;
begin
  if Button = mbRight then
  begin
    Form2.Close;
    Exit;
  end;
  if Button = mbLeft then
  begin
    if not Drag then
    begin
      GetCursorPos(StartPT);
      OldPT := StartPT;
      Image1.Canvas.Pen.mode := pmnot;
      Image1.canvas.brush.Style := bsclear;
      Drag := True;
    end
    else
    begin
      Image1.Picture.Bitmap.Assign(Form1.ScreenPic);
      GetCursorPos(CurrentPT);
      if CurrentPT.X > StartPT.X then
      begin
        if CurrentPT.Y > StartPT.Y then
          SelectRect := Rect(StartPT, CurrentPT)
        else SelectRect := Rect(StartPT.X, CurrentPt.Y, CurrentPT.X, StartPT.Y);
      end
      else
      begin
        if CurrentPT.Y < StartPT.Y then
          SelectRect := Rect(CurrentPT, StartPT)
        else
          SelectRect := Rect(CurrentPT.X, StartPT.Y, StartPT.X, CurrentPT.Y);
      end;
      Form1.Image1.Picture.Bitmap := nil;
      Form1.Image1.Width := SelectRect.Right - SelectRect.Left;
      Form1.Image1.Height := SelectRect.Bottom - SelectRect.Top;
      Form1.Image1.Canvas.CopyRect(Rect(0, 0, Form1.Image1.Width, Form1.Image1.Height), Form1.ScreenPic.Canvas, SelectRect);
      Drag := False;
      Form2.Close;
    end;
  end;
end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  CurrentPT: TPoint;
begin
  if Drag then
  begin
   // Form2.Image1.Picture.Bitmap.Assign(Form1.ScreenPic);
    //绘制选取框
    GetCursorPos(CurrentPT);
    with Form2.Image1.Picture.Bitmap.Canvas do
    begin
     //擦除旧的选择框
      MoveTo(StartPT.X, StartPt.Y);
      LineTo(StartPT.X, OldPT.Y);
      MoveTo(StartPT.X, StartPt.Y);
      LineTo(OldPT.X, StartPT.Y);
      MoveTo(OldPT.X, OldPT.Y);
      LineTo(OldPT.X, StartPT.Y);
      MoveTo(OldPT.X, OldPT.Y);
      LineTo(StartPT.X, OldPT.Y);
      //更新位置
      OldPT := CurrentPT;
      //画新的选择框
      MoveTo(StartPT.X, StartPt.Y);
      LineTo(StartPT.X, CurrentPT.Y);
      MoveTo(StartPT.X, StartPt.Y);
      LineTo(CurrentPT.X, StartPT.Y);
      MoveTo(CurrentPT.X, CurrentPT.Y);
      LineTo(CurrentPT.X, StartPT.Y);
      MoveTo(CurrentPT.X, CurrentPT.Y);
      LineTo(StartPT.X, CurrentPT.Y);
    end;
  end;
end;

end.