unit CursorCaptrue;

interface

uses
  BinaryList,
  Windows, Classes, SysUtils, Graphics;

type
  TCursorImage = class (TComponent)
  private
    FIconInfo : TIconInfo;
    FCursorInfo : TCursorInfo;
    procedure init;
    function get_CursorInfo: boolean;
    procedure get_IconInfo;
  private
    FPosition: TPoint;
    FHotSpot: TPoint;
    FBitmapMask: TBitmap;
    FBitmapColor: TBitmap;
    FBitmapInvert: TBitmap;
    FOffset: TPoint;
    function GetX: integer;
    function GetY: integer;
    function GetOffsetX: integer;
    function GetOffsetY: integer;
    procedure SetOffsetX(const Value: integer);
    procedure SetOffsetY(const Value: integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Capture;
    procedure Draw(ABitmap:TBitmap);
  published
    property Offset : TPoint read FOffset write FOffset;
    property OffsetX : integer read GetOffsetX write SetOffsetX;
    property OffsetY : integer read GetOffsetY write SetOffsetY;
    property X : integer read GetX;
    property Y : integer read GetY;
    property Position : TPoint read FPosition;
    property HotSpot : TPoint read FHotSpot;
    property BitmapMask : TBitmap read FBitmapMask;
    property BitmapColor : TBitmap read FBitmapColor;
    property BitmapInvert : TBitmap read FBitmapInvert;
  end;

  TCursorCaptrue = class (TComponent)
  private
    FIndex : integer;
    FCursorImages : TBinaryList;
    FOffset: TPoint;
    procedure clear_CursorImages;
    function GetOffsetX: integer;
    function GetOffsetY: integer;
    procedure SetOffsetX(const Value: integer);
    procedure SetOffsetY(const Value: integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Capture;
    procedure Draw(ABitmap:TBitmap);
  published
    property Offset : TPoint read FOffset write FOffset;
    property OffsetX : integer read GetOffsetX write SetOffsetX;
    property OffsetY : integer read GetOffsetY write SetOffsetY;
  end;

implementation

{ TCursorImage }

procedure TCursorImage.Capture;
begin
  init;

  if get_CursorInfo = false then Exit;

  get_IconInfo;
end;

constructor TCursorImage.Create(AOwner: TComponent);
begin
  inherited;

  FOffset := Point(0, 0);

  FBitmapMask := TBitmap.Create;
  FBitmapColor := TBitmap.Create;
  FBitmapInvert := TBitmap.Create;

  init;
end;

destructor TCursorImage.Destroy;
begin
  FreeAndNil(FBitmapMask);
  FreeAndNil(FBitmapColor);
  FreeAndNil(FBitmapInvert);

  inherited;
end;

procedure TCursorImage.Draw(ABitmap: TBitmap);
var
  OldCopyMode : TCopyMode;
begin
  OldCopyMode := ABitmap.Canvas.CopyMode;
  try
    ABitmap.Canvas.CopyMode := cmSrcAnd;
    ABitmap.Canvas.Draw(X, Y, FBitmapMask);

    ABitmap.Canvas.CopyMode := cmSrcPaint;
    ABitmap.Canvas.Draw(X, Y, FBitmapColor);

    if (FBitmapInvert.Width * FBitmapInvert.Width) > 0 then begin
      ABitmap.Canvas.CopyMode := cmSrcInvert;
      ABitmap.Canvas.Draw(X, Y, FBitmapInvert);
    end;
  finally
    ABitmap.Canvas.CopyMode := OldCopyMode;
  end;
end;

function TCursorImage.GetOffsetX: integer;
begin
  Result := FOffset.X;
end;

function TCursorImage.GetOffsetY: integer;
begin
  Result := FOffset.Y;
end;

function TCursorImage.GetX: integer;
begin
  Result := FPosition.X - FHotSpot.X - FOffset.X;
end;

function TCursorImage.GetY: integer;
begin
  Result := FPosition.Y - FHotSpot.Y - FOffset.Y;
end;

function TCursorImage.get_CursorInfo: boolean;
begin
  Result := false;
  FCursorInfo.cbSize:= SizeOf(FCursorInfo);
  if (GetCursorInfo(FCursorInfo) = false) or (FCursorInfo.Flags <> CURSOR_SHOWING) then Exit;

  FPosition := FCursorInfo.ptScreenPos;

  Result := true;
end;

procedure TCursorImage.get_IconInfo;
var
  Icon : TIcon;
  bmpMask, bmpColor : TBitmap;
begin
  Icon := TIcon.Create;
  bmpMask := TBitmap.Create;
  bmpColor := TBitmap.Create;
  try
    Icon.Handle := CopyIcon(FCursorInfo.hCursor);
    if GetIconInfo(Icon.Handle, FIconInfo) then begin
      FHotSpot := Point(FIconInfo.xHotspot, FIconInfo.yHotspot);
      bmpMask.Handle := FIconInfo.hbmMask;
      bmpColor.Handle := FIconInfo.hbmColor;

      FBitmapMask.Assign(bmpMask);
      FBitmapColor.Assign(bmpColor);

      if FBitmapMask.Height > FBitmapMask.Width then begin
        FBitmapInvert.Width := FBitmapMask.Width;
        FBitmapInvert.Height := FBitmapMask.Height div 2;
        FBitmapInvert.Canvas.CopyRect(
          Rect(0, 0, FBitmapInvert.Width, FBitmapInvert.Height),
          FBitmapMask.Canvas,
          Rect(0, FBitmapInvert.Height, FBitmapInvert.Width, FBitmapMask.Height)
        );
        FBitmapMask.Height := FBitmapMask.Height div 2;
      end else begin
        FBitmapInvert.Width := 0;
        FBitmapInvert.Height := 0;
      end;
    end;
  finally
    Icon.Free;
    bmpMask.Free;
    bmpColor.Free;
  end;
end;

procedure TCursorImage.init;
begin
  FPosition := Point(0, 0);
  FHotSpot := Point(0, 0);

  FBitmapMask.Width := 0;
  FBitmapColor.Width := 0;
  FBitmapInvert.Width := 0;
end;

procedure TCursorImage.SetOffsetX(const Value: integer);
begin
  FOffset.X := Value;
end;

procedure TCursorImage.SetOffsetY(const Value: integer);
begin
  FOffset.Y := Value;
end;

{ TCursorCaptrue }

function CompareCursorImage(Item1, Item2: Pointer): Integer;
var
  pItem1 : TCursorImage absolute Item1;
  pItem2 : TCursorImage absolute Item2;
begin
  if pItem1.FCursorInfo.hCursor > pItem2.FCursorInfo.hCursor then Result := 1
  else if pItem1.FCursorInfo.hCursor < pItem2.FCursorInfo.hCursor then Result := -1
  else Result := 0;
end;

procedure TCursorCaptrue.Capture;
var
  NewCursorImage, OldCursorImage : TCursorImage;
begin
  FIndex := -1;

  NewCursorImage := TCursorImage.Create(Self);
  if NewCursorImage.get_CursorInfo = false then begin
    NewCursorImage.Free;
    Exit;
  end;

  // 새로운 커서 핸들이라면, 추가하고 IconInfo도 가져온다.
  // 이미 존재하는 커서 핸들이면, 기존 것이 재사용되기 때문에 객체를 삭제한다.
  if FCursorImages.InsertByOrder(NewCursorImage, CompareCursorImage, true) then begin
    NewCursorImage.get_IconInfo;
  end else begin
    OldCursorImage := Pointer(FCursorImages.Items[FCursorImages.LastIndex]);
    OldCursorImage.FPosition := NewCursorImage.FPosition;

    NewCursorImage.Free;
  end;

  FIndex := FCursorImages.LastIndex;
end;

procedure TCursorCaptrue.clear_CursorImages;
var
  Loop : Integer;
  CursorImage : TCursorImage;
begin
  for Loop := 0 to FCursorImages.Count-1 do begin
    CursorImage := Pointer(FCursorImages.Items[Loop]);
    CursorImage.Free;
  end;

  FCursorImages.Clear;
end;

constructor TCursorCaptrue.Create(AOwner: TComponent);
begin
  inherited;

  FOffset := Point(0, 0);

  FCursorImages := TBinaryList.Create;
end;

destructor TCursorCaptrue.Destroy;
begin
  clear_CursorImages;

  FreeAndNil(FCursorImages);

  inherited;
end;

procedure TCursorCaptrue.Draw(ABitmap: TBitmap);
var
  CursorImage : TCursorImage;
begin
  if FIndex = -1 then Exit;

  CursorImage := Pointer(FCursorImages.Items[FIndex]);
  CursorImage.Offset := Self.Offset;
  CursorImage.Draw(ABitmap);
end;

function TCursorCaptrue.GetOffsetX: integer;
begin
  Result := FOffset.X;
end;

function TCursorCaptrue.GetOffsetY: integer;
begin
  Result := FOffset.Y;
end;

procedure TCursorCaptrue.SetOffsetX(const Value: integer);
begin
  FOffset.X := Value;
end;

procedure TCursorCaptrue.SetOffsetY(const Value: integer);
begin
  FOffset.Y := Value;
end;

end.
