简单窗体振动

{*******************************************************}
{                                                       }
{       Delphi Thread Sample                            }                            
{       Creation Date 2012.08.25                        }
{       Created By: ming                                }
{                                                       }
{*******************************************************}
unit unitWorkThread;

interface

uses
  Classes,Windows, Messages, SysUtils, Graphics, StdCtrls, Controls, DateUtils;

const
  WM_UPDATE  = WM_USER + $100;
  WM_LEFT    = WM_USER + $101;
  WM_RIGHT   = WM_USER + $102;
  WM_TOP     = WM_USER + $103;
  WM_BOTTOM  = WM_USER + $104;
  WM_DEFAULT = WM_USER + $105;

type
  TWorkThread = class(TThread)
  private
    { Private declarations }
    FEvent,FMainFormHWND: HWND;
    FDoTimes,FTickTimes: Integer;
    FMsg: string;
    FMemo:  TMemo;
    FInterval: Cardinal;
    procedure doSyncProc1;
    procedure doSomething;
    procedure syncOutputMsg;
    procedure doOutputMsg(const msg: string);
    procedure _sleep(millisecond:Cardinal);
  protected
    procedure Execute; override;
  public
    constructor Create(Suspend: boolean); overload;
    constructor Create(Suspend: boolean; mmoOutput: TMemo); overload;
    destructor Destroy; override;
  public
    procedure exitThread;
  public
    property Interval:Cardinal read FInterval write FInterval;
    property MainFormHWND: HWND read FMainFormHWND write FMainFormHWND;
    property DoTimes:Integer read FDoTimes write FDoTimes;
  end;

var
  WorkThread: TWorkThread;

implementation

{ TWorkThread }

constructor TWorkThread.Create(Suspend: boolean);
begin
  inherited Create(Suspend);
  FEvent := CreateEvent(nil,False,False,nil);
  FreeOnTerminate := True;
  FInterval := 100;
end;

constructor TWorkThread.Create(Suspend: boolean; mmoOutput: TMemo);
begin
  inherited Create(Suspend);
  FEvent := CreateEvent(nil,False,False,nil);
  FreeOnTerminate := True;
  FInterval := 100;  
  FMemo := mmoOutput;
  doOutputMsg('Thread Create');
end;

destructor TWorkThread.Destroy;
begin
  CloseHandle(FEvent);
  doOutputMsg('Thread Destroy');
  inherited;
end;

procedure TWorkThread.doSyncProc1;
begin

end;

procedure TWorkThread.doOutputMsg(const msg: string);
begin
  FMsg := msg;
  Synchronize(syncOutputMsg);
end;

procedure TWorkThread.syncOutputMsg;
begin
  if Assigned(FMemo) then
    FMemo.Lines.Add(FMsg);
end;

procedure TWorkThread.doSomething;
const
  K_SLEEP = 20;
begin
  SendMessage(FMainFormHWND,WM_LEFT,0,0); _Sleep(K_SLEEP);
  SendMessage(FMainFormHWND,WM_DEFAULT,0,0);

  SendMessage(FMainFormHWND,WM_RIGHT,0,0); _Sleep(K_SLEEP);
  SendMessage(FMainFormHWND,WM_DEFAULT,0,0);

  SendMessage(FMainFormHWND,WM_TOP,0,0);   _Sleep(K_SLEEP);
  SendMessage(FMainFormHWND,WM_DEFAULT,0,0);

  SendMessage(FMainFormHWND,WM_BOTTOM,0,0); _Sleep(K_SLEEP);
  SendMessage(FMainFormHWND,WM_DEFAULT,0,0);

  Inc(FTickTimes);
  if FTickTimes >= FDoTimes then
  begin
    FTickTimes := 0;
    Self.Suspend;
  end;
end;

procedure TWorkThread.Execute;
begin
  inherited;
  while not Terminated do
  begin
    if WaitForSingleObject(FEvent,FInterval)=WAIT_OBJECT_0 then
    begin
      Break;
    end;
    doSomething;
  end;
end;

procedure TWorkThread.exitThread;
begin
  if FEvent>0 then
  begin
    SetEvent(FEvent);
    if Suspended then Resume;
  end;
end;

procedure TWorkThread._sleep(millisecond: Cardinal);
begin
  WaitForSingleObject(Self.Handle,millisecond);
end;

{=============================================================}
{ Use TWorkThread
procedure TForm1.btnCreateThreadClick(Sender: TObject);
begin
  WorkThread := TWorkThread.Create(False,mmoOutput);
  //WorkThread.Interval := 1000;
  if WorkThread.Suspended then
    WorkThread.Resume;
end;

procedure TForm1.btnDestroyThreadClick(Sender: TObject);
begin
  if Assigned(WorkThread) then  
    WorkThread.exitThread;
end;
}

end.

unit unitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, unitWorkThread{Thread};

type
  TfrmMain = class(TForm)
    btnStart: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
  private
    { Private declarations }
    FDestWindow: HWND;
    FOriginalRect: TRect;
    procedure DefaultPostion;
    procedure GoLeft;
    procedure GoRight;
    procedure GoTop;
    procedure GoBottom;
  protected
    procedure OnLeft(var aMag: TMessage); message WM_LEFT;
    procedure OnRight(var aMag: TMessage); message WM_RIGHT;
    procedure OnTop(var aMag: TMessage); message WM_TOP;
    procedure OnBottom(var aMag: TMessage); message WM_BOTTOM;
    procedure OnDefault(var aMag: TMessage); message WM_DEFAULT;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
const
  K_OFFSET = 2;

implementation

{$R *.dfm}

{ TfrmMain }

procedure TfrmMain.defaultPostion;
begin
  SetWindowPos(FDestWindow,HWND_TOP,FOriginalRect.Left,FOriginalRect.Top,0,0,SWP_NOSIZE);
end;

procedure TfrmMain.OnDefault(var aMag: TMessage);
begin
  defaultPostion;
end;

procedure TfrmMain.GoBottom;
begin
  SetWindowPos(FDestWindow,HWND_TOP,FOriginalRect.Left,FOriginalRect.Top - K_OFFSET,0,0,SWP_NOSIZE);
end;

procedure TfrmMain.GoLeft;
begin
  SetWindowPos(FDestWindow,HWND_TOP,FOriginalRect.Left + K_OFFSET,FOriginalRect.Top,0,0,SWP_NOSIZE);
end;

procedure TfrmMain.GoRight;
begin
  SetWindowPos(FDestWindow,HWND_TOP,FOriginalRect.Left - K_OFFSET,FOriginalRect.Top,0,0,SWP_NOSIZE);
end;

procedure TfrmMain.GoTop;
begin
  SetWindowPos(FDestWindow,HWND_TOP,FOriginalRect.Left,FOriginalRect.Top + K_OFFSET,0,0,SWP_NOSIZE);
end;

procedure TfrmMain.OnBottom(var aMag: TMessage);
begin
  GoBottom;
end;

procedure TfrmMain.OnLeft(var aMag: TMessage);
begin
  GoLeft;
end;

procedure TfrmMain.OnRight(var aMag: TMessage);
begin
  GoRight;
end;

procedure TfrmMain.OnTop(var aMag: TMessage);
begin
  GoTop;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  Self.DoubleBuffered := True;
  FDestWindow := Handle;
  GetWindowRect(FDestWindow,FOriginalRect);
  WorkThread := TWorkThread.Create(TRUE);
  WorkThread.Interval := 10;
  WorkThread.MainFormHWND := Self.Handle;
  WorkThread.DoTimes := 10;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  if Assigned(WorkThread) then
    WorkThread.exitThread;
end;

procedure TfrmMain.btnStartClick(Sender: TObject);
begin
  if Assigned(WorkThread) then
  begin
    if WorkThread.Suspended then
      WorkThread.Resume;
  end;
end;

end.