(*  GREATIS SYSTEM MOUSE                       *)
(*  Copyright (C) 2005-2008 Greatis Software   *)
(*  http://www.greatis.com/delphicb/sysmouse/  *)
(*  http://www.greatis.com/bteam.html          *)
(*                                             *)
(*  GREATIS DELPHI TOYS                        *)
(*  http://www.greatis.com/delphicb/toys/      *)

unit SMMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, SysMouse, ExtCtrls, ComCtrls;

type
  TfrmSysMouseMain = class(TForm)
    cmpSystemMouse: TSystemMouse;
    pgcMain: TPageControl;
    tshCursors: TTabSheet;
    tshClipping: TTabSheet;
    tshPosition: TTabSheet;
    lsbSystemCursors: TListBox;
    lblDefaultCursor: TLabel;
    pnlDefaultCursor: TPanel;
    pntDefaultCursor: TPaintBox;
    pnlCurrentCursor: TPanel;
    pntCurrentCursor: TPaintBox;
    lblCurrentCursor: TLabel;
    lblSystemCursors: TLabel;
    cmbSystemCursors: TComboBox;
    btnSetDTCursors: TButton;
    btnRestoreDefaultCursors: TButton;
    lblVCLCursors: TLabel;
    cmbVCLCursors: TComboBox;
    btnClipByRect: TButton;
    lblClipInfo: TLabel;
    btnClipByFormBounds: TButton;
    btnClipByFormClient: TButton;
    btnClipByControlBounds: TButton;
    btnClipByWindow: TButton;
    rgrPositionMode: TRadioGroup;
    lblPositionInfo: TLabel;
    grbButtons: TGroupBox;
    btn1: TButton;
    btn3: TButton;
    btn2: TButton;
    btn4: TButton;
    btnMoveToStartButton: TButton;
    procedure lsbSystemCursorsClick(Sender: TObject);
    procedure pntDefaultCursorPaint(Sender: TObject);
    procedure pntCurrentCursorPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cmbSystemCursorsClick(Sender: TObject);
    procedure cmbVCLCursorsClick(Sender: TObject);
    procedure btnSetDTCursorsClick(Sender: TObject);
    procedure btnRestoreDefaultCursorsClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnClipByRectClick(Sender: TObject);
    procedure btnClipByFormBoundsClick(Sender: TObject);
    procedure btnClipByFormClientClick(Sender: TObject);
    procedure btnClipByControlBoundsClick(Sender: TObject);
    procedure btnClipByWindowClick(Sender: TObject);
    procedure btnPositionClick(Sender: TObject);
    procedure btnMoveToStartButtonClick(Sender: TObject);
  private
    { Private declarations }
    FDefaultCursor: HCursor;
    FCurrentCursor: HCursor;
    procedure UpdateCursorsPage;
  public
    { Public declarations }
  end;

var
  frmSysMouseMain: TfrmSysMouseMain;

implementation

{$R *.DFM}
{$R CURSORS.RES}

procedure TfrmSysMouseMain.UpdateCursorsPage;
begin
  with cmpSystemMouse,lsbSystemCursors do
  begin
    FDefaultCursor:=DefaultCursors[TSystemCursorIndex(ItemIndex)];
    FCurrentCursor:=SystemCursors[TSystemCursorIndex(ItemIndex)];
    cmbSystemCursors.ItemIndex:=cmbSystemCursors.Items.IndexOfObject(TObject(SystemCursors[TSystemCursorIndex(ItemIndex)]));
    cmbVCLCursors.ItemIndex:=cmbVCLCursors.Items.IndexOfObject(TObject(SystemVCLCursors[TSystemCursorIndex(ItemIndex)]));
  end;
  pntDefaultCursor.Invalidate;
  pntCurrentCursor.Invalidate;
end;

procedure TfrmSysMouseMain.lsbSystemCursorsClick(Sender: TObject);
begin
  UpdateCursorsPage;
end;

procedure TfrmSysMouseMain.pntDefaultCursorPaint(Sender: TObject);
begin
  with Sender as TPaintBox,Canvas do
    DrawIconEx(Handle,(Width-32) div 2,(Height-32) div 2,
    FDefaultCursor,
    32,32,0,0,DI_DEFAULTSIZE or DI_NORMAL);
end;

procedure TfrmSysMouseMain.pntCurrentCursorPaint(Sender: TObject);
begin
  with Sender as TPaintBox,Canvas do
    DrawIconEx(Handle,(Width-32) div 2,(Height-32) div 2,
    FCurrentCursor,
    32,32,0,0,DI_DEFAULTSIZE or DI_NORMAL);
end;

procedure TfrmSysMouseMain.FormCreate(Sender: TObject);
var
  C: TSystemCursorIndex;
  i: Integer;
  S: string;
begin
  lsbSystemCursors.ItemIndex:=0;
  with cmpSystemMouse do
  begin
    for C:=Low(TSystemCursorIndex) to High(TSystemCursorIndex) do
      cmbSystemCursors.Items.AddObject(SystemCursorNames[C],TObject(DefaultCursors[C]));
    for i:=-2 downto -32 do
      if CursorToIdent(i,S) then
        cmbVCLCursors.Items.AddObject(S,TObject(i));
  end;
  UpdateCursorsPage;
end;

procedure TfrmSysMouseMain.cmbSystemCursorsClick(Sender: TObject);
begin
  with cmbSystemCursors,Items,cmpSystemMouse do
    SystemCursors[TSystemCursorIndex(lsbSystemCursors.ItemIndex)]:=HCursor(Objects[ItemIndex]);
  UpdateCursorsPage;
end;

procedure TfrmSysMouseMain.cmbVCLCursorsClick(Sender: TObject);
begin
  with cmbVCLCursors,Items,cmpSystemMouse do
    SystemVCLCursors[TSystemCursorIndex(lsbSystemCursors.ItemIndex)]:=TCursor(Objects[ItemIndex]);
  UpdateCursorsPage;
end;

procedure TfrmSysMouseMain.btnSetDTCursorsClick(Sender: TObject);
var
  C: TSystemCursorIndex;
begin
  with cmpSystemMouse do
    for C:=Low(TSystemCursorIndex) to High(TSystemCursorIndex) do
      SystemCursors[C]:=LoadCursor(HInstance,PChar(SystemCursorNames[C]));
  UpdateCursorsPage;
end;

procedure TfrmSysMouseMain.btnRestoreDefaultCursorsClick(Sender: TObject);
begin
  cmpSystemMouse.RestoreSystemCursors;
  UpdateCursorsPage;
end;

procedure TfrmSysMouseMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_ESCAPE then cmpSystemMouse.Clipping:=clipNone;
end;

procedure TfrmSysMouseMain.btnClipByRectClick(Sender: TObject);
begin
  with cmpSystemMouse do
  begin
    Clipping:=clipByRect;
    with Screen do
      ClipRect:=Rect(Width div 4,Height div 4,3*Width div 4,3*Height div 4);
  end;
end;

procedure TfrmSysMouseMain.btnClipByFormBoundsClick(Sender: TObject);
begin
  cmpSystemMouse.Clipping:=clipByFormBounds;
end;

procedure TfrmSysMouseMain.btnClipByFormClientClick(Sender: TObject);
begin
  cmpSystemMouse.Clipping:=clipByFormClient;
end;

procedure TfrmSysMouseMain.btnClipByControlBoundsClick(Sender: TObject);
begin
  with cmpSystemMouse do
  begin
    Clipping:=clipByControlBounds;
    ClipControl:=Sender as TControl;
  end;
end;

procedure TfrmSysMouseMain.btnClipByWindowClick(Sender: TObject);
begin
  with cmpSystemMouse do
  begin
    Clipping:=clipByWindowBounds;
    ClipWindow:=FindWindow('Shell_TrayWnd',nil);
  end;
end;

procedure TfrmSysMouseMain.btnPositionClick(Sender: TObject);

  function NextButton(Cur: TButton): TButton;
  var
    I: Integer;
  begin
    I:=Succ(Cur.Tag);
    if I>4 then I:=1;
    Result:=FindComponent('btn'+IntToStr(I)) as TButton;
  end;

begin
  with cmpSystemMouse do
    if rgrPositionMode.ItemIndex=0 then MoveToControl(NextButton(Sender as TButton))
    else MouseControl:=NextButton(Sender as TButton);
end;

procedure TfrmSysMouseMain.btnMoveToStartButtonClick(Sender: TObject);
var
  StartButtonHandle: HWND;
begin
  StartButtonHandle:=FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,'Button',nil);
  with cmpSystemMouse do
    if rgrPositionMode.ItemIndex=0 then MoveToWindow(StartButtonHandle)
    else MouseWindow:=StartButtonHandle;
end;

end.
