unitform1.pas

一个设置状态栏方面的小程序

unit unitForm1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Status: TStatusBar;
    Button1: TButton;
    procedure StatusDrawPanel(StatusBar: TStatusBar; Panel:
      TStatusPanel; const Rect: TRect);
    procedure Button1Click(Sender: TObject);
  private
    progress: TProgressbar;
    StatusDrawRect: TRect; //记录要插入状态条特技的坐标范围
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

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


procedure TForm1.Button1Click(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.