http://www.cnblogs.com/Jekhn/archive/2012/08/25/2656656.html

线程,消息函数,SetWindowPos设置窗体位置

if WaitForSingleObject(FEvent,FInterval)=WAIT_OBJECT_0 then用法

//Main Form   http://www.cnblogs.com/Jekhn/archive/2012/08/25/2656656.html

unit unitMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, unitWorkThread{Thread}; type
TfrmMain = class(TForm)
btnStart: TButton;
mmo1: TMemo;
btn1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure btn1Click(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 = ; implementation {$R *.dfm} { TfrmMain } procedure TfrmMain.defaultPostion;
begin
SetWindowPos(FDestWindow,HWND_TOP,FOriginalRect.Left,FOriginalRect.Top,,,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,,,SWP_NOSIZE);
end; procedure TfrmMain.GoLeft;
begin
SetWindowPos(FDestWindow,HWND_TOP,FOriginalRect.Left + K_OFFSET,FOriginalRect.Top,,,SWP_NOSIZE);
end; procedure TfrmMain.GoRight;
begin
SetWindowPos(FDestWindow,HWND_TOP,FOriginalRect.Left - K_OFFSET,FOriginalRect.Top,,,SWP_NOSIZE);
end; procedure TfrmMain.GoTop;
begin
SetWindowPos(FDestWindow,HWND_TOP,FOriginalRect.Left,FOriginalRect.Top + K_OFFSET,,,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,mmo1);
WorkThread.Interval := ;
WorkThread.MainFormHWND := Self.Handle;
WorkThread.DoTimes := ;
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; procedure TfrmMain.btn1Click(Sender: TObject);
begin
if Assigned(WorkThread) then
begin
WorkThread.exitThread;
end
else
begin
//
end; end; end.

unitMain

object frmMain: TfrmMain
Left =
Top =
Width =
Height =
Caption = 'frmMain'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch =
TextHeight =
object btnStart: TButton
Left =
Top =
Width =
Height =
Caption = 'btnStart'
TabOrder =
OnClick = btnStartClick
end
object mmo1: TMemo
Left =
Top =
Width =
Height =
Align = alRight
ImeName = '中文 (简体) - 搜狗拼音输入法'
Lines.Strings = (
'mmo1')
ScrollBars = ssBoth
TabOrder =
end
object btn1: TButton
Left =
Top =
Width =
Height =
Caption = '退出线程'
TabOrder =
OnClick = btn1Click
end
end

TfrmMain窗体文件

//Thread

{*******************************************************}
{ }
{ 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 + $;
WM_LEFT = WM_USER + $;
WM_RIGHT = WM_USER + $;
WM_TOP = WM_USER + $;
WM_BOTTOM = WM_USER + $;
WM_DEFAULT = WM_USER + $; 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 := ;
end; constructor TWorkThread.Create(Suspend: boolean; mmoOutput: TMemo);
begin
inherited Create(Suspend);
FEvent := CreateEvent(nil,False,False,nil);
FreeOnTerminate := True;
FInterval := ;
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 = ;
begin
SendMessage(FMainFormHWND,WM_LEFT,,); _Sleep(K_SLEEP);
SendMessage(FMainFormHWND,WM_DEFAULT,,);
doOutputMsg('Thread WM_LEFT 第'+inttostr(FTickTimes));
SendMessage(FMainFormHWND,WM_RIGHT,,); _Sleep(K_SLEEP);
SendMessage(FMainFormHWND,WM_DEFAULT,,);
doOutputMsg('Thread WM_RIGHT 第'+inttostr(FTickTimes));
SendMessage(FMainFormHWND,WM_TOP,,); _Sleep(K_SLEEP);
SendMessage(FMainFormHWND,WM_DEFAULT,,);
doOutputMsg('Thread WM_TOP 第'+inttostr(FTickTimes));
SendMessage(FMainFormHWND,WM_BOTTOM,,); _Sleep(K_SLEEP);
SendMessage(FMainFormHWND,WM_DEFAULT,,);
doOutputMsg('Thread WM_BOTTOM 第'+inttostr(FTickTimes));
Inc(FTickTimes);
if FTickTimes >= FDoTimes then
begin
FTickTimes := ;
Self.Suspend;
end;
end; procedure TWorkThread.Execute;
begin
inherited;
while not Terminated do
begin
//FInterval表示发信号量过了后等待的时间
//WAIT_OBJECT_0表示 等待的事件已经激活
if WaitForSingleObject(FEvent,FInterval)=WAIT_OBJECT_ then
begin
Break;
end;
doSomething;
end;
end; procedure TWorkThread.exitThread;
begin
if FEvent> 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 Unit2; interface implementation end.

unitWorkThread

转:简单窗体振动-WaitForSingleObject,消息,winapi的更多相关文章

  1. 深入解析Windows窗体创建和消息分发

    Windows GUI採用基于事件驱动的编程模型,其实差点儿全部的界面库都是这样做的.在纯粹的Window32 SDK编程时代.人们还能够搞懂整个Windows窗口创建和消息的流通过程.可是在如今各种 ...

  2. DirectUI中模态对话框和菜单的原理(自己控制整个Windows消息循环。或者,用菜单模拟窗体打开时用SetCapture取得控制权,一旦窗体收到WM_CAPTURECHANGED消息就把窗体退出)

    经常有人问关于模态对话框和系统菜单内部实现原理方面的问题, 因为系统通过API隐藏了太多细节,这2个问题确实令初学者甚至是有经验的开发者困扰, 下面是我个人的一些经验总结. 先说模态对话框,外部看模态 ...

  3. C#简单窗体应用程序(三)

    使用C#创建窗体应用程序的基本步骤: (1)创建项目: (2)用户界面设计: (3)属性设置: (4)编写程序代码: (5)保存.调试.运行: 例题:设计歌曲列表界面,效果如下: 第一步:创建项目: ...

  4. java实现简单窗体小游戏----球球大作战

    java实现简单窗体小游戏----球球大作战需求分析1.分析小球的属性: ​ 坐标.大小.颜色.方向.速度 2.抽象类:Ball ​ 设计类:BallMain—创建窗体 ​ BallJPanel—画小 ...

  5. 【Web】一个非常简单的移动web消息框

    适用:h5+jquery,移动网页最佳 最近在写个简单的公众号页面,前端验证时有些信息要提示,很简单的需求实在不想找啥现成的轮子,又不至于用alert这么粗暴,遂写了个非常简单的消息框,效果如图: 特 ...

  6. vc++实例创建简单窗体

    #include<windows.h>#include<stdio.h>LRESULT CALLBACK WinSunProc(HWND hwnd,UINT uMsg,WPAR ...

  7. Delphi窗体间发送消息或字符串

    在Delphi 开发中,常常应用到窗体消息传递,以达成某种操作要求,以下列举一个应用的例子,供大家参考. 自定义过程/函数方法://发送字符串到指字句柄的窗口中 (接收窗体需用发送时的消息常量WM_C ...

  8. springboot 简单使用 activemq 接收消息

    1.在pom.xml 加入配置文件 <dependency> <groupId>org.springframework.boot</groupId> <art ...

  9. C#简单窗体应用程序(二)

    使用C#创建控制台应用程序的基本步骤: (1)创建项目: (2)用户界面设计: (3)属性设置: (4)编写程序代码: (5)保存.调试.运行: 例题:设计登录界面,效果如下: 第一步:创建项目: 文 ...

随机推荐

  1. 【错误总结】java.lang.NoClassDefFoundError: org/objectweb/asm/ClassVisitor

    运行环境      JDK1.7 64位      Window 7  64位      Ecplise Java EE IDE      Struts 2.3.9      Tomcat 7 说明: ...

  2. 【学习笔记】Servlet的配置

    为了让Servlet能响应用户的请求,需要将Servlet配置在Web应用中. 从Servlet3.0开始,配置Servlet有两种方式: l 在Servlet类中使用@WebServlet Anno ...

  3. Java 中文乱码问题总结

    开发java应用出现乱码是很常见的,毕竟现在unicode的使用还不是很广泛,在使用gb2312(包含了gbk简体,big5繁体)的系统中要正确 实现中文的display和数据库的存储是最基本的要求. ...

  4. 3D游戏编程大师技巧──2D引擎的编译问题

    接上一篇文章,这里将介绍2D引擎的编译,从现在开始才真正进入<3D游戏编程大师技巧>的学习.本书的第一.二章只是简介了游戏编程和windows编程,从第三章开始才是介绍<window ...

  5. 如何使用FileZilla上传和下载文件

    一.使用FileZilla上传文件 1 打开 FileZilla 按照如下图所示,填写远程 Linux 的 IP ,用户名,密码,还有端口号(默认22) 2 选中左边需要上传的文件,然后拖到右边,等待 ...

  6. spring mvc controller间跳转 重定向 传参

    http://blog.csdn.net/jackpk/article/details/19121777/

  7. 【Unity3d】火炬之光的X射线效果

    http://www.cnblogs.com/dosomething/archive/2012/04/03/2431149.html 人物和摄像机之间存在例如墙壁等的阻挡时  可以修改阻挡材质的alp ...

  8. SDK,API,DLL名词解释

    SDK (software devalopment kit) 软件开发工具包 : 一般都是一些软件工程师Wie特定的软件包.软件框架.硬件平台.操作系统等建立应用软件时的开发工具的集合. API (A ...

  9. 服务端调用dubbo的方式

    方式1.通过dubbo 方式2.通过spring applicationContext-dubbo.xml 注意引入提供方的接口jar包

  10. toast组件小结

    简介:toast是"吐司"的意思,它属于android杂项组件,是一个简单的消息提示框,类似于javascript中的alert. 作用 显示文本 显示图片 显示图文 3.常用方法 ...