Цветной Progress Bar
Речь пойдет об индикаторе процесса выполнения (Progress Bar'е) нестандартного цвета.
Казалось бы, ничего сложного в этом нет. Просто берем и меняем свойство Color у компонента. Но у компонента нет такого свойства. Вот тут-то и начинается тот самый ступор, в который часто впадают новички в Delphi.
Дело в том, что компонент TProgressBar является, по сути, просто оберткой стандартного системного компонента. Мало того, если внимательно вглядеться в текст компонента TProgressBar, который находится в модуле ComCtrls.pas, то станет понятно, что цвет индикатора вообще нигде не задается. Почему? Да очень просто - по стандартам Microsoft любой индикатор степени выполнения должен иметь цвет, описанный в системе и никакой другой.
Но отчаиваться рано. Раз мы ничего не нашли в исходном тексте компонента, а искать в исходных текстах следует сразу после обращения к помощи Delphi, то наша дорога должна лежать напрямую к сайту MSDN Library, на котором представлена исчерпывающая информация о любом аспекте любой версии Windows. На сайте MSDN Library мы нашли сообщение PBM_SETBARCOLOR, чье переведенное описание я приведу в конце.
Теперь, когда мы знаем, что нам для установки цвета индикатора надо послать одно сообщение, давайте попробуем его послать. Хм... Если положить компонент индикатора на форму и посылать ему сообщение, то цвет, либо не меняется, либо держится только до следующей перерисовки окна. Нет, такой хоккей нам не нужен.
Решается данная проблема просто - к компоненту TProgressBar надо добавить свойство Color и перекрыть метод, отвечающий за рисование окна. Создаем новый компонент на основе старого и смотрим в текст модуля ComCtrls.pas в поисках названия метода, который надо перекрывать. Опять задержка. Метод Paint отсутствует. Еще более внимательное изучение компонента-родителя даст нам ощущение того, что у TProgressBar вообще нет окна, хоть он и является прямым потомком класса TWinControl.
На самом деле это не так. Окно у индикатора есть, только оно создается, рисуется и сразу же уничтожается. Видимо, для экономии системных ресурсов.
Ввиду всего вышесказанного, получается, что нам надо перекрыть метод, отвечающий за создание окна компонента. Такой метод имеет стандартное имя и называется CreateWnd. Вообще, этот метод часто перекрывают, но это тема для отдельного разговора.
Итак, создав свойство Color типа TColor у нашего наследника перекрываем его метод CreateWnd следующим образом:
procedure TgsProgressBar.CreateWnd; begin inherited; if HandleAllocated then SendMessage(Handle, PBM_SETBARCOLOR, 0, FColor); end;Собственно, почти все. Единственное место, которое требует доработки - во время присвоения нового цвета, индикатор не перерисовывается. Для этого, аналогичный код надо в писать в метод, обрабатывающий установку свойства Color (обычно, SetColor).
В общем, ничего сложного. Как я уже сказал в названии статьи хитрости действительно маленькие.
Удачи!
Сообщение PBM_SETBARCOLOR
Устанавливает цвет индикатора степени выполнения в соответствующем элементе управления.
Синтаксис
Для использования вызовите функцию SendMessage нижеследующим образом.
lResult = SendMessage( // returns LRESULT in lResult (HWND) hWndControl, // handle to destination control (UINT) PBM_SETBARCOLOR, // message ID (WPARAM) wParam, // = 0; not used, must be zero (LPARAM) lParam // = (LPARAM) (COLORREF) clrBar; );Параметры
wParam
Должен быть нулем
clrBar
Ссылка COLORREF на новый цвет индикатора. Для задания стандартного системного значения используйте CLR_DEFAULT.
Возвращаемое значение
Возвращает предыдущий цвет индикатора или CLR_DEFAULT, если индикатор был нарисован цветом по-умолчанию.
Информация о сообщении
Минимальные версии DLL: comctl32.dll version 4.71 или более поздняя
Заголовочный файл: commctrl.h
Минимальная ОС: Windows 2000, Windows NT 4.0 с установленным Internet Explorer 4.0, Windows 98, Windows 95 с установленным Internet Explorer 4.0
Текст модуля gsProgressBar
//**! ---------------------------------------------------------- //**! This unit is a part of GSPackage project (Gregory Sitnin's //**! Delphi Components Package). //**! ---------------------------------------------------------- //**! You may use or redistribute this unit for your purposes //**! while unit's code and this copyright notice is unchanged //**! and exists. //**! ---------------------------------------------------------- //**! (c) Gregory Sitnin, 2001-2002. All rights reserved. //**! ---------------------------------------------------------- unit gsProgressBar; {***} interface {***} uses Windows, Messages, Classes, Graphics, ComCtrls; type TgsProgressBar = class(TProgressBar) private { Private declarations } FColor: TColor; procedure SetColor(const Value: TColor); protected { Protected declarations } public { Public declarations } procedure CreateWnd; override; published { Published declarations } property Color: TColor read FColor write SetColor; end; procedure Register; {***} implementation {***} procedure Register; begin RegisterComponents('GSPackage', [TgsProgressBar]); end; { TgsProgressBar } procedure TgsProgressBar.CreateWnd; begin inherited; if HandleAllocated then SendMessage(Handle, PBM_SETBARCOLOR, 0, FColor); end; procedure TgsProgressBar.SetColor(const Value: TColor); begin FColor := Value; if HandleAllocated then SendMessage(Handle, PBM_SETBARCOLOR, 0, FColor); end; end.Вот и всё, Удачи!