Как вставить ProgressBar в StatusBar (3)

Delphi , Компоненты и Классы , TProgressBar

Как вставить ProgressBar в StatusBar (3)

Способ 1

Корректнее было бы самому канву рисовать, но можно и просто вставить - держи функцию для этого - применять вместо метода Create.

Code:

Function  CreateProgressBar(StatusBar:TStatusBar; index:integer):TProgressBar;

            var findleft:integer;

                  i:integer;

begin

            result:=TProgressBar.create(Statusbar);

            result.parent:=Statusbar;

            result.visible:=true;

            result.top:=2;

            findleft:=0;

            for i:=0  to index-1  do  findleft:=findleft+Statusbar.Panels[i].width+1;

            result.left:=findleft;

            result.width:=Statusbar.Panels[index].width-4;

            result.height:=Statusbar.height-2;

            end;

Автор: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)

Взято с Vingrad.ru http://forum.vingrad.ru

Есть ещё два принципиально разных решения. Первый вариант - это сделать все " вручную" .

Здесь создается Bitmap с текстом (возможно любое изображение). Чтобы нарисовать светлую часть полосы, достаточно скопировать кусок Bitmap на StatusBar, а чтобы нарисовать темную часть полосы, нужно скопировать кусок Bitmap с инвертированием. При этом фон станет темным, а текст светлым. Реализация ясна из самой программы.

Второй вариант более простой в реализации, но и менее функциональный. StatusBar является наследником TWinControl, а следовательно, на нем можно разместить еще какие-то компоненты. Но сделать это можно только динамически (непосредственно из программы). На StatusBar помещается компонент ProgressBar, вначале невидимый. Когда в нем появляется необходимость, его нужно сделать видимым и начать изменять свойство Position.

Из этого примера хорошо видны некоторые достоинства и недостатки объектов.

Если у Вас Delphi3, то строчка pb.Smooth := true; работать не будет. На сайте выложена версия программы с заменой этой строчки. Впрочем, ее можно просто удалить - принципиально это ничего не изменит. Скачать все необходимые для компиляции файлы проекта можно на program.dax.ru.

Способ 2

Code:

uses Commctrl;

            const

            MaxProgress = 50;

            var

            bm:  TBitmap;

            //  Возвращает прямоугольник нулевой панели:

            function GetPanelRect: TRect;

            begin

            SendMessage(Form1.StatusBar1.Handle, SB_GETRECT,  0,

               integer(@result));

            InflateRect(result, -1, -1);

            end;

             

            //  Копирует часть bm на StatusBar

            procedure CopyPart(left, right: integer;  ACopyMode: TCopyMode);

            var bmRect, pnRect: TRect;

            begin

            bmRect  := Rect(left, 0, right, bm.Height - 1);

            pnRect  := bmRect;

            with GetPanelRect do

               OffsetRect(pnRect, Left, Top);

            with Form1.StatusBar1.Canvas do begin

               CopyMode := ACopyMode;

               CopyRect(pnRect, bm.Canvas, bmRect);

            end;

            end;

             

            procedure TForm1.FormCreate(Sender:  TObject);

            begin

            with StatusBar1.Panels.Add do begin

              Width  := 100;

              Style  := psOwnerDraw;

            end;

            with StatusBar1.Panels.Add do begin

              Width  := 0;

              Text  := 'abc';

            end;

            Timer1.Enabled := false;

            Timer1.Interval := 50;

            end;

             

            procedure TForm1.Button1Click(Sender:  TObject);

            begin

            Timer1.Enabled := true;

            bm :=  TBitmap.Create;

            with GetPanelRect do begin

               bm.Width := Right - Left;

               bm.Height := Bottom - Top;

            end;

            with bm.Canvas do begin

               Brush.Color := clSilver;

               FillRect(Bounds(0, 0, bm.Width, bm.Height));

               TextOut(1, 1, 'Doing smth...');

            end;

            CopyPart(0, bm.Width - 1, cmSrcCopy); // Вывод текста

            end;

             

            procedure TForm1.Timer1Timer(Sender:  TObject);

            begin

            Timer1.Tag := Timer1.Tag + 1;

            if Timer1.Tag >  MaxProgress then begin

               Timer1.Enabled := false;

               Timer1.Tag := 0;

               StatusBar1.Repaint; //  Очистка StatusBar

            end else

             // Вывод только что  закрашенной части:

               CopyPart(trunc((Timer1.Tag - 1) / MaxProgress * bm.Width),

                 trunc(Timer1.Tag / MaxProgress * bm.Width), cmNotSrcCopy);

            end;

             

            procedure  TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;

            Panel:  TStatusPanel; const Rect: TRect);

            var p: integer;

            begin

            if (Panel.Index = 0) and (Timer1.Tag >  0) then begin

              p :=  round((Rect.Right - Rect.Left) * Timer1.Tag / MaxProgress);

             // Вывод закрашенной  части:

               CopyPart(0, p, cmNotSrcCopy);

             // Вывод незакрашенной  части:

               CopyPart(p + 1, bm.Width - 1, cmSrcCopy);

            end;

            end;

Способ 3

Code:

uses Commctrl;

            const

            MaxProgress = 50;

            var pb: TProgressBar;

             

            function GetPanelRect: TRect;

            begin

            SendMessage(Form1.StatusBar1.Handle, SB_GETRECT,  0, integer(@result));

            end;

             

            procedure TForm1.FormCreate(Sender:  TObject);

            begin

            with StatusBar1.Panels.Add do begin

              Width  := 100;

              Style  := psOwnerDraw;

            end;

            with StatusBar1.Panels.Add do begin

              Width  := 0;

              Text  := 'abc';

            end;

            Timer1.Enabled := false;

            Timer1.Interval := 50;

            pb :=  TProgressBar.Create(StatusBar1);

            pb.Visible := false;

            pb.Parent := StatusBar1;

            pb.BoundsRect := GetPanelRect;

            pb.Smooth := true;

            pb.Step  := 1;

            end;

             

            procedure TForm1.Button1Click(Sender:  TObject);

            begin

            Timer1.Enabled := true;

            pb.Position := 0;

            pb.Max  := MaxProgress;

            pb.Visible := true;

            end;

             

            procedure TForm1.Timer1Timer(Sender:  TObject);

            begin

            Timer1.Tag := Timer1.Tag + 1;

            if Timer1.Tag >  MaxProgress then begin

               Timer1.Enabled := false;

               Timer1.Tag := 0;

               pb.Visible := false;

            end else pb.StepIt;

            end;

Даниил Карапетян.

На сайте http://delphi4all.narod.ru

Вы пытаетесь вставить TProgressBar в панель состояния вашего приложения Delphi.

Вот три различных способа достижения этого:

Метод 1: Создание TProgressBar на лету

Этот метод заключается в создании экземпляра TProgressBar и установке его свойств вручную. Код предоставлен в вопросе, но я суммирую его здесь:

function CreateProgressBar(StatusBar: TStatusBar; index: integer): TProgressBar;
begin
  Result := TProgressBar.Create(StatusBar);
  Result.Parent := StatusBar;
  Result.Visible := True;
   // Установка других свойств...
end;

Этот метод может быть полезен, если вам нужно еще больше настроить экземпляр TProgressBar.

Метод 2: Использование TBitmap и рисование на нем

Этот метод заключается в создании экземпляра TBitmap, рисовании на нем и затем копировании битов на панель состояния. Код предоставлен в вопросе:

uses Commctrl;

// ... 
procedure CopyPart(left, right: integer; ACopyMode: TCopyMode);
begin
   // ... 
end;

Этот метод может быть полезен, если вам нужно нарисовать custom-прогресс-индикатор.

Метод 3: Использование TProgressBar и установка его свойств

Этот метод заключается в создании экземпляра TProgressBar на лету и установке его свойств. Код предоставлен в вопросе:

uses Commctrl;

// ... 
procedure TForm1.FormCreate(Sender: TObject);
begin
  pb := TProgressBar.Create(StatusBar1);
  pb.Visible := False;
   // Установка других свойств...
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled := True;
  pb.Position := 0;
  pb.Max := MaxProgress;
  pb.Visible := True;
end;

// ...

Этот метод, вероятно, является самым простым и удобным в использовании.

Все три метода могут быть использованы для вставки TProgressBar в панель состояния, но Метод 3 (использование экземпляра TProgressBar) probably является наиболее Convenient.

В статье описаны три способа вставки ProgressBar в StatusBar в Delphi: первый - создание ProgressBar наStatusBar, второй - использование компонента ProgressBar и его изменение вручную, третий - добавление ProgressBar на панель StatusBar.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.

:: Главная :: TProgressBar ::

Время компиляции файла: 2024-08-19 13:29:56
2024-10-12 15:09:23/0.0042400360107422/0