实例147 制作渐变填充的进度条

进度条经常用于表示程序运行的进度，本实例演示如何制作一个颜色渐变填充的进度条。

向窗体上添加一个TTimer组件和一个TProgressBar组件。TTimer组件用来改变进度条中的进度数值，并且控制进度条的颜色。添加组件后的窗体如图8-42所示。

图8-42 添加组件后的窗体

为了达到动态控制进度条的效果，在程序运行过程中自动通过TTimer组件来设置进度条的进度数值，为此需要先设置TTimer组件的Interval属性值为100，Enabled属性值为True，然后添加TTimer组件的响应代码如下：

procedure TForm1.Timer1Timer(Sender: TObject);

var

color:Integer;

begin

if self.ProgressBar1.Position<100 then

self.ProgressBar1.Position:=self.ProgressBar1.Position+1

else

self.ProgressBar1.Position:=0;

color:=Trunc(self.ProgressBar1.Position*$FF/100);

SendMessage(ProgressBar1.Handle,PBM_SETBARCOLOR,0,TColor(color));

end;

在TTimer的Enabled属性为True的前提下，程序每隔100毫秒就会改变进度条中的进度数值。如果进度数值小于100，那么就把进度数值加1，反之就设置进度数值为0。然后程序就根据进度数值来确定进度条的颜色，使得进度条的颜色在黑色和红色之间均匀变化。最后通过SendMessage函数发送一个改变进度条颜色的消息来设置进度条的颜色。

程序代码如下：

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, ComCtrls, COMMCtrl;

type

TForm1 = class(TForm)

ProgressBar1: TProgressBar;

Timer1: TTimer;

procedure Timer1Timer(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

var

color:Integer;

begin

if self.ProgressBar1.Position<100 then

self.ProgressBar1.Position:=self.ProgressBar1.Position+1

else

self.ProgressBar1.Position:=0;

color:=Trunc(self.ProgressBar1.Position*$FF/100);

SendMessage(ProgressBar1.Handle,PBM_SETBARCOLOR,0,TColor(color));

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

progressbar1.Min:=0;

progressbar1.Max:=100;

end;

end.

保存文件，然后按F9键运行程序，程序运行结果如图8-43所示。

图8-43 程序运行结果