Здравствуйте уважаемые подписчики!

Прежде всего, хочу поздравить всех подписчиков Subscribe.ru с переводом нашей рассылки в золото! Действительно наша рассылка заслужила перевода в Золото. Мы заботимся о наших подписчиках и не оставляем их без внимания. Хочу выразить всем подписчиками (не только на Subscribe.ru, но и на Content.mail.ru) огромную благодарность за ваши труды! С Вами рассылка процветает, без Вас, конечно же, завянет... А ведь каждый подписчик у нас на вес золота! И особенно хотелось бы поблагодарить Игоря, который у нас занимает первое место в турнирной таблице за его самую большую активность в рассылке! Игорь, к Вашим ответам просто невозможно придраться, у Вас всегда изумительные, полные ответы. Ну а также выражаем особую благодарность остальным 10 участникам в TOP-10 нашей рассылки!

Ну а теперь о сайте VisualBasic.noka.ru. Наш сайт проходит очередное глобальное обновление. Сайт будет улучшен полностью, от времени загрузки до дизайна. Изменится концепция регистрации пользователей, появятся новые файлы, контролы, статьи, а также многое другое! Впервые на сайте будет общедоступная статистика, где Вы сможете узнать самую посещаемую страницу сайта, а также самый скачиваемый файл.

ВНИМАНИЕ! Ссылки в ответах на файлы ресурсов в сети не будут работать до конца обновления портала! Примите это к сведению! После обновления все ссылки будут работать в нормальном режиме!

1. Вопросы, касающиеся другой сферы программирования, а также сферы ПО - НЕ ПРИНИМАЮТСЯ!

2. Письма с указанием ссылок на какой-либо ресурс или сайт будут отвергнуты, либо ссылкы будут заменены на <РЕКЛАМА> и не будут опубликованы в рассылке!

3. Используйте текстовый (не HTML) формат писем при написании вопроса или ответа.

4. ПИСЬМА С СОДЕРЖАНИЕМ ТИПА "ПИШИ СЮДА, Я ТЕБЕ ВЫШЛЮ ИСХОДНИК", ЛИБО "НАПИШИ МНЕ, Я ТЕБЕ ОБЪЯСНЮ" БОЛЬШЕ НЕ ПУБЛИКУЮТСЯ! ЕСЛИ ВЫ ХОТИТЕ ПОДЕЛИТЬСЯ ФАЙЛОМ, ПРИСЫЛАЙТЕ ЕГО АВТОРУ РАССЫЛКИ. ЭТО ВАМ НЕ ФОРУМ И НЕ СЛУЖБА СООБЩЕНИЙ МЕЖДУ ПОДПИСЧИКАМИ!

5. Если Вы присылаете некорректные вопросы, они будут рассмотрены автором и откорректированы. Вопросы, смысл которых будет не понятен, либо не найден, будут перезапрошены у отправителя вопроса.

Темы ФОРУМА:

Visual Basic / Basic не в пачёте?

FAQ Visual Basic / Моя первая программа

FAQ Visual Basic / Установка системных настроек принтера

FAQ Visual Basic / Последняя версия VB

Все об ActiveX / MS Agent's

FAQ Basic / Шифрование данных

Предложения и пожелания / Комментарии к статьям

---

40/ Здраствуйте ! У меня к вам будет один вопрос. Можно ли на ВБ (у меня установлена 6-я версия программы) сделать поиск подключенных компьютеров по локальной сети.Мне нужно узнать их ай-пи адрес и желательно имя компьютера. Я начинающий программист, если можно, обьясните более подробно. Заранее спасибо [Ответить]

---

63/ Здравствуйте! Как сделать столбец для таблицы с помощью VB который будет показывать номера кварталов с min зарплатой(в таблице 4 квартала). Другой столбец - Динамика изменения средней зарплаты по кварталам (рост, падение, колебание, постоянно)\ нужно найти среднее знаение среди записей каждого отдела и чтобы написал динамику изменени, то что напискано в скобках, одно слово. [Ответить]

---

76/ podskazhite pozhalusta, kak pravil'nee pristupit' k sozdaniu tablic i kakogo roda tablica nujna dlya vvoda, obrabotki i rascheta dannix, na VB.net. mne bazu sozdavat' ne nado. Zaranee spasibo [Ответить]

---

88/ Здравствуйте. У меня такой вопрос: можно ли из VB послать команду так, чтобы включилась удалённая машина в сети, на которой включен WakeUp on LAN. Если да, то как? За ранее спасибо за оказанную помощь! [Ответить]

---

99/ Здравствуйте. Создается регистратор переговоров. Подскажите, пожалуйста, каким образом записать звук в файл, чтобы в дальнейшем можно было открыть его и прослушать? Заранее спасибо. [Ответить]

---

100/ Здравствуйте. Меня интересует протокол ZModem или подобный. Спасибо [Ответить]

---

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

Заранее благодарен Евгений [Ответить]

---

115/ Как при работе в сети при разрыве связи можно узнать, что связь разорвана
удаленным сервером или локальной программой (ошибка 600)? [Ответить]

---

117/ Как сделать чтобы при выборе шрифта с помощью Microsoft CommonDialog менялся
и набор символов (Кириллица, Западноевропейский и т.п.)? Спасибо. [Ответить]

---

122/ Как сделать чтобы при нажатии на объект ListView НЕ воспроизводился тот
идиотский звук, который воспроизводится? [Ответить]

---

129/ Проблема то в том, что с оборотом нужно напечатать на сетевом принтере не
все листы, а только последний, на обороте которого печатается так называемый
"расчет рассылки", в котором указывается, сколько отпечатано экземпляров,
кто исполнял документ, кто печатал, дата печати документа и т.п. (выпускные
данные) это такое правило делопроизводства. Для этого в конце документа
вставляется разрыв страницы и на новой странице набирается или генериться
расчет рассылки. Сетевой принтер с двухсторонней печатью первые n-2 листа
выкидывает в выходной лоток, а предпоследний кладет в лоток оборотной
печати, затем его оттуда забирает и прогоняет его еще раз через блок печати,
но печатает его уже с оборотной стороны, так как лист прошел через лоток
оборотной печати. Если б я знал, как из свойств документа изъять количество
листов, то как-нибудь решил бы задачку сам и мои девушки не мучались бы с
этой проблемой.

Вопрос:

предполагаю, как можно решить, но не знаю, как реализовать. Исходные данные.

Есть сетевой принтер с возможностью двухсторонней печати. Пользователи
работают с MS Word. На печать посылаются задания из n листов. При этом листы
с 1 по n-2 должны быть напечатаны с одной стороны. Лист n-1 является
последним листом документа, а лист n оборотной стороной листа n-1.

Предполагаемое решение. По нажатию кнопки "Печать1" из переменной
"Количество листов в документе" извлекается значение и присваивается
переменной n. Если n<<2 выводится на экран сообщение "Печать с оборотом
невозможна" и производится выход из программы, если n>>2 вызывается на
исполнение функция печати, которой в параметрах передается:

1) Печатать листы с 1 по n-2;
2) Печатать без оборота.
Вызывается на исполнение функция печати, которой в параметрах передается:
1) Печатать листы n-1, n;
2) Печатать с оборотом.

При этом желательно сделать так, чтобы между вызовами функций печати в
очередь печати не проскочило какое-нибудь задание. Естественно, все это
оформить в виде макроса. Прошу Вас помочь мне>.



На Си++ получилось что-то вроде этого:

void Print1 (void) /* Эта функция связана с кнопкой "Печать1" */
{
int n; /* количество листов в документе */
n = (Извлекаем количество листов);
if (n < 2)
{
cout << "Печать с оборотом невозможна";
/* Можно вызвать функцию Worda для односторонней печати, если n >> 0 */
if (n > 0) PrintWorda (int 1, int 1, int 0);
}
if (n > 2) PrintWorda (int 1, int n-2, int 0); /* Печать без оборота */
PrintWorda (int n-1, int n, int 1); /* Печать с оборотом, в том числе для n
== 2 */
} [Ответить]

---

130/ Доброго времени суток, User`ы. Подскажите пожалуйсто, как в VB 6.0 к какому-либо устройству в порте COM по определённому адресу? Благодарю за внимание и за ответ. Спасибо. [Ответить]

---

132/ Добрый день! На вопрос "Как узнать программно(есть ли стандартные функции или нестандартные): -уровень заряда батарее в ноутбуке; -температуру жесткого диска; -температуру процессора; -скорости вентиляторов. Заранее благодарен!" я что-то не получил ответь
Тожностью как можно на text1.text = "температура" [Ответить]

---

136/ Здравствуйте!
У меня возникла проблема: для создания страниц сайта специфической тематики (математика) требуется программа, способная сохранять введенные пользователем в объект Equation данные в формате gif или png [как это делает MS Word, при сохранении документа в html формате. Т.е. технологический процесс такой: введение формул в Ворде, сохранение в html -> получение рисунков -> верстка страницы].
Сохранять данные в виде рисунка не проблема, но размер у них не такой какой необходим. Это и есть проблема: как сделать так, чтобы OLE объект со вставленным Equation'ом, изменял свои размеры в соответствии с изменениями размеров Equation'а (как это реализовано в MS Word) [Ответить]

---

144/ Подскажите: есть MySQL база, в ней есть какбы ячейки с номером,
например 84538834 или 444449329232, эти ячейки содержат информацию -
числа например 100 332 или 50.
Как можно средствами VB сделать программу которая искала бы в
этой базе значения этих ячеек равные нулю и удаляла бы их, и самое
главное нужен отчет о номерах удалённых ячеек, т.е. сколько чего
удалено из базы. [Ответить]

---

---

67/Здравствуйте! У меня к Вам два вопроса по VBA.
1. Мне часто приходится выполнять расчеты в Excel по формулам. Каким образом можно организовать вычисление в цикле так, чтобы после каждого следующего обращения формулы к ячейке X ее содержимое изменялось бы с определенным шагом?
2. При поиске в таблице базы данных какого-либо значения я пользуюсь формулами "ВПР" или "ГПР". Как можно сделать, чтобы при нахождении приближенного значения функция возвращала наименьшее из наибольших значений в строке или столбце списка, а не наибольшее из наименьших, как заложено в формулах?:::::::::::: [Ответить]

Отвечает: ElenaB_
1) Обычно это делается так
В одну ячейку (н/р A1) вводится первоначальное значение X, в соседнюю (B1) - формула F(X), а еще в какую-нибудь ячейку (C1) шаг (можно назвать ее Step)
После этого в ячейку A2 можно ввести формулу =A1+$C$1 (или =A1+Step), после этого скопировать эту ячейку A2 и вставить вниз нужное число раз, а также скопировать ячейку B1 и вставить ее также вниз, получается, что на один раз больше, таким образом в столбце А образуется ряд X-ов c шагом Step, а в столбце В ряд значений F(X) для X из столбца А. Это стандартный подход к таким вычислениям.

Если Вы не хотите размножать формулы в ячейках, а обойтись только двумя ячейками (я не совсем поняла формулировку вопроса, при автоматическом режиме вычислений, вообще-то говоря, нельзя отследить обращение формулы к ячейке, это сам Excel решает, когда пересчитывать), то лучше вообще это делать просто в VBA, меняя значение ячейки с X, а F(X) вычислять, например, через функцию Evaluate (с Evaluate для сложных формул могут возникнуть проблемы, так что без особой необходимости не советую), или перейти в режим ручного вычисления, и в макросе менять значение X, вызывать Calculate, потом брать значение F(X) и т.п., тем более не советую, страшно неэффективно. На самом деле в этом случае лучше вообще не использовать ячейки, а просто все считать в VBA

2) Кроме ВПР и ГПР есть функция ПОИСКПОЗ, которая дает такую возможность, если таблица отсортирована по убыванию, а третий аргумент равен -1. Но она дает не само значение, а только его строку в таблице (если вместо ВПР) или столбец (если вместо ГПР), а дальше надо использовать индекс.

Если таблица размещена в A1:C1, а значение мы ищем в столбце В (2), то формула примерно может выглядеть так (при сортировке по убыванию столбца A)

=ИНДЕКС(A1:C7;ПОИСКПОЗ(4;A1:A7;-1);2)

Если наверняка не может быть точного совпадения (наверное, не стоит на это рассчитывать никогда, так что просто для иллюстрации), то вроде бы можно и так (при сортировке по возрастанию столбца А)

=ИНДЕКС(A1:C7;ПОИСКПОЗ(4;A1:A7;1)+1;2)

---

Оценка за ответ: 5

---

119/Привет всем программистам! Недавно, читая статью об оптимизации приложений, я столкнулся со следующим вопросом. Для того, чтобы вы меня правильно поняли, цитирую часть статьи: "...Если вы создали большое приложение, подумайте о том, как разбить его на более мелкие. Используйте только одну главную исполняемую программу, которая вызывает другие программы, а также DDE-технологию для осуществления связей. Когда вы открываете неглавное приложение, откройте DDE-связь с главным приложением...". Так вот, может ли кто-нибудь кратко рассказать об DDE-технологии? Я об этом имею лишь общее понятие. Если можно, то объясните на примере. Заранее благодарю. С уважением, Алексей. [Ответить]

Отвечает: Вадим
Dinamic Data Exchenge обмен данными между приложениями через общую облать
памяти (буфер) - в данный момент устаревшая (по видимому в скором времени и
поддерживаться не будет). И спользуется очень просто на элементах управления
и форме настрой свойства: LinkItem, LinkMode, LinkTopic и все! Можно еще
через винапи, но я когда пробовал столкнулся с пачкой гимора. Так к слову:
может лучше использовать сокеты для обмена данными м-ду приложениями? В
случае чего можно ведь потом и в сети развернуть вся это дело?

---

Оценка за ответ: 5

---

125/Здравствуйте.
Скажите пожалуйста, что такое списки управления доступом (Access Control Lists - используется в функции GetVolumeInformation) [Ответить]

Отвечает: Вадим
Это списки в которых определено кто и что может делать с файлом, папкой, устройством и прочее. Актуально только для систем Win2000 выше (по дате рождения) и файловых систем NTFS.

---

Оценка за ответ: 4

---

126/Как можно прочитать данные с COM порта? [Ответить]

Отвечает: Вадим
Существует специальный компонент mscomm32.ocx

---

Оценка за ответ: 3

---

137/Привет! Подскажите как показать анимацию GIF'а [Ответить]

Отвечает: Игорь
Один из вариантов отображения анимации Gif'a я предлагал, но пообещал найти
еще один вариант, как это можно сделать. Так вот:

Создайте новый проект Visual Basic. На форму поместите 3 командные кнопки, 1
текстовое поле, 1 объект Image и 1 таймер. Все имена элементов оставьте по
умолчанию, а для объекта Image в свойстве Index введите значение "0".
Текстовое поле (Text1) будет служить для ввода полного пути и имени
изображения формата Gif. Командные кнопки - для воспроизведения анимации,
остановки и продолжения воспроизведения. Объект Image будет отображать
анимацию рисунка. Вставьте в проект один модуль. В модули формы и
программный модуль вставьте коды, расположенные ниже. Все остальное будет
понятно, пример прилагается.

Приложение к ответу (исходный код):
Option Explicit Dim FrameCount As Long Private Sub Command1_Click() Timer1.Enabled = False If LoadGif(Text1, Image1) Then FrameCount = 0 Timer1.Interval = CLng(Image1(0).Tag) Timer1.Enabled = True End If End Sub Private Sub Command2_Click() Timer1.Enabled = False End Sub Private Sub Command3_Click() Timer1.Enabled = True End Sub Private Sub Form_Load() With Text1 .Text = "clip.gif" .Top = 120 .Left = 120 .Height = 375 .Width = 2535 .TabIndex = 0 End With With Command1 .Caption = "Пуск" .Top = 120 .Height = 375 .Width = 1215 .Left = 2760 .Default = True End With With Command2 .Caption = "Стоп" .Top = 120 .Height = 375 .Width = 1215 .Left = 4200 End With With Command3 .Caption = "Продолжить" .Top = 120 .Height = 375 .Width = 1215 .Left = 5520 End With With Image1(0) .Left = 120 .Top = 720 .Height = 855 .Width = 2655 End With With Me .Width = 6945 .Height = 2115 .Caption = "GIF ANIMATION" End With Timer1.Enabled = False End Sub Private Sub Timer1_Timer() Dim i As Integer If FrameCount < TotalFrames Then Image1(FrameCount).Visible = False FrameCount = FrameCount + 1 Image1(FrameCount).Visible = True Timer1.Interval = CLng(Image1(FrameCount).Tag) Else FrameCount = 0 For i = 1 To Image1.Count - 1 Image1(i).Visible = False Next i Image1(FrameCount).Visible = True Timer1.Interval = CLng(Image1(FrameCount).Tag) End If End Sub КОД МОДУЛЯ: Option Explicit Public RepeatTimes As Long Public TotalFrames As Long Public Function LoadGif(sFile As String, aImg As Variant) As Boolean LoadGif = False If Dir$(sFile) = "" Or sFile = "" Then MsgBox "File " & sFile & " not found", vbCritical Exit Function End If On Error GoTo ErrHandler Dim fNum As Integer Dim imgHeader As String, fileHeader As String Dim buf$, picbuf$ Dim imgCount As Integer Dim i&, j&, xOff&, yOff&, TimeWait& Dim GifEnd As String GifEnd = Chr(0) & Chr(33) & Chr(249) For i = 1 To aImg.Count - 1 Unload aImg(i) Next i fNum = FreeFile Open sFile For Binary Access Read As fNum buf = String(LOF(fNum), Chr(0)) Get #fNum, , buf 'Get GIF File into buffer Close fNum i = 1 imgCount = 0 j = InStr(1, buf, GifEnd) + 1 fileHeader = Left(buf, j) If Left$(fileHeader, 3) <> "GIF" Then MsgBox "This file is not a *.gif file", vbCritical Exit Function End If LoadGif = True i = j + 2 If Len(fileHeader) >= 127 Then RepeatTimes& = Asc(Mid(fileHeader, 126, 1)) + (Asc(Mid(fileHeader, 127, 1)) * 256&) Else RepeatTimes = 0 End If Do ' Split GIF Files at separate pictures ' and load them into Image Array imgCount = imgCount + 1 j = InStr(i, buf, GifEnd) + 3 If j > Len(GifEnd) Then fNum = FreeFile Open "temp.gif" For Binary As fNum picbuf = String(Len(fileHeader) + j - i, Chr(0)) picbuf = fileHeader & Mid(buf, i - 1, j - i) Put #fNum, 1, picbuf imgHeader = Left(Mid(buf, i - 1, j - i), 16) Close fNum TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256&)) * 10& If imgCount > 1 Then xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256&) yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256&) Load aImg(imgCount - 1) aImg(imgCount - 1).Left = aImg(0).Left + (xOff * Screen.TwipsPerPixelX) aImg(imgCount - 1).Top = aImg(0).Top + (yOff * Screen.TwipsPerPixelY) End If ' Use .Tag Property to save TimeWait interval for separate Image aImg(imgCount - 1).Tag = TimeWait aImg(imgCount - 1).Picture = LoadPicture("temp.gif") Kill ("temp.gif") i = j End If DoEvents Loop Until j = 3 ' If there are one more Image - Load it If i < Len(buf) Then fNum = FreeFile Open "temp.gif" For Binary As fNum picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0)) picbuf = fileHeader & Mid(buf, i - 1, Len(buf) - i) Put #fNum, 1, picbuf imgHeader = Left(Mid(buf, i - 1, Len(buf) - i), 16) Close fNum TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10 If imgCount > 1 Then xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256) yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256) Load aImg(imgCount - 1) aImg(imgCount - 1).Left = aImg(0).Left + (xOff * Screen.TwipsPerPixelX) aImg(imgCount - 1).Top = aImg(0).Top + (yOff * Screen.TwipsPerPixelY) End If aImg(imgCount - 1).Tag = TimeWait aImg(imgCount - 1).Picture = LoadPicture("temp.gif") Kill ("temp.gif") End If TotalFrames = aImg.Count - 1 Exit Function ErrHandler: MsgBox "Error No. " & Err.Number & " when reading file", vbCritical LoadGif = False On Error GoTo 0 End Function
Скачать прикрепленный файл >>>

---

Оценка за ответ: 5


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

Повесь на форме Timer1, PictureBox1(0) - тоесть первый элемент масива PictureBox назови
его pic и поставь ему Top и Left в 0. Единственное с чем придется поиграться так это подбор цвета фона gifa.

Приложение к ответу (исходный код):
Вот исходники: Код модуля формы: Option Explicit Dim FrameCount As Long Private Sub Form_Load() LoadGif "angel.gif", pic frmTestRgnSkin.BackColor = MaskColor pic(0).BackColor = MaskColor For i = 0 To pic.Count - 1 pic(i).Top = 0: pic(i).Left = 0: pic(i).AutoSize = True Next TotalFrames = pic.Count - 1 FrameCount = 0 lRgn = lGetRegion(Me.pic(FrameCount), MaskColor) frmTestRgnSkin.Height = pic(0).Height frmTestRgnSkin.Width = pic(0).Width SetWindowRgn Me.hwnd, lRgn, True DeleteObject lRgn Timer1.Interval = 100 Timer1.Enabled = True End Sub Private Sub Timer1_Timer() pic(FrameCount).Visible = False If FrameCount < TotalFrames Then FrameCount = FrameCount + 1 Me.Height = pic(FrameCount).Height Me.Width = pic(FrameCount).Width Timer1.Interval = 100 Else FrameCount = 0 Timer1.Interval = 100 End If pic(FrameCount).Visible = True lRgn = lGetRegion(pic(FrameCount), MaskColor) SetWindowRgn Me.hwnd, lRgn, True DeleteObject lRgn End Sub Код модуля: Option Explicit Public i As Long Public lRgn As Long Public Const MaskColor = vbBlack Public Const RGN_OR = 2 Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long Public k As Long Public RepeatTimes As Long 'This one calculates, Public TotalFrames As Long Public lHeight As Long Public lWidth As Long 'Покадровая прорисовка Public Function lGetRegion(pic As PictureBox, lBackColor As Long) As Long Dim lRgn As Long Dim lSkinRgn As Long Dim lStart As Long Dim lX As Long Dim lY As Long Dim phDC As Long ' Оптимизация phDC = pic.hdc ' Оптимизация 'создаем пустой регион, с которого начнем работу lSkinRgn = CreateRectRgn(0, 0, 0, 0) With pic 'подсчитаем размеры рисунка в Pixel lHeight = .Height / Screen.TwipsPerPixelY lWidth = .Width / Screen.TwipsPerPixelX For lX = 0 To lHeight - 1 lY = 0 Do While lY < lWidth 'ищем нужный Pixel Do While lY < lWidth And GetPixel(phDC, lY, lX) = lBackColor lY = lY + 1 Loop If lY < lWidth Then lStart = lY Do While lY < lWidth And GetPixel(phDC, lY, lX) <> lBackColor lY = lY + 1 Loop If lY > lWidth Then lY = lWidth 'нужный Pixel найден, добавим его в регион lRgn = CreateRectRgn(lStart, lX, lY, lX + 1) CombineRgn lSkinRgn, lSkinRgn, lRgn, RGN_OR DeleteObject lRgn End If Loop Next End With lGetRegion = lSkinRgn End Function 'Читаем с Gif кадры и заполняем ими PictureBox Public Function LoadGif(sFile As String, aImg As Variant) As Boolean Dim FileName As String LoadGif = False If Dir$(sFile) = "" Or sFile = "" Then MsgBox "File " & sFile & " not found", vbCritical Exit Function End If On Error GoTo ErrHandler Dim fNum As Integer, Kilkist As Integer Dim imgHeader As String, fileHeader As String Dim buf$, picbuf$ Dim imgCount As Integer Dim i&, j&, xOff&, yOff&, TimeWait& Dim GifEnd As String GifEnd = Chr(0) & Chr(33) & Chr(249) For i = 1 To aImg.Count - 1 Unload aImg(i) Next i fNum = FreeFile Open sFile For Binary Access Read As fNum buf = String(LOF(fNum), Chr(0)) Get #fNum, , buf 'Get GIF File into buffer Close fNum i = 1 imgCount = 0 j = InStr(1, buf, GifEnd) + 1 fileHeader = Left(buf, j) If Left$(fileHeader, 3) <> "GIF" Then MsgBox "This file is not a *.gif file", vbCritical Exit Function End If LoadGif = True i = j + 2 If Len(fileHeader) >= 127 Then RepeatTimes& = Asc(Mid(fileHeader, 126, 1)) + (Asc(Mid(fileHeader, 127, 1)) * 256&) Else RepeatTimes = 0 End If Do ' Split GIF Files at separate pictures ' and load them into Image Array imgCount = imgCount + 1 j = InStr(i, buf, GifEnd) + 3 If j > Len(GifEnd) Then FileName = "temp.gif" 'imgCount & ".gif" fNum = FreeFile Open FileName For Binary As fNum picbuf = String(Len(fileHeader) + j - i, Chr(0)) picbuf = fileHeader & Mid(buf, i - 1, j - i) Put #fNum, 1, picbuf imgHeader = Left(Mid(buf, i - 1, j - i), 16) Close fNum TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256&)) * 10& If imgCount > 1 Then xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256&) yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256&) Load aImg(imgCount - 1) End If ' Use .Tag Property to save TimeWait interval for separate Image aImg(imgCount - 1).Tag = TimeWait aImg(imgCount - 1).Picture = LoadPicture(FileName) Kill (FileName) If lHeight < frmTestRgnSkin.pic(imgCount - 1).Height Then lHeight = aImg(imgCount - 1).Height End If If lWidth < frmTestRgnSkin.pic(imgCount - 1).Width Then lWidth = aImg(imgCount - 1).Width End If i = j End If DoEvents Loop Until j = 3 If i < Len(buf) Then fNum = FreeFile Open "temp.gif" For Binary As fNum picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0)) picbuf = fileHeader & Mid(buf, i - 1, Len(buf) - i) Put #fNum, 1, picbuf imgHeader = Left(Mid(buf, i - 1, Len(buf) - i), 16) Close fNum TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10 If imgCount > 1 Then xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256) yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256) Load aImg(imgCount - 1) End If aImg(imgCount - 1).Tag = TimeWait aImg(imgCount - 1).Picture = LoadPicture("temp.gif") Kill ("temp.gif") End If TotalFrames = aImg.Count - 1 lHeight = lHeight / Screen.TwipsPerPixelY lWidth = lWidth / Screen.TwipsPerPixelX Exit Function ErrHandler: MsgBox "Error No. " & Err.Number & " when reading file", vbCritical LoadGif = False On Error GoTo 0 End Function ruslan-iz@mail.ru

---

Оценка за ответ: 5

---

140/Здравствуйте!
Я с VB знаком давно но руки не доходили до него написать что-то
серйозное. Решил написать программу для создания комбинаций клавиш на
мыши. Например: Колесо + Левая кнопка мыши = Копировать, и т. п. Но я
никак не могу определить какая же кнопка мыши нажата(или колесо).
Заранее благодарен. [Ответить]

Отвечает: Subs
EnzO)Stalker'у
А одновременные нажатия ловятся путем прибавления одиночных. Например:
If Button = 1 + 2 Then
MsgBox "Левая + Правая кнопка мыши"
End If
Но вот в Form_MouseUp или Form_MouseDown поймать их вряд ли удастся (будет
срабатывать первое одиночное) а в Form_MouseMove, пожалуйста.

И еще, при ответе на 139-й вопрос, Вы под "контейнер" использовали
PictureBox. А надо использовать переменную.
Dim picHidden as Picture
set picHidden = LoadPicture(...
(600 picturebox'ов (пустых) = ~1mb ОЗУ)
(600 переменных picture (пустых) = ~0mb ОЗУ)

---

Оценка за ответ: 5

---

142/ Здравствуйте уважаемые программисты!
Как создать файл имя которого переменная adres?
Заранее спасибо! [Ответить]

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


Переменный бывают нескольких типов: String, Variant, Boolean и другие.
Надеюсь Ваша переменная имеет тип String (т.е. строковая).

Dim adres As String

Private Sub Form_Load()
adres = "MYFILE.TXT" 'Задаем Имя файла
Open "C:\" & adres For Output As #1
Rem: "C:\" & adres > Полный путь + имя файла, которое читается из переменной
"adres" _
В данном случае в корне диска С создастся файл "MYFILE.TXT"
Close #1
End Sub

Конечно, не понятно какой тип файла Вам необходимо создавать (мой ответ на
Ваш вопрос показывает создание текстового файла), но как Вы задали свой
вопрос, так я на него и ответил... ФАЙЛ СОЗДАЕТСЯ, его имя - переменная
ADRES. Все!

---

Оценка за ответ: 5

---

143/Вот какая проблема:
Задавал я вам один вопрос, об отображении немецких символов...но он не совсем корректный.
У меня находятся на форме datagrid и label.Проблема в том что в самой таблице символы
отображаются и если ввести их в label.caption они тоже отображаются,но если написать так:

datagrid1.Col = 1
datagrid1.Row = 1
Label1.Caption = datagrid1.text

то символы изменяются (например с a на а ).Подскажите пожалуйста что можно сделать чтобы исправить ето? [Ответить]

Отвечает: Bourn
см. пример
Скачать прикрепленный файл >>>

---

Оценка за ответ: 5

---

145/Есть база данных MySQL, нужно добавить в эту базу пин коды, например
3424242432 или 77773377238, а также их значения, например 100 200 или
20. Но, если в базе уже имеется этот номер, то добавление не
происходит (замена), как это сделать кто-нибудь знает? [Ответить]

Отвечает: Bullet [PCLO]
Судя по вопросу, базу mySQL ты уже создал и подключил к программе, и остается
только выполнить сами SQL запросы. Так как ты не описал название
таблицы в которой хранятся данные, формат полей таблицы и их
наименования, то будем исходить из того, что таблица называется Table1, а все
поля в ней текстовые и имею следующие названия PIN_ID, PIN_Val (Пин
код и его значение). Ну а теперь приступим к твоим SQL запросам.

Берем код, который ты хочешь добавить в базу, например 3424242432 (из
твоего примера)

Естественно подразумевается что до этого ты правильно настроил доступ
к самой базе и как минимум написал в коде программы такое:



Приложение к ответу (исходный код):
Dim dbConn As Connection Dim recSet As ADODB.Recordset Set dbConn = New Connection dbConn.CursorLocation = adUseClient dbConn.Open "PROVIDER=SQLOLEDB;SERVER=ЗдесьУкажиИмяСвоегоСервера;DATABASE=ЗдесьУкажиИмяСвоейБазыДанных;TRUSTED_CONNECTION=YES" Смотрим в базу на наличие такого кода: Set recSet = New Recordset recSet.Open "select PIN_ID from Table1 where PIN_ID='3424242432'", dbConn, adOpenStatic, adLockOptimistic ' Если такое значение не было найдено в базе, то добавляем его If recSet.RecordCount = 0 Then recSet.Open "insert into table1 (PIN_ID,PIN_Val) values ('3424242432','100')" Else ' А если такой код уже был, то сделаем замену ему recSet.Open "update table1 set PIN_Val = '100' where PIN_ID = '3424242432'" End If Set recSet = Nothing Вот собственно и все. Если все же ты не знаешь как подключить базу и что такое строка конекта (поскольку из вопроса не ясно умеешь ты это делать или нет), то это уже другой вопрос и тебе следует задать его отдельно.

---

Оценка за ответ: 5

---

146/Не подскажете ли вы, как получить список вложенных папок в одной! [Ответить]

Отвечает: Super-Vadim
См. пример

Приложение к ответу (исходный код):
Dim dbConn As Connection Dim recSet As ADODB.Recordset Set dbConn = New Connection dbConn.CursorLocation = adUseClient dbConn.Open "PROVIDER=SQLOLEDB;SERVER=ЗдесьУкажиИмяСвоегоСервера;DATABASE=ЗдесьУкажиИмяСвоейБазыДанных;TRUSTED_CONNECTION=YES" Смотрим в базу на наличие такого кода: Set recSet = New Recordset recSet.Open "select PIN_ID from Table1 where PIN_ID='3424242432'", dbConn, adOpenStatic, adLockOptimistic ' Если такое значение не было найдено в базе, то добавляем его If recSet.RecordCount = 0 Then recSet.Open "insert into table1 (PIN_ID,PIN_Val) values ('3424242432','100')" Else ' А если такой код уже был, то сделаем замену ему recSet.Open "update table1 set PIN_Val = '100' where PIN_ID = '3424242432'" End If Set recSet = Nothing Вот собственно и все. Если все же ты не знаешь как подключить базу и что такое строка конекта (поскольку из вопроса не ясно умеешь ты это делать или нет), то это уже другой вопрос и тебе следует задать его отдельно.
Скачать прикрепленный файл >>>

---

Оценка за ответ: 5


Отвечает: Bullet [PCLO]
Мне когда то попался код неизвестного автора, я его немного
изменил и теперь им пользуюсь.

Приложение к ответу (исходный код):
В модуль вставляй этот код: Option Explicit Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Public Enum AtributConst FILE_ATTRIBUTE_ARCHIVE = &H20 FILE_ATTRIBUTE_COMPRESSED = &H800 FILE_ATTRIBUTE_DIRECTORY = &H10 'FILE_ATTRIBUTE_ENCRYPTED=??? FILE_ATTRIBUTE_HIDDEN = &H2 FILE_ATTRIBUTE_NORMAL = &H80 'FILE_ATTRIBUTE_OFFLINE=??? FILE_ATTRIBUTE_READONLY = &H1 'FILE_ATTRIBUTE_REPARSE_POINT=??? 'FILE_ATTRIBUTE_SPARSE_FILE=??? FILE_ATTRIBUTE_SYSTEM = &H4 FILE_ATTRIBUTE_TEMPORARY = &H100 End Enum Public Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Public Type WIN32_FIND_DATA dwFileAttributes As AtributConst ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * 260 cAlternate As String * 14 End Type Private Const INVALID_HANDLE_VALUE = -1 'Возникает при отсутствии файла Public Function StartFind(ByVal sFilter As String, ByRef FindArray() As WIN32_FIND_DATA) Dim lngHandle As Long 'Хандл открытого файла Dim TempData As WIN32_FIND_DATA 'Временная переменная lngHandle = FindFirstFile(sFilter & Chr(0), TempData) 'Находим хандл If lngHandle = INVALID_HANDLE_VALUE Then Exit Function 'Если ничего нет, уходим ReDim FindArray(0) 'Ресайзим массив под 1-й файл (директорию) FindArray(0) = TempData 'Присваеваем информацию о файле Do Until FindNextFile(lngHandle, TempData) = 0 'Продолжаем поиск, пока не ошибемся DoEvents 'Не зависаем ReDim Preserve FindArray(UBound(FindArray) + 1) 'Ресайзим массив на 1 больше прежнего FindArray(UBound(FindArray)) = TempData 'Присвоение очередной порции информации Loop Call FindClose(lngHandle) 'Побаловались да и хватит... End Function 'Поиск файлов по маске в подкаталогах Public Sub ScanForDirs(StartPath As String, kkDirs() As String, objList As Object) Dim i As Long, Dir1() As String, kDir As Long kDir = UboundS(kkDirs()) kDir = kDir + 1 If Right(StartPath, 1) = "\" Then Else StartPath = StartPath + "\" End If DirBoxEmu StartPath, Dir1() For i = 0 To UboundS(Dir1()) DoEvents ReDim Preserve kkDirs(i + kDir) kkDirs(i + kDir) = StartPath + Dir1(i) ScanForDirs StartPath + Dir1(i), kkDirs(), objList objList.AddItem kkDirs(i + kDir) Next End Sub 'Эмуляция DirBox Private Sub DirBoxEmu(Path As String, Dirs() As String) Dim Data() As WIN32_FIND_DATA, i As Long, Counter As Long, TempName As String Counter = -1 Erase Dirs() If Mid(Path, Len(Path), 1) = "\" Then Else Path = Path + "\" End If Erase Data() StartFind Path + "*", Data() For i = 0 To UboundFind(Data()) DoEvents TempName = Left(Data(i).cFileName, InStr(1, Data(i).cFileName, Chr(0)) - 1) If TempName <> "." And TempName <> ".." Then If GetEntryType(Data(i).dwFileAttributes) = 1 Then Counter = Counter + 1 Debug.Print "Counter - " & Counter ReDim Preserve Dirs(Counter) Dirs(Counter) = TempName End If End If Next End Sub Private Function GetEntryType(dwAttributes As Long) As Long GetEntryType = 0 'файл по умолчания If (dwAttributes And &H10) = &H10 Then GetEntryType = 1 ' каталог Else GetEntryType = 0 'файл End If End Function 'Странности в работи функции UBound() вынудили написать свои Public Function UboundFind(Data() As WIN32_FIND_DATA) As Long On Error GoTo Handler: UboundFind = UBound(Data()) Exit Function Handler: UboundFind = -1 End Function Public Function UboundS(Data() As String) As Long On Error GoTo Handler: UboundS = UBound(Data()) Exit Function Handler: UboundS = -1 End Function А на форме размести текстовое окно txtPath, список List1, кнопку Command1 и вставь такой код: Private Sub Command1_Click() Dim a() As String List1.Clear ScanForDirs txtPath.Text, a(), List1 End Sub В текстовом окне укажи папку, список вложенных папок которой нужно отобразить и жми на Command1.

---

Оценка за ответ: 5

---

148/Скажите пожалуйста, как сделать массив типа Variant (или String)
видимым на всю программу? Заранее благодарен. [Ответить]

Отвечает: HouseBugs
В модуле программы в секции Option Explicit обьяви свой масив как
Public. Пример Public ИмяМасива(Размерность) As String

---

Оценка за ответ: 3


Отвечает: Игорь
Лично я в Вашем вопросе вижу два вопроса и не понятно, что именно Вас
интересует. То ли Вы спрашиваете, как создать массив в Visual Basic, то ли
как сделать его видимым на всю программу. И в том и в другом случае видно,
что Вы новичок в Visual Basic, поэтому отвечу на оба вышеперечисленных
вопроса.

1) КАК СДЕЛАТЬ МАССИВ ТИПА VARIANT (ИЛИ STRING)

Массив представляет собой набор переменных с одним именем и разными
индексами. Каждая такая переменная называется элементом массива. Количество
хранящихся в массиве элементов называется размером массива. Размер массива
ограничен объемом оперативной памяти и типом данных элементов массива.
Все элементы массива имеют одинаковый тип. Однако если массив имеет тип
variant, то отдельные элементы могут содержать данные разных типов.
Например, одни элементы могут быть числами, другие - строками или объектами.
Индекс элемента указывается в круглых скобках после имени массива. Например,
strNames(l), strNames(2), strNames(10) являются элементами массива с именем
strNames. Вы можете использовать каждый из элементов массива точно так же,
как и простую переменную.
В Visual Basic существуют массивы фиксированного размера и динамические
массивы. Массив фиксированного размера имеет неизменный размер, заданный при
его объявлении. Динамические массивы могут изменять размер в процессе
выполнения.
ОБЪЯВЛЕНИЕ МАССИВА ФИКСИРОВАННОГО РАЗМЕРА
Объявление массива фиксированного размера зависит от области его видимости и
осуществляется следующим образом:
> глобальный массив объявляется с помощью оператора Public в секции
Declaration модуля:
> массив уровня модуля - с помощью оператора Private в секции Declaration
модуля;
> локальный массив - с помощью оператора Private процедуры.
При объявлении массива после его имени в круглых скобках указывается верхняя
граница массива. По умолчанию нижней границей массива является 0. Например,
в приведенном ниже коде, который вводится в секцию Declaration модуля,
задается массив из 21 элемента. Индекс элементов массива изменяется от 0 до
20:
Dim intCountPar (20) As Integer
Для создания глобального массива такого же размера необходимо использовать
следующий код:
Public intCountPar (20) As Integer Можно явно задать нижнюю границу массива,
используя ключевое слово то:
Dim intCountPar (1 To 20) As Integer
В этом случае задается массив из 20 элементов. Индекс элементов массива
изменяется от 1 до 20.
Visual Basic позволяет использовать многомерные массивы. Например, в
следующем коде объявляется двумерный массив размерностью 21х21:
Dim intCountPar (20, 20) As Integer
При использовании многомерных массивов, как и в случае одномерных, можно
явно задавать нижнюю границу:
Dim intCountPar (1 To 20, 1 То 20) As Integer Dim intCountPar (20, 1 То 20)
As Integer
В верхней строке кода явно заданы верхняя и нижняя граница обеих
размерностей. В нижней строке задана верхняя и нижняя граница только для
второй размерности.

ОБЪЯВЛЕНИЕ ДИНАМИЧЕСКОГО МАССИВА
В случае, когда размер массива заранее неизвестен. Visual Basic позволяет
использовать динамические массивы, размеры которых можно изменять во время
выполнения. Применение динамических массивов позволяет эффективно управлять
памятью, выделяя память под большой массив лишь на то время, когда этот
массив используется, а затем освобождая ее.
Создание динамического массива осуществляется следующим образом:
1. Объявляется массив с помощью ключевых слов, используемых при создании
массива фиксированного размера. Список размерностей массива остается пустым.
При объявлении глобального массива необходимо выбрать ключевое слово Public,
при объявлении массива на уровне модуля - Dim, при объявлении массива в
процедуре - Dim или static. Например,
Dim intCountPar О As Integer
2. С помощью выполняемого оператора ReDim указывается размерность массива в
виде числа или выражения. Синтаксис оператора ReDim аналогичен синтаксису
оператора объявления массива фиксированного размера. Например, размерность
массива может быть задана любым из следующих способов:
ReDim intCountPar (х)
ReDim intCountPar (20)
ReDim intCountPar (1 То 20)
При выполнении оператора ReDim данные, размещенные в массиве ранее,
теряются. Это удобно в том случае, если данные вам больше не нужны и вы
хотите переопределить размерность массива и подготовить его для размещения
новых данных. Если вы хотите изменить размер массива, не потеряв при этом
данных, то необходимо воспользоваться оператором ReDim с ключевым словом
Preserve. Например, приведенный ниже программный код увеличивает размер
массива на единицу без потери хранящихся в массиве данных:
ReDim Preserve intCountPar (X + 1)
Замечание: Использование оператора ReDim с ключевым словом Presterve
позволяет изменять только верхнюю границу последней размерности многомерных
размеров.

2) КАК СДЕЛАТЬ МАССИВ ВИДИМЫМ НА ВСЮ ПРОГРАММУ

При выполнении программы принципиальное значение имеет область действия
выбранных переменных (или массивов). Попытка использования переменных,
которые не действуют в данном месте программы, приводит к ошибке
программирования или же к неоднозначности результатов. В Visual Basic можно
применять глобальные и локальные переменные. Глобальные переменные, о чем Вы
спрашивали, ДОСТУПНЫ ИЗ ЛЮБОЙ ЧАСТИ ПРОГРАММЫ. Для локальных переменных
можно задавать область действия в рамках всего модуля или отдельной
процедуры.
Для создания переменной, которую вы хотите определить в качестве ГЛОБАЛЬНОЙ,
в раздел General Declarations главного модуля приложения поместите оператор
Public, например:
Public gdtmFinish As Date
Вы также можете объявить глобальную переменную или массив и в модуле
какой-либо формы, но затем необходимо будет указывать ссылку на это форму
при присвоении значений, например, Form1.gdtmFinish = "значение". Из моей
практики такое объявление часто приводит к ошибкам и в большинстве случаем
все равно приходится объявлять массив или переменную в программном модуле...
Для объявления переменной, локальной внутри модуля или формы, используйте
оператор Private или Dim в разделе General Declarations модуля или формы. В
этом случае объявленная переменная будет доступна для всех входящих в форму
или модуль процедур, но в то же время недоступной в процедурах других
модулей и форм.
Переменные, локальные на уровне процедуры, создаются операторами Dim или
Static внутри процедуры, например:
Sub CalcTotal
Dim bSuccess As Boolean
. . .
End Sub
Конечно же, я понимаю, что Вам трудно понять все выше написанное, но со
временем Вы приобретете опыт и у Вас больше не будут возникать подобные
вопросы! Желаю удачи!!!

---

Оценка за ответ: 5


Отвечает: Super-Vadim
Нужно просто объявить этот массив в Модуле – если конечно программа
состоит не из одной Form1. А если из одной Form1, то достаточно
поместить объявление массива в General Declarations этой формы.
В модуле массив объявляется так:
Public Mas(10) as Variant

А в форме вот так:
Dim Mas(10) as Variant

---

Оценка за ответ: 4


Отвечает: Вадим
в любом стандартном модуле объявить: public SomeArray() as Variant
или global SomeArray()as variant. В последнем случае он будет виден и за
пределами
программы

---

Оценка за ответ: 4


Отвечает: Bullet [PCLO]
Создаешь в проекте модуль, в модуле пишешь
Public aTestArray(1 To 10) As String
или
Public aTestArray(1 To 10) As Variant

и после этого в любой точке программы можеш его использовать

---

Оценка за ответ: 4


Отвечает: Bourn
В самом начале формы помещаем одну из предложенных ниже конструкций:
Private h1(1 to 100) As Variant
Public h2(1 to 100) As Variant
Dim h3(1 to 100) As Variant

---

Оценка за ответ: 4


Отвечает: Bourn
Если имеется ввиду Public массив, то в объектном модуле (например в коде
формы) его объявить невозможно. Добавьте в проект простой модуль, и уже в
нем объявляйте Public массив.

---

Оценка за ответ: 4

---

149/Здравствуйте уважаемые программисты. У меня к вам такой вопрос. Я сделал
себе программу дозвона до Интернет с подсчетом времени работы в сети,
используя для этой цели стандартный объект "Таймер". Но, как выяснилось
позже, таймер, поставляемый с Visual Basic работает неправильно. А именно,
с каждой минутой он задерживается приблизительно на 1,5-2 секунды,
следовательно после 2-х минут работы - это уже 3-4 секунды, а после 10-ти
...(!!!). Я уже не буду говорить как наломала меня моя программа после 6-ти
часов работы. Время, которое отображалось на странице моей статистики у
моего провайдера ничуть не было похоже на время, отображаемое моей
программой...
Я проделал следующий опыт: Создал проект, добавил в него таймер и вставил
следующий код:

Option Explicit
Dim i As Integer

Private Sub Form_Load()
Timer1.Interval = 1000
Timer1.Enabled = True
i = 0
End Sub

Private Sub Timer1_Timer()
i = i + 1
Me.Caption = i
End Sub

Проследите сами, совпадает ли время таймера с реальным. Для проверки я
использовал несколько бытовых секундомеров. Может такая проблема только у
меня? Если нет, то как можно исправить эту проблему? А больше всего,
хотелось бы узнать, можно ли обойти этот таймер от Microsoft каким-либо
другим способом? Заранее благодарен всем советчикам, подключившимся к моему
вопросу. [Ответить]

Отвечает: Вадим
ничего удивительного нет. но можно использовать винапи - тогда проблема
решится - но не полностью. все это жестко завязано на системный таймер
машины, а вин сис-ма не реального времени. вывод прост - за какой либо малый
промежуток времени Т погрешность таймера можно принять равной 0, в остальных
случаях, когда времнной интервал большой - будет погрешность, хотя и
маленькая

---

Оценка за ответ: 5


Отвечает: HouseBugs
Это у всех такая лажа с VB элементом Timer, лучше используй функцию Timer:
перед самым началом подсчета TimeNacalo = Timer
в конце TimeConec = Timer
TimeProslo = TimeConec - TimeNacalo (результат в секундах).
Вот описание этой функции:
Timer - Возвращает Single, содержащее количество секунд, прошедших после полуночи.

---

Оценка за ответ: 5


Отвечает: Сергей Абрамов
См. приложение

Приложение к ответу (исходный код):
Option Explicit Dim i As Integer , Tm_begin ' Добавляешь переменную Tm_begin типа Вариант Private Sub Form_Load() Timer1.Interval = 1000 Timer1.Enabled = True i = 0 Tm_begin = Time ' Запоминаешь системнное время в момент запуска программы End Sub Private Sub Timer1_Timer() i = i + 1 If (Int (i/60)=i/60) Then i = Second (Time) - Second (Tm_begin) ' Т.е каждую минуту записываешь в переменную i истинное количество секунд работы программы ' Me.Caption = i End Sub

---

Оценка за ответ: 5


Отвечает: Артемий
Да в VB есть такая маленькая проблема с таймером, когда мне надо чтобы
тацмер отсчитывал время то я обычно ставил интервал равный 999. но и это
тоже не лучший вариант. Лочше чтобы программа запоминала начальное время
работы в сети и конечное потом их сравнивало, и получала результат.

---

Оценка за ответ: 5


Отвечает: Bullet [PCLO]
В модуль кидай следующее:

Приложение к ответу (исходный код):
Public nTimerCount As Long Function fTimer() Start = Timer Do DoEvents nTimerCount = Timer - Start Loop End Function На форме, в нужный момент запускаешь таймер Private Sub Form_Load() ... fTimer ... End Sub Теперь кол-во секунд от момента запуска таймера записывается в переменную nTimerCount. Если тебе нужно узнать минуты, то делишь на 60 и т.д. Если нужн обнулить, то обнуляешь. Если нужно поставить в паузу, то просто сохрани текущее значение nTimerCount и когда снимаешь паузу обнули nTimerCount и новое время вычисляй так ВремяПослеПаузы = СохраненноеЗначениеnTimerCount + nTimerCount Вроде все.

---

Оценка за ответ: 5


Отвечает: Bourn
Не совсем понятно о каком таймере от Microsoft ты говоришь,
но можно попробовать реализовать поставленную задачу, по
другому, пользуясь обычными часами :), продемонстрирую на
твоем же примере(время показывает в секундах минутах и часах):

Приложение к ответу (исходный код):
Option Explicit Dim i, j, k As Date Private Sub Form_Load() Timer1.Interval = 1 Timer1.Enabled = True i = Time End Sub Private Sub Timer1_Timer() j = Time k = j - i Me.Caption = k End Sub

---

Оценка за ответ: 5


Отвечает: Fedos
Таймер врёт (у всех).
Вообще, можно использовать другой способ подсчета времени.
Например можно оттолкнуться от функций Now или Time.
Или Timer, она возвращает количество секунд прошедших с начала суток
(00:00:00). (код в пустую форму):

Приложение к ответу (исходный код):
Dim X As Double Private Sub Form_Load() X = Timer End Sub Private Sub Form_Click() If Timer < X Then X = X - 86400 'это если изменится день. Cls Print "proga rabotaet:" Print (CInt(Timer - X) / 60 / 60) Mod (60 * 60) & " hour" Print (CInt(Timer - X) / 60) Mod 60 & " min" Print CInt(Timer - X) Mod 60 & " sec" End Sub Если будешь лазать в Интернете больше суток, то придется дописать проверку на изменение даты. А ище, можно попробовать так. После отключения от Инета, запускать прогу которая считает с log файла модема нужное время. Сначала считываем первую и последнюю строчки из файла Environ("windir") & "\" & Dir(Environ("windir") & "\ModemLog_*.txt") убираем лишнее (оставляем только дату с временем) и как в примере выше высчитываем время последнего лазания по инету.

---

Оценка за ответ: 5

Трюки с CD-Rom
CD-ROM. Открываем и закрываем	Скачать
Модуль: Управление CD-Rom	Скачать
Формы: операции с формами
Вызывает стандартное окно About	Скачать
Запрещаем нажатие кнопки X на форме	Скачать
Модуль: Прозрачные окна	Скачать
Модуль: Разные формы	Скачать
Перетаскивание окна не за заголовок	Скачать
Операции с формами (отображение, скрытие, загрузка, выгрузка) New!!!	Скачать
Форма с закругленными концами	Скачать
VBA – все, относящееся к прикладному программированию
Excel - программное создание базы данных в книге Excel New!!!	Скачать
Проверка орфографии с помощью Word	Скачать
Файлы – операции с файлами
Модуль: Считывает размер файла, папки	Скачать
Применение FSO в приложении	Скачать
Пример показывает анимирование Gif-файла в приложении	Скачать
Просмоторщик ресурсов	Скачать
Создание MP3-коллекции файлов New!!!	Скачать
Файлы - стандартные операции с файлами в VB New!!!	Скачать
Операции с BMP (создание волн)	Скачать
Создание щтрих-кода в BMP-файле	Скачать
Реестр и INI-файлы
INI-файлы. Очень подробный пример для работы с Ini-файлами в приложении New!!!	Скачать
Изменяем параметры Internet Explorer New!!!	Скачать
Модуль: Работа с реестром	Скачать
Работа с реестром	Скачать
Пример реализации проверки файлов методом CRC New!!!	Скачать
Панель задач и трей
Progress Bar в Task Manager	Скачать
Блокирование/разблокирование, скрытие/отображение кнопки ПУСК New!!!	Скачать
Иконка в трее	Скачать
Иконка в трее	Скачать
Модуль: Иконка в трее	Скачать
Модуль: Иконка в трее 2	Скачать
Программно впихиваем текст в панель задач (рядом с часами) New!!!	Скачать
Часики в трее	Скачать
Меню в Visual Basic
Меню с использованием BMP-файлов (1)	Скачать
Меню с использованием BMP-файлов (2)	Скачать
Стильное VB меню	Скачать
Диалоги в Visual Basic
Вызов стандартного диалога открытия файла без использования контрола	Скачать
Модуль: Стандартные диалоги	Скачать
Элементы управления в Visual Basic
Кнопка XP New!!!	Скачать
Крутой ProgressBar	Скачать
Магическая кнопка! New!!!	Скачать
Перебор цвета в Combo Box New!!!	Скачать
Поворот текста под любым углом в PictureBox New!!!	Скачать
Работа с таблицами в MSFexGrid New!!!	Скачать
Создание таблицы с заголовками из ListBox	Скачать
Текст под любым углом в PictureBox New!!!	Скачать
Windows XP Style все по работе со стилями
Модуль: XP стиль	Скачать
ХР стиль в приложении Visual Basic	Скачать
Разное
Запрет нажатия клавиш Ctrl+Alt+Del	Скачать
Звонилка New!!!	Скачать
Информация о текущем пользователе New!!!	Скачать
Модуль: Информация о жестком диске	Скачать
Модуль: Программное переключение языка ввода с клавиатуры	Скачать
Модуль: Сортировка массива	Скачать
Модуль: Функции выключения, перезагрузки компьютера	Скачать
Модуль: Шатдаун компьютера	Скачать
Монитор статуса соединения с сетью New!!!	Скачать
Пример известной игры Lines	Скачать
Работа с DirectX	Скачать
Работа с консолью в windows	Скачать
Работа с портами в Windows	Скачать
Создание анимированных изображений	Скачать
Создание программы установки	Скачать
Считывает серийный номер жесткого диска	Скачать
Удаленное подключение к компьютеру	Скачать
Устанавливаем приоритет приложения в Windows	Скачать
Цифровое табло	Скачать
Часики	Скачать
Часы с таймером	Скачать
Читаем разную информацию о БИОСЕ	Скачать

Есть вопросы относительно статьи, задавайте!

В предыдущем выпуске Алексей задал вот такой вопрос: Как заставить работать Package & Deployment Wizard в Visual Basic 6.0

У меня 2 вопроса по поводу статьи "Как заставить работать Package & Deployment Wizard в Visual Basic 6.0" (кстати особое спасибо Игорю за статью, она очень помогла):
1. Есть ли программа которая создаёт не инсталляционных пакетов, а для деинсталляционных?
2. Можно ли сделать в Package & Deployment Wizard, чтобы Setup устанавливал не одно приложение, а допустим два соеденённым в vbg файл, к примеру если я создаю игру менеджер футбольного клуба, первый проект сама игра, а второй редактор базы данных?
Заранее спасибо.

Ответов поступило 2:

Отвечает Игорь:
Вы, конечно же, понимаете, что автор рассылки запретит мне отвечать на Ваш вопрос, т.к. он не относится к Visual Basic, отвечу коротко - таких программ много. Если Вы имеете в виду такую программу, поставляемую с Visual Basic, то таковой нет, НО сам Package Wizard создает то, о чем Вы спрашивали. Обратите внимание на файл St6unst.log, который создается в папке программы, которую Вы устанавливаете с помощью Package Wizard. Открыв его с помощью блокнота, Вы сможете увидеть весь ход инсталяции Вашей программы и список всех файлов, которые установились и их места назначения (т.е. папки, куда они установились). Ни в коем случае не удаляйте этот файл, если захотите со временем удалить программу, т.к. без него деинсталяции не произойдет. А произвести ее можно с помощью Панели Управления - вкладка Установка и удаление программ. Кстати сама программа деинсталяции хранится в папке Windows - St6unst.exe, но запускать ее необходимо с необходимым ключом, например, C:\WINDOWS\st6unst.exe -n "C:\Program Files\:\ST6UNST.LOG", где "C:\Program Files\:\ST6UNST.LOG" это и есть полный путь к файлу St6unst.log.

На второй Ваш вопрос затрудняюсь ответить.

Отвечает Андрей:
К сожалению, я не пользовался данным пакетом, но обычно всегда создаётся
деинсталляционный модуль. Это просто обязательно. Лично я больше
предпочитаю InnoSetup: http://www.jrsoftware.org/

Опять же поступило еще 4 новых вопроса по статьям, опубликованным в нашей рассылке:

Stormbringer:
при тестировании примера на адресах
www.yandex.ru
www.rambler.ru
www.google.com

я не получил размер документа, Почему? [ОТВЕТИТЬ НА ВОПРОС]

Тимур Бекбулатов:
Уважаемые эксперты ! Ответьте пожалуйста, если сможете, на следующие
вопросы.

1. Создаю инсталяционный пакет штатными средствами Visual Basic. Однако,
попытка установить программу на другом компьютере с помощью этого пакета
обычно проваливается, хотя изредка получается. Причем, у меня подозрение,

что это бывает на чистом компьютере (в том смысле, что на нем ни разу я не
устанавливал эту программу). Обычно устанавливаю под Windows XP (всякие -без
SP,SP1,SP2). Ошибки выдаются разные, но обычно следующая:

The file 'D:\docume~1\tima\locals~1\temp\msftqws.pdw\$(DLLSelfRegisterEx)'
could not be registered because it was not found. Что это за файл. И вообще
как решить проблему. Обычно я поступаю так. Вызываю диспетчер задач и снимаю
пакет установки. После этого обычно приложение запускается без проблем. Хотя
бывает и нет (но редко). И программная группа в меню Пуск пуста. Приходится
потом ярлык от программы вставлять туда вручную.

2. Может использовать пакеты установки от других производителей ? Но тогда
как регистрировать ActiveX сторонних производителей имеющих лицензионную
информацию. В штатном пакете это как-то решено. И после установки в штатном
режиме не появляются требования зарегистрировать тот или иной ActiveX. [ОТВЕТИТЬ НА ВОПРОС]

Артемий:
Internet Transfer Control это конечно хорошая вещб но всеже она очень мало
функциональна, в ней заложены основные возможности основной Internet
библиотеке Windows WININET.DLL. В то время как WININET.DLL содержит
множество других интересных и полезных вещей, например, через нее можно
узнать скорость передачи даных и общий объем передоваемого трафика.
А вопрос вот какой существует ли документация или файлы помощи по этой
библиотеке, если да то неплохо былобы эту информацию опубликовать в
рассылки.

И еще вопрос как можно скачивать файл в несколько потоков одновременно,
например, разбить файл на три части и качать каждую часть отдельно и
оодновременно.
И если произощел разрыв связи, и файл был недокачен, как можно продолжить
процесс с тогоже места. [ОТВЕТИТЬ НА ВОПРОС]

Sergey:
Здравствуйте, Игорь.
У меня есть сэмплы запросов файлов по http и созданию http сервера. Но
меня интересует другое, связанное с этим, но... Меня интересует proxy
сервер написанный на Visual Basic. Интересует по двум причинам 1)
шпионить за одной из программ 2) перенаправлять её запросы на нужное
мне место. Разбираться мне в этом нет времени и особого желания,
почитать ещё куда не шло, а вот разбираться в одиночку -- н-е-е-е.
Считаю это интересная тема, подробно касающаяся методов
приёма/передачи данных по http, которую стоило бы рассмотреть. Хотя...
у меня нет никаких представлений и данных о том, как работает proxy.
Как Вы на это смотрите? [ОТВЕТИТЬ НА ВОПРОС]

http://www.delphi.int.ru - Программирование на DELPHI: Вопросы и Ответы читателей; Статьи по программированию на Delphi, других языках программирования, графике (OpenGL/DirectX); Компоненты, Пакеты, Plug-in'ы, Модули для Delphi; Исходники программ, игр; Документация и ссылки на документацию по программированию; Рассылка, в которой каждый программист найдёт что-то полезное!

http://infomania2004.webhost.ru. Этот сайт создан для того, чтобы вы могли получить интересующую вас информацию с минимальными затратами сил и времени. Если вы не нашли здесь нужной информации, оставьте заявку...">

Все о Динамо - www.DynamoMania.ru На этом сайте вы найдете все новости и интервью ВСЕХ видов спорта Динамо. Также на сайте есть таблицы всех видов спорта. Видео и Фото материалы. И все это на одном сайте - www.DinamoMania.ru Это первый и единственный сайт, который освещает все виды одного клуба.