Полезное для программистов:

Фриланс
Новости
Статьи
   
Рубрики:

Error. Page cannot be displayed. Please contact your service provider for more details. (32)


Как поместить ProgressBar в панель StatusBar?

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

Код

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
Взято с Vingrad.ru http://forum.vingrad.ru


--------------------------------------------------------------------------------

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

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

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

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

Способ 1

Код

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;


Способ 2

Код

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;


Все советы и замечания, пожалуйста, присылайте на subscribe@program.dax.ru
Даниил Карапетян.


Автор: StayAtHome
Взято из http://forum.vingrad.ru
Автор: DRKB
Сайт: http://www.delphist.com






Просмотров: 3064

 

 

Новые статьи:


Популярные:
  1. Как сделать цикличным проигрывание MIDI-файла?
  2. Создание AVI файла из рисунков
  3. Как устройство "отключить в данной конфигурации"?
  4. Kто в данный момент присоединен через Сеть?
  5. Как узнать количество доступной памяти?
  6. Как реализовать в RichEdit разноцветный текст?
  7. Как скрыть свое приложение от ProcessViewer
  8. Как программно нажать/скрыть/показ кнопку "Start"?
  9. Модуль работы с ресурсами в PE файлах
10. Функции вызова диалоговых окон выбора
11. Проверка граматики средствами Word'а из Delphi.
12. Модуль для упрощенного вызова сообщений
13. Функции для записи и чтение своих данных в, ЕХЕ- файле
14. Рекурсивный просмотр директорий
15. Network Traffic Monitor
16. Разные модули
17. Универсальная функция для обращения к любым экспортируем функциям DLL
18. Библиотека от VladS
19. Протектор для UPX'а
20. Еще об ICQ, сообщения по контакт листу?
21. Использование открытых интерфейсов
22. Теория и практика использования RTTI
23. Работа с TApplication
24. Примеры использования Drag and Drop для различных визуальных компонентов
25. Что такое порт? Правила для работы с портами
26. Симфония на клавиатуре
27. Загрузка DLL
28. Исправление автоинкремента
29. Взаимодействие с чужими окнами
30. Проверить дубляжи в столбце


 

 

 
 
На главную