main.pas

可以得到鼠标的确切位置

unit main;

interface

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

type
  TMainForm = class(TForm)
    ShapingTimer: TTimer;
    tray: TTrayIcon;
    popMenu: TPopupMenu;
    mnuExit: TMenuItem;
    mnuActive: TMenuItem;
    N1: TMenuItem;
    mnuSettings: TMenuItem;
    procedure ShapingTimerTimer(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mnuActiveClick(Sender: TObject);
    procedure mnuSettingsClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    fActive: boolean;
    procedure SetActive(const Value: boolean);
    property Active : boolean read fActive write SetActive;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation
{$R *.dfm}

uses settings;

{$REGION 'Hide from TaskBar'}
procedure TMainForm.FormActivate(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
end;
{$ENDREGION}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  FormStyle := fsStayOnTop;
  WindowState := wsMaximized;

  fActive := true;
  mnuActive.Checked := true;
  ShapingTimer.Enabled := true;
end;

procedure TMainForm.mnuActiveClick(Sender: TObject);
begin
  Active := mnuActive.Checked;
end;

procedure TMainForm.mnuExitClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.mnuSettingsClick(Sender: TObject);
var
  wasActive : Boolean;
begin
  wasActive := Active;

  Active := false;
  try
    TSettingsForm.Execute;
  finally
    Active := wasActive;
  end;

end;

procedure TMainForm.SetActive(const Value: boolean);
begin
  fActive := Value;

  ShapingTimer.Enabled := Value;

  Visible := Value;
end;


procedure TMainForm.ShapingTimerTimer(Sender: TObject);
const
  HALF_LINE_DIM = 1;
var
  mp : TPoint;
  shape, shpLT, shpRT, shpLB, shpRB, shapeMouse: HRGN;
begin
  mp := Mouse.CursorPos;

  shape := CreateRectRgn(0,0,0,0);

  shpLT := CreateRectRgn(0, 0, mp.X , Height);
  shpRT := CreateRectRgn(mp.X + HALF_LINE_DIM , 0, Width, Height);

  shpLB := CreateRectRgn(0, 0, Width, mp.Y );
  shpRB := CreateRectRgn(0, mp.Y + HALF_LINE_DIM, Width, Height);

  //leave "place" for mouse point
  shapeMouse := CreateRectRgn(mp.X-1, mp.Y-1, mp.X+2, mp.Y+2);

  CombineRgn(shape,shape,shpLT,RGN_XOR);
  CombineRgn(shape,shape,shpRT,RGN_XOR);
  CombineRgn(shape,shape,shpLB,RGN_XOR);
  CombineRgn(shape,shape,shpRB,RGN_XOR);

  CombineRgn(shape,shape,shapeMouse,RGN_DIFF);

  DeleteObject(shpLT);
  DeleteObject(shpRT);
  DeleteObject(shpLB);
  DeleteObject(shpRB);
  DeleteObject(shapeMouse);

  if shape <>  0 then
  begin
    try
      SetWindowRgn(Handle, shape, true);
      Show;
    except
      Hide;
    end;
  end
  else
  begin
    Hide;
  end;
end;

end.