type  
  TForm1 = class(TForm)  
    Label1: TLabel;  
    procedure FormShow(Sender: TObject);  
    procedure FormKeyDown(Sender: TObject; var Key: Word;  
      Shift: TShiftState);  
  private  
    OriginLeft, OriginTop, Counter, LeftPosition, RightPosition,  
      TopPosition, BottomPosition: Integer;  
  public  
    procedure AfterMSG(var aMsg: TMessage); message WM_EXITSIZEMOVE;  
    procedure During(var aMsg: TWMMove); message WM_MOVE;  
    procedure DefaultProc;  
    procedure Reaction;  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.DFM}  
  
const  
  Threshold = 125; // bei größerer Auslenkung erfolgt keine Reaktion  
  Limit = 8; // etwa bei der 8. Schüttelbewegung erfolgt die Reaktion  
  
procedure TForm1.DefaultProc; // Grundstellung  
begin  
  BottomPosition := 0;  
  RightPosition := 0;  
  LeftPosition := 0;  
  TopPosition := 0;  
  OriginLeft := Left;  
  OriginTop := Top;  
  Counter := 0;  
end;  
  
procedure TForm1.FormShow(Sender: TObject);  
begin  
  DefaultProc;  
end;  
  
procedure TForm1.Reaction;  
begin  
  // mach was, z.B.:  
  beep;  
  // aber keine modalen Fenster oder Dialoge öffnen,  
  // da AfterMSG sonst nicht ausgeführt wird.  
end;  
  
procedure TForm1.During(var aMsg: TWMMove);  
var  
  Horizontal, Vertical: Integer;  
  procedure CountProc(var Pos: integer);  
  begin  
    if (LeftPosition > -Threshold) and (RightPosition < Threshold)  
      and (TopPosition > -Threshold) and (BottomPosition < Threshold)  
      then inc(Counter);  
    OriginLeft := Left;  
    Pos := 0;  
  end;  
  procedure SetOriginTop(var Pos: integer);  
  begin  
    OriginTop := Top;  
    Pos := 0;  
  end;  
begin  
  inherited;  
  if (Counter < Maxint) and Visible  
    then begin  
    Vertical := Top - OriginTop;  
    if Vertical < 0 then begin  
      if Vertical < TopPosition then TopPosition := Vertical  
      else SetOriginTop(BottomPosition);  
    end else  
      if Vertical > 0 then begin  
        if Vertical > BottomPosition then BottomPosition := Vertical  
        else SetOriginTop(TopPosition);  
      end;  
    Horizontal := Left - OriginLeft;  
    if Horizontal < 0 then begin  
      if Horizontal < LeftPosition then LeftPosition := Horizontal  
      else CountProc(RightPosition);  
    end else  
      if Horizontal > 0 then begin  
        if Horizontal > RightPosition then RightPosition := Horizontal  
        else CountProc(LeftPosition);  
      end;  
    if Counter >= Limit then begin  
      Counter := Maxint;  // Maus muss wieder losgelassen werden  
      Reaction;  
    end;  
  end;  
end;  
  
procedure TForm1.AfterMSG(var aMsg: TMessage);  
begin  
  inherited;  
  DefaultProc;  
end;  
  
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;  
  Shift: TShiftState);  
  function IsKeyDown(Key: Integer): Boolean;  
  begin  
    Result := HiWord(DWord(GetKeyState(Key))) <> 0;  
  end;  
begin  
  if (key = VK_HOME) and (iskeydown(91) or iskeydown(92))  
    then Reaction;  
end;