王甲春（wjiachun、老猫）个人Blog

VBA查找指定部分文本的测试代码

wjiachun — 2008-11-18 8:28:58

Cells.Find(What:="/*XXX", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
    e1 = ActiveCell.Row

    Cells.Find(What:="XXXX*/", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
    e2 = ActiveCell.Row

    Rows(CStr(e1) & ":" & CStr(e2)).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste

在vista上安装delphi7的解决方案

wjiachun — 2008-10-27 17:30:34

相信很多delphi爱好者因在vista不能正常使用delphi7而烦恼，甚至有些朋友说vista的出现就是delphi的未日了。我可以明确告诉大家，delphi7绝对可以在vista下正常使用。在vista上安装过d7的朋友都知道，当你正常安装d7后，启动d7时，屏幕会出现一个对话框。对话框的提示很明显，delphi不能rename一个文件，这说明了什么？会不会是用户的权限不够？没错，你猜对了。我现在给大家提供一个解决方案，大家可以参考一下。
　　step1，修改“C:\Program Files\Borland\Delphi7\Bin”的权限（右击上面的目录-》属性-》安全-》编辑-》修改后确定退出），赋予于users组modify权限；

　　step2，修改“C:\Program Files\Borland\Delphi7\Projects”的权限（右击上面的目录-》属性-》安全-》编辑-》修改后确定退出），赋予于users组modify权限；

　　step3，运行d7，一切正常。

　　done!还等什么，赶快试试吧！

隐藏文件夹病毒清理助手 V 1.081014

wjiachun — 2008-10-13 10:57:05

一、软件说明
1.你的计算机是否出现“this computer is being attacked”？系统进程中是否出现Global.exe和Fonts.exe等，结束后又自动出现？是否发现U盘文件夹神秘“消失”？双击文件夹打开的却是当前计算机的图片文件夹？是否无法切换中文输入法？
2.出现以上症状之一，你可以尝试使用“隐藏文件夹病毒清理助手”清理病毒。
3.本软件只针对隐藏文件夹病毒中毒后辅助清理，不能清理其他病毒，也不能代替杀毒软件。
软件下载：
点击下载此文件

二、使用说明
1.请严格按照界面提示使用本软件。
2.使用【2.病毒扫描】检测计算机是否中毒，若没有中毒可直接使用【4.按盘符清理】清除任意磁盘分区或U盘、移动硬盘等存储设备。
3.若上一步检测出系统已经感染病毒，则需要重新启动系统，进入“安全模式”后，使用【3.清除病毒】进行杀毒。
4.杀毒时需要按照【结束病毒进程】-【删除病毒文件】-【还原注册表】顺序依次清理。
5.作者承诺软件本身不对系统以及文件产生破坏，为保险起见仍请主动备份相关文件。

三、软件咨询或建议反馈：
北京市第二中学网络中心  王甲春
Email:jiachun@gmail.com
http://wang.minidns.net

四、软件更新
  20081014
修复清除病毒尸体时程序出现的异常，还原注册表的.reg文件关联。
  20081013
第一次升级，在清理U盘基础上加上杀毒功能，彻底清除系统内病毒；同时BS一下对此病毒放手不管的大小商业收费杀毒软件，忙着挣钱却不顾用户计算机的死活。
  20080908
新学期开学，制作软件，初步清理U盘本身。顺便BS一下听过本人《流氓软件与计算机安全漫谈》讲座后
依然中招的朋友，未听过讲座的可以在北京市教育资源网上找到讲座的录制资源；

PS.此贴改造为杀毒软件更新专用贴。"this computer is being attacked" 病毒专杀。目前清理方式最简单彻底的专杀工具，已经由绿盟等众多网站提供下载！

十一回老家后羿公园的照片

wjiachun — 2008-10-10 10:57:05

非常漂亮的公园关键还free

雕塑标志

与外甥女合影

奈何桥

骑墙派

欢乐谷凭教师证免费游玩

wjiachun — 2008-9-22 10:57:05

人实在是太多了

忘了名字很刺激

这个一点不刺激

蚂蚁王国

摆个Y 还有 A P 的照片没上

暑假蹲守猜猜我拍到了什么？

wjiachun — 2008-9-1 10:57:05

蹲守猜猜我拍到了什么？

发布（PIE） Prolog Inference Engine 绿色汉化版

wjiachun — 2008-8-28 10:57:05

Prolog Inference Engine 绿色汉化版
本人从 Visual Prolog 7.1 中提取并汉化
希望对研究人工智能的朋友有所帮助

点击下载此文件

DelphiZeus 12. 多媒体和多线程计时器的使用

wjiachun — 2008-6-27 16:51:44

返回首页

　　在《画刷、画笔和计时器入门》一文中，程序使用了一个计时器并发送 WM_TIMER 消息到 MessageProc ，这引起闪屏窗体改变其文本。如果希超过 200 毫秒的时间间隔，使用 SetTimer( ) 获取时间事件是一个常规做法。对于低于 200 毫秒的时间间隔，系统计时器的精确度就会相当的低。因此我们必须做出一定的改进，使用多媒体计时器和多线程计时器。本文的定时器程序演示了如何使用 SetTimer( ) ，通过一个独立的时间消息函数来完成同样的闪屏工作。另一种计时器——多媒体计时器用于显示动画。多媒体计时器比系统计时器更加精确控制 SetTimer( ) 函数。另一种计时器——多线程计时器将被创建，演示如何创建一个独立线程并使用 SleepEx( ) 函数激活计时事件。
　　为了演示系统计时器和多媒体计时器的不同精确度，两个一模一样的文字滚动函数被用于测试，一个通过系统计时器激活，另一个通过多媒体计时器激活，因此你可以看到文字滚动的快慢结果。为了度量这些计时器的实际时间间隔，本文使用了性能计数器，它每秒可以计数超过１百万次，可以用于最快的事件计时。多媒体计时器通常用于动画图像和精灵移动。本文将演示如何完成一个小球移动的动画，小球图片在某个范围的连续位置被绘制。动画显示的两种不同的方法在这里展示了，一种在显示处直接绘制小球，另一种喷绘整个区域来避免闪烁。
　　对于系统计时器我们以前使用过 SetTimer( ) 函数，因此下面首先谈谈 TimerProc 函数的使用。

利用 SetTimer( ) 使用 TimerProc
　　这里我们使用 TimerProc 函数代替 WM_TIMER 消息激活定时事件。参见 Win32 API 帮助中的 TimerProc 部分。在调用 SetTimer( ) 函数的时候你需要给出 TimerProc 的地址作为最后一个参数，如：

SetTimer(hForm1,4,1000, @TimerProc);
　　否则，SetTimer( ) 就与前面《画刷、画笔和计时器入门》一文中一样，在 WindowProc 函数中使用 WM_TIMER 消息。如果你在 SetTimer( ) 函数的最后一个参数给出一个方法地址， WM_TIMER 消息将调用这个过程代替该消息完成工作。如果你查看下面的程序的 TimerProc 部分，你可以发现：

TimerProc(Wnd: HWnd; Mesg, TimerID, SysTime: Longint); stdcall;
　　这四个参数与 MessageProc( )的参数类似，Wnd 为 hForm1，Mesg 为 WM_TIMER。我们还检测 TimerID 参数来获取 ID 编号，并为这个 TimerID 执行代码。SysTime 参数是 GetTickCount( ) 函数返回的系统 TicCount 。

多媒体计时器
　　多媒体计时器允许开发人员使用计算机硬件对应的最大分辨力（或精确度）的可能性来安排时间事件。多媒体计时器允许你安排时间时间高于其他计时服务的精确度，特别是使用 SetTimer( ) 函数的系统计时器。
　　多媒体计时器对于需要高精度计时的程序非常有用。比如，一个 MIDI 音序器需要一个准确的计时器，因为它必须保持 MIDI 序列的事件排列在精确的 1 毫秒内。不像 SetTimer( ) 函数使用的 WM_TIMER 消息，多媒体计时器可以在程序处理其他事件时触发它的回调函数。
　　为了获得多媒体计时器所能支持的最小和最大计时精度，可以使用 timeGetDevCaps( ) 函数。这个函数使用允许的最小和最大计时精度填充 TTimeCaps 记录的wPeriodMin 和 wPeriodMax 数值，这个范围与计算机以及 Windows 平台及版本关系密切。在获得多媒体计时器所能支持的最小和最大计时精度后，你必须设置你的程序需要使用的最小精度。使用 timeBeginPeriod( ) 和 timeEndPeriod( ) 函数可以设置和清除这个精度。你必须匹配每次调用 timeBeginPeriod( ) 就要调用 timeEndPeriod( )，在调用这两者时给出相同的最小精度。一个程序可以多次进行 timeBeginPeriod( ) 调用，只要每次对应调用 timeEndPeriod( )。
　　在你设置多媒体计时器的精度以后，你可以通过使用 timeSetEvent( ) 函数开始计时事件。这个函数返回一个计时器标识，可以用于停止或分辨计时器事件。函数的第三个参数是 TimeProc 回调函数的地址，当计时器事件发生时函数被调用。一共有两种类型的多媒体计时器事件：单个与周期。单个的计时器事件只在特定毫秒数以后发生一次。周期计时器事件在每个特定毫秒数的时间间隔后持续激活。周期计时器的时间间隔被称作事件延迟。周期计时器事件延迟等于或小于 10 毫秒会消耗 CPU 资源的重要部分。在计时器事件中，计时器事件精度与事件延迟长度之间的关系非常重要。举例来说，如果你设置精度为 5 毫秒，事件延迟为 100 毫秒，多媒体计时器可以在 95 到 105 毫秒范围时间以后通知回调函数。你可以在任何时候使用 timeKillEvent( ) 函数取消一个活动的计时器事件。切记在结束拥有 TimerProc 的程序或线程前取消掉所有外部计时器。为了使用多媒体计时器函数，你需要 Uses 子句部分加上 mmsystem 单元。

多媒体计时器工作于独立线程
　　为了保持高精度计时，多媒体计时器工作在它自己的 Windows 系统线程中。这个系统线程不会被系统模式对话框暂停，因此当你按下 Ctrl - Alt - Delete 键并得到关闭程序的对话框的时候，你程序的线程被暂停了，但是多媒体计时器线程持续运行并调用 TimerProc ，因此当系统模式对话框关闭后，对话框存在时调用的计时事件将会被无延迟调用。

多线程计时器
　　除了多媒体计时器，你可以创建一个单独的线程，使用 SleepEX( ) 函数休眠该线程，每次 SleepEX( ) 返回时激活一个事件。线程是操作系统分配处理时间的基本单元。线程可以运行任何一部分处理代码，包括正在被其他线程运行的部分。Windows 操作系统支持多任务优先级，呈现的效果是多个线程同时执行。多个任务在进程或线程内分隔它们需要的可用处理时间。在 API 中创建一个独立线程允许线程不会被另一个线程的代码执行。本文不打算解释所有的独立线程的动态和因素。你可以参考 Win32 API 帮助的 Processes and Threads 相关部分。
　　如果查看下面程序的代码的 DoThreadTimer( ) 过程，你会注意到：

hThread := BeginThread(nil, 0, @ThreadFunc, nil, 0, ThreadId);
　　 BeginThread( ) 函数开启一个新的独立线程，因为第三个参数 @ThreadFunc 为：
function ThreadFunc(Parameter: Pointer): Integer; stdcall;
　　这就是将要执行的线程。这个 ThreadFunc( ) 和一个 .dpr 程序代码的执行比较相似，这个线程在“begin”处开始执行，在“end;”处结束执行。因此，你需要循环以保持这个线程的活动状态，如果你在这个线程创建了窗体你也需要使用消息循环，但是本文没有创建窗体，只是使用一个 While 循环，循环体为 SleepEx(TimerR.Interval, False); 只要 thdTiming 为 true ， While 循环将保持运行，因此你需要在开始这个线程前设置 thdTiming 为 true。
　　更多信息请参看下面代码内的详细注释。

计时器程序

　　这个程序与《画刷、画笔和计时器入门》一文一样创建一个闪屏，但是它不是直接在桌面 HDC 上直接绘制，而是创建一个闪屏窗口并在上面绘制。前面的例子使用 SetTimer( ) 处理闪屏上文字的显示并切换到主窗体，本例使用 TimerProc 处理 WM_TIMER 事件。本程序在 580x42 窗体上创建四个按钮和一个检查框。你应该注意到窗体类注册为 CS_OWNDC 风格： Style := CS_BYTEALIGNCLIENT or CS_OWNDC;
　　CS_OWNDC 风格给出窗体一个持续长久的 HDC，被称作私有设备场景，一个为该类窗体所有的唯一的设备场景。因此，你只需要获取 HDC 一次，然后就可以在所有的喷绘中使用。尽管 CS_OWNDC 风格非常方便，你还是要小心使用，因为每个设备场景都使用系统资源的一部分。由于本例需要处理图形动画，私有的 HDC 是非常有用的，因为我们不需要在移动小球时成千上万次调用 GetDC( ) 进行喷绘。
　　在 DrawEdge(PaintS.hDC, ScrolRect1, EDGE_SUNKEN, BF_RECT); 函数中使用 WM_PAINT 消息绘制了两个文本滚动框，这呈现了一个 Windows 系统控件（编辑框）的外观。如果你单击“开始滚动”按钮，ScrollText 过程将被调用来创建文本滚动框的背景位图。TimeSetEvent( ) 和 SetTimer( ) 将被调用，开始两个同样 38 毫秒时间间隔的计时器。SetTimer( ) 计时事件激活 TimerProc 在上面的文本滚动框上绘制一个新的矩形，TimeSetEvent( ) 计时事件激活 MMTimerProc 在下面的文本滚动框上绘制滚动文本。
　　更多信息请参看下面代码内的详细注释。

program Timers;
{本程序使用三种不同的方法处理计时事件，这里没有使用 SetTimer 函数的 WM_TIMER 消息，
而是一个特定的 TimerProc 函数。本例还演示了多媒体计时的使用，它比 SetTimer 更加精
确。本例还演示了独立线程中使用 SleepEx( ) 激活计时事件的例子。}
uses
  Windows, Messages, SmallUtils, mmsystem;
  {mmsystem 单元为多媒体计时器使用}
  {$R *.RES}
type
  ThreadRec = record
    Interval: Cardinal;
    ID: Word;
  end;

var
  wClass: TWndClass;
  hForm1, hExitBut, hScrollBut, hSpriteBut, hPFlipBut, hThreadCB: THandle;
  Font1, Brush1, Brush2, Brush3, Pen1, hThread: THandle;
  SpriteBmp1, MaskBmp, FlipBmp, BkgndBmp: THandle;
  mainMsg: TMSG;
  Rect1, ScrolRect1, ScrolRect2: TRect;
  FormDC, Bmp1DC, MaskDC, FlipDC, BkgndDC: HDC;
  FontLog1: TLogFont;
  DrawTimes: Byte;
  Posit1, Posit2: Integer;
  BrushLog1: TLogBrush;
  Scrolling, GetPer, GetPer1, Moving, GoRight, GoDown, Fliping, thdTiming: Boolean;
  Size1: TSize;
  TimeCaps1: TTimeCaps;
  TimerID1, TickCount: Cardinal;
  PerFreq, PerCount0, PerCount1, PerCount2, PerCount3: Int64;
  BallPoint: TPoint;
  TimerR: ThreadRec;

const
  Splash = 'Timers';
  TextStr1 = 'This is a WM_TIMER Scroll';
  TextStr2 = 'This is a MM Timer Scroll';

procedure ShutDown;
begin
  KillTimer(hForm1, 1);
  KillTimer(hForm1, 2);
  KillTimer(hForm1, 3);
  KillTimer(hForm1, 4);
  {确保计时器销毁}
  thdTiming := False;
  timeKillEvent(TimerID1);
  TimeEndPeriod(TimeCaps1.wPeriodMin);
  {确定在程序关闭前使用 timeKillEvent 和 TimeEndPeriod }
  CloseHandle(hThread);
  {释放系统的线程句柄}
  DeleteObject(Font1);
  DeleteObject(Brush1);
  DeleteObject(Brush2);
  DeleteObject(Brush3);
  DeleteObject(Pen1);
  ReleaseDC(hForm1, FormDC);
  DeleteDC(Bmp1DC);
  DeleteDC(MaskDC);
  DeleteDC(FlipDC);
  DeleteDC(BkgndDC);
  DeleteObject(SpriteBmp1);
  DeleteObject(MaskBmp);
  DeleteObject(FlipBmp);
  DeleteObject(BkgndBmp);
  PostQuitMessage(0);
end;

function MakeBrush(Color1, Color2: Cardinal): THandle;
var
  BmpDC: hDC;
  i, k, Dot: Integer;
  Bitmap1: THandle;
  TempDC: HDC;
begin
  {这里使用两种颜色的画刷创建斜纹位图}
  TempDC := GetDC(0);
  Bitmap1 := CreateCompatibleBitmap(TempDC, 8, 8);
  BmpDC := CreateCompatibleDC(TempDC);
  ReleaseDC(GetDesktopWindow, TempDC);
  SelectObject(BmpDC, Bitmap1);
  Dot := 0;
  for i := 0 to 7 do
  begin
    for k := 0 to 7 do
      if ((k + Dot) mod 4) <> 0 then
        SetPixelV(BmpDC, i, k, Color1)
      else
        SetPixelV(BmpDC, i, k, Color2);
    Inc(Dot);
  end;
  BrushLog1.lbStyle := BS_PATTERN;
  BrushLog1.lbHatch := Bitmap1;
  Result := CreateBrushIndirect(BrushLog1);
  DeleteDC(BmpDC);
  DeleteObject(Bitmap1);
end;

function MakeBrush3: THandle;
var
  BmpDC: hDC;
  Bitmap2: THandle;
  i, k, Dot: Integer;
  TempDC: HDC;
begin
  {这里用黑白交互的画刷创建位图}
  TempDC := GetDC(0);
  {这个函数在窗体之前调用，因此这里获取桌面 hDC}
  Bitmap2 := CreateBitmap(8, 8, 1, 1, nil);
  BmpDC := CreateCompatibleDC(TempDC);
  ReleaseDC(GetDesktopWindow, TempDC);
  SelectObject(BmpDC, Bitmap2);
  Dot := 0;
  for i := 0 to 7 do
  begin
    for k := 0 to 7 do
      if ((k + Dot) mod 2) <> 0 then
        SetPixelV(BmpDC, i, k, $00000000)
      else
        SetPixelV(BmpDC, i, k, $00FFFFFF);
    Inc(Dot);
  end;
  BrushLog1.lbStyle := BS_PATTERN;
  BrushLog1.lbHatch := Bitmap2;
  Result := CreateBrushIndirect(BrushLog1);
  DeleteDC(BmpDC);
  DeleteObject(Bitmap2);
end;

procedure TimerProc(Wnd: HWnd; Mesg, TimerID, SysTime: Longint); stdcall;
var
  TimeRec: TSystemTime;
  Time: string;
  OldColor: Cardinal;
  OldMode: Integer;
  OldFont: THandle;
begin
  {如果函数地址在 SetTimer( ) 给出的话，WM_TIMER 消息将激活这个 TimerProc 函数。}
  case TimerID of
    1:
      begin
        {这里停止闪屏并显示主窗体}
        KillTimer(hForm1, 1);
        KillTimer(hForm1, 2);
        ReleaseDC(GetDesktopWindow, MaskDC);
        MaskDC := 0;
        ShowWindow(hForm1, SW_SHOWNORMAL);
        SetTimer(hForm1, 4, 1000, @TimerProc);
      end; //1
    2:
      begin
        {这里喷绘闪屏，没有创建闪屏窗体，直接在桌面上绘制。使用 DrawTimes 来
        检测绘制哪个闪屏字母。}
        if DrawTimes = 0 then
          PatBlt(MaskDC, Rect1.Left + 80, Rect1.Top + 30, 300, 250, PATCOPY)
        else if DrawTimes < 7 then
          TextOut(MaskDC, 0, 0, @Splash[DrawTimes], 1)
        else
          PatBlt(MaskDC, Rect1.Left + 80, Rect1.Top + 30, 300, 250, DSTINVERT);
        Inc(DrawTimes);
        if DrawTimes > 8 then
          KillTimer(hForm1, 2);
      end; //2
    3:
      begin
        {这里绘制滚动文本}
        {FormDC := GetDC(hForm1);
        SelectObject(FormDC, Brush2);
        SetBkMode(FormDC,TRANSPARENT);
        上面三行不必使用，因为我们使用私有的设备场景 FormDC}
        if GetPer1 and (PerFreq <> 0) then
        begin
          {性能计数器是一个高精度的计数器，它可以查出两次调用
          QueryPerformanceCounter( ) 之间的时间间隔。}
          QueryPerformanceCounter(PerCount3);
          GetPer1 := False;
          SetBkMode(FormDC, OPAQUE);
          Time := Int2Str(((PerCount3 - PerCount2) * 10000) div PerFreq);
          Insert('.', Time, Length(Time));
          TextOut(FormDC, 6, ScrolRect1.Top + 6, PChar(Time), Length(Time));
          {这将显示 PerCount2 和 PerCount3 之间的间隔毫秒数，它应该等于  SetTimer
          的时间间隔 Interval ，但是不管你设置低于 55 的任何数值，interval 都将
          大约等于 55 ，55 毫秒是系统计时器能处理的最快间隔。}
          SetBkMode(FormDC, TRANSPARENT);
          Time := '';
        end;
        if Posit1 > Size1.cx + 17 then
        begin
          {每次滚动循环 Posit1 都只会大于 Size1.cx+17 一次}
          Posit1 := 0;
          if PerFreq <> 0 then
          begin
            QueryPerformanceCounter(PerCount2);
            GetPer1 := True;
          end;
        end;
        InflateRect(ScrolRect1, -2, -2);
        PatBlt(FormDC, ScrolRect1.Left, ScrolRect1.Top, 196, 26, PATCOPY);
        ExtTextOut(FormDC, ScrolRect1.Left - Posit1, ScrolRect1.Top + 4,
          ETO_CLIPPED, @ScrolRect1, TextStr1, 25, nil);
        {ExtTextOut( ) 修整文本输出到 ScrolRect1}
        ExtTextOut(FormDC, ScrolRect1.Right - Posit1, ScrolRect1.Top + 4,
          ETO_CLIPPED, @ScrolRect1, TextStr1, 25, nil);
        Inc(Posit1);
        InflateRect(ScrolRect1, 2, 2);
      end; //3
    4:
      begin
        {计时事件每秒激发一次，绘制本地时间到窗体上，就像一个时钟。}
        GetLocalTime(TimeRec);
        {为了获取日期和时间你可以使用 GetLocalTime}
        OldFont := SelectObject(FormDC, GetStockObject(ANSI_VAR_FONT));
        OldColor := SetBkColor(FormDC, GetSysColor(COLOR_BTNFACE));
        OldMode := SetBkMode(FormDC, OPAQUE);
        {由于私有的 DC 应用于该窗体，所有的 DC 对象和模式设置将会保留在 FormDC ，
        即使在这个函数以后。所以你需要记录你改变的 DC 设置用来还原它们。}
        Time := '本地日期：' + Int2Str(TimeRec.wMonth) + '/' +
          Int2Str(TimeRec.wDay) +
          '/' + Int2Str(TimeRec.wYear) + '    时间：' + Int2Str(TimeRec.wHour)
          +
          ':' +
          Int2Str(TimeRec.wMinute) + '  ' + Int2Str(TimeRec.wSecond) +
          ' 秒   ';
        TextOut(FormDC, 128, 365, @Time[1], Length(Time));
        {在绘制文本后复位 FormDC 设置，否则其他动画绘制操作将受到影响。}
        SelectObject(FormDC, OldFont);
        SetBkColor(FormDC, OldColor);
        SetBkMode(FormDC, OldMode);
        Time := '';
      end;
  end; // case
end;

procedure MoveBall;
var
  PCstr: string;
begin
  {这里产生一个精灵动画（一个小球和阴影的图片），因此它在一个矩形范围移动，看起来
  像是碰撞边缘。}
  if GetPer and (PerFreq <> 0) then
  begin
    {这将显示该计时器的实际时间间隔，注意这是在多媒体或多线程计时器中设置的。}
    QueryPerformanceCounter(PerCount1);
    GetPer := False;
    SetBkMode(FormDC, OPAQUE);
    PCstr := Int2Str(((PerCount1 - PerCount0) * 100000) div PerFreq);
    Insert('.', PCstr, Length(PCstr) - 1);
    TextOut(FormDC, 460, 120, PChar(PCstr), Length(PCstr));
    SetBkMode(FormDC, TRANSPARENT);
  end;
  SelectObject(FormDC, Brush1);
  {SetROP2(FormDC,R2_COPYPEN);}
  PatBlt(FormDC, BallPoint.x, BallPoint.y, 49, 44, PATCOPY);
  {BallPoint 用于记住小球的位置，GoRight 和 GoDown 用于设置移动方向。}
  if BallPoint.x > 366 then
  begin
    GoRight := False;
    if PerFreq <> 0 then
    begin
      QueryPerformanceCounter(PerCount0);
      GetPer := True;
    end;
  end
  else if BallPoint.x < 104 then
    GoRight := True;
  {当位置到达最大值 366 和最小值 104 的时候改变小球的位置，正好对应矩形位置减去
  精灵位图的宽度。}
  if GoRight then
    Inc(BallPoint.x, 5)
  else
    Dec(BallPoint.x, 4);
  {改变 BallPoint 的 X 和 Y 将会移动小球，你需要匹配像素与时间间隔来设置小球
  移动的速度。}
  if BallPoint.y > 213 then
    GoDown := False
  else if BallPoint.y < 12 then
  begin
    GoDown := True;
    if PerFreq <> 0 then
    begin
      QueryPerformanceCounter(PerCount0);
      GetPer := True;
    end;
  end;
  if GoDown then
    Inc(BallPoint.y, 3)
  else
    Dec(BallPoint.y, 2);
  {电视使用每秒 25 帧的速度（时间间隔大约 40 毫秒）。你可以尝试保持动画间隔为
  30 到 40 毫秒之间并调整移动的像素累加值来获取你需要的速度。}
  SelectObject(FormDC, Brush3);
  {SetRop2 为 R2_MASKPEN 并绘制椭圆，这样只有 Brush3 的黑色像素被绘制出一个阴影效果。}
  Ellipse(FormDC, BallPoint.x + 4, BallPoint.y + 5, BallPoint.x + 49, BallPoint.y + 44);
  {下面两个喷绘过程需要获取透明位图，第一个位图 MaskBmp 使用 ScrAnd 光栅操作符
  绘制。后一个使用 SrcInvert 光栅操作符反色绘制 Bmp1 ，因此颜色将会返回正常状
  态，透明区域将会切换为 hDC 背景色。}
  BitBlt(FormDC, BallPoint.x, BallPoint.y, 40, 40, MaskDC, 0, 0, SrcAnd);
  BitBlt(FormDC, BallPoint.x, BallPoint.y, 40, 40, Bmp1DC, 0, 0, SrcInvert);
end;

procedure FlipIt;
var
  RectP: TRect;
  {Counts: Cardinal;}
begin
  {如果你查看上面的 MoveBall 动画，你将发现小球有时会有所闪烁，如果背景绘制和
  小球绘制使用不同的屏幕刷新速度，将会出现闪烁状态。在这个动画过程中使用了一种
  被称作 Page-Flipping 的方法。不在屏幕上绘制新的背景和小球，而是在一个位图上
  完成这个绘制工作，然后把整个位图喷绘到屏幕上，这样背景和小球绘制之间就没有刷
  新，因此就没有闪烁了。然而，位图可能因为上面绘制动画精灵或者 Scanline 以及其
  他图形操作变得很大，这样，绘制位图到屏幕上就会比动画时间间隔长一些，因此你可
  以在 Page-Flipping 时做一点限制。}
  if PerFreq <> 0 then
    QueryPerformanceCounter(PerCount2);
  BitBlt(FlipDC, BallPoint.x, BallPoint.y, 49, 47, BkgndDC,
        BallPoint.x, BallPoint.y, SrcCopy);
  {通过复制 BkgndBmp 到上面擦除精灵}
  if BallPoint.x > 240 then
    GoRight := False
  else if BallPoint.x < 4 then
    GoRight := True;
  if GoRight then
    Inc(BallPoint.x, 5)
  else
    Dec(BallPoint.x, 4);
  if BallPoint.y > 196 then
    GoDown := False
  else if BallPoint.y < 2 then
    GoDown := True;
  if GoDown then
    Inc(BallPoint.y, 3)
  else
    Dec(BallPoint.y, 2);
  {在 FlipBmp 上绘制新的精灵}
  Ellipse(FlipDC, BallPoint.x + 4, BallPoint.y + 5, BallPoint.x + 49, BallPoint.y + 44);
  BitBlt(FlipDC, BallPoint.x, BallPoint.y, 40, 40, MaskDC, 0, 0, SrcAnd);
  BitBlt(FlipDC, BallPoint.x, BallPoint.y, 40, 40, Bmp1DC, 0, 0, SrcInvert);
  BitBlt(FormDC, 100, 10, 380, 250, FlipDC, 0, 0, SrcCopy);
  {现在整个 FlipBmp 被复制到 FormDC 而不是仅仅覆盖精灵的一小部分。因为只有一次
  绘制操作，所以没有闪烁。}
  if PerFreq <> 0 then
  begin
    {这将演示高性能计数来绘制位图以及绘制位图到窗体上。}
    QueryPerformanceCounter(PerCount3);
    {Counts := ((PerCount3-PerCount2)*1000) div PerFreq;}
    {为了获取毫秒级的时间，你需要用 PerFreq 整除，但是这个位图是足够小的，所以用
    不了 1 毫秒时间。}
    SetBkMode(FormDC, OPAQUE);
    SetRect(RectP, 424, 5, 474, 35);
    FillRect(FormDC, RectP, wClass.hbrBackground);
    TextOut(FormDC, 424, 5, PChar(Int2Str({Counts} PerCount3 - PerCount2)),
        Length(Int2Str({Counts} PerCount3 - PerCount2)));
    SetBkMode(FormDC, TRANSPARENT);
  end;
end;

procedure ScrollIt;
var
  Ticks: string;
begin
  {这个动画显示文字，这样看上去就像文本从右向左移动。这与 TimerProc 的 case 3
  一样滚动文本，这样你可以看出多媒体计时器与系统计时器动画的不同。}
  {FormDC := GetDC(hForm1);
  SelectObject(FormDC, Brush2);
  SetBkMode(FormDC,TRANSPARENT);}
  {不需要使用上面的函数，因为这里在私有 DC 上绘制。}
  if GetPer and (PerFreq <> 0) then
  begin
    {这将显示该计时器的实际时间间隔，注意这是在多媒体或多线程计时器中设置的。}
    QueryPerformanceCounter(PerCount1);
    GetPer := False;
    SetBkMode(FormDC, OPAQUE);
    TextOut(FormDC, ScrolRect2.Right + 8, ScrolRect2.Top + 6, PChar('Ticks ' +
        Int2Str(GetTickCount - TickCount)),
        Length('Ticks ' + Int2Str(GetTickCount - TickCount)));
    Ticks := Int2Str(((PerCount1 - PerCount0) * 10000) div PerFreq);
    Insert('.', Ticks, Length(Ticks));
    TextOut(FormDC, 6, ScrolRect2.Top + 6,
        PChar(Ticks {Int2Str(((PerCount1-PerCount0)*1000) div PerFreq)}),
        Length(Ticks {Int2Str(((PerCount1-PerCount0)* 1000) div PerFreq)}));
    SetBkMode(FormDC, TRANSPARENT);
    Ticks := '';
  end;
  if Posit2 > Size1.cx + 17 then
  begin
    Posit2 := 0;
    if PerFreq <> 0 then
    begin
      QueryPerformanceCounter(PerCount0);
      TickCount := GetTickCount;
      GetPer := True;
    end;
  end;
  {Size1 用于不同的文本 TextStr1，然后在这里使用，但是它给出与 TimerProc 滚动
  一样的宽度，这样便于对比。}
  InflateRect(ScrolRect2, -2, -2);
  BitBlt(FormDC, ScrolRect2.Left, ScrolRect2.Top, Size1.cx + 17,
    ScrolRect2.Bottom - ScrolRect2.Top, BkgndDC, Posit2, 0, SrcCopy);
  BitBlt(FormDC, ScrolRect2.Right - Posit2, ScrolRect2.Top, Posit2,
    ScrolRect2.Bottom - ScrolRect2.Top, BkgndDC, 0, 0, SrcCopy);
  {PatBlt(FormDC, ScrolRect2.Left, ScrolRect2.Top, 196, 26,PATCOPY);
  ExtTextOut(FormDC,ScrolRect2.Left-Posit2, ScrolRect2.Top+4,
           ETO_CLIPPED, @ScrolRect2, TextStr2, 25, nil);
  ExtTextOut(FormDC,ScrolRect2.Right-Posit2, ScrolRect2.Top+4,
           ETO_CLIPPED, @ScrolRect2, TextStr2, 25, nil);}
  InflateRect(ScrolRect2, 2, 2);
  {ReleaseDC(hForm1, FormDC);}
  Inc(Posit2, 2);
end;

procedure MMTimerProc(uTimerID, uMessage: cardinal; dwUser, dw1, dw2: integer);
  stdcall;
begin
  {你需要设置所有的操作到其他过程，这里除了调用这些过程外不要进行其他操作。这个
  函数将被多媒体计时器事件调用，甚至是在过程被前一个尚未结束的 MMTimerProc 调用
  的情况下。多媒体计时器工作于独立线程。}
  case dwUser of
    1: MoveBall;
    2: FlipIt;
    10: ScrollIt;
  else
    timeKillEvent(TimerID1);
  end;
end;

function ThreadFunc(Parameter: Pointer): Integer; stdcall;
begin
  {你需要设置所有的操作到其他过程，这里除了调用这些过程外不要进行其他操作。这个
  函数工作于独立线程，即使这个过程被前一个尚未结束的 ThreadFunc 调用的情况下也
  可以被调用。}
  Result := 0;
  while thdTiming do
  begin
    {thdTiming 暂停这个线程，它在 while 循环中使用 SleepEx 获得计时时间间隔的效果。}
    SleepEx(TimerR.Interval, False);
    case TimerR.ID of
      1: if thdTiming then FlipIt;
         {检测 thdTiming 防止它在 SleepEx 时改变}
      2: if thdTiming then MoveBall;
    else
      Break;
    end;
  end;
  TimerR.ID := 0;
  EndThread(Result);
  {ExitThread(Result);}
  {EndThread 下面的代码不会被执行}
  TextOut(FormDC, 4, 100, '在 EndThread 下面', 17);
end;

procedure DoThreadTimer(Interval, TimerID: Word);
var
  ThreadId: LongWord;
begin
  {时间间隔应该大于 4 ，否则要使用大量的进程时间周期，如果你使用小于 5 的时间间
  隔，应该使用 SetThreadPriority( ) 设置线程为最高优先级。}
  if TimerR.ID <> 0 then Exit;
  {TimerR.ID 在线程结束时被设置为 0，检测是否为 0 确保如果进程在运行中则不开始。}
  if Interval < 5
  then TimerR.Interval := 5
  else TimerR.Interval := Interval;
  TimerR.ID := TimerID;
  CloseHandle(hThread);
  {由于线程可能不止一次被创建，所以你应该关闭句柄。如果你想使用多个线程，你应该
  跟踪每个线程的句柄并关闭它。}
  hThread := BeginThread(nil, 0, @ThreadFunc, nil, 0, ThreadId);
  {BeginThread( ) 是一个 Delphi 的系统函数，它与 Windows 的 CreateThread( ) 函数
  基本一样，只是它还设置了一个全局变量 IsMultiThread ，从而保证线程安全。下面是
  CreateThread( ) 函数原型，一样可以使用。}
  {hThread := CreateThread(
        NIL,                // no security attributes
        0,                  // use default stack size
        @ThreadFunc,        // thread function
        nil,                // argument to thread function
        0,                  // use default creation flags
        ThreadId);}
  {SetThreadPriority(hThread, THREAD_PRIORITY_ABOVE_NORMAL);}
  {使用 EndThread( ) 对应 BeginThread( ) ，使用 ExitThread( ) 对应
  CreateThread( ) ，参见上面的 ThreadFunc( ) 部分。}
end;

procedure ScrollText;
var
  Interval, Accur: Word;
begin
  if Scrolling then
  begin
    Scrolling := False;
    timeKillEvent(TimerID1);
    KillTimer(hForm1, 3);
    EnableWindow(hSpriteBut, True);
    EnableWindow(hPFlipBut, True);
    EnableWindow(hThreadCB, True);
    SetWindowText(hScrollBut, '开始滚动');
    DeleteDC(BkgndDC);
    DeleteObject(BkgndBmp);
    PatBlt(FormDC, ScrolRect1.Left + 2, ScrolRect1.Top + 2, 196, 26, PATCOPY);
    PatBlt(FormDC, ScrolRect2.Left + 2, ScrolRect2.Top + 2, 196, 26, PATCOPY);
    TextOut(FormDC, ScrolRect1.Left + 4, ScrolRect1.Top + 6, TextStr1, 25);
    TextOut(FormDC, ScrolRect2.Left + 4, ScrolRect2.Top + 6, TextStr2, 25);
    Posit1 := 1;
    Posit2 := 1;
  end
  else
  begin
    EnableWindow(hSpriteBut, False);
    EnableWindow(hPFlipBut, False);
    EnableWindow(hThreadCB, False);
    SelectObject(FormDC, Brush2);
    SetBkMode(FormDC, TRANSPARENT);
    InflateRect(ScrolRect2, -2, -2);
    BkgndBmp := CreateCompatibleBitmap(FormDC, Size1.cx + 17,
      ScrolRect2.Bottom - ScrolRect2.Top);
    BkgndDC := CreateCompatibleDC(FormDC);
    SelectObject(BkgndDC, BkgndBmp);
    SelectObject(BkgndDC, Brush2);
    SetBkMode(BkgndDC, TRANSPARENT);
    PatBlt(BkgndDC, 0, 0, Size1.cx + 17, ScrolRect2.Bottom - ScrolRect2.Top,
      PATCOPY);
    TextOut(BkgndDC, 3, 4, TextStr2, 25);
    InflateRect(ScrolRect2, 2, 2);
    timeKillEvent(TimerID1);
    Interval := 38;
    Accur := Interval div 2;
    if Accur < TimeCaps1.wPeriodMin then
      Accur := TimeCaps1.wPeriodMin;
    if Accur > TimeCaps1.wPeriodMax then
      Accur := TimeCaps1.wPeriodMax;
    if TimeCaps1.wPeriodMin <> 0 then
      TimerID1 := TimeSetEvent(Interval, Accur, @MMTimerProc, 10,
        TIME_PERIODIC);
    SetTimer(hForm1, 3, Interval, @TimerProc);
    {注意多媒体计时器与系统计时器的时间间隔一样}
    Scrolling := True;
    SetWindowText(hScrollBut, '停止滚动');
    TextOut(FormDC, ScrolRect1.Left, ScrolRect1.Top - 28,
      PChar('文本滚动时间间隔为 ' +
      Int2Str(Interval)), 19 + Length(Int2Str(Interval)));
  end;
end;

procedure MakeMoveBall;
var
  TDC: HDC;
  TempBmp, TempBrush, TempPen: THandle;
begin
  {这里创建一个位图动画精灵，它在圆周围添加一些高亮与暗影的弧形区域，这样看起来
  就是一个 3D 的球体。}
  Bmp1DC := CreateCompatibleDC(FormDC);
  MaskDC := CreateCompatibleDC(FormDC);
  TDC := CreateCompatibleDC(FormDC);
  SpriteBmp1 := CreateCompatibleBitmap(FormDC, 40, 40);
  MaskBmp := CreateCompatibleBitmap(FormDC, 40, 40);
  {由于假定外观为一个球体，位图是不规则的，我们需要绘制透明的位图。为了完成这个
  操作，我们需要使用覆盖位图，希望透明的区域为白色。}
  TempBmp := CreateCompatibleBitmap(FormDC, 40, 40);
  {TempBmp 将会得到反色，反色位图将复制到精灵位图。}
  SelectObject(Bmp1DC, SpriteBmp1);
  SelectObject(MaskDC, MaskBmp);
  SelectObject(TDC, TempBmp);
  SelectObject(MaskDC, GetStockObject(WHITE_BRUSH));
  PatBlt(MaskDC, 0, 0, 40, 40, PATCOPY);
  SelectObject(Bmp1DC, GetStockObject(WHITE_BRUSH));
  PatBlt(Bmp1DC, 0, 0, 40, 40, PATCOPY);
  SelectObject(MaskDC, GetStockObject(BLACK_BRUSH));
  Ellipse(MaskDC, 0, 0, 40, 40);
  TempBrush := CreateSolidBrush($00AADD00);
  SelectObject(Bmp1DC, TempBrush);
  Ellipse(Bmp1DC, 0, 0, 40, 40);
  SelectObject(Bmp1DC, GetStockObject(WHITE_BRUSH));
  {白色画刷用于添加高亮}
  PatBlt(Bmp1DC, 10, 8, 5, 5, PATCOPY);
  TempPen := CreatePen(PS_SOLID, 1, $00669900);
  SelectObject(Bmp1DC, TempPen);
  {几个弧形区域使用黑色画笔绘制，为小球添加阴影效果。}
  Arc(Bmp1DC, 2, 2, 38, 38, 18, 40, 40, 18);
  DeleteObject(TempPen);
  TempPen := CreatePen(PS_SOLID, 1, $0099AA00);
  SelectObject(Bmp1DC, TempPen);
  Arc(Bmp1DC, 5, 5, 35, 35, 20, 40, 40, 20);
  DeleteObject(TempPen);
  TempPen := CreatePen(PS_SOLID, 1, $0099BB00);
  SelectObject(Bmp1DC, TempPen);
  Arc(Bmp1DC, 8, 8, 32, 32, 22, 40, 40, 22);
  DeleteObject(TempPen);
  TempPen := CreatePen(PS_SOLID, 1, $00D2E4B4);
  SelectObject(Bmp1DC, TempPen);
  Arc(Bmp1DC, 3, 3, 37, 37, 16, 0, 0, 16);
  BitBlt(TDC, 0, 0, 40, 40, MaskDC, 0, 0, SrcCopy);
  BitBlt(TDC, 0, 0, 40, 40, Bmp1DC, 0, 0, SrcErase);
  {为了获取透明位图效果，我们复制 MaskDC 到 TDC ，这样我们对 Bmp1DC 进行任何擦除
  操作，将会反转 Bmp1DC 位图颜色。}
  BitBlt(Bmp1DC, 0, 0, 40, 40, TDC, 0, 0, SrcCopy);
  {临时的 TDC 反色球将复制到 Bmp1DC}
  DeleteDC(TDC);
  DeleteObject(TempBmp);
  DeleteObject(TempBrush);
  DeleteObject(TempPen);
end;

procedure EndAnimation;
begin
  thdTiming := False;
  timeKillEvent(TimerID1);
  EnableWindow(hScrollBut, True);
  EnableWindow(hPFlipBut, True);
  EnableWindow(hThreadCB, True);
  EnableWindow(hSpriteBut, True);
  DeleteDC(Bmp1DC);
  DeleteDC(MaskDC);
  DeleteObject(SpriteBmp1);
  DeleteObject(MaskBmp);
  BallPoint.x := 150;
  BallPoint.y := 100;
end;

procedure Animate;
var
  Interval, Accur: Word;
begin
  if Moving then
  begin
    Moving := False;
    EndAnimation;
    SetWindowText(hSpriteBut, '开始移动');
    {SelectObject(TempDC, GetSysColorBrush(COLOR_BTNFACE));
    PatBlt(TempDC, 100, 10, 320, 250,PATCOPY);}
    {ReleaseDC(hForm1, TempDC);}
  end
  else
  begin
    timeKillEvent(TimerID1);
    EnableWindow(hScrollBut, False);
    EnableWindow(hPFlipBut, False);
    EnableWindow(hThreadCB, False);
    SetWindowText(hSpriteBut, '停止移动');
    Moving := True;
    QueryPerformanceCounter(PerCount0);
    {TempDC := GetDC(hForm1);}
    MakeMoveBall {(TempDC)};
    SelectObject(FormDC, Brush1);
    PatBlt(FormDC, 100, 10, 320, 250, PATCOPY);
    {SetBkMode(TempDC, TRANSPARENT);}
    BitBlt(FormDC, BallPoint.x, BallPoint.y, 40, 40, MaskDC, 0, 0, SrcAnd);
    BitBlt(FormDC, BallPoint.x, BallPoint.y, 40, 40, Bmp1DC, 0, 0, SrcInvert);
    SelectObject(FormDC, GetStockObject(NULL_PEN));
    QueryPerformanceCounter(PerCount1);
    SetBkMode(FormDC, OPAQUE);
    TextOut(FormDC, 35, 5, PChar(Int2Str(PerCount1 - PerCount0)),
      Length(Int2Str({(}(PerCount1 - PerCount0) {* 1000) div PerFreq})));
    Interval := 27;
    {缩短时间间隔可以提高移动速度，但是会增加处理时间。你应该增加像素位置的改变量
    来提高移动速度，如果时间间隔低于 30 则提高时间间隔。}
    Accur := Interval div 2;
    if Accur < TimeCaps1.wPeriodMin then
      Accur := TimeCaps1.wPeriodMin;
    if Accur > TimeCaps1.wPeriodMax then
      Accur := TimeCaps1.wPeriodMax;
    if SendMessage(hThreadCB, BM_GETSTATE, 0, 0) = BST_CHECKED then
    begin
      Interval := 18;
      thdTiming := True;
      DoThreadTimer(Interval, 2);
      {12 毫秒低于你应该使用的时间间隔，你应该使用 2 倍的时间 24 毫秒，同时双倍
      你移动的像素位置，由
      Inc(BallPoint.x,5) else Dec(BallPoint.x,4);
      改变为
     Inc(BallPoint.x,10) else Dec(BallPoint.x,8);}
    end
    else if TimeCaps1.wPeriodMin <> 0 then
      TimerID1 := TimeSetEvent(Interval, Accur, @MMTimerProc, 1, TIME_PERIODIC);
    TextOut(FormDC, 430, 92, PChar('移动的时间间隔为 '+ Int2Str(Interval)),
      17 + Length(Int2Str(Interval)));
    SetBkMode(FormDC, TRANSPARENT);
    {SetRop2 设置为 R2_MASKPEN ，这样将在 MoveBall 中绘制圆，只有 Brush3 的黑色
    像素被绘制，从而得到阴影效果。}
    SetROP2(FormDC, R2_MASKPEN);
  end;
end;

procedure PageFlip;
var
  TempBrush: THandle;
  Interval, Accur: Word;
begin
  if Fliping then
  begin
    Fliping := False;
    EndAnimation;
    SetWindowText(hPFlipBut, 'PageFlip 移动');
    DeleteDC(FlipDC);
    DeleteDC(BkgndDC);
    DeleteObject(FlipBmp);
    DeleteObject(BkgndBmp);
  end
  else
  begin
    EnableWindow(hScrollBut, False);
    EnableWindow(hSpriteBut, False);
    EnableWindow(hThreadCB, False);
    Fliping := True;
    SetWindowText(hPFlipBut, '停止 Flip');
    SelectObject(FormDC, GetSysColorBrush(COLOR_BTNFACE));
    PatBlt(FormDC, 100, 10, 320, 250, PATCOPY);
    MakeMoveBall;
    BkgndBmp := CreateCompatibleBitmap(FormDC, 280, 240);
    BkgndDC := CreateCompatibleDC(FormDC);
    SelectObject(BkgndDC, BkgndBmp);
    SelectObject(BkgndDC, Brush2);
    PatBlt(BkgndDC, 0, 0, 280, 240, PATCOPY);
    SelectObject(BkgndDC, Font1);
    TempBrush := CreateSolidBrush($00FF0000);
    SelectObject(BkgndDC, TempBrush);
    Ellipse(BkgndDC, 10, 30, 270, 210);
    DeleteObject(TempBrush);
    SetBkMode(BkgndDC, TRANSPARENT);
    TextOut(BkgndDC, 17, 70, 'Page Flip', 9);
    FlipBmp := CreateCompatibleBitmap(FormDC, 280, 240);
    FlipDC := CreateCompatibleDC(FormDC);
    SelectObject(FlipDC, FlipBmp);
    BitBlt(FlipDC, 0, 0, 280, 240, BkgndDC, 0, 0, SrcCopy);
    SelectObject(FlipDC, Brush3);
    SelectObject(FlipDC, GetStockObject(NULL_PEN));
    SetROP2(FlipDC, R2_MASKPEN);
    QueryPerformanceCounter(PerCount1);
    SetBkMode(FormDC, OPAQUE);
    TextOut(FormDC, 35, 5, PChar(Int2Str(PerCount1 - PerCount0)),
      Length(Int2Str(((PerCount1 - PerCount0) * 1000) div PerFreq)));
    Interval := 24;
    Accur := Interval div 2;
    if Accur < TimeCaps1.wPeriodMin then
      Accur := TimeCaps1.wPeriodMin;
    if Accur > TimeCaps1.wPeriodMax then
      Accur := TimeCaps1.wPeriodMax;
    if SendMessage(hThreadCB, BM_GETSTATE, 0, 0) = BST_CHECKED then
    begin
      Interval := 34;
      thdTiming := True;
      DoThreadTimer(Interval, 1);
    end
    else if TimeCaps1.wPeriodMin <> 0 then
      TimerID1 := TimeSetEvent(Interval, Accur, @MMTimerProc, 2, TIME_PERIODIC);
    TextOut(FormDC, 430, 70, PChar('Flip的时间间隔为 ' + Int2Str(Interval)),
      17 + Length(Int2Str(Interval)));
    SetBkMode(FormDC, TRANSPARENT);
  end;
end;

function MessageProc(hWnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM):
  UINT; stdcall;
var
  PaintS: TPaintStruct;
begin
  case Msg of
    WM_PAINT:
      begin
        BeginPaint(hWnd, PaintS);
        DrawEdge(PaintS.hDC, ScrolRect1, EDGE_SUNKEN, BF_RECT);
        {滚动文本框需要一个凹陷的边缘，这样看起来像是 Windows 控件。}
        DrawEdge(PaintS.hDC, ScrolRect2, EDGE_SUNKEN, BF_RECT);
        TextOut(PaintS.hDC, 6, 202, PChar('PerFreq=' + Int2Str(PerFreq)),
          8 + Length(Int2Str(PerFreq)));
        if not Scrolling then
        begin
          SelectObject(PaintS.hDC, Brush2);
          SetBkMode(PaintS.hDC, TRANSPARENT);
          PatBlt(PaintS.hDC, ScrolRect1.Left + 2, ScrolRect1.Top + 2, 196, 26,
            PATCOPY);
          PatBlt(PaintS.hDC, ScrolRect2.Left + 2, ScrolRect2.Top + 2, 196, 26,
            PATCOPY);
          TextOut(PaintS.hDC, ScrolRect1.Left + 4, ScrolRect1.Top + 6, TextStr1, 25);
          TextOut(PaintS.hDC, ScrolRect2.Left + 4, ScrolRect2.Top + 6, TextStr2,
            25);
        end;
        if Moving then
        begin
          SelectObject(PaintS.hDC, Brush1);
          PatBlt(PaintS.hDC, 100, 10, 320, 250, PATCOPY);
        end;
        EndPaint(hWnd, PaintS);
      end;
    WM_COMMAND: if lParam = abs(hExitBut) then
        PostMessage(hForm1, WM_CLOSE, 0, 0)
      else if lParam = abs(hScrollBut) then
        ScrollText
      else if lParam = abs(hSpriteBut) then
        Animate
      else if lParam = abs(hPFlipBut) then
        PageFlip;
    WM_DESTROY: ShutDown;
  end;
  Result := DefWindowProc(hWnd, Msg, wParam, lParam);
end;

begin // 主程序开始 //
  DrawTimes := 0;
  Scrolling := False;
  GetPer := False;
  GetPer1 := False;
  Moving := False;
  Fliping := False;
  GoRight := True;
  GoDown := True;
  thdTiming := False;
  BallPoint.x := 150;
  BallPoint.y := 100;
  Posit1 := 1;
  Posit2 := 1;
  TimerID1 := 0;
  TimerR.ID := 0;
  hThread := 0;
  SetRect(ScrolRect1, 40, 276, 240, 306);
  SetRect(ScrolRect2, 40, 316, 240, 346);
  {ScrolRect1 和 ScrolRect2 用于绘制文本滚动框}
  Brush1 := MakeBrush($003366FF, $00FFFFFF);
  Brush2 := MakeBrush($00EEF0FF, $0033E0EF);
  Brush3 := MakeBrush3;
  Pen1 := CreatePen(PS_SOLID, 4, $00990099);
  with FontLog1 do
  begin
    lfHeight := -60;
    lfWidth := 0;
    lfItalic := 0;
    lfWeight := FW_NORMAL;
    lfCharSet := ANSI_CHARSET;
    lfOutPrecision := OUT_TT_PRECIS;
    lfClipPrecision := CLIP_DEFAULT_PRECIS;
    lfQuality := ANTIALIASED_QUALITY;
    lfPitchAndFamily := VARIABLE_PITCH or FF_SWISS;
    lfFaceName := 'Comic Sans MS';
  end;
  Font1 := CreateFontIndirect(FontLog1);

  wClass.hInstance := hInstance;
  with wClass do
  begin
    Style := CS_BYTEALIGNCLIENT or CS_OWNDC;
    {由于设置为 CS_OWNDC 风格，这将使得 Form1 窗口拥有一个私有的设备场景 hDC 。
    使用这个风格是因为动画使用快速绘制，这样每次动画精灵喷绘是不需要反复使用
    GetDC 和 ReleaseDC 。}
    hIcon := LoadIcon(hInstance, 'MAINICON');
    lpfnWndProc := @MessageProc;
    hbrBackground := COLOR_BTNFACE + 1;
    lpszClassName := 'Form Class';
    hCursor := LoadCursor(0, IDC_ARROW);
  end;
  RegisterClass(wClass);

  SetRect(Rect1, 0, 0, 574, 394);
  if not AdjustWindowRect(Rect1, WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU,
    False) then
    SetRect(Rect1, 0, 0, 580, 420);

  hForm1 := CreateWindow(wClass.lpszClassName, ' 更多计时器',
    WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU,
    (GetSystemMetrics(SM_CXSCREEN) div 2) - 276,
    (GetSystemMetrics(SM_CYSCREEN) div 2) - 222,
    Rect1.Right - Rect1.Left, Rect1.Bottom - Rect1.Top, 0, 0, hInstance, nil);

  FormDC := GetDC(hForm1);
  {默认的 hDC 字体将被用于绘制文本滚动框}
  GetTextExtentPoint32(FormDC, TextStr1, 25, Size1);
  {由于窗口类使用 CS_OWNDC 风格，使用 ReleaseDC(hForm1, FormDC); 无效}

  hExitBut := CreateWindow('Button', '退出',
    WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
    484, 360, 74, 24, hForm1, 0, hInstance, nil);

  hScrollBut := CreateWindow('Button', '开始滚动',
    WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
    20, 360, 78, 24, hForm1, 0, hInstance, nil);
  SendMessage(hScrollBut, WM_SETFONT, GetStockObject(ANSI_VAR_FONT), 0);

  hSpriteBut := CreateWindow('Button', '开始移动',
    WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
    310, 290, 78, 24, hForm1, 0, hInstance, nil);
  SendMessage(hSpriteBut, WM_SETFONT, GetStockObject(ANSI_VAR_FONT), 0);

  hPFlipBut := CreateWindow('Button', 'PageFlip 移动',
    WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
    420, 290, 86, 24, hForm1, 0, hInstance, nil);
  SendMessage(hPFlipBut, WM_SETFONT, GetStockObject(ANSI_VAR_FONT), 0);

  hThreadCB := CreateWindow('Button','多线程计时器',
    WS_CHILD or BS_AUTOCHECKBOX or WS_VISIBLE,
    350, 320, 150, 24, hForm1, 0, hInstance, nil);
  SendMessage(hThreadCB, WM_SETFONT, GetStockObject(ANSI_VAR_FONT), 0);

  if TimeGetDevCaps(@TimeCaps1, sizeof(TimeCaps1)) = TIMERR_NOERROR then
    TimeBeginPeriod(TimeCaps1.wPeriodMin)
  else
    TimeCaps1.wPeriodMin := 0;
  {上面两行的 TimeGetDevCaps 和 TimeBeginPeriod 都是必须的，用于设置多媒体计时
  器，这比使用 SetTimer 绘制移动动画精灵效果更好。}
  if not QueryPerformanceFrequency(PerFreq) then
    PerFreq := 0;
  {QueryPerformanceFrequency 获得每秒高性能计数器统计的数目，它可以每秒超过百万次。}
  GetWindowRect(hForm1, Rect1);
  MaskDC := GetDC(0);
  {本程序直接在桌面上绘制闪屏，最好不直接在桌面上绘制，这里是为了演示你可以在桌面
  上绘制，但是你应该创建一个闪屏窗体来绘制。}
  SelectObject(MaskDC, Font1);
  SetTextColor(MaskDC, $003366FF);
  SetBkColor(MaskDC, $00DDEE33);
  SetTextCharacterExtra(MaskDC, 8);
  SetTextAlign(MaskDC, TA_UPDATECP);
  MoveToEx(MaskDC, Rect1.Left + 106, Rect1.Top + 108, nil);
  SelectObject(MaskDC, Pen1);
  SelectObject(MaskDC, GetStockObject(NULL_BRUSH));
  Rectangle(MaskDC, Rect1.Left +78, Rect1.Top +28, Rect1.Left +383, Rect1.Top +283);
  SelectObject(MaskDC, Brush1);
  {两个计时器开始工作，第二个将逐步绘制文本作为闪屏，第一个将结束闪屏并显示主窗体。}
  SetTimer(hForm1, 2, 330, @TimerProc);
  SetTimer(hForm1, 1, 4500, @TimerProc);

  while GetMessage(mainMsg, 0, 0, 0) do
  begin
    TranslateMessage(mainMsg);
    DispatchMessage(mainMsg);
  end;
end.