如何在状态栏中加入进度条?(100分)

  • 主题发起人 主题发起人 eastweast
  • 开始时间 开始时间
E

eastweast

Unregistered / Unconfirmed
GUEST, unregistred user!
如何在状态栏中加入进度条?有没有好用的控件!
如果不用空间的话怎末实现,有没有资料介绍?
 
用progressbar
 
1stClass里面有fcStatusBar
 
1st Class 2000 等套件都有这样功能的控件!
 
干嘛是可以干的,方法就和你往上面放图片一样DRAW,就是刷新恐怖了点,抖得厉害:)
 
  首先,在FROM中放置一个状态条控件Status。调节Status.Panels,在其中插入3个状态条嵌板。把第二个嵌板的参数Style设置成psOwnerDraw。这一点很重要,如果没有这样做,将永远无法显示文字以外的东西。然后在状态条的OnDrawPanel事件中插入一行StatusDrawRect:=rect;以记录参数Style设置成psOwnerDraw的嵌板的坐标。
  第二步,在FROM的Private中申明一个TProgressBar类型的变量Progress。然后在一个菜单的消息响应过程中调用Create方法把它建立起来,再设定状态条为该进程条的父窗口,进而设定进程条的一些必要参数。例如:最大值、最小值、原点坐标、高度和宽度等。

  最后编译一下该程序,你就会发现在状态条中被插入了一个运动着的进程条。
  类似地,你还可以在状态条中插入其他可视控件,如:按键、位图和动画控件等等。
以下是范例程序:
type
TForm1 = class(TForm)//定义一个窗口类
Status: TStatusBar;
MainMenu1: TMainMenu;
file1: TMenuItem;
insertprocressbar1: TMenuItem;
N1: TMenuItem;
exit1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure StatusDrawPanel(StatusBar: TStatusBar; Panel:
TStatusPanel;const Rect: TRect);
procedure FormDestroy(Sender: TObject);
procedure exit1Click(Sender: TObject);

procedure insertprocressbar1Click(Sender: TObject);
private
colorindex : integer; BookOpen:Boolean;
ssbmp:Tbitmap; progress:TProgressbar;
StatusDrawRect:TRect; //记录要插入状态条特技的坐标范围
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
end;

procedure TForm1.StatusDrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
StatusDrawRect:=rect; //记录要实现状态条特技的坐标范围
end;

procedure TForm1.exit1Click(Sender: TObject);
begin
close;
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; //begin

end.
 
(1)分别将TStatusBar、TProgressBar、TTimer构件件放置到窗体上。
(2)使用对象观察器分别将设置它们的Name特性为StatusBar1、ProgressBar1、Timer1。
(3)为StatusBar1创建三个TStatusPanel对象。
(4)设置第2个TStatusPanel对象的Style := psOwnerDraw。
(5)设置ProgressBar1的Max、Min、Position属性分别为100、0、0。

处理事件
(1)当窗体创建时,确定进度条的初始位置,因此在FormCreate中增加以下代码:
procedure TForm1.Form1Create(Sender: TObject);
begin
StatusBar1.Panels.Items[1].Width:=Progressbar1.Width ;
StatusBar1.Panels.Items[0].Width:=(ClientWidth- StatusBar1.Panels.Items[1].Width)-10 ;
ProgressBar1.Parent:=StatusBar1 ;
end;
(2)在StatusBar1的OnDrawPanel事件中增加以下的代码:
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect);
begin
ProgressBar1.BoundsRect := Rect ;
end;
(3)处理FormResize事件:
procedure TForm1.FormResize(Sender: TObject);
begin //当Form的大小发生变化的时候,改变状态条的宽度
StatusBar1.Panels.Items[0].Width := (ClientWidth - StatusBar1.Panels.Items[1].Width) - 10 ;
end;
(4)处理Timer1的OnTimer事件(在状态条构件中动态演示进度条的变化)
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ProgressBar1.Position := ProgressBar1.Position +1;
if ProgressBar1.Position >= 100 then
ProgressBar1.Position := 0;
end;
 
动态创建进度条.把它的parent设为状态栏!
 
源码一个:
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(y),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.
 
自己生成一个控件
TYourStatusbar=class(TStatusbar)
...

在其create中加入某个参数
csAccept...//具体我记不太清了
 
自己生成一个控件
TYourStatusbar=class(TStatusbar)
...

在其create中加入某个参数
controlstyle=controlstyl+[csaccept]
 
dfs控件包中的状态条倒是比较好用,而且这个控件包比1stcalss这些小多了。
 
好象是controlstyle=controlstyl+[CsAcceptsControls]
 
没有必要那么麻烦,同意jack1。

var
ProgressBar :TProgressBar;
begin
ProgressBar :=TProgressBar.Create(StatusBar1);
ProgressBar.Parent :=StatusBar1;
ProgressBar.Height :=StatusBar1.Height;
ProgressBar.Width :=StatusBar1.Panels[0].Width;
ProgressBar.Visible :=True;
end;
 
天真兄,你也真能copy!
别生气,开玩笑
 
卷起千堆雪tyn的方法很方便,我已经试验过了。
 
to bigroom:
你已经试过了吗?没有发现什么问题吗?
 
JQW兄:真巧,又碰到一块儿!:)
 
是啊,我试过了,能用啊
 
同意卷起千堆雪tyn
 
后退
顶部