随笔 - 2146  文章 - 97 评论 - 11767 trackbacks - 253


DelphiX 提供了高性能的计时器 TDXTimer, 使用方法和 Timer 基本一样.

我们在使用 Timer 时, 很少把 Interval 设为 50 以下(这应该是它精确度的极限);
使用 TDXTimer 可以把 Interval 置为 0, 表示尽可能地快!

本例效果图:



代码文件:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DXClass, DXDraws, ComCtrls;

type
  TForm1 = class(TForm)
    DXDraw1: TDXDraw;
    DXTimer1: TDXTimer;
    TrackBar1: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
    procedure TrackBar1Change(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DXDraw1.Align := alClient;
  TrackBar1.Align := alBottom;
  TrackBar1.Height := 23;
  TrackBar1.ShowSelRange := False;
  TrackBar1.Min := 0;
  TrackBar1.Max := 500;
  TrackBar1.Position := TrackBar1.Max div 2;

  DXTimer1.Interval := TrackBar1.Position;
  Randomize;
end;

procedure TForm1.DXTimer1Timer(Sender: TObject; LagCount: Integer);
var
  x1,y1,x2,y2: Integer;
begin
  {随机位置}
  x1 := Random(DXDraw1.Width);
  y1 := Random(DXDraw1.Height);
  x2 := Random(DXDraw1.Width);
  y2 := Random(DXDraw1.Height);

  DXDraw1.Surface.Fill(0);
  with DXDraw1.Surface.Canvas do begin
    Brush.Color := Random($FFFFFF); {随机颜色}
    Ellipse(x1, y1, x2, y2);
    Release;
  end;
  DXDraw1.Flip;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  DXTimer1.Interval := TrackBar1.Position;
end;

end.


窗体文件:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 206
  ClientWidth = 339
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object DXDraw1: TDXDraw
    Left = 24
    Top = 24
    Width = 100
    Height = 100
    AutoInitialize = True
    AutoSize = True
    Color = clBlack
    Display.FixedBitCount = False
    Display.FixedRatio = True
    Display.FixedSize = True
    Options = [doAllowReboot, doWaitVBlank, doCenter, do3D, doDirectX7Mode, doHardware, doSelectDriver]
    SurfaceHeight = 100
    SurfaceWidth = 100
    TabOrder = 0
    Traces = <>
  end
  object TrackBar1: TTrackBar
    Left = 96
    Top = 144
    Width = 150
    Height = 28
    TabOrder = 1
    OnChange = TrackBar1Change
  end
  object DXTimer1: TDXTimer
    ActiveOnly = True
    Enabled = True
    Interval = 1000
    OnTimer = DXTimer1Timer
    Left = 144
    Top = 24
  end
end

posted on 2009-01-12 17:15  万一  阅读(...)  评论(...编辑  收藏