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

Способ вывода таких сообщений предусмотрен приложением. Называется он Статус бар и вызывается он прямо из кода в редакторе Visual Basic следующей записью:
Application.StatusBar = “сообщение для пользователя”.

Во многих случаях, этого вполне достаточно, чтобы успокоить пользователей Ваших программ. Если Вы хотите сообщать больше информации, сообщить оставшееся время обработки, процент выполнения, позволить остановить процедуру, то одним статус баром не обойтись.

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

Скачать файл с классом можно в конце статьи.

Состав прогресс бара

Строится окно загрузки на основе простой пользовательской формы UserForm, которая содержит следующие элементы:

1. Два элемента Label. Используются в совокупности для отображения полосы загрузки. Первый применяется как контейнер и имеет отличный от фона формы фон. Второй вкладывается в первый и имеет динамическую ширину, которая меняется вместе с процентом выполнения процесса. Ее фон отличный от фона формы и фона родительского элемента. Эти элементы можно заменить на один дополнительный, который так и называется — ProgressBar, но с его использованием могут быть связаны некоторые проблемы, речь о которых пойдет ниже.
2. Три элемента Label. Каждый из них не зависит от остальных и предназначается для вывода конкретной информации: продолжительность процесса, оставшееся время, количество пройденных этапов процесса.
3. ТехBox для вывода специальных сообщений пользователю.

Если вывести все элементы на форму, то она будет иметь такой вид:

В случае ненадобности тех или иных элементов, их можно не выводить. Контроль за выводом элементов осуществляет класс «ProgressBar», экземпляр которого для начала необходимо создать (Set var = New ProgressBar). Затем, используя созданный класс, можно программным образом заполнить форму элементами и задавать им конкретные значения.

Описание класса и способов создания окна загрузки

Для начала рассмотрим доступные методы данного класса, не концентрируясь на коде, а только на его функциональности:

• Метод createLoadingBar – создает полосу загрузки на форме;
• createString – создает сроку «Обработано: … %»;
• createtimeDuration – создает сроку «Продолжительность обработки: …»;
• createtimeFinish – создает строку «Оставшееся время обработки: …»;
• createTextBox – создает элемент TextBox;
• setParameters – задает параметры окна загрузки для предстоящего процесса. Принимает 3 аргумента:
  • expProcess_INT – обязательный аргумент. Принимает целое число, сообщающее, из какого количества этапов состоит последующий процесс;
  • UpdateInterval_INT – необязательный аргумент. С его помощью можно задать интервал обновления формы, т.е. через какое количество этапов все элементы окна загрузки необходимо обновить;
  • UpdTimeInterval_INT_SEC – необязательный аргумент. Задает интервал обновления формы в секундах. Аргумент имеет смысл только в том случае, если не задан аргумент UpdateInterval_INT.
• В том случае, если оба аргумента, задающие интервал, не указаны или принимают значение 0, то по умолчанию интервал обновления будет равняться одной секунде.
• Метод Start – запускает окно загрузки. Данный метод важен потому, что он отображает саму форму и запоминает время запуска, которое в дальнейшем используется для расчетов. Метод принимает один необязательный аргумент — title. С его помощью можно задать заголовок формы полосы загрузки. Значение заголовка по умолчанию равняется строке «Процесс выполнения».
• Update – обновляет форму, если прошел интервал заданный методом setParameters. Данный метод принимает два необязательных аргумента:
  • curProcess – целое число. Номер текущего этапа процесса;
  • stringTextBox – строка для элемента TextBox.
• exitBar – закрывает прогресс бар и выгружает форму из памяти.
• getForm – возвращает ссылку на форму прогресс бара.

Можно заметить, что прогресс бар обязательно устанавливает интервал обновления окна загрузки. Поэтому сообщения, заданные в аргументе stringTextBox метода Update, попадут в форму только в случае, если интервал это позволит. Но можно напрямую обратиться к форме и внести сообщение – ссылка_на_форму.Text = “сообщение”.

Это сделано по двум причинам.

Первая причина. При выводе в форму оставшегося времени обработки, его расчет производится, исходя из среднего времени, затраченного на один этап процесса, а затем умноженного на число оставшихся процессов. Данный способ является достаточно простым и понятным, но так как этапы выполняются не всегда с одной и той же скоростью, то время постоянно перепрыгивает с одного показателя на другой, что не позволяет адекватно его оценивать. Особенно данный эффект заметен в начале, когда прошедших этапов для оценки не так много. Установив интервал, Вы можете смягчить данный эффект. Рекомендуемого интервала в данном случае нет, так как все зависит от конкретного процесса.

Второй причиной является производительность. Не смотря на то, что идея вывода информации по загрузке является вполне обоснованной, само ее использование сильно замедляет процесс. Например, с использованием ProgressBar время обработки нижеприведенного примера составляет 1 минута 17 секунд при установленном интервале обновления в секунду. При обновлении формы на каждом этапе, за 2 минуты обработалось чуть больше 2 сотых процента. Без использования на все ушло 8 секунд. Поэтому старайтесь использовать прогресс бар только в случаях, когда это действительно важно и применяйте к нему оптимальный интервал – секунды достаточно, свыше данного значения особых изменений в производительности не наблюдается.

Также предусмотрена возможность остановить выполнение всех процессов, закрыв окно загрузки. Предварительно пользователю будет выведено окно с подтверждением.

Пример подключения прогресс бара к макросу

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

Sub test()    ' Объявляем переменную для загрузки строки  Dim strC As String  strC = Cells(1, 1).Value    ' увеличиваем ее содержание  strC = strC & strC & strC & strC & strC  strC = strC & strC & strC & strC & strC  strC = strC & strC & strC & strC & strC  strC = strC & strC & strC & strC & strC  strC = strC & strC & strC & strC & strC    ' создаем экземпляр класса прогресс бара  Dim bar As ProgressBar  Set bar = New ProgressBar    ' создаем элементы формы прогресс бара  ' последовательность создания элементов не имеет никакого значения, т.к.  ' перед его создание проверяется наличие остальных. Если элементы найдены, то они сдвигаются  bar.createtimeFinish    ' вывод строки для оставшегося времени  bar.createLoadingBar    ' вывод полосы загрузки  bar.createString    ' вывод строки пройденных этапов из общего количества с указанием процента  bar.createtimeDuration  ' текущая время обработки процесса  bar.createTextBox   ' вывод пустого текстового поля  bar.setParameters Len(strC), 0, 5   ' Задание параметров для последующей обработки:                                      ' 1 - указание числа этапов процесса;                                      ' 2 - интервал обновления формы, в данном случае ноль, но можно вовсе опустить                                      ' 3 - интервал обновления в секундах, применяется, только если предыдущий аргумент равен нулю или опущен    bar.Start   ' запускаем прогресс бар перед началом процесса  For i = 1 To Len(strC)      ch = Mid(strC, i, 1)      bar.Update i    ' обновляем прогресс бар и передаем ему номер текущего этапа процесса                      ' вторым аргументом можно передать строку для текстового поля, но она попадет туда только в случае,                      ' если интервал это позволяет, поэтому к элементу формы можно обратиться по его имени "Text"  Next i  bar.exitBar ' Закрываем прогресс бар    Set bar = Nothing ' удаляем экземпляр класса прогресс бара    End Sub

Многоуровневая полоса загрузки

Применение описанного в статье класса позволяет создавать независимые друг от друга окна загрузки для многоуровневых процессов.

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

Рекомендация: Для дочерних процессов добавляйте к формам загрузок уникальные заголовки (ProgressBar.Start Заголовок). Это уведомит пользователя программы о том, что сейчас выполняется подпроцесс.

Специальный элемент Microsoft ProgressBar Control

Выше было сказано о том, что саму полосу загрузки можно заменить дополнительным элементом управления формы, который специально предназначен для этого и называется Microsoft ProgressBar Control, version 6.0. Чтобы применить его, достаточно нажать правой кнопкой мыши на панели Tollbox и выбрать пункт «Additional Control…».

Но с применением этого элемента могут быть связаны проблемы работоспособности программы на разных версиях MS Office (в основном 2010 и 2013) и Windows, когда Вы попытаетесь добавить его в UserForm. Приложение выдаст ошибку «Библиотека не зарегистрирована».

Для ее устранения сначала проверьте наличие на Вашем компьютере файла MSCOMTCL.ocx. Это библиотека содержащая общие элементы управления Windows 6.0. Он должен располагаться в папке WindowsSysWOW64 для 64-разрядных ОС либо WindowsSistem32 для 32-разрядных. В случае необходимости скачайте его и разместите в требуемую папку.

После того, как Вы убедились в наличии библиотеки, следует ее зарегистрировать. Запустите командную строку от имени администратора (Пуск -> Все программы -> Стандартные -> Командная строка) и выполните команду regsvr32 MSCOMTCL.ocx.

Скачать пример полосы загрузки на VBA

Скачать пример progressbar VBA с применением элементов Label.

Скачать пример progressbar VBA c применением Microsoft ProgressBar Control.

Если материалы office-menu.ru Вам помогли, то поддержите, пожалуйста, проект, чтобы мы могли развивать его дальше.

У Вас недостаточно прав для комментирования.

There have been many other great posts, however I’d like to say that theoretically you should be able to create a REAL progress bar control:

1. Use CreateWindowEx() to create the progress bar

A C++ example:

hwndPB = CreateWindowEx(0, PROGRESS_CLASS, (LPTSTR) NULL, WS_CHILD | WS_VISIBLE, rcClient.left,rcClient.bottom - cyVScroll,rcClient.right, cyVScroll,hwndParent, (HMENU) 0, g_hinst, NULL); 

hwndParent Should be set to the parent window. For that one could use the status bar, or a custom form! Here’s the window structure of Excel found from Spy++:

This should therefore be relatively simple using FindWindowEx() function.

hwndParent = FindWindowEx(Application.hwnd,,"MsoCommandBar","Status Bar") 

After the progress bar has been created you must use SendMessage() to interact with the progress bar:

Function MAKELPARAM(ByVal loWord As Integer, ByVal hiWord As Integer)     Dim lparam As Long     MAKELPARAM = loWord Or (&H10000 * hiWord) End Function  SendMessage(hwndPB, PBM_SETRANGE, 0, MAKELPARAM(0, 100)) SendMessage(hwndPB, PBM_SETSTEP, 1, 0) For i = 1 to 100     SendMessage(hwndPB, PBM_STEPIT, 0, 0)  Next DestroyWindow(hwndPB) 

I’m not sure how practical this solution is, but it might look somewhat more ‘official’ than other methods stated here.

1. Введение

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

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

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

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

• размещаем прогресс-бар на форме, установив его свойство «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  

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

  i& = RestoreDC(hdc, iDc)  

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

  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, и вставьте в него приведенный ниже код.

  '>>  '>>    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 ' Величина из интервала                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.

AutoIt: 3.

Версия: 3.3.6.1

Категория: Автоматизация, Интеракция, Система / Реестр, Элементы GUI, Разное

Описание:

Для приложений, написанных на Excel/VBA существует достаточно много примеров реализации прогресс-бара, напр., ссылка:http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/

.

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

Предлагаемое оешение (см. файл вложения) содержит демонстрационный пример: рабочая книга Excel с макросами и скрипт на Autoit. При исполнении рабочего приложения я использую  откомпилированный вариант скрипта (предлагаю перед прогоном примера откомпилировать приложенный в архиве скрипт в исполнимый файл .exe средствами Autoit).

Смысл реализованного прогресс-бара — добавить возможность асинхронного обновления прогресс-бара. Сначала стартуется макрос из Excel путем нажатия на кнопку «Run Example of APB (Autoit Progress Bar)». Основное Excel-приложение запускает Autoit-скрипт, а далее через системный реестр передает скрипту команды. То есть, основное приложение (VBA/Excel) и сателлит (скрипт на Autoit) работают параллельно. Скрипт в цикле (c конфигурируемой задержкой) читает реестр и выполняет полученные команды. По полученным командам скрипт обновляет прогресс-бар.

Одна из команд — AutoShow — позволяет выполнять автоматическое периодическое обновление прогресс-бара от начального до конечного значения, что позволяет «сгладить» процесс обновления прогресс-бара в случае длительно исполняемого процесса на стороне Excel-приложения.

В архив входят рабочая книга, скрип и краткое описание процесса взаимодействия Excel-приложения со скриптом.

Пример не лишен недостатков, в частности, взаимодействие Excel и Autoit могло бы быть реализовано более эффективным способом (буду рад вашим предложениям с с примерами реализации такого взаимодействия).

Код/Пример:

Файл: ссылка:http://

Снимок:

История версий:Источник: ссылка:http://

Автор(ы):