Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.11.28;
Скачать: CL | DM;

Вниз

Как вставить в одну из панелей статус бара прогрес бар?   Найти похожие ветки 

 
vov   (2004-11-12 09:30) [0]

Вопрос в теме.


 
stone ©   (2004-11-12 09:42) [1]

ProgressBar.Parent := StatusBar;
также указать Left, Top и другие необходимые параметры


 
GLFox   (2004-11-12 09:56) [2]

Можно глянуть здесь:
http://www.delphiplus.org/articles/components/statusbar/index.html


 
grom   (2004-11-12 20:31) [3]

unit Main;

interface

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

type
 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   Button3: TButton;
   StatusBar1: TStatusBar;
   Timer1: TTimer;
   procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
     Panel: TStatusPanel; const Rect: TRect);
   procedure Button1Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
  Percent: Integer;
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
 Panel: TStatusPanel; const Rect: TRect);
var s: String;
   TH: Integer;
   Rec: TRect;
   X: Integer;
   Y: Integer;
begin
 S := Format("%u%%",[Percent]);
 TH := (Rect.Right - Rect.Left) * Percent div 100;
 X := ((Rect.Right - Rect.Left) + StatusBar.Canvas.Font.Height * Length(s)) div 2;
 Y := ((Rect.Bottom - Rect.Top)-(StatusBar.Canvas.Font.size div 2))  div 2 ;

 StatusBar1.Canvas.Brush.Color := clWhite;
 Rec := Classes.Rect(Th,Rect.Top,Rect.Right,Rect.Bottom);
 StatusBar.Canvas.TextRect(Rec,x,y,s);
 {рисование не заполненной чести линейки}
 StatusBar.Canvas.Font.Color := StatusBar.Canvas.Brush.Color;
 StatusBar.Canvas.Brush.Color :=  clNavy;
 Rec := Classes.Rect(Rect.Left,Rect.Top,TH,Rect.Bottom);
 StatusBar.Canvas.TextRect(Rec,x,y,S);
 {рисование заполненной чести линейки}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled := True;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if Timer1.Enabled then
 Timer1.Enabled := not Timer1.Enabled;
Percent := 0;
StatusBar1.Invalidate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Percent = 100 then
 Percent := 0;
Percent := Percent + 1;
StatusBar1.Invalidate;
end;

end.



Страницы: 1 вся ветка

Текущий архив: 2004.11.28;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.038 c
14-1100415869
YurikGL
2004-11-14 10:04
2004.11.28
jpeg-троян


4-1097760226
Дядя
2004-10-14 17:23
2004.11.28
Срочно - надо заблокировать клаву и мышь, Но


11-1083500021
Delphi5.01
2004-05-02 16:13
2004.11.28
WrapText(Msg,SeparatorChar,[ ],155);


14-1100163573
AlexG
2004-11-11 11:59
2004.11.28
В чем рассширяемость XML?


14-1099877440
KilkennyCat
2004-11-08 04:30
2004.11.28
громадный орех в соседнем форуме.