截屏

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Image1: TImage;
    Image2: TImage;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure SnapScreen(a,b,c,d:Integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.SnapScreen(a,b,c,d:Integer);    //任意区域截图,参数为截图坐标
var
   bmpscreen:Tbitmap;
    jpegscreen:Tjpegimage;
    FullscreenCanvas:TCanvas;
    dc:HDC;
    sourceRect, destRect: TRect;
begin
    try
       dc:=getdc(0);
       fullscreencanvas:=Tcanvas.Create;
       fullscreencanvas.Handle:=dc;
       bmpscreen:=Tbitmap.create;
       bmpscreen.Width :=c-a;
       bmpscreen.Height :=d-b;
       sourcerect:=Rect(0,0,c-a ,d-b );
       destrect:= Rect(a,b,c,d);
       bmpscreen.Canvas.CopyRect(sourcerect,fullscreenCanvas,destrect);
       //jpegscreen:=Tjpegimage.Create ;
       //jpegscreen.Assign (bmpscreen);
       //jpegscreen.CompressionQuality:=100;
       //jpegscreen.SaveToFile(ExtractFilePath(ParamStr(0))+'tmp.jpg');
       bmpscreen.SaveToFile(ExtractFilePath(ParamStr(0))+'tmp.bmp');
       FullscreenCanvas.Free;
       bmpscreen.Free;
       //jpegscreen.Free ;
       ReleaseDC(0, DC);
   except
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SnapScreen(self.Left,self.Top,Self.Left+self.Width,Self.Top+self.Height); //截取当前活动窗口



end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    SnapScreen(0,0,Screen.Width,Screen.Height);   //截取全屏
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
    SnapScreen(159,117,400,135);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
    SnapScreen(159,133,400,151);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
    snapScreen(159,149,400,167);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
    SnapScreen(159,165,400,183);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
self.Image1.Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'bmp\001.bmp');
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
self.Image2.Picture.LoadFromFile(ExtractFilePath(ParamStr(0))+'tmp.bmp');
end;

procedure TForm1.Button9Click(Sender: TObject);
var
   i,j:integer;
   Tmp:Tcolor;
   Rcolor:array[1..3] of byte;
   S:string;
begin
   for i := 0 to 240 do
     begin
        for j := 0 to 17 do
          begin
             self.Image1.Picture.Bitmap.Canvas;
             Tmp := self.Image1.Picture.Bitmap.Canvas.Pixels[i,j];
             Rcolor[1] := GetRValue(tmp);
             Rcolor[2] := GetGValue(tmp);
             Rcolor[3] := GetBValue(tmp);
             //SetString(s,PChar(Rcolor),Length(Rcolor));
             SetString(s, PChar(@Rcolor[1]), 3);
             //label1.Caption :=string(a);// + b + c;// inttostr(a) + inttostr(b) inttostr(c);
             label1.Caption := s;
          end;
     end;
end;

end.

转载于:https://www.cnblogs.com/xiaoxingchi/archive/2010/01/17/1650043.html

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值