源码一个:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
status: TStatusBar;
insertprocressbar1: TButton;
procedure FormPaint(Sender: TObject);
procedure statusDrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
procedure insertprocressbar1Click(Sender: TObject);
private
{ Private declarations }
procedure wmnchittest(var msg:twmnchittest);
message wm_nchittest;
public
{ Public declarations }
colorindex : integer; BookOpen:Boolean;
ssbmp:Tbitmap; progress:TProgressbar;
StatusDrawRect:TRect; //记录要插入状态条特技的坐标范围
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormPaint(Sender: TObject);
var i:word;
dy,y:real;
begin
dy:=clientheight/256;
y:=0;
for i:=255 downto 0 do
begin
canvas.brush.color:=$00000000+i*$10000;
canvas.fillrect(rect(0,round
,clientwidth,round(y+dy)));
y:=y+dy;
end;
end;
procedure TForm1.wmnchittest(var msg:twmnchittest);
begin
inherited;
if (htclient=msg.result) then msg.result:=htcaption;
end;
procedure TForm1.statusDrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
StatusDrawRect:=rect; //记录要实现状态条特技的坐标范围
end;
procedure TForm1.insertprocressbar1Click(Sender: TObject);
var i,count:integer;
staPanleWidth:integer;
begin
progress:=TProgressbar.create(form1);
count:=3000; //进程条的最大值
staPanleWidth:=status.Panels.Items[2].width;
//由于进程条的很宽,所以需要改变状态条嵌板的宽度,这里先保存它的宽度。
status.Panels.Items[2].width:=150; // 改变宽度
status.repaint;
with progress do
begin
top:=StatusDrawRect.top;
left:=StatusDrawRect.left;
width:=StatusDrawRect.right-StatusDrawRect.left;
height:=StatusDrawRect.bottom-StatusDrawRect.top;
//设定进程条的宽度和高度
visible:=true;
try
Parent := status; //该进程条的拥有者为状态条status
Min := 0; Max := Count; //进程条的最大和最小值
Step := 1; //进程条的步长
for i := 1 to Count do
Stepit; // 累加进程条
ShowMessage('现在,进程条将要从内存中被释放');
finally
Free; //释放进程条
end; //try
end; //with
status.Panels.Items[2].width:=staPanleWidth; //恢复状态条嵌板的宽度
end;
end.