Schüttel-Funktion / Fenster hin und her schütteln /Windows 7

[Bambuti2000]

Hi allerseits.
Ich finde die Idee recht gut hab mich mal an was ran gewagt. Ist vielleicht noch nicht ganz rund, gerade mit den Schüttel-Variablen, aber sieht meiner Meinung schon mal so aus als ob es in die richtige Richtung gehen könnte.
Ich hab mal einen Auszug meines Quellcodes und im Anhang die Exe:

Delphi-Quellcode:

unit MainForm;

interface

uses
  Windows, Messages, Classes, Graphics, Forms;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    r, _r, Ticker, OldXPos, OldYPos: Integer;
    sTime: Int64;
    procedure DrawCanvas(Text: String);
    procedure CheckIfShaking(xPos, yPos: Integer; StartTime: Int64);
    procedure WMWindowPosChanging(var Message: TWMWINDOWPOSCHANGING);message WM_WINDOWPOSCHANGING;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{*** Das Auge isst mit ***}
procedure TForm1.DrawCanvas(Text: String);
var tWidth, tHeight: Integer;
begin
  with Canvas do
  begin
    tWidth:=TextWidth(Text);
    tHeight:=TextHeight(Text);
    Font.Style:=[fsBold];
    Brush.Color:=clWhite;
    TextOut((Width div 2)-(tWidth div 2), (Height div 3), Text);
    Brush.Color:=clRed;
    FrameRect(Rect((Width div 2)-(tWidth div 2)-2, (Height div 3)-2, (Width div 2)+(tWidth div 2)+2, (Height div 2)-5));
    FrameRect(Rect((Width div 2)-(tWidth div 2)-1, (Height div 3)-1, (Width div 2)+(tWidth div 2)+1, (Height div 2)-6));
  end;
end;

procedure TForm1.CheckIfShaking(xPos, yPos: Integer; StartTime: Int64);
begin
  if (sTime < (StartTime + 2000)) then
  begin
    if xPos < OldXPos then r := 1 else r := 0;
    if yPos < OldYPos then Inc(r, 2);
    if r <> _r then Inc(Ticker) else Ticker := 0;
  end
  else
  begin
    sTime := StartTime;
    Ticker:=0;
  end;
  if Ticker > 2 then DrawCanvas(' !!! SHAKIN'' !!! ');
  _r := r;
  OldXPos:=xPos;
  OldYPos:=yPos;
end;

Procedure TForm1.WMWindowPosChanging(Var Message: TWMWINDOWPOSCHANGING);
Var
  MoniRect, DistRect: TRect;
Begin
  { Abmessungen des Monitors, auf dem sich das Fenster befindet }
  MoniRect := Screen.Monitors[Monitor.MonitorNum].WorkareaRect; 

  With Message Do
    With DistRect Do
    Begin
      CheckIfShaking(WindowPos.X, WindowPos.Y, GetTickCount);

  {*** Ab hier wird der SnapEffect bearbeitet (ist für den Schütteleffekt nicht notwendig, nur ein AddOn)***}
      { Abweichungen vom Monitorrand }
      Top    := WindowPos.Y - MoniRect.Top; 
      Bottom := WindowPos.Y + Height - MoniRect.Bottom; 
      Left   := WindowPos.X - MoniRect.Left; 
      Right  := WindowPos.X + Width - MoniRect.Right;

      { Obere Fensterkante } 
      If (Top <=  SnapBuffer) And 
         (Top >= -SnapBuffer) Then
        WindowPos.Y := MoniRect.Top
      { Untere Fensterkante } 
      Else If (Bottom <=  SnapBuffer) And 
              (Bottom >= -SnapBuffer) Then 
        WindowPos.Y := MoniRect.Bottom - Height;
      { Linke Fensterkante } 
      If (Left <=  SnapBuffer) And 
         (Left >= -SnapBuffer) Then 
        WindowPos.X := MoniRect.Left 
      { Rechte Fensterkante } 
      Else If (Right <=  SnapBuffer) And 
              (Right >= -SnapBuffer) Then 
        WindowPos.X := MoniRect.Right - Width;
    End; 
End;

procedure TForm1.FormCreate(Sender: TObject);
begin
  sTime:=GetTickCount;
  OldXPos:=Left;
  OldYPos:=Top;
end;

end.

Ich hoffe das regt ein wenig an.

Gruß
Bambuti2000