Прогресс бар в статус баре

1. Введение

Редкая серьезная программа обходится без прогресс-бара - чрезвычайно полезного элемента управления. Его назначение - показать пользователю, что приложение работает, а не зависло.

В VB есть стандарный компонент ProgressBar. Применять его достаточно просто:

• подключить к проекту компонент "Microsoft Windows Common Controls" (существует несколько версий);
• дизайнером разместить прогресс-бар;
• установить свойства "Min" и "Max";
• в коде приложениия (в нужном месте) устанавливать свойство "Value" (оно должно находиться в интервале [Min,Max]. При этом в линейке прогесс-бара будет отрисовано нужное к-во "квадратиков".

Так в чем же проблема? А вот в чем: к сожалению, этот прогресс-бар невозможно поместить в контейнер (самым распространенным из которых является статус-бар - обычно это область, располагающаяся внизу окна). Есть, правда, один способ для решения этой проблемы:

• размещаем прогресс-бар на форме, установив его свойство "Align" в нуль (константа vbAlignNone). При этом прогресс-бар может иметь любые координаты;
• делаем прогресс-бар невидимым (Visible=False);
• размещаем на форме статус-бар с несколькими панелями. Решаем, в какой панели будем отображать прогресс-бар.
• когда прогресс-бар понадобится, вычисляем координаты нужной панели и устанавливаем у нашего прогесс-бара (пока невидимого) свойства "Left", "Top", "Width" и "Height" так, чтобы прогресс-бар "вписался" в нужную панель;
• делаем прогресс-бар видимым;
• пользуемся прогресс-баром как обычно;
• когда прогресс-бар больше не нужен - снова делаем его невидимым.

Способ, как видите, достаточно прост. К недосткам его можно отнести низкую эстетичность - панель для отображения прогресс-бара должна быть достаточно длинной, иначе "квадратики" будут выглядет не очень приглядно. Кроме того, цвет "квадратиков" нельзя менять (по крайней мере, я не знаю, как).

Как-то мне в руки попал известный пример "Прогресс-бар в системном трее". Я подумал: а неплохо было бы организовать прогресс-бар в статус баре в подобном же графическом стиле. Предлагаемая статья как раз об этом.

2. Основная идея

Мы сделаем прогресс-бар в выбираемой панели статус-бара, используя графические функции Windows. Эту же идею мы применим при конструировании прогресс-бара для использования в Excel.

Суть можно сформулировать очень просто: мы будем рисовать в нужной панельки статус-бара прямоугольник, ширина которого характеризует ход выполнения процесса. Одновременно в центре панельки будем показывать процент выполнения. Это будет выглядеть примерно так:

На мой взгляд, вид такого прогесс-бара симпатичнее стандартного (при условии, что цвета основных частей прогресс-бара может выбирать разработчик).

3. Приступаем к реализации

А, собственно, какие проблемы? Для рисования прямоугольника есть оператор Line, а для вывода текста - Print. Увы! Эти операторы применимы к форме или к PictureBox. У статус-бара таких методов нет... Что же делать? Можно, конечно, как было описано выше, разместить невидимый PictureBox на форме, а в нужный момент наложить его на выбранную панельку. Желающие могут это проделать, а мы пойдем другим путем: воспользуемся графическим интерфейсом Windows (GDI).

Следующее далее описание ни в коей мере не претендует на полноту; для желающих есть специальные (и очень объемные!) руководства. Автор пользовался "Библией API" Д.Эпплмана.

Базовым понятием графического интерфейса GDI является понятие контекста графического устройства. Контекст устройства можно сравнить с холстом художника - это то, на чем рисуют (наши коллеги-Дельфисты так его и называют "canvas" т.е. канва, холст). Все графические функции Windows требуют ссылки на какой-либо контекст. Как догадываются читатели, контекст - довольно сложная структура. Но нам не требуется проникновения в детали - достаточно получить ссылку на контекст. Visual Basic не позволят сделать это "в одно действие", нам придется сделать это самим.

Контекст можно получить для любого окна, при условии, что известен его хэндл (hwnd). Не у всех визуальных компонентов VB можно получить хэндл окна. К счастью, у статус-бара свойство hwnd обеспечено. Теперь, чтобы получить контекст устройства, достаточно вызвать функцию GetDC. Вот ее описание:

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

а вот ее вызов:

hdc& = GetDC(StatusBar.hwnd)

Здесь StatusBar - это статус-бар, расположенный на форме проекта; hwnd - хэндл его окна.

Идеология использования контекстов такова:

• получаем контекст;
• сохраняем его;
• рисуем в контексте все необходимое;
• восстаналиваем исходный контекст.

Для сохранения контекста служит вызов SaveDC:

iDc = SaveDC(hdc)

Значение переменной iDc (результат, возвращаемый функцией) не следует изменять - он понадобится при восстановлении контекста.

Функцию SaveDc нужно, разумеется, предварительно объявить:

Declare Function SaveDC Lib "gdi32" (ByVal hdc As Long) As Long[.CODE]

Для восстановления контекста служит функция RestoreDc. Обращение к ней выглядит так:

[CODE]i& = RestoreDC(hdc, iDc)[.CODE]

А вот объявление этой функции:

[CODE]Declare Function RestoreDC Lib "gdi32" (ByVal hdc As Long, _
                              ByVal nSavedDC As Long) As Long

Итак, "тасовать холсты" мы научились. Займемся рисованием.

Художник рисует кистью. Пользователь Windows GDI - тоже. Кисть - это еще одно базовое понятие GDI. Кисть необходимо создать. Мы будем использовать простейшую кисть - она оставляет сплошной след. Вот как создается такая кисть:

hBrush& = CreateSolidBrush(Color&)

Здесь Color& - цвет кисти (может быть сформирован функцией RGR(RR&,GG&,BB&) или QBcolor(n%). Естественно, функцию CreateSolidBrush нужно предварительно описать:

Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Чтобы нарисовать прямоугольник служит функция Rectangle. Вот ее описание:

Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, _
      ByVal X1 As Long, _
      ByVal Y1 As Long, _
      ByVal X2 As Long, _
      ByVal Y2 As Long) As Long

Как и говорилось выше, первый параметр - это ссылка на контекст устройства ("холст"). Четыре остальных параметра интуитивно понятны - это координаты левого верхнего и правого нижнего угла прямоугольника. Но где же ссылка на кисть? Ее нет... потому что ее нужно выбрать заранее. Это делает функция SelectObject:

Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
              ByVal hObject As Long) As Long

Первый параметр - снова ссылка на контекст устройства, а второй - ссылка на кисть (то, что возвращает CreateSolidBrush). Когда кисть создана и выбрана, можно вызвать функцию Rectangle и рисовать прямоугольники.

Поскольку нам предстоит не только рисовать прямоугольники, но и выводить текст (процент выполнения), придется познакомиться с тем, как это делает Windows. Для вывода текста предназначена функция DrawText:

Declare Function DrawText Lib "user32" 
      Alias "DrawTextA" (ByVal hdc As Long, _
      ByVal lpStr As String, _
      ByVal nCount As Long, _
      lpRect As RECT, _
      ByVal wFormat As Long)  As Long

первый параметр - ссылка на контекст, второй параметр - это строка, которую мы хотим вывести, третий - длина строки (имейте в виду, что длина строки должна быть длинным целым). Четвертый параметр задает прямоугольник, в котором будет размещаться текст. Это переменная пользовательского типа RECT:

Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

(Left, Top) - левая верхняя вершина, (Right, Bottom) - правая нижняя.

Параметр wFormat задает положение текста в прямоугольнике. Мы будем использовать вывод по центру:

Const DT_CENTER = &H1

А чем же задается цвет текста? Цветом кисти? Нет, кисти к тексту никакого отношения не имеют. Для задания цвет текста служит специальная функция SetTextColor:

Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, _
              ByVal crColor As Long) As Long

Про первый параметр я уже не говорю, а второй - это цвет выводимого текста. Текст выводится поверх старого содержимого "холста". Можно задать режим "взаимодействия" текста со старым содержимым. Нас вполне устроит режим вывода текста "как есть" без изменения. Чтобы обеспечить такой режим вывода, нужно вызвать функцию SetBkMode:

a& = SetBkMode(hdc, 1)

декларируется эта функция так:

Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, _
                             ByVal nBkMode As Long) As Long

Результат этой функции (a&) не используется. Второй параметр (единица) как раз и задает нужный режим вывода.

Если не вызвывать функцию SetBkMode, то текст будет выводиться так:

что, согласитесь, не очень симпатично.

Перед тем, как перейти к программе, я хотел бы сделать важное замечание. Оно касается единиц измерения.

Все графические функции Windows в качестве единицы измерения понимают только пикселы. А VB позволяет разработчикам использовать самые разные единицы измерения: твипы, пункты, сантиметры, миллиметры, дюймы... Перед обращением к графической функции все координатные параметры должны быть переведены в пикселы. Как это сделать? Не очень трудно.

Начнем с твипов. По определению, твип это (1/1440) дюйма (т.н. "логического дюйма"; подробности - у Д.Эпплмана). Объект Screen в VB имеет два полезных метода:

px=Screen.TwipsPerPixelX

и

py=Screen.TwipsPerPixelY

Первая возвращает количество твипов на пиксел по горизонтали для Вашей видео-системы, вторая - соответственно количество твипов на пиксел по вертикали.

Если мы хотим из твипов получить пикселы, достаточно воспользоваться одной из формул:

• picX=TwipX/px - для горизонтали;
• picY=TwipY/py - для вертикали.

Здесь TwipX, TwipY - горизонтальный и вертикальный размеры в твипах, а picX, picY - те же размеры в пикселах.

Теперь нам нетрудно "разделаться" и с другими единицами измерения:

Пункт - это (1/72) дюйма, т.е. пункт равен двадцати твипам. Поэтому для работы с пунктами формулы будут иметь вид:

px=(Screen.TwipsPerPixelX)/20
py=(Screen.TwipsPerPixelY)/20      

picX=PointX/px
picY=PointY/py

Дюйм содержит 1440 твипов, поэтому для работы с дюймами формулы будут такие:

px=(Screen.TwipsPerPixelX)/1440
py=(Screen.TwipsPerPixelY)/1440 
 
picX=InchX/px
picY=InchY/py

С дюймами и пунктами все ясно. Для сантиметров и миллиметров дело обстоит ненамного сложнее. Как известно, 1 дюйм=2.54 см. Поэтому для пересчета сантиметров в пикселы формулы будут такие:

px=((Screen.TwipsPerPixelX)/1440)*2.54
py=((Screen.TwipsPerPixelY)/1440)*2.54 
 
picX=cmX/px
picY=cmY/py

Столь же легко решается проблема пересчета миллиметров в пикселы:

px=((Screen.TwipsPerPixelX)/1440)*25.4
py=((Screen.TwipsPerPixelY)/1440)*25.4 
 
picX=mmX/px
picY=mmY/py

Visual Basic обеспечивает еще одну систему измерения координат - "Знаки". Это чуть более хитрая система. Для нее формулы перевода таковы:

px = Screen.TwipsPerPixelX / 120
py = Screen.TwipsPerPixelY / 240

picX=charX/px
picY=charY/py

При рисовании наших прямоугольников API-шными вызовами мы должны будем преобразовать все размеры в пикселы. Формулы перевода мы теперь знаем. Но как узнать, какую метрику использует разработчик (который будет пользоваться нашим прогресс-баром)? Заставлять его использовать только пикселы? Слишком жесткое ограничение... Сейчас мы его обойдем. Наш статус-бар, где будет располагаться прогресс-бар, находится на какой-то форме, верно? При этом он наследует ее метрику. А метрику формы задает ее свойство ScaleMode. Таким образом, величина

scMode% = StatusBar.Parent.ScaleMode 

как раз то, что нам нужно:

Величина scMode- Метрика

• Твипы
• Пункты
• Пикселы
• Знаки
• Дюймы
• Миллиметры
• Сантиметры

Напомню, что Parent - это указатель на родительский объект. Для статус-бара это форма, на которой он расположен.

Вот, в принципе, и все, что нужно, чтобы реализовать заявленные идеи.

Теперь самое время обсудить интерфейс нашего прогресс-бара. На мой взгляд, лучше всего реализовать наш прогресс-бар в виде класса. Тогда статус-бар и номер панельки, в котором мы рисуем прогресс-бар, цвета всех основных элементов и, разумеется, Min,Max и Value будут свойствами. А отображение очередного состояния можно оформить как метод.

Использование класса оправдано еще и потому, что класс можно потом включить в ActiveX-Dll и распространять в виде библиотеки.

4. Промежуточные итоги

Ниже приводится полный текст класса. Для подключения его к Вашему проекту, создайте в нем пустой модуль класса, переименуйте в clsPBar, и вставьте в него приведенный ниже код.

'<<<<<<<<<<<<<<<<<               Класс clsPBar          >>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<  Рисует прогресс-бар в заданной панельке статус-бара   >>>>>>>>>>>>

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

'::: Необходимые объявления API-вызовов и констант

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, _
  ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function SaveDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function RestoreDC Lib "gdi32" (ByVal hdc As Long, _
  ByVal nSavedDC As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
  ByVal hObject As Long) As Long

Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, _
  ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, _
  ByVal wFormat As Long) As Long

Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, _
  ByVal nBkMode As Long) As Long

Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, _
  ByVal crColor As Long) As Long

Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long

Private Const DT_CENTER = &H1

'::: Локальные переменные класса

Private bColor_loc As Long
Private fColor_loc As Long
Private tColor_loc As Long

Private prgMin     As Long
Private prgMax     As Long
Private prgValue   As Long

Private hwnd       As Long
Private hdc        As Long
Private iDc        As Long
Private hBrush_1   As Long
Private hBrush_2   As Long
Private MainRect   As RECT
Private txtRect    As RECT

Private flgPrep    As Boolean
Private flgCannot  As Boolean

Private X1         As Long
Private Y1         As Long
Private X2         As Long
Private Y2         As Long
Private Pbw        As Long
Private Pbh        As Long

Private dxCurr     As Long
Private dxLast     As Long

'::: Свойства, свойства, свойства... 

Public Property Let Min(vMin As Long)
       prgMin = vMin
End Property

Public Property Get Min() As Long
       Min = prgMin
End Property

Public Property Let Max(vMax As Long)
       prgMax = vMax
End Property

Public Property Get Max() As Long
       Max = prgMax
End Property

Public Property Let Value(vVal As Long)
       prgValue = vVal
End Property

Public Property Get Value() As Long
       Value = prgValue
End Property

Public Property Get bColor() As Long
       bColor = bColor_loc
End Property

Public Property Let bColor(ByVal vNewValue As Long)
       bColor_loc = vNewValue
End Property

Public Property Get fColor() As Long
       fColor = fColor_loc
End Property

Public Property Let fColor(ByVal vNewValue As Long)
       fColor_loc = vNewValue
End Property

Public Property Get tColor() As Long
       tColor = tColor_loc
End Property

Public Property Let tColor(ByVal vNewValue As Long)
       tColor_loc = vNewValue
End Property

'::: Код инициализации. Выполняется при создании объекта

Private Sub Class_Initialize()

        prgMax = 100
        prgMin = 0
        prgValue = 0

        fColor_loc = RGB(0, 0, 128)
        bColor_loc = RGB(130, 130, 180)
        tColor_loc = RGB(255, 255, 0)
        
        dxCurr = 0
        dxLast = 0
        
        flgPrep = False
        flgCannot = False

End Sub

'::: Внутренняя процедура подготовки. Выполняется при первом обращении
'::: к только что созданному прогресс-бару

Private Sub Prepare(StatBar As Object, NPan As Integer)
        
        scMode% = StatBar.Parent.ScaleMode
        
        Select Case scMode%
        
               Case 1  '::: Twip = 1/1440 дюйма
               
                    ppx# = Screen.TwipsPerPixelX
                    ppy# = Screen.TwipsPerPixelY
               
               Case 2  '::: Point = 1/72 дюйма
               
                    ppx# = Screen.TwipsPerPixelX / 20
                    ppy# = Screen.TwipsPerPixelY / 20
               
               Case 3  '::: Pixel
               
                    ppx# = 1
                    ppy# = 1
               
               Case 4  '::: знаки
               
                    ppx# = Screen.TwipsPerPixelX / 120
                    ppy# = Screen.TwipsPerPixelY / 240
               
               Case 5  '::: Дюйм
               
                    ppx# = Screen.TwipsPerPixelX / 1440
                    ppy# = Screen.TwipsPerPixelY / 1440
               
               Case 6  '::: Миллиметр
               
                    ppx# = (Screen.TwipsPerPixelX / 1440) * 25.4
                    ppy# = (Screen.TwipsPerPixelY / 1440) * 25.4
               
               Case 7  '::: Сантиметр
               
                    ppx# = (Screen.TwipsPerPixelX / 1440) * 2.54
                    ppy# = (Screen.TwipsPerPixelY / 1440) * 2.54
               
               Case Else

                    StatBar.Panels(NPan).Text = "Не могу отобразить"
                    
                    flgCannot = True
                    Exit Sub
               
        End Select
        
        '::: Получим handle окна статус-бара
        hwnd = StatBar.hwnd

        '::: Получим контекст графического устройства, где предстоит рисовать
        hdc = GetDC(hwnd)

        '::: Сохраним его...
        iDc = SaveDC(hdc)

        '::: Создадим кисть для переднего плана
        hBrush_1 = CreateSolidBrush(fColor)

        '::: Создадим кисть для заднего плана
        hBrush_2 = CreateSolidBrush(bColor)

        '::: Ширина рабочей панельки -2 пиксела
        Pbw = (StatBar.Panels(NPan).Width) / ppx# - 2
        
        '::: Высота рабочей панельки -2 пиксела
        Pbh = (StatBar.Height) / ppy# - 2
        
        '::: Абсолютная X-координата левого верхнего угла
        X1 = -(StatBar.Left / ppx#) + (StatBar.Panels(NPan).Left) / ppx# + 1
        
        '::: Абсолютная Y-координата левого верхнего угла
        Y1 = (StatBar.Top) / ppy# + 1
         
        '::: Абсолютная X-координата правого нижнего угла
        X2 = X1 + Pbw
        
        '::: Абсолютная X-координата правого нижнего угла
        Y2 = Y1 + Pbh

        With txtRect
             .Top = 1
             .Left = X1
             .Right = X1 + Pbw
             .Bottom = 1 + Pbh
        End With

        a& = SetBkMode(hdc, 1)

        P& = SetTextColor(hdc, tColor)

        ttl$ = "100%"
        ltxt& = 1

        Ht& = DrawText(hdc, ttl$, ltxt&, txtRect, &H400)

        With txtRect
             .Top = 1 + (Pbh - Ht&) / 2
             .Left = X1
             .Right = X1 + Pbw
             .Bottom = txtRect.Top + Ht&
        End With

        flgPrep = True
        flgOK = True

End Sub

'::: А это - функция отображения прогресс-бара
'::: У нее два входных параметра: ссылка на статус-бар, и
'::: номер панельки статус-бара

Public Sub ShowProgress(StatBar As Object, NPan As Integer)
       If flgCannot Then Exit Sub
       If (Not flgPrep) Then Prepare StatBar, NPan
       If flgPrep Then
          SS# = prgValue
          ZZ# = Abs(prgMax - prgMin)
          Fract# = (SS# / ZZ#)
          dxCurr = Pbw * Fract#
          If dxCurr <> dxLast Then
             ttl$ = Format$(Fract#, "##0%")
             SelectObject hdc, hBrush_1         ' выбираем первую кисть
             Rectangle hdc, X1, 2, (X1 + dxCurr), Pbh
             SelectObject hdc, hBrush_2         ' выбираем вторую кисть      
             Rectangle hdc, (X1 + dxCurr - 1), 2, (X1 + Pbw), Pbh
             ltxt& = Len(ttl$)
             a& = DrawText(hdc, ttl$, ltxt&, txtRect, DT_CENTER)
             dxLast = dxCurr
             DoEvents
          End If
       End If
End Sub

'::: Код терминирования. Выполняется, когда объект уничтожается

Private Sub Class_Terminate()
        If flgPrep Then i& = RestoreDC(hdc, iDc)
End Sub

'<<<<<<<<<<<<<<<<<<<<<<<<< Конец класса >>>>>>>>>>>>>>>>>>>>>>>>>

В этом классе собраны воедино все идеи, высказанные выше.

Если Вы внимательно анализировали код класса, то наверняка обратили на две внутренние (закрытые) переменные dxCurr и dxLast. Назначение их следующее. Предположим, что наш глобальный цикл, выполнение которого мы хотим визуализировать, выполняется несколько сот тысяч раз, а каждый "виток" выполняется очень быстро. Если вставить обращение к методу ShowProgress в такой цикл, то перерисовка прогресс-бара тоже будет выполняться на каждом витке. При этом возможно, что новое положение закрашенного прямоугольника не будет отличаться от предыдущего. Зачем же его (да, кстати, и текст в центре) перерисовывать? Кроме "отъедания" ресурсов и мигания такая перерисовка ничего не дает. Вот для предотвращения этой ненужной перерисовки и служат переменные dxCurr и dxLast. Если при очередном обращении к ShowProgress dxCurr=dxLast, то рисование обходится.

Как пользоваться этим классом? Очень просто.

Разместите на форме статус-бар с двумя или более панельками. Решите, в какой панельке будет прогресс-бар. Когда прогресс-бар понадобится, пишем:

...

Dim myPBar As clsPBar
...
Set myPBar= New clsPBar

With myPBar
        .min=...                  ' минимум
        .max=...                 ' максимум
        .Fcolor=RGB(...)      ' цвет переднего плана
        .Bcolor=RGB(...)      ' цвет заднего плана
        .Tcolor=RGB(...)      ' цвет текста
End With

...

Do ' Глобальный цикл
       ...
       myPBar.Value=V ' Величина из интервала [min,max]      
       myPBar.ShowProgress(Forma.StatusBar,Npan)
       ...
Loop

Set myPBar=Nothing
...

В качестве приложения к этой статье Вы можете скачать пример простого приложения, в котором используется описанный прогресс-бар.

5. Беда! Утечка памяти!

Пару лет назад, когда я создал этот "шедевр", со мной произошла неприятность. Отладив (как мне казалось) класс, я включил его в реальный проект и передал на тестирование. Тестирование ошибок не обнаружило, и программа была передана эксплуатационникам. Сначала все было хорошо. Но через несколько дней мне пожаловались, что при длительной работе моя программа завешивает компьютер. Помогает только перезагрузка. Поскольку проект без прогресс-бара исправно работал и не вызывал проблем, подозрение пало на прогресс-бар. Я быстренько воспроизвел ситуацию, о которой толковали эксплуатационники, и убедился, что при отключении прогресс-бара программа работает четко, а с прогресс-баром через некоторое время виснет. В чем же дело? Оказалось - в том, что я невнимательно читал Д.Эпплмана: созданные кисти нужно уничтожать при уничтожении объекта. Никто за нас это делать не будет!

Если приведенный выше код поместить в объемлющий цикл и выполнить пару тысяч раз - зависание почти неминуемо. Если запустить индикатор системных ресурсов, то отчетливо видно, как они стремительно "утекают". Ситуация эта, кстати, по-английски называется "memory leak" - "утечка памяти".

Чтобы уничтожить кисть нужно воспользоваться API-вызовом DeleteObject:

q& = DeleteObject(hBrush)

А вот как эта функция декларируется:

Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Код терминирования класса должен быть на самом деле таким:

Private Sub Class_Terminate()
        If flgPrep Then
           q& = DeleteObject(hBrush_1)
           q& = DeleteObject(hBrush_2)
           i& = RestoreDC(hdc, iDc)
        End If
End Sub

Каюсь перед читателем! Я нарочно включил в тест класса не вполне корректный код терминирования чтобы продемонстрировать собственную (поучительную!) ошибку и сделать соответствующие выводы.

А пример-приложение содержит правильный класс. Он утечки памяти не вызывает.

6. А как быть с Excel?

Во введении я обещал сделать прогресс-бар и для использовании в VBA (применительно к Excel). В чем-то ситуация здесь проще, а в чем-то сложнее.

Для получения ссылки на контекст нужно получить хэндл окна, где мы хотим рисовать. При работе в VB это хэндл окна статус-бара, расположенного на форме. В Excel добраться до хэндла окна статус-бара затруднительно (хотя, вероятно, возможно). Я решил поступить так: размещать линейку прогресс-бара в центре главного окна. Хэндл главного окна Excel можно найти с помощью API-вызова FindWindow:

hwnd = FindWindow("XLMAIN", 0)

Этот вызов ищет окно по заголовку. У Excel заголовок - "XLMAIN". Естественно, что функция FindWindow должна быть продекларирована:

Declare Function FindWindow Lib "user32"  _ 
      Alias "FindWindowA" (ByVal lpClassName As String, _
      ByVal lpWindowName As Long) As Long

Функция Prepare теперь принимает вид:

Private Sub Prepare()
        hwnd = FindWindow("XLMAIN", 0)
        l& = GetWindowRect(hwnd, MainRect)
        hdc = GetDC(hwnd)
        iDc = SaveDC(hdc)
        hBrush_1 = CreateSolidBrush(QBColor(9))
        hBrush_2 = CreateSolidBrush(QBColor(8))
        '::: Прогресс-бар выводим в центре окна
        '::: ширина - 200 пикс.
        Y1 = (MainRect.Bottom - MainRect.Top) / 2
        X1 = (MainRect.Right - MainRect.Left - 200) / 2
        W& = 200
        With txtRect
             .Top = Y1
             .Left = X1
             .Right = X1 + 200
             .Bottom = Y1 + 17
        End With
        a& = SetBkMode(hdc, 1)
        p& = SetTextColor(hdc, QBColor(14))
        flgPrep = True
End Sub

А в остальном класс такой-же, как и для VB, за исключением того, что все размеры только в пикселах, и не нужен пересчет. Перед выводом прогресс-бара рекомендую установить Application.ScreenUpdating=False, а после завершения - вернуть Application.ScreenUpdating=True.

Открывая книгу PBtest.xls, Вы, естественно, должны включить макросы (иначе пример работать не будет!) Для запуска щелкните в главном меню по пункту "Прогресс-бар". Остальное, надеюсь, ясно.

Успехов!

Вы можете скачать готовые примеры на VB и VBA.