转:简单窗体振动-WaitForSingleObject,消息,winapi
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的更多相关文章
- 深入解析Windows窗体创建和消息分发
Windows GUI採用基于事件驱动的编程模型,其实差点儿全部的界面库都是这样做的.在纯粹的Window32 SDK编程时代.人们还能够搞懂整个Windows窗口创建和消息的流通过程.可是在如今各种 ...
- DirectUI中模态对话框和菜单的原理(自己控制整个Windows消息循环。或者,用菜单模拟窗体打开时用SetCapture取得控制权,一旦窗体收到WM_CAPTURECHANGED消息就把窗体退出)
经常有人问关于模态对话框和系统菜单内部实现原理方面的问题, 因为系统通过API隐藏了太多细节,这2个问题确实令初学者甚至是有经验的开发者困扰, 下面是我个人的一些经验总结. 先说模态对话框,外部看模态 ...
- C#简单窗体应用程序(三)
使用C#创建窗体应用程序的基本步骤: (1)创建项目: (2)用户界面设计: (3)属性设置: (4)编写程序代码: (5)保存.调试.运行: 例题:设计歌曲列表界面,效果如下: 第一步:创建项目: ...
- java实现简单窗体小游戏----球球大作战
java实现简单窗体小游戏----球球大作战需求分析1.分析小球的属性: 坐标.大小.颜色.方向.速度 2.抽象类:Ball 设计类:BallMain—创建窗体 BallJPanel—画小 ...
- 【Web】一个非常简单的移动web消息框
适用:h5+jquery,移动网页最佳 最近在写个简单的公众号页面,前端验证时有些信息要提示,很简单的需求实在不想找啥现成的轮子,又不至于用alert这么粗暴,遂写了个非常简单的消息框,效果如图: 特 ...
- vc++实例创建简单窗体
#include<windows.h>#include<stdio.h>LRESULT CALLBACK WinSunProc(HWND hwnd,UINT uMsg,WPAR ...
- Delphi窗体间发送消息或字符串
在Delphi 开发中,常常应用到窗体消息传递,以达成某种操作要求,以下列举一个应用的例子,供大家参考. 自定义过程/函数方法://发送字符串到指字句柄的窗口中 (接收窗体需用发送时的消息常量WM_C ...
- springboot 简单使用 activemq 接收消息
1.在pom.xml 加入配置文件 <dependency> <groupId>org.springframework.boot</groupId> <art ...
- C#简单窗体应用程序(二)
使用C#创建控制台应用程序的基本步骤: (1)创建项目: (2)用户界面设计: (3)属性设置: (4)编写程序代码: (5)保存.调试.运行: 例题:设计登录界面,效果如下: 第一步:创建项目: 文 ...
随机推荐
- 现代软件工程作业 第二章 Github的使用
Github的使用 创建团队 Github首页点击Create Orginazation,出现如下界面: 填写相关信息,邀请团队成员: 点击确认,创建团队完成,界面如下: 创建新的版本库 点击Crea ...
- pyqt信号和槽应用举例
第一篇手写随笔. 项目的部分代码: 在子线程中改变主窗体的标签. class MyForm(QDialog): def __init__(self, parent=None): self.config ...
- [Python] from scipy import sparse 报 DLL load failed:找不到指定模块错误
依赖vc运行环境.需要安装 vc_redist Py3.5要安装2015版 传送门: https://www.microsoft.com/zh-CN/download/details.aspx?id= ...
- 4. K线经典组合及意义一
一. K线的三种形态: 1. 上升形态 2. 下跌形态 3. 顶部及底部形态 二. K线组合三大类 1. 上升形态,当这种K线或K线组合出现,表示股价要上涨. 2. 下跌形态,当这种K线或K线组合出现 ...
- jsonp 实例
一直以为很复杂吧?其实很简单,简单到你不敢相信 1.前端引好jquery文件 2.前端代码: $.ajax({ url: 'http://www.xxxxxxxx.com/expand.a ...
- AM335x kernel4.4.12 LCD 时钟翻转设置记录
TI AM335x kernel 4.4.12 LCD display 时钟翻转记录 因为公司硬件上已经确定LCD 转LVDS 转换芯片上确认以上升沿时钟为基准,所以只能在软件上调整相关东西. 入口在 ...
- TBitmapSurface.StretchFrom
procedure TBitmapSurface.StretchFrom(const Source: TBitmapSurface; const NewWidth, NewHeight: Intege ...
- C#发送邮件异常:根据验证过程,远程证书无效
今天在做发送邮件功能时,开始用qq邮箱和163邮箱都可以正常发送,后再改用我公司的邮箱和smtp时竟然报错了. 异常提示-----"根据验证过程,远程证书无效",后来通过查询资料解 ...
- visual studio installer 打包123
下载安装visual studio installer
- java 使用正则表达式过滤HTML中标签
/** * 去掉文本中的html标签 * * @param inputString * @return */ public static String html2Text(String inputSt ...