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

unit WEMain;

interface

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

type
  TfrmWinEventMain = class(TForm)
    cmpWinEvent: TWinEvent;
    pgcMain: TPageControl;
    tshSystemAlert: TTabSheet;
    lsvSystemAlert: TListView;
    tshForegroundWindow: TTabSheet;
    lsvForegroundWindow: TListView;
    tshMoveSize: TTabSheet;
    lsvMoveSize: TListView;
    tshLocationChange: TTabSheet;
    pntLocationChange: TPaintBox;
    lblLocationChangeCursor: TLabel;
    tshMore: TTabSheet;
    tshAltTabWindow: TTabSheet;
    grbAltTabPosition: TGroupBox;
    rbtAltTabDefault: TRadioButton;
    rbtAltTabLeftTop: TRadioButton;
    rbtAltTabRightTop: TRadioButton;
    rbtAltTabLeftBottom: TRadioButton;
    rbtAltTabRightBottom: TRadioButton;
    tshNameChange: TTabSheet;
    pntNameChange: TPaintBox;
    lblNameChangeHandle: TLabel;
    pnlMore: TPanel;
    memMore: TMemo;
    lblSystemAlert: TLabel;
    lblForegroundWindow: TLabel;
    lblMoveSize: TLabel;
    lblLocationChange: TLabel;
    lblNameChange: TLabel;
    lblAltTabWindow: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure cmpWinEventSystemAlert(Sender: TObject; Alert: TSystemAlert;
      MBHandle: Integer; BoxCaption, MessageText: String;
      Buttons: TMsgDlgButtons);
    procedure cmpWinEventForegroundWindow(Sender: TObject;
      WindowHandle: Integer);
    procedure cmpWinEventMoveSizeStart(Sender: TObject;
      WindowHandle: Integer);
    procedure cmpWinEventMoveSizeEnd(Sender: TObject;
      WindowHandle: Integer);
    procedure cmpWinEventObjectLocationChange(Sender: TObject;
      ObjectHandle, ObjectID, ChildID: Integer);
    procedure pntLocationChangePaint(Sender: TObject);
    procedure cmpWinEventSwitchStart(Sender: TObject;
      WindowHandle: Integer);
    procedure cmpWinEventObjectNameChange(Sender: TObject; ObjectHandle,
      ObjectID, ChildID: Integer);
    procedure pntNameChangePaint(Sender: TObject);
  private
    { Private declarations }
    CurrentCursor: HCURSOR;
    procedure AddMoveSizeInfo(Action: string; WND: HWND);
  public
    { Public declarations }
  end;

var
  frmWinEventMain: TfrmWinEventMain;

implementation

{$R *.dfm}

procedure TfrmWinEventMain.AddMoveSizeInfo(Action: string; WND: HWND);
var
  C: array[0..32767] of Char;
  R: TRect;
begin
  with lsvMoveSize.Items.Add do
  begin
    Caption:=Action;
    with Subitems do
    begin
      Add('$'+IntToHex(WND,8));
      GetClassName(WND,C,SizeOf(C));
      Add(C);
      GetWindowText(WND,C,SizeOf(C));
      Add(C);
      GetWindowRect(WND,R);
      with R do Add(Format('(%d,%d),(%d,%d)',[Left,Top,Right,Bottom]));
    end;
  end;
end;

procedure TfrmWinEventMain.FormCreate(Sender: TObject);
begin
  cmpWinEvent.Active:=True;
end;

procedure TfrmWinEventMain.cmpWinEventSystemAlert(Sender: TObject;
  Alert: TSystemAlert; MBHandle: Integer; BoxCaption, MessageText: String;
  Buttons: TMsgDlgButtons);
var
  B: TMsgDlgBtn;
  S: string;
begin
  with lsvSystemAlert.Items.Add do
  begin
    case Alert of
      saWarning: Caption:='Warning';
      saError: Caption:='Error';
      saQuestion: Caption:='Question';
      saCritical: Caption:='Critical';
      saSystem: Caption:='System';
    else Caption:='Unknown';
    end;
    with Subitems do
    begin
      Add(BoxCaption);
      Add(MessageText);
      S:='';
      for B:=Low(B) to High(B) do
        if B in Buttons then
          case B of
            mbYes: S:=S+'Yes, ';
            mbNo: S:=S+'No, ';
            mbOK: S:=S+'OK, ';
            mbCancel: S:=S+'Cancel, ';
            mbHelp: S:=S+'Help, ';
            mbAbort: S:=S+'Abort, ';
            mbRetry: S:=S+'Retry, ';
            mbIgnore: S:=S+'Ignore, ';
          end;
      SetLength(S,Length(S)-2);
      Add(S);
    end;
  end;
end;

procedure TfrmWinEventMain.cmpWinEventForegroundWindow(Sender: TObject;
  WindowHandle: Integer);
var
  C: array[0..32767] of Char;
begin
  with lsvForegroundWindow.Items.Add do
  begin
    Caption:='$'+IntToHex(WindowHandle,8);
    with Subitems do
    begin
      GetClassName(WindowHandle,C,SizeOf(C));
      Add(C);
      GetWindowText(WindowHandle,C,SizeOf(C));
      Add(C);
    end;
  end;
end;

procedure TfrmWinEventMain.cmpWinEventMoveSizeStart(Sender: TObject;
  WindowHandle: Integer);
begin
  AddMoveSizeInfo('Start',WindowHandle);
end;

procedure TfrmWinEventMain.cmpWinEventMoveSizeEnd(Sender: TObject;
  WindowHandle: Integer);
begin
  AddMoveSizeInfo('End',WindowHandle);
end;

procedure TfrmWinEventMain.cmpWinEventObjectLocationChange(Sender: TObject;
  ObjectHandle, ObjectID, ChildID: Integer);
var
  P: TPoint;
begin
  if ObjectID=Integer(OBJID_CURSOR) then
  begin
    GetCursorPos(P);
    with P do
      lblLocationChangeCursor.Caption:=Format(' '#13'Cursor position (%d,%d)'#13' ',[X,Y]);
    pntLocationChange.Invalidate;
  end;
end;

procedure TfrmWinEventMain.pntLocationChangePaint(Sender: TObject);
var
  P: TPoint;
begin
  with (Sender as TPaintBox),Canvas do
  begin
    Pen.Width:=3;
    MoveTo(Width div 2,Height div 2);
    GetCursorPos(P);
    P:=ScreenToClient(P);
    LineTo(P.X,P.Y);
  end;
end;

procedure TfrmWinEventMain.cmpWinEventSwitchStart(Sender: TObject;
  WindowHandle: Integer);
var
  R: TRect;

  procedure MoveWindowTo(XS,YS,XE,YE: Integer);
  const
    Steps = 10;
  var
    i: Integer;
  begin
    for i:=1 to Steps do
      SetWindowPos(WindowHandle,0,XS+i*(XE-XS) div Steps,YS+i*(YE-YS) div Steps,0,0,SWP_NOSIZE or SWP_NOCOPYBITS or SWP_NOZORDER);
  end;

begin
  if not rbtAltTabDefault.Checked then
    with Screen,R do
    begin
      GetWindowRect(WindowHandle,R);
      if rbtAltTabLeftTop.Checked then MoveWindowTo(Left,Top,0,0)
      else
        if rbtAltTabLeftBottom.Checked then MoveWindowTo(Left,Top,0,Height-Bottom+Top)
        else
          if rbtAltTabRightTop.Checked then MoveWindowTo(Left,Top,Width-Right+Left,0)
          else
            if rbtAltTabRightBottom.Checked then MoveWindowTo(Left,Top,Width-Right+Left,Height-Bottom+Top)
    end;
end;

{$IFDEF VER100}
{$DEFINE VERSION3}
{$ENDIF}
{$IFDEF VER110}
{$DEFINE VERSION3}
{$ENDIF}

{$IFDEF VERSION3}
type
  TCursorInfo = record
    cbSize: DWORD;
    flags: DWORD;
    hCursor: HCURSOR;
    ptScreenPos: TPoint;
  end;

function GetCursorInfo(var pci: TCursorInfo): BOOL;
  stdcall; external 'user32.dll' name 'GetCursorInfo';
{$ENDIF}

procedure TfrmWinEventMain.cmpWinEventObjectNameChange(Sender: TObject;
  ObjectHandle, ObjectID, ChildID: Integer);
var
  CI: TCursorInfo;
begin
  CI.cbSize:=SizeOf(CI);
  GetCursorInfo(CI);
  if (ObjectID=Integer(OBJID_CURSOR)) and (CurrentCursor<>CI.hCursor) then
  begin
    CurrentCursor:=CI.hCursor;
    pntNameChange.Invalidate;
    lblNameChangeHandle.Caption:='Current cursor handle $'+IntToHex(CurrentCursor,8);
  end;
end;

procedure TfrmWinEventMain.pntNameChangePaint(Sender: TObject);
begin
  with (Sender as TPaintBox),Canvas do
    DrawIconEx(Handle,0,0,CurrentCursor,Width,Height,0,Brush.Handle,DI_IMAGE);
end;






end.
