Visual2000 · Архив статей А.Колесова & О.Павловой
Андрей Колесов, Ольга Павлова
© Андрей Колесов, Ольга Павлова, 2000
В состав VB входит удобное средство преобразования отдельных значений Red, Green и Blue в одно цветовое значение типа Long — это функция RGB. К сожалению, VB не позволяет проводить обратное преобразование, но вы можете получить конкретные цветовые значения из шестнадцатеричного представления значения типа Long, создаваемого функцией RGB. Для этого создадим следующую функцию и поместим ее в стандартном модуле программы:
Public Type RGB_Type
R As Long
G As Long
B As Long
End Type
Public Function ToRGB(ByVal Color _
As Long) As RGB_Type
'
Dim ColorStr As String
ColorStr = Right$("000000" & Hex$(Color), 6)
With ToRGB
.R = Val("&h" & Right$(ColorStr, 2))
.G = Val("&h" & Mid$(ColorStr, 3, 2))
.B = Val("&h" & Left$(ColorStr, 2))
End With
End Function
Чтобы воспользоваться данной функцией, поместите в форму какое-либо изображение, задав необходимое имя в свойстве Picture формы, а затем введите такой код:
Private Sub Form_MouseUp(Button _
As Integer, Shift As Integer, _
X As Single, Y As Single)
'
Dim RGB_Point As RGB_Type
RGB_Point = ToRGB(Point(X, Y))
With RGB_Point
Me.Caption = "R = " & .R & " G = " & .G & " B = " & .B
End With
End Sub
Запустите программу на выполнение. Щелкая мышью на различных частях изображения, вы будете видеть в заголовке формы соответствующие значения RGB. Обратите внимание, что при работе в VB3 вам нужно получать эти значения по отдельности, поскольку VB не поддерживал возвращение заданных пользователем типов данных до версии VB4. Подобное преобразование можно осуществить более быстрым способом, если воспользоваться командой LSet, которая копирует содержимое одного заданного пользователем типа данных (user-defined type, udt) в другой. Для этого заменим функцию, находящуюся в стандартном модуле программы, на такую:
Public Type RGB_Type
R As Byte
G As Byte
B As Byte
Filler As Byte
End Type
Private Type RGB_Full_Type
lngRGB As Long
End Type
Public Function ToRGB(ByVal _
vlngColor As Long) As RGB_Type
'
Dim udtRGBFull As RGB_Full_Type
udtRGBFull.lngRGB = vlngColor
LSet ToRGB = udtRGBFull
End Function
Вопреки распространенному мнению, операторы Debug.Print не всегда удаляются из исполняемых файлов. Продемонстрируем, например, такой случай. Создайте новый проект, поместите на форму командную кнопку Command1 и напишите для нее такой код:
Private Sub Command1_Click() Debug.Print DebugTime End Sub Public Function DebugTime() MsgBox "Привет!" End Function
Скомпилируйте программу, запустите ее на выполнение и щелкните командную кнопку. На экране, как ни удивительно, появится окно сообщения. Это, конечно же, искусственная ситуация, но можно легко представить себе случаи, когда оператор Debug.Print используется для печати возвращаемого значения функции. Если переменные передаются как параметры ByRef и если функция изменяет значения этих переменных, то подобная ошибка распространится и на исполняемый файл, а обнаружить ее будет крайне трудно.
Таким образом, сформулируем основные выводы:
Существует возможность упростить некоторые вычислительные процедуры в Excel, а также добавить в Word отсутствующие в нем функции. К сожалению, большинство учебных пособий по VBA в Office 97 предназначены для изучения нематематических функциональных возможностей пакетов, например форматирования текста или вывода графических изображений.
Отсутствие необходимой документации ставит в затруднительное положение тех, кто хочет использовать макросы для решения своих математических задач, поскольку обработка числовых значений в ячейке таблицы Word происходит иначе, чем в ячейке электронной таблицы Excel. Потратив некоторое время, вы, конечно же, найдете необходимое описание синтаксиса математических функций в справочной системе Word или Excel. Кроме того, можно воспользоваться руководством Microsoft Office 97: Visual Basic Programmer's Guide, изданным корпорацией Microsoft (русская версия была выпущена "Русской Редакцией"), где рассматриваются практически все вопросы на данную тему.
Здесь мы приводим два примера, которые в явном виде демонстрируют разницу при работе в Word и Excel. Они вычисляют кубическую сумму значений первых восьми ячеек столбца 1 и помещают результат в девятую ячейку столбца 1:
Sub ColumnMath()
Dim x As Long, i As Long
Dim myTable As Table
Dim myStr As String
x = 0
Set myTable = ActiveDocument.Tables(1)
For i = 1 To 8
x = x + myTable.Cell(i, 1).Range.Calculate ^ 3
Next I
myStr = Str(x)
myTable.Cell(9, 1).Range. InsertAfter (myStr)
End Sub
Sub ColumnMath()
Dim x As Long, i As Long
Sheets("Sheet1").Activate x = 0
For i = 1 To 8
x = x + Cells(i, 1).Value ^ 3
Next i
Range("a9").Value = x
End Sub
Данные вычисления могут быть проведены целиком в рамках функциональных возможностей Excel, однако для этого потребуется создать дополнительный столбец. А вот как выполнить подобные действия внутри Word? Попытаемся разобраться в этом. Напомним, что Word VBA имеет неинтуитивный синтаксис для обработки ячеек. Чтобы прочитать значение ячейки, следует использовать ключевое слово Calculate.
А чтобы записать какую-либо величину в ячейку, надо вначале преобразовать ее в строковую переменную, а затем применить абсолютно неочевидное ключевое слово InsertAfter. Нумерация таблиц в документе Word осуществляется последовательно, поэтому в первом примере мы имеем дело с первой таблицей документа. Каждая таблица рабочей книги Excel представляет собой одну большую таблицу, поэтому во втором примере мы работаем с первой таблицей рабочей книги. Кроме того, во втором примере Range("a9") можно заменить на Cells(9, 1) или на один из других вариантов, требующих использования ключевого слова Range.
Как вы уже наверняка знаете, для вычисления интервала между двумя датами можно использовать встроенную в VB функцию DateDiff. Но работать с этой функцией нужно очень внимательно, с учетом входящих в нее ограничений.
Отгадайте такую загадку. Заданы две даты в виде переменных DateStart и DateFinish. Чтобы определить временной интервал между ними, мы написали такую процедуру:
Print "Интервал в годах = "; DateDiff("yyyy", DateStart, DateFinish)
Print "Интервал в месяцах= "; DateDiff("m", DateStart, DateFinish)
Print "Интервал в днях = "; DateDiff("d", DateStart, DateFinish)
Print "Интервал в часах = "; DateDiff("h", DateStart, DateFinish)
Print "Интервал в минутах = "; DateDiff("n", DateStart, DateFinish)
Print "Интервал в секундах= "; DateDiff("s", DateStart, DateFinish)
И получили такой парадоксальный результат:
Интервал в годах = 1 Интервал в месяцах = 1 Интервал в днях = 1 Интервал в часах = 1 Интервал в минутах = 1 Интервал в секундах = 1
ВОПРОС. Почему так произошло и о каких датах шла речь?
ОТВЕТ. Дело в том, что функция DateDiff определяет временной интервал элементарно — в соответствии с заданным первым параметром просто отбрасывает значения даты "после этой точки". То есть если вы задали "день", то отбрасываются часы (0 часов), если месяц — дни (первое число месяца). В соответствии с этим алгоритмом получается, что между 31 мая 2000-го и 1 июня 2000-го в единицах "месяц" разница — один месяц (что в определенном смысле совершенно верно).
В нашем же примере исходные значения даты были равны
DateS = "31.12.2000 23:59:59" DateF = "01.01.2001"
Изменение показателя текущего момента на одну секунду привело к изменению минут, часов, суток, месяца и года (и даже века и тысячелетия). Очевидно, что самое точное определение интервала дается в данном случае в секундах (этой точности вполне достаточно для решения большинства бытовых и деловых проблем). Но как интерпретировать величину типа 12 345 678 сек? Конечно, желательно получить информацию в более привычных единицах — месяцах, днях, минутах. В таких случаях вам поможет подпрограмма DateIntervals, позволяющая передавать две даты и свои собственные переменные для указанного интервала:
Public Sub DateIntervals(ByVal DateS _
As Date, ByVal DateF As Date, ParamArray Prams())
If UBound(Prams) < 0 Then Exit Sub
Dim i As Long, itr As String
'
' Если не задан день, то считаем его "сегодняшним"
If DateValue(DateS) = 0 Then DateS = DateS + DateValue(Now)
If DateValue(DateF) = 0 Then DateF = DateF + DateValue(Now)
'
For i = 0 To IIf(UBound(Prams) > 5, 5, UBound(Prams))
If Not IsMissing(Prams(i)) Then
If i = 0 Then
itr = "yyyy"
Else
itr = Mid$("mdhns", i, 1)
End If
Prams(i) = DateDiff(itr, DateS, DateF)
If DateAdd(itr, Prams(i), DateS) <= DateF Then _
Prams(i) = Prams(i) - 1
DateS = DateAdd(itr, Prams(i), DateS)
End If
Next i
End Sub
Подпрограмма DateIntervals возвращает наибольший полный интервал
указанного вами типа (год, месяц, день, час, минута, секунда) между
двумя датами. Например, чтобы получить интервал времени в часах и
минутах между 09:00 и 17:15, передайте в подпрограмму эти две даты, а
также две переменные, задающие размерность интервала. Используйте
запятые, чтобы пропустить более крупные ненужные интервалы:
Dim Hours As Variant, Minutes As Variant
Call DateIntervals(Now, "23.05.2000", , , , Hours, Minutes)
MsgBox "Часов = " & Hours & _
"Минут = " & Minutes
Подпрограмма вернет "Часов = 8, Минут = 15".
Однако здесь следует обратить внимание на такой любопытный момент. Если вы выполните такое обращение к функции:
Call DateIntervals("28.02.2000", "01.03.2001", Years, , Days)
MsgBox Years & " " & Days
Call DateIntervals("29.02.2000", "01.03.2001", Years, , Days)
MsgBox Years & " " & Days
то получите для разных начальных дат один и тот же результат — 1 год и 1 день. Казалось бы, в подпрограмме есть ошибка, но это не так. Данный парадокс объясняется неопределенностью интервала в один год — он может быть 365 и 366 дней (так же, как и в один месяц). Соответственно в первом случае "год" является високосным (366 дней), а во втором — обычным (365 дней). Чтобы представить эту ситуацию, вообразите, что ваш знакомый говорит 31 января: "Позвони мне ровно через месяц" (или 29 февраля 2000 года — "ровно через год"). Когда же будет эта точная дата намеченного звонка?
Отметим также, что алгоритм расчета интервала с использованием привычных единиц можно выполнить и по-другому — сначала определить интервал в секундах, а потом выделить из него минуты, часы и сутки (с месяцами и годами тут возникнут те же проблемы). Но он будет выглядеть не так изящно, как приведенная выше подпрограмма.
В процедуре DateIntervals хотелось бы обратить внимание еще на три используемые нами конструкции:
В принципе, можно было бы просто зарезервировать в вызывающей подпрограмме массив Param (0 To 5) и использовать непосредственно его. Но в данном случае подпрограмма выполнила бы расчет для всех элементов этого массива. Применение ParamArray позволяет нам пропускать "ненужные" параметры. Например, в нашем обращении мы получим результат в полных годах и весь остаток интервала — в секундах:
Call DateIntervals("28.02.2000", "01.03.2001", Years, , , , ,Secs)
MyVal = IIf(expr, truepart, falsepart)
которая равнозначна такому варианту:
If expr Then MyVal = truepart Else MyVal = falsepart End If
If DateAdd(itr, Prams(i), DateS) <= DateF Then _
Prams(i) = Prams(i) - 1
Любители хитроумных преобразований данных могли бы предложить более "изящный" вариант:
Prams(i) = Prams(i) + (DateAdd(itr, Prams(i), DateS) > DateF)
имея в виду, что арифметическое значение логического выражения будет равно -1 (True) или 0 (False). Мы, со своей стороны, настоятельно не рекомендуем пользоваться неявными преобразованиями типов данных.
Проблема заключается в том, что в некоторых случаях имя каталога содержит символ обратной косой черты в конце, а иногда — нет. Пример такой путаницы — обращение к свойству Path объекта App. Если приложение находится в подкаталоге, то такой черты в конце не будет (например, C:\dir_x\dir_y\dir_z), но если оно располагается в корневом каталоге диска, то черта появится (например, С:\). Это нужно, в частности, учитывать при формировании полного имени файла, то есть вместо:
strFullFileName = App.Path & strFileName
нужно применять, например, такую конструкцию:
strFullFileName = App.Path & IIf(Right$( _
App.Path, 1) = "\", "", '\') & strFileName
Если вам лень каждый раз писать этот код, можете создать функцию AppPath:
Public Function AppPath() As String ' Замените App.Path на ' AppPath во всем тексте программы AppPath = App.Path & IIf(Right$(App.Path, 1) = "\", "", "\") End Function
Обратите внимание, что если вы автоматически добавляете обратную косую черту ко всем вызовам App.Path, а путь окажется корневым каталогом, то вы получите совершенно неинформативное сообщение об ошибке: Run-time error '5': Invalid procedure call.