Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.11.28;
Скачать: [xml.tar.bz2];

Вниз

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

 
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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.45 MB
Время: 0.031 c
1-1100277025
heady
2004-11-12 19:30
2004.11.28
строка с разделителями


4-1097839781
UVV
2004-10-15 15:29
2004.11.28
Com порт, срочно помогите, pls, вторую неделю бьёмся ...


3-1098630775
Настенька!!!
2004-10-24 19:12
2004.11.28
многострочность dbgrid (не в заголовках)


3-1098790713
Галинка
2004-10-26 15:38
2004.11.28
Как сохранить в БД цвет...


1-1100350228
redlord
2004-11-13 15:50
2004.11.28
как узнать сколько занял файл на диске





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский