qcapture.pas

大家来看看很好的源码啊里面包含很多知识点啊学习学习

//###############################################################
//######作者:杨畅(sheepchang)##################################
//######Email:[e-mail] QQ:1103754####################
//######我为人人，人人为我。希望大家一起交流，共同进步!##########
//###############################################################
unit qcapture;

interface

uses
  Windows,Classes,Graphics,Forms,Clipbrd,JPEG, Controls,
  ExtCtrls;

type
  TForm5 = class(TForm)
    Timer1: TTimer;
    Image1: TImage;
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;
  //定义区域截图时用到的变量
  foldx,x1,y1,x2,y2,oldx,oldy,foldy : Integer;
  Flag,Trace : Boolean;

implementation

uses capture, setkey;

{$R *.dfm}
//BMP格式图片转JPG格式
procedure BMPToJPG(BmpFileName:string);
var
  Jpeg : TJPEGImage;
  Bmp : TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.LoadFromFile(BmpFileName);
    Jpeg := TJPEGImage.Create;
    try
      Jpeg.Assign(Bmp);
      Jpeg.Compress;
      //保存图片
      Jpeg.SaveToFile(Form4.SavePictureDialog1.FileName);
    finally
      Jpeg.Free;
    end;
  finally
     Bmp.Free;
  end;
end;

procedure TForm5.Timer1Timer(Sender: TObject);
var
  Fullscreen:Tbitmap;
  FullscreenCanvas:TCanvas;
  DC:HDC;
begin
  Timer1.Enabled := False;//关闭计时器Timer1
  Fullscreen := TBitmap.Create;//创建一个BITMAP来存放图象
  Fullscreen.Width := Screen.width;
  Fullscreen.Height := Screen.Height;
  DC:=GetDC(0);//取得屏幕的DC，参数0指的是屏幕
  FullscreenCanvas := TCanvas.Create;//创建一个CANVAS对象
  FullscreenCanvas.Handle := DC;
  Fullscreen.Canvas.CopyRect(Rect(0,0,Screen.Width,Screen.Height),FullscreenCanvas,
  Rect(0,0,Screen.Width,Screen.Height));//把整个屏幕复制到BITMAP中
  FullscreenCanvas.Free;//释放CANVAS对象
  ReleaseDC(0,DC);//释放DC
  Image1.picture.Bitmap:=fullscreen;//拷贝下的图象赋给Image1
  Image1.Width := Fullscreen.Width;
  Image1.Height:=Fullscreen.Height;
  Fullscreen.free;//释放bitmap
  Form5.WindowState := wsMaximized;//窗口最大化
  Form5.show;//显示窗口
  foldx:=-1;
  foldy:=-1;
  Image1.Canvas.Pen.mode := Pmnot; //笔的模式为取反
  Image1.Canvas.pen.color := clblack; //笔为黑色
  Image1.Canvas.brush.Style := bsclear;//空白刷子
  Flag := True;
end;

procedure TForm5.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if trace=true then//是否在追踪鼠标？
  begin//是，擦除旧的矩形并画上新的矩形
    with Image1.canvas do
    begin
        rectangle(x1,y1,oldx,oldy);
        Rectangle(x1,y1,x,y);
        oldx:=x;
        oldy:=y;
    end;
  end
  else if flag=true then//在鼠标所在的位置上画十字
  begin
    with Image1.canvas do
        begin
          MoveTo(foldx,0);//擦除旧的十字
          LineTo(foldx,Screen.Height);
          MoveTo(0,foldy);
          LineTo(Screen.Width,foldy);
          MoveTo(x,0);//画上新的十字
          LineTo(x,Screen.Height);
          MoveTo(0,y);
          LineTo(Screen.Width,y);
          foldx:=x;
          foldy:=y;
        end;
  end;
end;

procedure TForm5.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Width,Height : Integer;
  NewBitmap : TBitmap;
begin
  if (Trace = False) then//TRACE表示是否在追踪鼠标
  begin//首次点击鼠标左键，开始追踪鼠标。
    Flag := False;
    with Image1.canvas do
    begin
        MoveTo(foldx,0);
        LineTo(foldx,screen.height);
        MoveTo(0,foldy);
        LineTo(screen.width,foldy);
    end;
    x1 := x;
    y1 := y;
    oldx := x;
    oldy := y;
    Trace := True;
    Image1.Canvas.Pen.mode:=pmnot;//笔的模式为取反
    //这样再在原处画一遍矩形，相当于擦除矩形。
    Image1.canvas.pen.color := clblack;//笔为黑色
    Image1.canvas.brush.Style := bsclear;//空白刷子
    end
  else
  begin//第二次点击，表示已经得到矩形了，把它拷贝到FORM5中的IMAGE部件上。
    x2 := x;
    y2 := y;
    Trace := False;
    Image1.Canvas.Rectangle(x1,y1,oldx,oldy);
    Width := abs(x2-x1);
    Height := abs(y2-y1);
    Form4.Image1.Width := Width;
    Form4.Image1.Height := Height;
    NewBitmap:=Tbitmap.create;
    NewBitmap.Width := Width;
    NewBitmap.Height := Height;
    NewBitmap.Canvas.CopyRect
    (Rect(0,0,width,Height),Form5.Image1.Canvas,
    Rect(x1,y1,x2,y2));//拷贝
    Form4.Image1.Picture.Bitmap := NewBitmap;//放到Form4的Image1上
    Clipboard.Assign(Form4.Image1.Picture);//把Image1中的图象复制到剪贴板
    NewBitmap.Free; //释放Bitmap
if  Form2.dxCheckbox2.checked then
  begin //若程序的提示参数为真那么出现提示窗体
  if Application.MessageBox('所选区域已截取并复制到了剪贴板！可在其它程序中粘贴！现在是否保存？','快速截图提示',MB_YESNO+MB_ICONINFORMATION)=IDYES then
    begin
      if Form4.SavePictureDialog1.Execute then
        begin
          //若保存的图片为文件类型列表中的第一个即*.jpg
          if Form4.SavePictureDialog1.FilterIndex=1 then
            begin //则调用BMP转JPG过程转化
            Form4.Image1.Picture.SaveToFile(Form4.SavePictureDialog1.FileName);
            BMPToJPG(Form4.SavePictureDialog1.FileName);
            end
          else//若保存的图片不是文件类型列表中的第一个即*.bmp
            begin//则默认扩展名为*.bmp
            Form4.SavePictureDialog1.DefaultExt:='*.bmp';
            Form4.SavePictureDialog1.FilterIndex:=2;
            Form4.Image1.Picture.SaveToFile(Form4.SavePictureDialog1.FileName);
            end
        end
      else
     Close;
     form5.Close;
  end
else
Form5.Close;
end;
Form5.Close;
end;
end;
end.