bmpset.pas

经过研究本人初略的将原代码进行了模拟

unit BmpSet;

interface
uses
  windows, messages, Sysutils, Variants, Classes, Graphics, Controls, Forms;

procedure GetScreen(var Bmp: TBitmap; GetCur: Boolean = false); //获取屏幕
function CpBMP(var B1, B2: TBitmap): TRect;
procedure CopyBmpRect(var BBak, BStart, BSend: TBitmap; var VRect: TRect;
  PixBit: TPixelFormat = pf8bit);
implementation

procedure GetScreen(var Bmp: TBitmap; GetCur: Boolean = false);
var
  Dc                : HDC;
  MyCanvas          : TCanvas;
  MyRect            : TRect;
  DrawPos           : TPoint;
  MyCursor          : TIcon;
  mp                : TPoint;
  Threadld          : dword;
  pIconInfo         : TIconInfo;
  Cursorx, Cursory  : Integer;
  hld               : hwnd;
begin
  Bmp := TBitmap.Create;
  Dc := GetWindowDC(0);
  MyCanvas := TCanvas.Create;
  try
    MyCanvas.handle := Dc;
    MyRect := Rect(0, 0, Screen.Width, Screen.Height);
    Bmp.Width := MyRect.Right;
    Bmp.Height := MyRect.Bottom;
    Bmp.Canvas.CopyRect(MyRect, MyCanvas, MyRect);
  finally
    MyCanvas.handle := 0;
    MyCanvas.Free;
    ReleaseDC(0, Dc);
  end;

  if GetCur then
  begin
    GetCursorPos(DrawPos);
    MyCursor := TIcon.Create;
    GetCursorPos(mp);
    hld := WindowFromPoint(mp);
    Threadld := GetWindowThreadProcessId(hld, nil);
    AttachThreadInput(GetCurrentThreadId, Threadld, true);
    MyCursor.handle := GetCursor();
    AttachThreadInput(GetCurrentThreadId, Threadld, false);
    GetIconInfo(MyCursor.handle, pIconInfo);
    Cursorx := DrawPos.x - Round(pIconInfo.xHotspot);
    Cursory := DrawPos.y - Round(pIconInfo.yHotspot);
    Bmp.Canvas.Draw(Cursorx, Cursory, MyCursor);
    DeleteObject(pIconInfo.hbmColor);
    DeleteObject(pIconInfo.hbmMask);
    MyCursor.ReleaseHandle;
    MyCursor.Free;
  end;
end;

function CpBMP(var B1, B2: TBitmap): TRect;
var
  i, j, k           : Integer;
  row1, row2        : pByteArray;
  BitsPerPixel      : Integer;
  firstt            : Boolean;
  x1, y1, x2, y2    : Integer;
begin

  case B1.PixelFormat of
    pf8bit: BitsPerPixel := 1;
    pf16bit: BitsPerPixel := 2;
    pf32bit: BitsPerPixel := 4;
  else
    BitsPerPixel := 4;
  end;

  firstt := true;

  x1 := 0;
  x2 := 0;
  y1 := 0;
  y2 := 0;

  for i := 0 to B1.Height - 1 do
  begin
    row1 := pByteArray(B1.Scanline[i]);
    row2 := pByteArray(B2.Scanline[i]);
    for j := 0 to B1.Width - 1 do
    begin
      for k := 0 to BitsPerPixel - 1 do
      begin
        if row1[j * BitsPerPixel + k] <> row2[j * BitsPerPixel + k] then
        begin
          if firstt then
          begin
            y1 := i;
            x1 := j;
            y2 := i;
            x2 := j;
            firstt := false;
          end
          else
          begin
            if j < x1 then
              x1 := j;
            if i > y2 then
              y2 := i;
            if j > x2 then
              x2 := j;
          end;
          Break;
        end;
      end;
    end;

  end;
  Result := Rect(x1, y1, x2, y2);
end;

procedure CopyBmpRect(var BBak, BStart, BSend: TBitmap; var VRect: TRect; PixBit: TPixelFormat = pf8bit);
var
  TmpRect           : TRect;
begin

  BBak.PixelFormat := PixBit;
  BStart.PixelFormat := PixBit;
  VRect := CpBmp(BBak, BStart);
  TmpRect.Left := 0;
  TmpRect.Top := 0;
  TmpRect.Right := VRect.Right - VRect.Left;
  TmpRect.Bottom := VRect.Bottom - VRect.Top;

  BSend.Width := TmpRect.Right;
  BSend.Height := TmpRect.Bottom;
  BSend.Canvas.CopyRect(TmpRect, BStart.Canvas, VRect);

  BBak.Assign(BStart);
end;

end.