u00202.pas

Delphi编程五大妙招源程序

unit U00202;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    StatusBar1: TStatusBar;
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
  private
    { Private declarations }
    procedure wmnchittest(var msg:twmnchittest);message wm_nchittest;
  public
    { Public declarations }
    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.Button1Click(Sender: TObject);
Var
   ssbmp:Tbitmap;
   progress:TProgressbar;
   I, count:integer;
   staPanleWidth:integer;
begin
  progress:=TProgressbar.create(form1);
  count:=9000; //进程条的最大值
  staPanleWidth:=StatusBar1.Panels.Items[1].width; //由于进程条的很宽，所以需要改变状态条嵌板的宽度，这里先保存它的宽度。
  StatusBar1.Panels.Items[1].width:=300; // 改变宽度
  StatusBar1.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 := StatusBar1; //该进程条的拥有者为状态条status
      Max := Count; //进程条的最大和最小值
      Min := 0;
      Step := 1; //进程条的步长
      for i := 1 to Count do Stepit; // 累加进程条
      ShowMessage('现在，进程条将要从内存中被释放');
    finally
      Free; //释放进程条
    end; //try
  end; //with
  StatusBar1.Panels.Items[1].width:=staPanleWidth; //恢复状态条嵌板的宽度
end;

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

end.