unit Unit_ScreenSpy

来源:互联网 发布:零食店铺推荐淘宝 编辑:程序博客网 时间:2024/05/16 10:01

unit Unit_ScreenSpy;

interface

uses
  Windows,Graphics,Classes,SysUtils, jpeg ;

const
  BMPBlockSize = 128;  //BMP块大小(宽和高都为BMPBlockSize)


type
  PDifBlock = ^TDifBlock ;
  TDifBlock = record     //不同块
    x,y:Integer;
    dn:Integer;         //不同象素点个数
  end;
  TScreenSpy = class
  private
   
    TMPStream : TMemoryStream ;    //单色图片
    TmpBmp : TBitmap;
    BlockCount :Integer;        //
    BlockList : array of PDifBlock;
    function GetPixelFormat:Byte;
    procedure SetixelFormat(PixelFormat : Byte );
    procedure MakeIndex4;
    procedure MakeIndex8;
    procedure MakeIndex24;

    procedure IniBlockList;
  protected

    ScreenBMP1,ScreenBMP2:TBitmap;
    LastBmp : Byte;
    procedure ScreenShot;       //截屏
    procedure MakeIndex;        //生成索引
  public
    jpg:boolean;
    ScreenWidth,ScreenHeight:Integer ;
    FPixelFormat : TPixelFormat ;

    procedure GetFirstBMP(FirstBmp : TStream );   //取第一幅屏幕图片并存入流中
    procedure GetNextBMP(NextBmp : TStream );     //取下一幅屏幕图片并存入流中
    constructor Create(a:integer); reintroduce;
    destructor Destroy; override;
    property PixelFormat : Byte read GetPixelFormat write SetixelFormat default 8;
 
  end;

  PRGBColor = ^TRGBColor;
  TRGBColor = record
    R,G,B:Byte;
  end;

implementation
constructor TScreenSpy.Create(a:integer);
var
  i:Integer;
begin
TMPStream :=TMemoryStream.Create;
TmpBmp := TBitmap.Create ;
ScreenBMP1:= TBitmap.Create;
ScreenBMP2:= TBitmap.Create;
LastBmp := 2;
case a of
4:   Fpixelformat:=pf4bit;
8:FPixelFormat := pf8bit ;                //默认
24: fpixelformat:=pf24bit;
end;
ScreenWidth := GetSystemMetrics(SM_CXSCREEN);   //显示器水平分辨率
ScreenHeight := GetSystemMetrics(SM_CYSCREEN);  //显示器垂直分辨率
IniBlockList;               //初始化列表
inherited Create;
end;

destructor TScreenSpy.Destroy;
var
  i:Integer;
begin
TMPStream.Free;
TmpBmp.Free;
ScreenBMP1.Destroy ;
ScreenBMP2.Destroy ;
for I := Low(BlockList) to High(BlockList) do                  //释放
  begin
    freeMem(BlockList[i]);
  end;
inherited destroy;
end;

procedure TScreenSpy.IniBlockList;
var
  x,y,i,widthcount,heightcount:Integer;
begin
if ScreenWidth mod BmpBlockSize <> 0 then
   WidthCount:=(ScreenWidth div BmpBlockSize)+1
else WidthCount:=ScreenWidth div BmpBlockSize;
if ScreenHeight mod BmpBlockSize <> 0 then
   HeightCount:=(Screenheight div BmpBlockSize)+1
else heightCount:=Screenheight div BmpBlockSize;

BlockCount :=  heightcount*widthcount;
SetLength(BlockList,BlockCount);
y := 0;
i :=0;
while y < ScreenHeight do
begin
  x := 0;
  while x < ScreenWidth  do
  begin
    GetMem(BlockList[i],SizeOf(TDifBlock));
    BlockList[i]^.X := x;
    BlockList[i]^.Y := y;
    BlockList[i]^.dn := 0;
    Inc(i);
    Inc(x,BMPBlockSize);
  end;
  Inc(y,BMPBlockSize);
end;
end; 

function TScreenSpy.GetPixelFormat:Byte;
begin
case FPixelFormat of
  pf4bit: Result := 4;
  pf8bit: Result := 8;
  pf24bit: Result := 24;
end;
end;


procedure TScreenSpy.SetixelFormat(PixelFormat : Byte );
begin
if PixelFormat < 8 then FPixelFormat := pf4bit
else if PixelFormat < 24 then FPixelFormat := pf8bit
else FPixelFormat := pf24bit ;
end;
 
procedure TScreenSpy.ScreenShot;   //截屏到ScreenBMP
var
  DC: HDC;
begin
DC:=GetDC(GetDesktopWindow);
if LastBmp = 2 then
  begin
    if ScreenBMP1.PixelFormat <> FPixelFormat  then ScreenBMP1.PixelFormat := FPixelFormat;
    if (ScreenBMP1.Width <> ScreenWidth) or (ScreenBMP1.Height <> ScreenWidth) then
      begin
           screenbmp1.Height :=screenheight;
           screenbmp1.Width :=screenwidth;

      end;

    BitBlt(ScreenBMP1.Canvas.Handle ,0,0,ScreenWidth,ScreenHeight,DC,0,0,SRCCOPY);
    LastBmp :=1;
  end
else
  begin
    if ScreenBMP2.PixelFormat <> FPixelFormat  then ScreenBMP2.PixelFormat := FPixelFormat;
    if (ScreenBMP2.Width <> ScreenWidth) or (ScreenBMP2.Height <> ScreenWidth) then
      begin
      ScreenBMP2.Width :=screenwidth;
      screenbmp2.Height:=screenheight;
      end;
    BitBlt(ScreenBMP2.Canvas.Handle ,0,0,ScreenWidth,ScreenHeight,DC,0,0,SRCCOPY);
    LastBmp := 2 ;
  end;
end;
procedure TScreenSpy.MakeIndex4;
var
  c1,c2:^Byte;
  x,y,yi,i,widthcount:Integer;
begin
y:=0;

while y < ScreenBMP1.height do
begin
         c1 := ScreenBMP1.ScanLine[y];
         c2 := ScreenBMP2.ScanLine[y];
         x := 0;
         if screenwidth mod bmpblocksize =0 then
         widthcount:=screenwidth div bmpblocksize   else
         widthcount:= (screenwidth div bmpblocksize) +1;

            if ((y+1) mod BMPBlockSize) = 0 then
            yi := (((y+1) div BMPBlockSize)-1) * widthcount
               else
             yi:=   ((y+1) div bmpblocksize) * widthcount ;

           while x < ScreenBMP1.Width  do
           begin
              if c1^ <> c2^ then      //8位色一次比较的是1个象素
                begin
                    i :=yi + x div BMPBlockSize;

                    Inc(BlockList[i]^.dn);
               end;
               Inc(x,2);
               try
               Inc(c1);
               Inc(c2);
              except
              end;
           end;
         Inc(y,2);   //隔行扫描
end;


end;

 

procedure TScreenSpy.MakeIndex8;
var
  c1,c2:^Byte;
  x,y,yi,i,widthcount:Integer;
begin
y:=0;

while y < ScreenBMP1.height do
begin
  if not comparemem(screenbmp1.ScanLine[y],screenbmp2.ScanLine[y],
  screenbmp1.Width )
  then
      begin
         c1 := ScreenBMP1.ScanLine[y];
         c2 := ScreenBMP2.ScanLine[y];
         x := 0;
         if screenwidth mod bmpblocksize =0 then
         widthcount:=screenwidth div bmpblocksize   else
         widthcount:= (screenwidth div bmpblocksize) +1;

        if ((y+1) mod BMPBlockSize) = 0 then
            yi := (((y+1) div BMPBlockSize)-1) * widthcount
               else
             yi:=   ((y+1) div bmpblocksize) * widthcount ;
           while x < ScreenBMP1.Width  do
           begin
              if c1^ <> c2^ then      //8位色一次比较的是1个象素
                begin
                    i :=yi + x div BMPBlockSize;
                    Inc(BlockList[i]^.dn);
                end;
               Inc(x,2);
               try
               Inc(c1,2);
               Inc(c2,2);
               except

               end;
           end;
        end;
        Inc(y,2);   //隔行扫描

end;

end;
procedure TScreenSpy.MakeIndex24;
var
  c1,c2:PRGBColor;
  x,y,yi,i,widthcount:Integer;
begin

y:=0;
while y < ScreenBMP1.height do
begin
  c1 := ScreenBMP1.ScanLine[y];
  c2 := ScreenBMP2.ScanLine[y];
  x := 0;
  if screenwidth mod bmpblocksize =0 then
  widthcount:=screenwidth div bmpblocksize   else
  widthcount:= (screenwidth div bmpblocksize) +1;

        if ((y+1) mod BMPBlockSize) = 0 then
            yi := (((y+1) div BMPBlockSize)-1) * widthcount
               else
             yi:=   ((y+1) div bmpblocksize) * widthcount ;
  while x < ScreenBMP1.Width  do
  begin
    if (c1^.R <> c2^.R) or (c1^.G <> c2^.G) or (c1^.B <> c2^.B) then
      begin
        i :=yi + x div BMPBlockSize;
        Inc(BlockList[i]^.dn);
      end;
    Inc(x,2);
    try
    Inc(c1,2);
    Inc(c2,2);
    except

    end;
  end;
    Inc(y,2);   //隔行扫描
end;

end;

procedure TScreenSpy.MakeIndex;
var
  i:Integer;
begin
case FPixelFormat of
  pf4bit: MakeIndex4;
  pf8bit: MakeIndex8;
  pf24bit: MakeIndex24;
end;
end;

 

procedure TScreenSpy.GetFirstBMP(FirstBmp : TStream );       //取第一幅屏幕图片并存入流中
 var tempstream:tmemorystream;
     i:integer;
     imagejpg: tjpegimage;
begin
i:=0;
FirstBmp.Size := 0;
ScreenShot;
firstbmp.Write(i,sizeof(integer)) ;
firstbmp.Write(i,sizeof(integer)) ;

case LastBmp of
  1:
  begin


  tempstream:=tmemorystream.Create ;
        if jpg then
        begin
           imagejpg:=tjpegimage.Create ;
           imagejpg.Assign(screenbmp1);
           imagejpg.CompressionQuality:=50;
           imagejpg.Compress ;
           imagejpg.SaveToStream(tempstream) ;
           imagejpg.Free ;

        end else
        begin

        screenbmp1.SaveToStream(TeMPStream);
        end;

 i:=     tempstream.size  ;
  firstbmp.Write(i,sizeof(integer))  ;
  tempstream.Position :=0;
  firstbmp.CopyFrom(tempstream,tempstream.size) ;

  tempstream.Free ;
  end;
  2:
  begin

      tempstream:=tmemorystream.Create ;
      if jpg then
        begin
           imagejpg:=tjpegimage.Create ;
           imagejpg.Assign(screenbmp2);
           imagejpg.CompressionQuality:=50;
           imagejpg.Compress ;
           imagejpg.SaveToStream(tempstream) ;
           imagejpg.Free ;

        end else
        begin

        screenbmp2.SaveToStream(TeMPStream);
        end;


  i:=     tempstream.size  ;
  firstbmp.Write(i,sizeof(integer))  ;
  tempstream.Position :=0;

  firstbmp.CopyFrom(tempstream,tempstream.size) ;
  tempstream.Free ;
  end;
 
end;

end;

procedure TScreenSpy.GetNextBMP(NextBmp : TStream );        //取下一幅屏幕图片并存入流中
var
  i,ii:Integer;
  Ssize:Integer;
  R1,R2:TRect;
  imagejpg:tjpegimage;
begin
ScreenShot;
MakeIndex;
NextBmp.Size := 0;
R1 := Rect(0,0,BMPBlockSize,BMPBlockSize);
ii:= 0;
for I := Low(BlockList) to High(BlockList) do
  begin
    if BlockList[i]^.dn > 1  then
      begin
        if not Assigned(TmpBmp) then  TmpBmp := TBitmap.Create;
        if TmpBmp.PixelFormat <> FPixelFormat  then TmpBmp.PixelFormat := FPixelFormat;
        if (TmpBmp.Width <> BMPBlockSize) or (TmpBmp.Height <> BMPBlockSize) then
          begin

          tmpbmp.Width :=bmpblocksize;
          tmpbmp.Height :=bmpblocksize;
          end;
        R2 := Rect(BlockList[i].x, BlockList[i].y, BlockList[i].x+BMPBlockSize, BlockList[i].y+BMPBlockSize);
        case LastBmp of
          1:TmpBmp.Canvas.CopyRect(R1, ScreenBMP1.Canvas, R2);
          2:TmpBmp.Canvas.CopyRect(R1, ScreenBMP2.Canvas, R2);
        end;
        TMPStream.Clear;
        if jpg then
        begin
           imagejpg:=tjpegimage.Create ;
           imagejpg.Assign(tmpbmp);
           imagejpg.CompressionQuality:=50;
           imagejpg.Compress ;
           imagejpg.SaveToStream(tmpstream) ;
           imagejpg.Free ;
          

        end else
        begin

        TmpBmp.SaveToStream(TMPStream);
        end;
        NextBmp.WriteBuffer(BlockList[i].x,SizeOf(Integer));   //图象坐标
        NextBmp.WriteBuffer(BlockList[i].y,SizeOf(Integer));   //图象坐标
        Ssize := TMPStream.Size;
        NextBmp.WriteBuffer(Ssize,SizeOf(Integer));
        NextBmp.CopyFrom(TMPStream,0);

        Inc(ii);
      end;
    BlockList[i]^.dn := 0;
  end;
 
end;

end.

原创粉丝点击