Здравствуйте, уважаемые!

Вот и нашлось время для рассылки! Я рад, что от Вас продолжают поступать вопросы и ответы по программированию, я рад, что мою рассылку читают и многие, надеюсь, любят.
Что же произошло за столь долгий срок? Повышение по должности, смена дизайна сайта и соответственно рассылки. Практически долгое время я не мог сделать выпуск, так как были некоторые проблемы с формированием HTML чудо-роботом. К счастью, все проблемы были решены очень быстро. Турнирная таблица пока отсутсвует, а баллы начисляются все-равно, так что не думайте, что я убрал баллы.

Кстати, давайте проголосуем...

Недавно я получил книгу по Visual Basic 2005, основанной на технологии .NET. Сразу признаюсь, с технологией .NET я не имел никогда никакого дела, не изменял и любимому VB6, но, полистав буквально вчера книгу, я узнал столько нового и интересного! До чего стало проще писать программы!
Соответственно многие догадались, о чем будет маленький опрос... Конечно о обучении VB2005.NET. Эта тема достаточно интересна, так что, кто заинтересовался, прошу голосовать

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

Отвечает	visualprogs@yandex.ru
	Так. Для номера с min - в коде находи нименьшее потом сортируй и помещай в столбец. Динамика, по очереди и записать переменные. Среднее найти тоже думаю не сложно. А так просто не очень понятен вопрос

Оценка за ответ эксперту visualprogs@yandex.ru: 3 баллов

Вопрос # 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 Для тех, кто не может прочитать (от автора рассылки): Подскажите пожалуйста, как правильнее приступить к созданию таблиц и какого рода таблица нужна для ввода, обработки и расчета данных, на VB.NET. Мне базу создавать не надо. Заранее спасибо.

[Ответить]

Отвечает	visualprogs@yandex.ru
	Я бы тебе вот какой совет дал: Как я сам когда то поступил, ну если конечно средства позволяют. Купи какую нибудь книжецу и станет по легче осваивать, тем более что в хороших книгах, разобраны основные аспекты работы. А если будешь собирать информацию по инету, то это уже так развлечение будет.

Оценка за ответ эксперту visualprogs@yandex.ru: 3 баллов

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

Отвечает

Evgueni Rytchko

Не помню где взято... 3.2.8 Wake-On-LAN This action allows you to start up a remote PC. This remote PC must support Wake-On-LAN. This means that you have to have a network card that is connected via anextra wire to the motherboard (or power supply) to provide some power. In thesystem BIOS, Wake-On-LAN must also be enabled. How it works: The network card constantly monitors the network for a ‘Magic Packet’ when thecomputer is switched off. This magic packet is a series of bytes that is sent over thenetwork.A magic packet consists of a header (6*0xFF) and the MAC address of the networkadapter repeated several times (16 times), for example if your MAC address is01:02:03:04:05:06 (6 bytes), then the magic packet looks like this: FFFFFFFFFFFF01020304050601020304050601020304050601020 30405060102030405060102030405060102030405060102030405 06010203040506010203040506010203040506010203040506010 203040506010203040506010203040506010203040506 The network adapter recognizes the sequence and triggers the power supply to turnon the computer.

Оценка за ответ эксперту Evgueni Rytchko: 5 баллов

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

Отвечает	visualprogs@yandex.ru
	Согласен с Сергеем у тебя так система настроена, у меня также не было ни каких звуков.

Оценка за ответ эксперту visualprogs@yandex.ru: 4 баллов

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

Отвечает	visualprogs@yandex.ru
	Нужно использовать MS comm control. Установить настройки: MSComm1.Settings = "9600,n,8,1" MSComm1.CommPort = 1 MSComm1.PortOpen = True А потом вот так: Open "COM1" for binary as #1 put 1,,&То что хочешь послать% Close #1

Оценка за ответ эксперту visualprogs@yandex.ru: 4 баллов

Вопрос # 136

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

[Ответить]

Отвечает	visualprogs@yandex.ru
	Подгонять размеры одного под другого

Оценка за ответ эксперту visualprogs@yandex.ru: 3 баллов

Вопрос # 159	Можно-ли в MS Access в таблице сохранить документ html и вывести его на форму для просмотра. А если можно, то как?
[Ответить]

Отвечает	visualprogs@yandex.ru
	А почему бы просто не сохранить штмл страницу на диске и вызывать дя просмотра на форму.

Оценка за ответ эксперту visualprogs@yandex.ru: 3 баллов

Вопрос # 162	Вот у меня вопрос. Имею 2 модема. Опишите мне подробно: 1) набор номера 2) соединение межде модемами 3) установка связи Желательно через MSComm
[Ответить]

Отвечает	visualprogs@yandex.ru
	Ну тут смотря что ты хочешь делать либо чат либо фало передавать. При чем я видел в сети примеры и того и другого, жаль на винте не нашел, хотя пример чата типа ICQ могу скинуть или сам поищи

Оценка за ответ эксперту visualprogs@yandex.ru: 3 баллов

Отвечает

visualprogs@yandex.ru

Internet Transfer Control Раньше работа с Internet, для программистов на Visual Basic, была возможна только используя непосредственный вызов функций API. С выпуском Visual Basic 5 все изменилось в связи с включением специального ActiveX компонента Internet Transfer Control. Internet Transfer Control обеспечивает поддержку двух стандартных протоколов FTP и HTTP. Протокол HTTP позволяет Вам соединяться с серверами world wide web и получать доступ к файлам. FTP протокол позволяет получать любой вид файлов от сервера FTP Internet, а также посылать их на такие же серверы, однако, в отличие от HTTP протокола, имеет больше возможностей. Internet Transfer Control - фактически является интерфейсом к основной Internet библиотеке Windows WININET.DLL. Эта DLL - часть Win32 API. Как Вы думаете работает Internet Explorer? Да, да, да вызывая функции из этой самой библиотеки. А зачем нам тогда этот Internet Transfer Control? Да, в принципе и не нужен, если только Вы не боитесь заблудиться в темном лесу под названием WININET.DLL и флаг Вам в руки, если это так. Получение файлов из Internet по HTTP протоколу Начнем, пожалуй, с самого простого - рассмотрим получение файлов из Internet по протоколу HTTP. Существует два метода используемых для получения файлов: OpenURL и Execute. Синхронный метод. Метод OpenURL используется, чтобы получить доступ к документу в Internet и помещает его копию на локальном компьютере. URL, который передается как параметр для метода OpenURL, может быть любым документом. Все, что Вы должны определить - URL документа, который Вам требуется и тип документа icString (текстовый файл) или icByteArray (бинарный файл, для программ и архивов). Вначале посмотрим, как получить обычный текстовый файл: Dim vData As Variant vData = Me.Inet1.OpenURL("http://www.vbnet.ru/default.asp", icString) Итак, файл получен. Что мы можем с ним сделать? Например сохранить на своем компьютере: Open "C:\index.htm" For Output As #1 Print #1, , vData Close #1 Файл получен и сохранен, теперь его можно посмотреть в любой программе, или написать свою для его просмотра. А что? Для этого можно использовать, например, Microsoft Internet Control. Внимание: Метод OpenURL выполняется синхронно, т.е. управление в Вашу программу будет передано только тогда, когда передача запрашиваемого файла будет завершена. Иными словами, Ваша программа будет неспособна выполняться пока идет передача файла и, если файл большой, а связь медленная, то Вы можете испытывать некоторые трудности с использованием этого метода, дело в том, что Ваша программа окажется «замороженной» на пару часиков в случае если принимаемый файл имеет внушительные размеры, ну и кому это понравится? Зато легко, но не очень хорошо, но легко. После, того, как Вы открыли файл методом OpenURL, Вам становятся доступны некоторые его свойства, которые тоже могут быть Вам полезны. Значение Описание Date Возвращает время и дату передачи документа. Формат: Wednesday, 27-April-96 19:34:15 GMT MIME-version Возвращает версию протокола MIME. Server Возвращает название сервера. Content-length Возвращает размер документа в байтах. Content-type Возвращает MIME тип данных. Last-modified Возвращает дату и время последней модификации документа. Формат: Wednesday, 27-April-96 19:34:15 GMT Итак, допустим, что Вы хотите узнать размер открытого документа. Для этого используйте такой код: sLenth = Inet1.GetHeader("Content-length") Внимание: Метод GetHeader можно использовать только после принятия заголовка или открытия документа методом OpenURL. Если Вы захотите узнать, например размер еще не открытого документа, то произойдет ошибка. Поэтому перед приемом документа, я рекомендую узнать его заголовок. Это позволит Вам определить размер документа и контролировать прогресс его приема. Если Вам нужно принять только заголовок документа, то воспользуйтесь следующим кодом: Inet1.Execute , "HEAD" 'задержка, пока запрос не выполнен Do If Not Inet1.StillExecuting Then Exit Do DoEvents Loop lLenthFile = CLng(Inet1.GetHeader("Content-length")) s = "Date: " & Inet1.GetHeader("Date") & vbCrLf s = s & "MIME-version: " & Inet1.GetHeader("MIME-version") & vbCrLf s = s & "Server: " & Inet1.GetHeader("Server") & vbCrLf s = s & "Content-length: " & CStr(lLenthFile) & vbCrLf s = s & "Content-type: " & Inet1.GetHeader("Content-type") & vbCrLf s = s & "Last-modified: " & Inet1.GetHeader("Last-modified") & vbCrLf Me.txtHead.Text = s Обратите внимание на переменную lLenthFile, которая равна размеру принимаемого файла. Это нам может потребоваться в дальнейшем. Внимание: Если принимаемый документ не бинарный файл или не HTML документ, а является ASP или другим динамически формируемым документом, то принятый заголовок может содержать искаженную информацию, например о его размере. Это связано с тем, что получить размер еще не существующего документа невозможно. Асинхронный метод. Для того, чтобы выполнение программы не прерывалось, существует способ асинхронной передачи файлов. Давайте рассмотрим его подробнее. Для асинхронной работы существует метод Execute. Execute метод посылает команду на отдаленный сервер Internet. Команда может быть запросом для получения, передачи файла на сервер, удаления, переименования файла и т.д. Кроме того, серверы HTTP имеют набор команд, которые позволяют Вам не, только получать или передавать файлы, но также могут передавать различную информацию о документе, сохраненном на сервере. Как только сервер получил команду, которая была передана ему Execute методом, он посылает ответ на Вашу программу, вызывая StateChanged событие Internet Transfer Control. Событие StateChanged имеет параметр, который указывает действие, которое удаленный компьютер только что выполнил. Как только это событие было вызвано, Вы можете предпринять какие либо действия в Вашей программе. В настоящее время документированы следующий команды для HTTP серверов: GET - прием файла с сервера, HEAD - прием заголовка, POST - альтернативный метод приема данных и PUT - передача данных на сервер. Итак, допустим, что Вы запросили на сервере файл mydocument.zip. Сервер принял Вашу команду и начинает возвращать Вам данные. Для получения данных, которые были переданы на Ваш компьютер, Вам нужно обратиться к методу GetChunk. Но здесь не все так просто, дело в том, что данные передаются не все сразу, а по частям или порциями. Обычно (по умолчанию) размер каждой порции данных 1024 байт. Это означает, что, если Вы требовали файл, который имеет размер 100 Кб, то Вы должны вызвать GetChunk метод примерно 100 раз, чтобы получить все требуемые данные. Для чего это сделано? Представте себе, что Ваша программа принимает файл размером 1 Мб, а скорость Вашего соединения с Internet 19200 бод. Это означает, что Ваша программа будет принимать файл примерно в течении 10 минут. Как Вы думаете, стоит сообщать пользователю Вашей программы о том, какая часть файла уже принята и сколько осталось еще принять? Я думаю, что стоит. Более того, я сделал индикатор прогресса приема файла, чтобы пользователь мог пойти и спокойно попить, например кофе. Да, кстати, если Вы думаете, что сервер всегда должен Вам возвратить данные, то Вы глубоко заблуждаетесь. Если Вы захотите удалить файл на сервере и пошлете ему правильную команду, то сервер сразу же скажет OK и удалит этот файл. А вот данных Вы от него никаких тогда не получите, но событие StateChanged произойдет и параметр State примет значение icResponseCompleted. Значит все в норме, и запрос был успешно выполнен. Фух… Кажется все написал, теперь давайте посмотрим на код. Обратите внимание, что прием данных ведется в переменую vtData(), имеющую тип Byte. Это сделано для того, чтобы можно было принимать любые типы файлов: текстовые и бинарные. С той же целью метод GetChunk вызывается с параметром icByteArray: Private Sub Inet1_StateChanged(ByVal State As Integer) Dim vtData() As Byte Dim intFile As Long Select Case State 'здесь можно обрабатывать другие события Case icResponseCompleted '12 'открываем файл для записи принимаемых данных intFile = FreeFile Open Me.txtFileName For Binary Access Write As #intFile 'принимаем первую порцию данных vtData = Inet1.GetChunk(1024, icByteArray) Do While LenB(CStr(vtData)) > 0 Put #intFile, , vtData 'следующая порция данных vtData = Inet1.GetChunk(1024, icByteArray) UpdateStatus Seek(1) Loop Put #intFile, , vtData Close #intFile End Select Me.stb.SimpleText = GetConnectionState(State) End Sub Еще хочу, чтобы Вы посмотрели на код процедуры UpdateStatus. Она отвечает за вывод информации о прогрессе приема файла. Для этого используется глобальная переменная lLenthFile, содержащая размер документа на сервере и передаваемый размер уже принятых данных. Процедура очень простая и служит только для того, чтобы записать в строку состояния, сколько принято данных в процентах от их общего количества. Sub UpdateStatus(lRec As Long) Dim i As Long i = lRec * 100 / lLenthFile Me.stb.SimpleText = "Принято: " & i & "%" DoEvents End Sub И ничего нет здесь сложного. Так, теперь мы знаем для чего нужно событие StateChanged и давайте посмотрим, какую информацию мы можем еще получать, используя его. Константа Значение Описание icNone 0 Информация о состоянии не доступна icResolvingHost 1 Поиск IP адреса сервера icHostResolved 2 IP адрес сервера найден icConnecting 3 Соединение с сервером icConnected 4 Соединился с сервером icRequesting 5 Запрос информации с сервера icRequestSent 6 Запрос на сервер успешно отправлен icReceivingResponse 7 Получение ответа от сервера icResponseReceived 8 Ответ от сервера был успешно принят icDisconnecting 9 Отключение от сервера icDisconnected 10 Отключение от сервера выполнено icError 11 Произошла ошибка во время сеанса связи с сервером icResponseCompleted 12 Запрос выполнен, все данные получены

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Вопрос # 167	Здравствуйте Как получить спектр музыкального файла?
[Ответить]

Отвечает

visualprogs@yandex.ru

Формат WAV файла WAV файл - это звуковой файл формата RIFF. Он состоит из трёх заголовков, за которыми следуют данные самого звукового файла, т.е. последовательность байт самого звукового сигнала. Разберём все три заголовка подробнее: Первый - RIFF заголовок. Он занимает 8 байт с самого начала файла и содержит следующую информацию (для удобства всё описано в структуре данных Visual Basic'а): Type RIFF_HEAD riffFmt As String * 4 ' Четыре буквы "RIFF" lenOfFileData As Long ' длина файла без этого заголовка, ' т.е. FileLen(Wav) - 8 End Type Второй заголовок - WAV заголовок. Вот его структура: Type WAVE_HEAD waveFmt As String * 8 ' 8 букв - "WAVEfmt " lenOfThunk As Long ' размер этого куска (16 байт) format As Integer ' формат WAV файла (обычно всегда 1) channels As Integer ' кол-во каналов (1 - моно, 2 - стерео) samplesPerSecond As Long ' зазрешение WAV файла, ' т.е. кол-во Samples'ов в сек (11025,22050,44100 и т.д.) avgBytesPerSecond As Long ' тоже самое blockAlign As Integer ' выравнивание блоков данных (обычно 1) bitsPerSample As Integer ' Кол-во Битов на один сэмпл (8/16) End Type Ну и наконец третий, заголовок данных: Type DATA_HEAD datastr As String * 4 ' 4 буквы "data" lenOfThunk As Long ' кол-во байт, ' отводящихся под сами WAV данные End Type Ну вот и всё, далее идут сами данные звукового файла. Если файл 2-х канальный, то данные идут по очереди, 1 канал, 2-ой, 1-ый, 2-ой... и т.д. Необходимо также помнить, что если файл 8 битный, то под каждый сэмпл отводится по одному байту, если же 16 битный - то по 2 байта. В конце файла иногда бывает некоторая дополнительная информация о WAV файле (имя Автора и т.д.), которую позволяют вносить программы типа Sound Forge. Ну вот и всё. Можете делать со звуковыми файлами различные чудеса! Для удобства можете использовать мой модуль для работы с WAV файлами

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Вопрос # 168

Для скачки файла из инета я использую в своей проге такой код: Private Function DownloadFile(ByVal FromUrl As String) As String 'процедура загрузки файла Dim hSession As Long Dim hFile As Long Dim LLenthFile As Long Dim AllFile As String Dim fBuffer As String Dim Ret As Long hSession = InternetOpen("прога", 0, "", "", 0) DoEvents hFile = InternetOpenUrl(hSession, FromUrl, "", 0, 0, 0) Do DoEvents fBuffer = Space(1024) InternetReadFile hFile, fBuffer, 1024, Ret If Ret <> 1024 Then fBuffer = Left$(fBuffer, Ret) AllFile = AllFile & fBuffer Loop Until Ret = 0 InternetCloseHandle hFile InternetCloseHandle hSession DownloadFile = AllFile End Function но он подвисает, думаю что в цикле Do(скачиваю много файлов) как сделать лучше(но без контролов)?

[Ответить]

Отвечает	haemmid
	Можно разместить на форме элемент Micrisoft InternetConrols, дать ему индекс 0 и затем с помощью ООП создавать новые элементы, в них загружать файлы. Так можно работать с несколькими загрузками, хотя я, наверное, не совсем понял вопроса... =)

Оценка за ответ эксперту haemmid: 3 баллов

Отвечает

visualprogs@yandex.ru

Получение файлов из Internet по HTTP протоколу Начнем, пожалуй, с самого простого - рассмотрим получение файлов из Internet по протоколу HTTP. Существует два метода используемых для получения файлов: OpenURL и Execute. Синхронный метод. Метод OpenURL используется, чтобы получить доступ к документу в Internet и помещает его копию на локальном компьютере. URL, который передается как параметр для метода OpenURL, может быть любым документом. Все, что Вы должны определить - URL документа, который Вам требуется и тип документа icString (текстовый файл) или icByteArray (бинарный файл, для программ и архивов). Вначале посмотрим, как получить обычный текстовый файл: Dim vData As Variant vData = Me.Inet1.OpenURL("http://www.vbnet.ru/default.asp", icString) Итак, файл получен. Что мы можем с ним сделать? Например сохранить на своем компьютере: Open "C:\index.htm" For Output As #1 Print #1, , vData Close #1 Файл получен и сохранен, теперь его можно посмотреть в любой программе, или написать свою для его просмотра. А что? Для этого можно использовать, например, Microsoft Internet Control. Внимание: Метод OpenURL выполняется синхронно, т.е. управление в Вашу программу будет передано только тогда, когда передача запрашиваемого файла будет завершена. Иными словами, Ваша программа будет неспособна выполняться пока идет передача файла и, если файл большой, а связь медленная, то Вы можете испытывать некоторые трудности с использованием этого метода, дело в том, что Ваша программа окажется «замороженной» на пару часиков в случае если принимаемый файл имеет внушительные размеры, ну и кому это понравится? Зато легко, но не очень хорошо, но легко. После, того, как Вы открыли файл методом OpenURL, Вам становятся доступны некоторые его свойства, которые тоже могут быть Вам полезны. Значение Описание Date Возвращает время и дату передачи документа. Формат: Wednesday, 27-April-96 19:34:15 GMT MIME-version Возвращает версию протокола MIME. Server Возвращает название сервера. Content-length Возвращает размер документа в байтах. Content-type Возвращает MIME тип данных. Last-modified Возвращает дату и время последней модификации документа. Формат: Wednesday, 27-April-96 19:34:15 GMT Итак, допустим, что Вы хотите узнать размер открытого документа. Для этого используйте такой код: sLenth = Inet1.GetHeader("Content-length") Внимание: Метод GetHeader можно использовать только после принятия заголовка или открытия документа методом OpenURL. Если Вы захотите узнать, например размер еще не открытого документа, то произойдет ошибка. Поэтому перед приемом документа, я рекомендую узнать его заголовок. Это позволит Вам определить размер документа и контролировать прогресс его приема. Если Вам нужно принять только заголовок документа, то воспользуйтесь следующим кодом: Inet1.Execute , "HEAD" 'задержка, пока запрос не выполнен Do If Not Inet1.StillExecuting Then Exit Do DoEvents Loop lLenthFile = CLng(Inet1.GetHeader("Content-length")) s = "Date: " & Inet1.GetHeader("Date") & vbCrLf s = s & "MIME-version: " & Inet1.GetHeader("MIME-version") & vbCrLf s = s & "Server: " & Inet1.GetHeader("Server") & vbCrLf s = s & "Content-length: " & CStr(lLenthFile) & vbCrLf s = s & "Content-type: " & Inet1.GetHeader("Content-type") & vbCrLf s = s & "Last-modified: " & Inet1.GetHeader("Last-modified") & vbCrLf Me.txtHead.Text = s Обратите внимание на переменную lLenthFile, которая равна размеру принимаемого файла. Это нам может потребоваться в дальнейшем. Внимание: Если принимаемый документ не бинарный файл или не HTML документ, а является ASP или другим динамически формируемым документом, то принятый заголовок может содержать искаженную информацию, например о его размере. Это связано с тем, что получить размер еще не существующего документа невозможно. Асинхронный метод. Для того, чтобы выполнение программы не прерывалось, существует способ асинхронной передачи файлов. Давайте рассмотрим его подробнее. Для асинхронной работы существует метод Execute. Execute метод посылает команду на отдаленный сервер Internet. Команда может быть запросом для получения, передачи файла на сервер, удаления, переименования файла и т.д. Кроме того, серверы HTTP имеют набор команд, которые позволяют Вам не, только получать или передавать файлы, но также могут передавать различную информацию о документе, сохраненном на сервере. Как только сервер получил команду, которая была передана ему Execute методом, он посылает ответ на Вашу программу, вызывая StateChanged событие Internet Transfer Control. Событие StateChanged имеет параметр, который указывает действие, которое удаленный компьютер только что выполнил. Как только это событие было вызвано, Вы можете предпринять какие либо действия в Вашей программе. В настоящее время документированы следующий команды для HTTP серверов: GET - прием файла с сервера, HEAD - прием заголовка, POST - альтернативный метод приема данных и PUT - передача данных на сервер. Итак, допустим, что Вы запросили на сервере файл mydocument.zip. Сервер принял Вашу команду и начинает возвращать Вам данные. Для получения данных, которые были переданы на Ваш компьютер, Вам нужно обратиться к методу GetChunk. Но здесь не все так просто, дело в том, что данные передаются не все сразу, а по частям или порциями. Обычно (по умолчанию) размер каждой порции данных 1024 байт. Это означает, что, если Вы требовали файл, который имеет размер 100 Кб, то Вы должны вызвать GetChunk метод примерно 100 раз, чтобы получить все требуемые данные. Для чего это сделано? Представте себе, что Ваша программа принимает файл размером 1 Мб, а скорость Вашего соединения с Internet 19200 бод. Это означает, что Ваша программа будет принимать файл примерно в течении 10 минут. Как Вы думаете, стоит сообщать пользователю Вашей программы о том, какая часть файла уже принята и сколько осталось еще принять? Я думаю, что стоит. Более того, я сделал индикатор прогресса приема файла, чтобы пользователь мог пойти и спокойно попить, например кофе. Да, кстати, если Вы думаете, что сервер всегда должен Вам возвратить данные, то Вы глубоко заблуждаетесь. Если Вы захотите удалить файл на сервере и пошлете ему правильную команду, то сервер сразу же скажет OK и удалит этот файл. А вот данных Вы от него никаких тогда не получите, но событие StateChanged произойдет и параметр State примет значение icResponseCompleted. Значит все в норме, и запрос был успешно выполнен. Фух… Кажется все написал, теперь давайте посмотрим на код. Обратите внимание, что прием данных ведется в переменую vtData(), имеющую тип Byte. Это сделано для того, чтобы можно было принимать любые типы файлов: текстовые и бинарные. С той же целью метод GetChunk вызывается с параметром icByteArray: Private Sub Inet1_StateChanged(ByVal State As Integer) Dim vtData() As Byte Dim intFile As Long Select Case State 'здесь можно обрабатывать другие события Case icResponseCompleted '12 'открываем файл для записи принимаемых данных intFile = FreeFile Open Me.txtFileName For Binary Access Write As #intFile 'принимаем первую порцию данных vtData = Inet1.GetChunk(1024, icByteArray) Do While LenB(CStr(vtData)) > 0 Put #intFile, , vtData 'следующая порция данных vtData = Inet1.GetChunk(1024, icByteArray) UpdateStatus Seek(1) Loop Put #intFile, , vtData Close #intFile End Select Me.stb.SimpleText = GetConnectionState(State) End Sub Еще хочу, чтобы Вы посмотрели на код процедуры UpdateStatus. Она отвечает за вывод информации о прогрессе приема файла. Для этого используется глобальная переменная lLenthFile, содержащая размер документа на сервере и передаваемый размер уже принятых данных. Процедура очень простая и служит только для того, чтобы записать в строку состояния, сколько принято данных в процентах от их общего количества. Sub UpdateStatus(lRec As Long) Dim i As Long i = lRec * 100 / lLenthFile Me.stb.SimpleText = "Принято: " & i & "%" DoEvents End Sub И ничего нет здесь сложного. Так, теперь мы знаем для чего нужно событие StateChanged и давайте посмотрим, какую информацию мы можем еще получать, используя его. Константа Значение Описание icNone 0 Информация о состоянии не доступна icResolvingHost 1 Поиск IP адреса сервера icHostResolved 2 IP адрес сервера найден icConnecting 3 Соединение с сервером icConnected 4 Соединился с сервером icRequesting 5 Запрос информации с сервера icRequestSent 6 Запрос на сервер успешно отправлен icReceivingResponse 7 Получение ответа от сервера icResponseReceived 8 Ответ от сервера был успешно принят icDisconnecting 9 Отключение от сервера icDisconnected 10 Отключение от сервера выполнено icError 11 Произошла ошибка во время сеанса связи с сервером icResponseCompleted 12 Запрос выполнен, все данные получены

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Вопрос # 171	Загоняю в ListView список файлов в директории. стиль report. Проблема - отобразить рядом с файлами значки соответствующих расширений, короче сделать проводник в стиле "таблица". Если подскажете буду благодарен.
[Ответить]

Отвечает	haemmid
	В ListView нельзя, но в MS Common Controls нечто подобное есть...

Оценка за ответ эксперту haemmid: 3 баллов

Вопрос # 172	вопрос по RAS: как получить параметры имеющихся на компе соединений(dial-up)?
[Ответить]

Отвечает

visualprogs@yandex.ru

Получение списка всех интернет-соединений. Добавьте на форму CommandButton и ListBox. Вставьте следующий код, запустите программу на выполнение. В ListBox'е вы получите имена всех интернет-соединений. При нажатии на CommandButton на форме будет напечатано имя интернет-соединения по умолчанию. Const REG_NONE = 0& Const REG_SZ = 1& Const REG_EXPAND_SZ = 2& Const REG_BINARY = 3& Const REG_DWORD = 4& Const REG_DWORD_LITTLE_ENDIAN = 4& Const REG_DWORD_BIG_ENDIAN = 5& Const REG_LINK = 6& Const REG_MULTI_SZ = 7& Const REG_RESOURCE_LIST = 8& Const REG_FULL_RESOURCE_DESCRIPTOR = 9& Const REG_RESOURCE_REQUIREMENTS_LIST = 10& Public rgeEntry$ Public rgeDataType& Public rgeValue$ Public rgeMainKey& Public rgeSubKey$ Const KEY_QUERY_VALUE = &H1& Const KEY_SET_VALUE = &H2& Const KEY_CREATE_SUB_KEY = &H4& Const KEY_ENUMERATE_SUB_KEYS = &H8& Const KEY_NOTIFY = &H10& Const KEY_CREATE_LINK = &H20& Const READ_CONTROL = &H20000 Const WRITE_DAC = &H40000 Const WRITE_OWNER = &H80000 Const SYNCHRONIZE = &H100000 Const STANDARD_RIGHTS_REQUIRED = &HF0000 Const STANDARD_RIGHTS_READ = READ_CONTROL Const STANDARD_RIGHTS_WRITE = READ_CONTROL Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Const KEY_EXECUTE = KEY_READ Private Type FILETIME lLowDateTime As Long lHighDateTime As Long End Type Const HKEY_CLASSES_ROOT = &H80000000 Const HKEY_CURRENT_USER = &H80000001 Const HKEY_LOCAL_MACHINE = &H80000002 Const HKEY_USERS = &H80000003 Const HKEY_PERFORMANCE_DATA = &H80000004 Const HKEY_CURRENT_CONFIG = &H80000005 Const HKEY_DYN_DATA = &H80000006 Private Declare Function RegOpenKeyEx& Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey&, ByVal lpszSubKey$, dwOptions&, ByVal samDesired&, lpHKey&) Private Declare Function RegCloseKey& Lib "advapi32.dll" (ByVal hKey&) Private Declare Function RegQueryValueEx& Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpszValueName$, ByVal lpdwRes&, lpdwType&, ByVal lpDataBuff$, nSize&) Private Declare Function RegEnumKeyEx& Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey&, ByVal dwIndex&, ByVal lpname$, lpcbName&, ByVal lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME) Private Declare Function RegQueryInfoKey& Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey&, ByVal lpClass$, lpcbClass&, ByVal lpReserved&, lpcSubKeys&, lpcbMaxSubKeyLen&, lpcbMaxClassLen&, lpcValues&, lpcbMaxValueNameLen&, lpcbMaxValueLen&, lpcbSecurityDescriptor&, lpftLastWriteTime As FILETIME) Public Function GetRegValue(keyroot As Variant, subkey As Variant, valname As String) Const KEY_ALL_ACCESS As Long = &HF0063 Const ERROR_SUCCESS As Long = 0 Const REG_SZ As Long = 1 Dim hsubkey As Long, dwType As Long, sz As Long Dim R As Long R = RegOpenKeyEx(keyroot, subkey, 0, KEY_ALL_ACCESS, hsubkey) sz = 256 v$ = String$(sz, 0) R = RegQueryValueEx(hsubkey, valname, 0, dwType, ByVal v$, sz) If R = ERROR_SUCCESS And dwType = REG_SZ Then retval = Left$(v$, sz) GetRegValue = retval Else retval = "--Not String--" End If R = RegCloseKey(hsubkey) End Function Public Sub rgeClear() rgeMainKey = 0 rgeSubKey = "" rgeValue = "" rgeDataType = 0 rgeEntry = "" End Sub Function RegEnumKeys&(bFullEnumeration As Boolean) Dim sRoot$, sRoot2$ Dim lRtn& Dim hKey& Dim strucLastWriteTime As FILETIME Dim sSubKeyName$ Dim sClassString$ Dim lLenSubKey& Dim lLenClass& Dim lKeyIndx& Dim lRet& Dim hKey2& Dim sSubKey2$ Dim sNewKey$ Dim sClassName$ Dim lClassLen& Dim lSubKeys& Dim lMaxSubKey& Dim sMaxSubKey$ Dim lMaxClass& Dim sMaxClass$ Dim lValues& Dim lMaxValueName& Dim lMaxValueData& Dim lSecurityDesc& lRtn = RegOpenKeyEx(rgeMainKey, rgeSubKey, 0&, KEY_READ, hKey) sClassName = Space$(255) lClassLen = CLng(Len(sClassName)) lRet = RegQueryInfoKey(hKey, sClassName, lClassLen, 0&, lSubKeys, lMaxSubKey, _ lMaxClass, lValues, lMaxValueName, lMaxValueData, lSecurityDesc, strucLastWriteTime) sMaxSubKey = Space$(lMaxSubKey + 1) sMaxClass = Space$(lMaxClass + 1) lKeyIndx = 0& Do While lRtn = ERROR_SUCCESS ReTryKeyEnumeration: sSubKeyName = sMaxSubKey lLenSubKey = lMaxSubKey sClassString = sMaxClass lLenClass = lMaxClass lRtn = RegEnumKeyEx(hKey, lKeyIndx, sSubKeyName, lLenSubKey, 0&, sClassString, _ lLenClass, strucLastWriteTime) If InStr(sSubKeyName, Chr$(0)) > 1 Then sSubKeyName = Left$(sSubKeyName, InStr(sSubKeyName, Chr$(0)) - 1) End If If lRtn = ERROR_SUCCESS Then Form1.List1.AddItem sSubKeyName lNewKey = lNewKey + 1 sNewKey = "A" & Format$(lNewKey, "000000") If bFullEnumeration = True Then sSubKey2 = sSubKeyName If rgeSubKey <> "" Then sSubKey2 = Trim(rgeSubKey) & "\" & sSubKeyName End If lRet = RegOpenKeyEx(rgeMainKey, sSubKey2, 0&, KEY_READ, hKey2) Else Exit Do End If lKeyIndx = lKeyIndx + 1 ElseIf lRtn = ERROR_MORE_DATA Then lMaxSubKey = lMaxSubKey + 5 lMaxClass = lMaxClass + 5 sMaxSubKey = Space$(lMaxSubKey + 1) sMaxClass = Space$(lMaxClass + 1) GoTo ReTryKeyEnumeration ElseIf lRtn = ERROR_NO_MORE_ITEMS Then lRtn = ERROR_SUCCESS Exit Do Exit Do End If Loop RegEnumKeys = lRtn lRtn = RegCloseKey(hKey) End Function Private Sub Form_Load() rgeMainKey = HKEY_CURRENT_USER rgeSubKey$ = "RemoteAccess\Profile" RegEnumKeys True End Sub Private Sub Command1_Click() Print GetRegValue(HKEY_CURRENT_USER, "RemoteAccess", "Default") End Sub

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Вопрос # 174	Всем привет! Кто нибудь знает как решать в ВБ диференциальные уравнения. Например такую: Численно решить методом Эйлера дифференциальное уравнение с заданными начальными условиями на отрезке с шагом h=0,1 при указанных значениях параметров: y’=1+x y2 ; y(0)=1, a=0, b=1.
[Ответить]

Отвечает

visualprogs@yandex.ru

Посмотри вот такой пример: Код формы: Dim m1(3, 3) As Double Dim m2(3, 1) As Double Private Sub Form_Load() ' Введем следующую систему уравнений: ' 5x+8y+z=2 ' 3x-2y+6z=-7 ' 2x+y-z=-5 m1(1, 1) = 5: m1(1, 2) = 8: m1(1, 3) = 1: m2(1, 1) = 2 m1(2, 1) = 3: m1(2, 2) = -2: m1(2, 3) = 6: m2(2, 1) = -7 m1(3, 1) = 2: m1(3, 2) = 1: m1(3, 3) = -1: m2(3, 1) = -5 End Sub Private Sub Command1_Click() Dim i As Integer, j As Integer Dim d As Double Dim dx(3, 3) As Double Dim dy(3, 3) As Double Dim dz(3, 3) As Double d = MDeterminant(m1) For i = 1 To 3 For j = 1 To 3 If j = 1 Then dx(i, j) = m2(i, 1) Else dx(i, j) = m1(i, j) If j = 2 Then dy(i, j) = m2(i, 1) Else dy(i, j) = m1(i, j) If j = 3 Then dz(i, j) = m2(i, 1) Else dz(i, j) = m1(i, j) Next Next MsgBox "x=" + Str$(MDeterminant(dx) / d) MsgBox "y=" + Str$(MDeterminant(dy) / d) MsgBox "z=" + Str$(MDeterminant(dz) / d) End Sub Private Sub Command2_Click() Dim i As Integer, j As Integer Dim a(3, 3) As Double Dim xyz() As Double For i = 1 To 3 For j = 1 To 3 a(i, j) = m1(i, j) Next Next MInvert a() MMult a(), m2(), xyz() MsgBox "x=" + Str$(xyz(1, 1)) MsgBox "y=" + Str$(xyz(2, 1)) MsgBox "z=" + Str$(xyz(3, 1)) End Sub Код модуля: ' Вычисление матрицы Public Function MDeterminant(matr() As Double) As Double Dim a() As Double, b() As Double Dim i As Byte, j As Byte Dim kol As Integer, k As Integer, n0 As Byte Dim nom0 As Byte Dim k0 As Byte, j0 As Byte Dim znak As Integer, mas As Byte Dim mn As Double Dim ii As Byte Dim n As Byte n = UBound(matr, 1) ' Если матрица состоит из двух элементов, то сразу вычисляем ее If n = 2 Then MDeterminant = matr(1, 1) * matr(2, 2) - matr(1, 2) * matr(2, 1) Exit Function End If ' Будем считать, что массив a - это некоторое число матриц, ' где n - размерность матрицы, kol - количество матриц kol = 1 ReDim a(n, n, kol) ' Присваиваем массиву a значения массива matr For i = 1 To n For j = 1 To n a(i, j, 1) = matr(i, j) Next Next ' Если массив а содержит матрицу например ' |x11 x12 x13| ' |x21 x22 x23| ' |x31 x32 x33| ' то в массив b запишем матрицы ' |x11*x22 x11*x23| |-x12*x21 -x12*x23| |x13*x21 x13*x22| ' | x32 x33 | | x31 x33 | | x31 x32 | ' Затем массивы меняются местами и так до тех пор пока не останутся ' матрицы 2x2 For ii = 1 To n - 2 n0 = n: n = n - 1: kol = n0 * kol znak = 1 ' Создаем массив b из массива a If mas = 0 Then ReDim b(n, n, kol) For k = 1 To kol ' k - номер текущей матрица в массиве b ' k0 - номер текущей матрицы в массиве a k0 = Int((k - 1) / n0) + 1 ' nom0 - номер колонки в матрице массива a nom0 = k - (k0 - 1) * n0 If nom0 = 1 Then znak = 1 For i = 1 To n For j = 1 To n ' Следующая строка аналогична строке ' If j < nom0 then j0 = j Else j0 = j + 1 j0 = j + Sgn(Int(j / nom0)) If i = 1 Then mn = znak * a(1, nom0, k0) Else mn = 1 b(i, j, k) = mn * a(i + 1, j0, k0) Next Next znak = -znak Next End If ' Создаем массив a из массива b If mas = 1 Then ReDim a(n, n, kol) For k = 1 To kol k0 = Int((k - 1) / n0) + 1 nom0 = k - (k0 - 1) * n0 If nom0 = 1 Then znak = 1 For i = 1 To n For j = 1 To n j0 = j + Sgn(Int(j / nom0)) If i = 1 Then mn = znak * b(1, nom0, k0) Else mn = 1 a(i, j, k) = mn * b(i + 1, j0, k0) Next Next znak = -znak Next End If mas = Abs(mas - 1) Next MDeterminant = 0 ' Окончательно вычисляем матрицу For k = 1 To kol If mas = 0 Then MDeterminant = MDeterminant + a(1, 1, k) * a(2, 2, k) - a(1, 2, k) * a(2, 1, k) End If If mas = 1 Then MDeterminant = MDeterminant + b(1, 1, k) * b(2, 2, k) - b(1, 2, k) * b(2, 1, k) End If Next End Function ' Обратная матрица Public Sub MInvert(matr() As Double) Dim i As Byte, i1 As Byte, i2 As Byte, j As Byte, j1 As Byte, j2 As Byte Dim d As Double Dim znak As Integer Dim a() As Double, b() As Double Dim n As Byte n = UBound(matr, 1) ReDim a(n, n) ReDim b(n - 1, n - 1) ' Если матрица состоит из двух элементов If n = 2 Then d = matr(1, 1) * matr(2, 2) - matr(1, 2) * matr(2, 1) a(1, 1) = matr(2, 2) / d a(1, 2) = matr(1, 2) / d a(2, 1) = -matr(2, 1) / d a(2, 2) = -matr(1, 1) / d matr(1, 1) = a(1, 1) matr(1, 2) = -a(1, 2) matr(2, 1) = a(2, 1) matr(2, 2) = -a(2, 2) Exit Sub End If ' Преобразуем матрицу ' Например, если исходная матрица ' |x11 x12 x13| ' |x21 x22 x23| ' |x31 x32 x33| ' то результат будет: '| |x22 x23| |-x21 -x23| |x21 x22| | '| |x32 x33| | x31 x33| |x31 x32| | '| '| |-x12 -x13| |x11 x13| |-x11 -x12| | '| | x32 x33| |x31 x33| | x31 x32| | '| '| |x12 x13| |-x11 -x13| |x11 x12| | '| |x22 x23| |x21 x23| |x21 x22| | ' где внутренние матрицы вычисляются с помощью описанной выше функции For i = 1 To n For j = 1 To n i2 = 1 For i1 = 1 To n For j1 = 1 To n If i1 = i Then GoTo Next1 If j1 = j Then GoTo Next1 b(i2, j2) = matr(i1, j1) j2 = j2 + 1 Next1: Next If i1 = i Then GoTo Next2 i2 = i2 + 1 Next2: j2 = 1 Next znak = (-1) ^ (i + j) a(i, j) = znak * MDeterminant(b()) Next Next d = MDeterminant(matr()) ' Окончательно преобразуем матрицу, отобразив элементы вокруг главной диагонали For i = 1 To n For j = 1 To n If i = j Then matr(i, j) = a(i, j) / d If i <> j Then matr(i, j) = a(j, i) / d Next Next End Sub ' Сложение матриц Public Sub MSum(matr1() As Double, matr2() As Double) Dim i As Byte, j As Byte For i = 1 To UBound(matr1, 1) For j = 1 To UBound(matr1, 2) matr1(i, j) = matr1(i, j) + matr2(i, j) Next Next End Sub ' Вычитание матриц Public Sub MDiff(matr1() As Double, matr2() As Double) Dim i As Byte, j As Byte For i = 1 To UBound(matr1, 1) For j = 1 To UBound(matr1, 2) matr1(i, j) = matr1(i, j) - matr2(i, j) Next Next End Sub ' Умножение матриц Public Sub MMult(matr1() As Double, matr2() As Double, matr3() As Double) Dim i As Byte, j As Byte, k As Byte ReDim matr3(UBound(matr1, 1), UBound(matr2, 2)) For k = 1 To UBound(matr2, 2) For i = 1 To UBound(matr1, 1) matr3(i, k) = 0 For j = 1 To UBound(matr1, 2) matr3(i, k) = matr3(i, k) + matr1(i, j) * matr2(j, k) Next Next Next End Sub

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Вопрос # 175

Вопрос стратегического плана. Есть государственное предприятие - бухгалтерия управления городского образования. Можно ли написать (и стоит ли?)с помощью VB6 и Access 2002 прграмму для начисления заработной платы и удержания налогов, если в управлении работают около 10000 человек. Способ начисления одинаковый почти у всех, но почти у каждого есть свои индивидуальные свойства по математике начисления зарплаты. Есть для этого проекта 15 бухгалтеров с компьютерами. Как лучше сделать (сетевой вариант, но уровень пользователей желает знать лучшего) или локально каждому по несколько учреждений на пк? 1с сложновата с интерфейсом и не все получилось у специалистов по 1с данного профиля, которых приглашали. Они конечно же старались сделать сетевую версию. Спасибо. С уважением Некрасов Андрей.

[Ответить]

Отвечает	NGAVT
	Здравствуйте, vb-question. По данному вопросу отвечу: можно сделать такую прогу и не надо для этого много программистов. Я занимаюсь сию с БД Access, один, так что если надумаеш, пиши - помогу.

Оценка за ответ эксперту NGAVT: 3 баллов

Вопрос # 180	Помогите!!!У нас компьютеры соединены сетью. Как можно узнать запущено ли определённое приложение на определённой машине а после запустить приложение тамже.
[Ответить]

Отвечает	visualprogs@yandex.ru
	Советую почитать по инфу ВинСоку. Нужно будет делать Клиент - Сервер

Оценка за ответ эксперту visualprogs@yandex.ru: 3 баллов

Вопрос # 189	Как сделать окно способным принимать файлы из проводника windows (Drag'n'Drop) Заранее спасибо.
[Ответить]

Отвечает	visualprogs@yandex.ru
	Используя DragDrop. Событие генерируется при сбрасывании объекта перетаскиваемого мышью. Имеет вот такой синтаксис: Private Sub target_DragDrop(Source As Control, X As Single, Y As Single) Параметр Source содержит имя текущего элемента сброшенного на на текущий объект. Параметры X и Y определяют координтаы курсора мыши на момент генерации события.

Оценка за ответ эксперту visualprogs@yandex.ru: 4 баллов

Вопрос # 190	Сел писать часы со стрелками, и не смог вывести зависимость координат стрелки от секунд, минут, часов. Мож у кого готовый примерчик есть - тоже пойдет.
[Ответить]

Отвечает

Роман

Вот пример на VBScript. Создай файл clock.htmlи вставь этот код, начиная с тега <HTML>. Далее запускай и не забудь разблокировать содержимое. <HTML> <HEAD> <TITLE>DirectAnimation SDK, VBScript sample</TITLE> <SCRIPT LANGUAGE="JScript"> <!-- if (window.top.frames.length!=0 && window.top.frames[0].ShowNoButtons!=null) window.top.frames[0].ShowNoButtons(); //--> </SCRIPT> <!--STRIP_END--> </HEAD> <!--TOOLBAR_START--> <!--TOOLBAR_EXEMPT--> <!--TOOLBAR_END--> <BODY BGCOLOR=BLACK LINK="#0033CC" TOPMARGIN=15 LEFTMARGIN=20> <FONT FACE="Verdana, Arial, Helvetica" COLOR=WHITE SIZE=2> <CENTER> <H1>CLOCK SAMPLE</H1> </CENTER> <OBJECT ID="DAControl" WIDTH=220 HEIGHT=220 ALIGN=LEFT HSPACE=20 CLASSID="CLSID:B6FFC24C-7E13-11D0-9B47-00C04FC2F51D"> </OBJECT> <P> This sample displays a clock and demonstrates the integration between VBScript and DirectAnimation. The time (hours, minutes, and seconds) for the clock is obtained using VBScript functions. These values are then used to construct the corresponding clock-hands using the DirectAnimation control. </P> <SCRIPT LANGUAGE="VBScript"> <!-- Set m = DAControl.PixelLibrary pi = 3.14159265359 Sub window_onLoad 'Get the current time and break it down into hours, minutes, and seconds. a = time min1 = minute(time) hr1 = hour(time) sec1 = second(time) Set xPos = m.Mul(m.DANumber(150), m.Cos(m.Mul(m.LocalTime,m.DANumber(0.3)))) Set yPos = m.Mul(m.DANumber(35), m.Cos(m.Mul(m.LocalTime,m.DANumber(0.5)))) 'Create the final clock image. Set clock = m.Overlay(hands(hr1,min1,sec1),face()) 'Display the clock. DAControl.Image = clock 'Set the background in case of a non-windowless browser (such as IE3). DAControl.BackgroundImage = m.SolidColorImage(m.Blue) 'Start the animation. DAControl.Start End Sub Function face() 'Create the background for the clock. Set fs1 = m.Font("Verdana",14,m.Yellow).Bold() Set linestyle="m.DefaultLineStyle.Color(m.Black)" Set fillstyle="m.SolidColorImage(m.ColorRGB(64,64,255))" Set txtPath1 = m.StringPathAnim(m.DAString("DIRECT"), fs1) Set textpcs1 = txtPath1.fill(lineStyle, fillStyle).Transform(m.Translate2(-10,-30)) Set txtPath2 = m.StringPathAnim(m.DAString("ANIMATION"), fs1) Set textpcs2 = txtPath2.fill(lineStyle, fillStyle) Set txtPath3 = m.StringPathAnim(m.DAString("TIME"), fs1) Set textpcs3 = txtPath3.fill(lineStyle, fillStyle).Transform(m.Translate2(10,30)) Set fgColor = m.Red Set bgColor = m.Blue Set bgFill= m.RadialGradientRegularPoly(fgColor,bgColor,50,2) Set bgFill = bgFill.Transform(m.Scale2Uniform(0.055)) Set background = m.Oval(200,200).Fill(m.DefaultLineStyle,bgFill) Set text = m.Overlay(textpcs1,m.Overlay(textpcs2,textpcs3)) 'Create the numbers for the clock. Set fs2 = m.Font("Verdana",12,m.White).Bold() For i = 1 To 12 Set vec = m.Vector2(82.5,0).Transform(m.Rotate2(-pi/6*(i-3))) Set text = m.Overlay(m.StringImage(i,fs2).Transform(m.Compose2(m.Translate2Vector(vec), _ m.Scale2Uniform(1.5))),text) Next Set text = text.Transform(m.Translate2(1,9)) 'Put the numbers on top of the background. Set face = m.Overlay(text,background) End Function Function hands(hr,min,sec) 'Create the hour, minute and second hands of the clock. Set bvr60 = m.DANumber(60) Set secFromMidnight = m.Add(m.DANumber(hr*3600+min*60+sec),m.LocalTime) Set secBvr = m.Mod(secFromMidnight,bvr60) Set minBvr = m.Mod(m.Div(secFromMidnight,bvr60),bvr60) Set hrBvr = m.Mod(m.Div(secFromMidnight,m.DANumber(3600)),m.DANumber(12)) ptsSec = Array( -5, -2, 90, -2, 90, 2, -5, 2 ) ptsMin = Array(-5, -3, 80, -3, 80, 3, -5, 3 ) ptsHr = Array(-5, -5, 65, -3, 65, 3, -5, 3 ) Set temp1 = m.Mul(m.DANumber(-pi/30),m.Sub(secBvr,m.DANumber(15))) Set temp2 = m.Mul(m.DANumber(-pi/30),m.Sub(minBvr,m.DANumber(15))) Set temp3 = m.Mul(m.DANumber(-pi/6),m.Sub(hrBvr,m.DANumber(3))) Set imgSec = m.PolyLine(ptsSec).Fill(m.DefaultLineStyle,m.SolidColorImage(m.White)) Set imgSec = imgSec.TransForm(m.Rotate2Anim(temp1)) Set imgMin = m.PolyLine(ptsMin).Fill(m.DefaultLineStyle,m.SolidColorImage(m.Red)) Set imgMin = imgMin.TransForm(m.Rotate2Anim(temp2)) Set imgHr = m.PolyLine(ptsHr).Fill(m.DefaultLineStyle,m.SolidColorImage(m.Magenta)) Set imgHr = imgHr.TransForm(m.Rotate2Anim(temp3)) Set hands = m.Overlay(imgSec,m.Overlay(imgMin,imgHr)) End Function --> </SCRIPT> </FONT> </BODY> </HTML>

Оценка за ответ эксперту Роман: 5 баллов

Вопрос # 199	Здравствуйте! Подскажите, плиз, как в VB6 сделать копию экрана и поместить в файл bmp или jpg. Заранее спасибо
[Ответить]

Отвечает

amd1991

Создаём форму и добавляем на нее: Picture1(PictureBox), Command1(Button/Command). Вставляем этот код: Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal SrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Const SRCCOPY = &HCC0020 Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Sub Command1_Click() Dim hDesk, hDeskDC 'Получаем дескриптор рабочего стола hDesk = GetDesktopWindow() 'Получаем контекст устройства hDeskDC = GetDC(hDesk) Form1.Visible = False 'Конечно замените form1 на имя своей формы DoEvents 'Получаем картинку BitBlt Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, hDeskDC, 0, 0, SRCCOPY Form1.Visible = True Picture1.Refresh SavePicture Picture1.Image, "c:\qwe.bmp" 'Сохраняем в BMP-файл End Sub Private Sub Form_Load() Picture1.AutoRedraw = True Form1.ScaleMode = 3 'Pixel GetScreenResolution End Sub 'Получаем разрешение экрана Public Function GetScreenResolution() As Boolean Dim X As Integer Dim y As Integer X = GetSystemMetrics(SM_CXSCREEN) y = GetSystemMetrics(SM_CYSCREEN) Picture1.Height = y Picture1.Width = X End Function Как видите всё просто!

Оценка за ответ эксперту amd1991: 5 баллов

Отвечает

vlad_t_kiev@mail.ru

Private Declare Function GetDestktopWindow Lib "user32" () As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Sub Form_Load() dwRop = &HCC0020 hSrcDC = GetDC(hwndSrc) Call BitBlt(hDC, 0, 0, ScaleWidth, ScaleHeight, hSrcDC, 0, 0, dwRop) Show SavePicture Me.Image, InputBox("Path/File") + "Scr.bmp" End Sub

Оценка за ответ эксперту vlad_t_kiev@mail.ru: 5 баллов

Отвечает

sasha

на форме поместить обьект Picture описать API функции, константы и собственную процедуру Public Declare Function GetDesktopWindow Lib "user32" () As Long Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Declare Function StretchBlt Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal hSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long Const SRCCOPY = &HCC0020 sub copy_screen() dim hDesk as long dim hDeskDC as long hDesk = GetDesktopWindow() hDeskDC = GetDC(hDesk) form1.Picture1.AutoRedraw = True StretchBlt form1.Picture1.hdc, 0, 0, form1.Picture1.Width, form1.Picture1.Height, hDeskDC, 0, 0, Screen.Width, Screen.Height, SRCCOPY form1.Picture1.Picture = form1.Picture1.Image form1.Picture1.AutoRedraw = False form1.picture2.Picture = form1.Picture1.Picture SavePicture form1.Picture1.Picture, ' "укажи свой путь и имя файла для сохранения" end sub

Оценка за ответ эксперту sasha: 5 баллов

Отвечает

Александр Шапошников

Способ основан на симуляции нажатия клавиши Print Screen (Const vbKeySnapshot = 44 (&H2C)), - для копирования изображения экрана, и методе Clipboard.GetData(vbCFBitmap), - для дальнейшего получения изображения в Picture (Picture Box). 'Объявляем в General Form1: Private Declare Sub keybd_event Lib "user32" _ (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long) Dim A As Integer 'в Properties Form1 устанавливаем BorderStyle в 0-None, для того, чтобы в 'момент получения «фотографии» экрана, детали формы не попали в «кадр» Private Sub Form_Load() 'делаем форму невидимой, но при этом оставляем активными все 'компоненты Form1.Height = 0 Timer1.Interval = 1 'очищаем Clipboard Clipboard.Clear 'копируем изображение экрана keybd_event vbKeySnapshot, 1, 0&, 0& End Sub Private Sub Timer1_Timer() A = A + 1 If A = 2 Then 'вклеиваем изображение в картинку Picture1.Picture = Clipboard.GetData(vbCFBitmap) 'задаём размеры формы и картинки Form1.Width = Screen.Width * 0.8 Form1.Height = Screen.Height * 0.8 Form1.Left = (Screen.Width - Width) / 2 Form1.Top = (Screen.Height - Height) / 2 Picture1.Height = Form1.ScaleHeight * 1 Picture1.Width = Form1.ScaleWidth * 1 Picture1.Left = (Form1.Width - Picture1.Width) / 2 Picture1.Top = (Form1.Height - Picture1.Height) / 2 End If If A = 2 Then 'очищаем Clipboard Clipboard.Clear 'выключаем Timer1 Timer1.Enabled = False End If End Sub 'для выхода из программы Private Sub Picture1_Click() End End Sub

Оценка за ответ эксперту Александр Шапошников: 5 баллов

Отвечает

visualprogs@yandex.ru

Есть хороший пример, выделяешь область на экране и сохраняешь в бмп файл, 2 формы и модуль. Довимть на первую форму: Picture1 и Image1. У формы 1 свойство BorderStyle в None. На формы 2 добавляем Picture1(AutoRedraw = True) и CommonDialog1. Так же дя 2 формы создаем меню: 2 основных: menu - Copy - Save - Hide и traymenu - Run - Exit Код модуля: "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long Public Const NIM_ADD = &H0 Public Const NIM_MODIFY = &H1 Public Const NIM_DELETE = &H2 Public Const NIF_MESSAGE = &H1 Public Const NIF_ICON = &H2 Public Const NIF_TIP = &H4 Public Const WM_MOUSEMOVE = &H200 Public Const WM_LBUTTONDOWN = &H201 Public Const WM_LBUTTONUP = &H202 Public Const WM_LBUTTONDBLCLK = &H203 Public Const WM_RBUTTONDOWN = &H204 Public Const WM_RBUTTONUP = &H205 Public Const WM_RBUTTONDBLCLK = &H206 Public Const WM_MBUTTONDOWN = &H207 Public Const WM_MBUTTONUP = &H208 Public Const WM_MBUTTONDBLCLK = &H209 Public Type NOTIFYICONDATA cbSize As Long hWnd As Long uId As Long uFlags As Long ucallbackMessage As Long hIcon As Long szTip As String * 64 End Type Public IconData As NOTIFYICONDATA Public Deskhwnd As Long Public DeskDc As Long Код формы 1: Dim picMouseDown As Boolean Dim picDrawFirst As Boolean Dim X0 As Integer, Y0 As Integer Dim X1 As Integer, Y1 As Integer Private Sub Form_Load() AutoRedraw = True Drawstyle="vbDot" DrawMode = vbInvert Image1.Visible = False Form2.CommonDialog1.Filter = "*.bmp|*.bmp" Move 0, 0, Screen.Width - 1, Screen.Height - 1 Hide ' Добавляем иконку в трей IconData.cbSize = Len(IconData) IconData.hWnd = Picture1.hWnd IconData.ucallbackMessage = WM_MOUSEMOVE IconData.hIcon = Form1.Icon IconData.uId = 1& IconData.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE IconData.szTip = "Пример копирования изображения с рабочего стола" & Chr$(0) Shell_NotifyIcon NIM_ADD, IconData ' Получаем описатель рабочего стола Deskhwnd = GetDesktopWindow ' Получаем контекст устройства рабочего стола DeskDc = GetDC(Deskhwnd) End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Если нажата левая кнопка мыши If Button = 2 Then ' Скрываем все пункты меню кроме пункта "Скрыть" Form2.Copy.Visible = False Form2.Save.Visible = False Form2.m1.Visible = False ' Выводим меню PopupMenu Form2.menu, 2 End If ' Если нажата левая кнопка мыши If Button = 1 Then Image1.Visible = False X0 = X Y0 = Y picMouseDown = True picDrawFirst = True End If End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Если нажата левая кнопка мыши If Button = 1 And picMouseDown = True Then ' Если был нарисован прямоугольник, то стираем его If picDrawFirst = False Then Line (X0, Y0)-(X1, Y1), , B End If ' Рисуем новый прямоугольник Line (X0, Y0)-(X, Y), , B X1 = X Y1 = Y picDrawFirst = False End If End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim yt As Integer, yd As Integer, xl As Integer, xr As Integer If Button = 1 And picDrawFirst = False And picMouseDown = True Then ' Стираем нарисованный прямоугольник Line (X0, Y0)-(X1, Y1), , B ' Перемещаем Image1 в соответствии с координатами прямоугольника If X0 < X1 Then xl = X0: xr = X1 Else xl = X1: xr = X0 If Y0 < Y1 Then yu = Y0: yd = Y1 Else yu = Y1: yd = Y0 Image1.Move xl - 15, yu - 15, xr - xl + 45, yd - yu + 45 Image1.Visible = True End If picMouseDown = False End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ' Освобождаем ресурсы ReleaseDC Deskhwnd, DeskDc End Sub Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Если нажата правая кнопка мыши If Button = 2 Then ' Делаем все пункты меню видимыми Form2.Copy.Visible = True Form2.Save.Visible = True Form2.m1.Visible = True ' Выводим меню PopupMenu Form2.menu, 2 End If X0 = X Y0 = Y End Sub Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Если нажата левая кнопка мыши If Button = 1 Then ' Перемещаем Image1 в соответствии с координатами мыши Image1.Left = Image1.Left + X - X0 Image1.Top = Image1.Top + Y - Y0 End If End Sub Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) ' При нажатии правой кнопки мыши на иконку выводим меню If X / Screen.TwipsPerPixelX = WM_RBUTTONDOWN Then PopupMenu Form2.traymenu, 2 End Sub Код формы 2: ' Копируем картинку в буфер Private Sub Copy_Click() CopyPicture Clipboard.Clear Clipboard.SetData Picture1.Image End Sub ' Сохраняем картинку Private Sub Save_Click() On Error Resume Next CommonDialog1.ShowSave If Err Then Exit Sub CopyPicture SavePicture Picture1.Image, CommonDialog1.FileName End Sub Private Sub CopyPicture() With Form1.Image1 ' Подгоняем размер Picture1 под размер выделенной области Picture1.Width = .Width Picture1.Height = .Height ' Копируем картинку с формы на Picture1 Picture1.Cls Picture1.PaintPicture Form1.Image, 0, 0, .Width - 30, .Height - 30, .Left + 15, .Top + 15, .Width - 30, .Height - 30 End With End Sub Private Sub Run_Click() ' Копируем изображение рабочего стола на форму BitBlt Form1.hdc, 0, 0, Screen.Width / 15, Screen.Height / 15, _ DeskDc, 0, 0, vbSrcCopy Form1.Show End Sub Private Sub Exit_Click() ' Удаляем иконку из трея IconData.cbSize = Len(IconData) IconData.hWnd = Picture1.hWnd IconData.uId = 1& Shell_NotifyIcon NIM_DELETE, IconData ' Освобождаем ресурсы ReleaseDC Deskhwnd, DeskDc End End Sub Private Sub Hide_Click() Form1.Image1.Visible = False Form1.Hide End Sub Удачи, вроде всего - очень хороший пример

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Отвечает

Леха

Cкриншот экрана, активного окна, печать и сохранение в файл Данный пример покажет, как можно сделать скриншот всего экрана, текущего окна (с заголовком и без), текущего окна по таймеру. А также пример печати скриншота и сохранения в файл. Расположите на форме 7 элементов CommandButton, элемент PictureBox (растяните изображение PictureBox как можно больше). А также расположите на форме элемент Microsoft Common Dialog Control 6.0 через меню Project | Components. Сохранять можно только в bmp Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Type PALETTEENTRY peRed As Byte peGreen As Byte peBlue As Byte peFlags As Byte End Type Private Type LOGPALETTE palVersion As Integer palNumEntries As Integer palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors. End Type Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function BitBlt Lib "GDI32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) As Long Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long Private Declare Function GetDesktopWindow Lib "USER32" () As Long Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long Private Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long Private Declare Function GetForegroundWindow Lib "USER32" () As Long Private Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal hDC As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long Private Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Long) As Long Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long Private Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As Long Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture Dim hDCMemory As Long Dim hBmp As Long Dim hBmpPrev As Long Dim r As Long Dim hDCSrc As Long Dim hPal As Long Dim hPalPrev As Long Dim RasterCapsScrn As Long Dim HasPaletteScrn As Long Dim PaletteSizeScrn As Long Dim LogPal As LOGPALETTE If Client Then hDCSrc = GetDC(hWndSrc) Else hDCSrc = GetWindowDC(hWndSrc) End If hDCMemory = CreateCompatibleDC(hDCSrc) hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc) hBmpPrev = SelectObject(hDCMemory, hBmp) RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) HasPaletteScrn = RasterCapsScrn And RC_PALETTE PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) If HasPaletteScrn And (PaletteSizeScrn = 256) Then LogPal.palVersion = &H300 LogPal.palNumEntries = 256 r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0)) hPal = CreatePalette(LogPal) hPalPrev = SelectPalette(hDCMemory, hPal, 0) r = RealizePalette(hDCMemory) End If r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy) hBmp = SelectObject(hDCMemory, hBmpPrev) If HasPaletteScrn And (PaletteSizeScrn = 256) Then hPal = SelectPalette(hDCMemory, hPalPrev, 0) End If r = DeleteDC(hDCMemory) r = ReleaseDC(hWndSrc, hDCSrc) Set CaptureWindow = CreateBitmapPicture(hBmp, hPal) End Function Public Function CaptureActiveWindow() As Picture Dim hWndActive As Long Dim r As Long Dim RectActive As RECT hWndActive = GetForegroundWindow() r = GetWindowRect(hWndActive, RectActive) Set CaptureActiveWindow = CaptureWindow(hWndActive, False, 0, 0, RectActive.Right - RectActive.Left, RectActive.Bottom - RectActive.Top) End Function Public Function CaptureClient(frmSrc As Form) As Picture Set CaptureClient = CaptureWindow(frmSrc.hWnd, True, 0, 0, frmSrc.ScaleX(frmSrc.ScaleWidth, frmSrc.ScaleMode, vbPixels), frmSrc.ScaleY(frmSrc.ScaleHeight, frmSrc.ScaleMode, vbPixels)) End Function Public Function CaptureScreen() As Picture Dim hWndScreen As Long hWndScreen = GetDesktopWindow() Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, Screen.Width \ Screen.TwipsPerPixelX, Screen.Height \ Screen.TwipsPerPixelY) End Function Public Function CaptureForm(frmSrc As Form) As Picture Set CaptureForm = CaptureWindow(frmSrc.hWnd, False, 0, 0, frmSrc.ScaleX(frmSrc.Width, vbTwips, vbPixels), frmSrc.ScaleY(frmSrc.Height, vbTwips, vbPixels)) End Function Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture Dim r As Long Dim Pic As PicBmp Dim IPic As IPicture Dim IID_IDispatch As GUID With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With With Pic .Size = Len(Pic) .Type = vbPicTypeBitmap .hBmp = hBmp .hPal = hPal End With r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) Set CreateBitmapPicture = IPic End Function Public Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture) Const vbHiMetric As Integer = 8 Dim PicRatio As Double Dim PrnWidth As Double Dim PrnHeight As Double Dim PrnRatio As Double Dim PrnPicWidth As Double Dim PrnPicHeight As Double If Pic.Height >= Pic.Width Then Prn.Orientation = vbPRORPortrait Else Prn.Orientation = vbPRORLandscape End If PicRatio = Pic.Width / Pic.Height PrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, vbHiMetric) PrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, vbHiMetric) PrnRatio = PrnWidth / PrnHeight If PicRatio >= PrnRatio Then PrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, Prn.ScaleMode) PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, vbHiMetric, Prn.ScaleMode) Else PrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, Prn.ScaleMode) PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, vbHiMetric, Prn.ScaleMode) End If Prn.PaintPicture Pic, 0, 0, PrnPicWidth, PrnPicHeight End Sub Private Sub Command1_Click() Set Picture1.Picture = CaptureScreen() End Sub Private Sub Command2_Click() Set Picture1.Picture = CaptureForm(Me) End Sub Private Sub Command3_Click() MsgBox "Через 3 секунды после закрытия окна вы получите изображение окна" Dim EndTime As Date EndTime = DateAdd("s", 3, Now) Do Until Now > EndTime DoEvents Loop Set Picture1.Picture = CaptureActiveWindow() Me.SetFocus End Sub Private Sub Command4_Click() Set Picture1.Picture = CaptureClient(Me) End Sub Private Sub Command5_Click() PrintPictureToFitPage Printer, Picture1.Picture Printer.EndDoc End Sub Private Sub Command6_Click() CommonDialog1.DefaultExt = ".BMP" CommonDialog1.Filter = "Bitmap Image (*.bmp)|*.bmp" CommonDialog1.ShowSave If CommonDialog1.FileName <> "" Then SavePicture Picture1.Picture, CommonDialog1.FileName End If End Sub Private Sub Command7_Click() Set Picture1.Picture = Nothing End Sub Private Sub Form_Load() Command1.Caption = "Весь экран" Command2.Caption = "Активное окно" Command3.Caption = "Активное окно (3 сек)" Command4.Caption = "Акт. окно бе загол." Command5.Caption = "Напечатать картинку" Command6.Caption = "Сохранить картинку" Command7.Caption = "Очистить" End Sub

Оценка за ответ эксперту Леха: 5 баллов

Вопрос # 200	Доброго времени суток уважаемые господа программисты!!! Я новичек в деле программирования на VB могли бы Вы мне подсказать как создать прогу которая следила бы за моим компутером и показывала кто ко мне подключается через локалку… а можно и отдельно через И-нет… Заранее благодарен…. И пожалуйста объясните усе простым языком
[Ответить]

Отвечает

Роман

Для решения этой задачи, пожалуй, подошёл бы только VB.Net, однако я не советовал делать это не только новичку, но и профессионалу, так как решение подобной задачи потребует титанических усилий. Лучше воспользуйся следующими программами. ISS BlackICE PC Protection v3.6 cbx Программа работает в фоновом режиме, постоянно контролируя состояние портов РС. В случае обнаружения попытки несанкционированного входа в вашу машину, программа подает звуковой и визуальный сигнал, сообщает о характере действий постороннего. Есть несколько уровней защиты. Iris Network Traffic Analyzer v4.0.6.4 На сегодняшний день, самый многофункциональный снифер и монитор сетевого трафика. Очень легкие настройки, перехватывает все. Полезно знать, что проходит во время нашего серфинга. Можно мониторить как и весь трафик так и отдельные программы. Анализатор пакетов eEye Digital Security Iris The Network Traffic Analyzer компании eEye - это настоящая революция в области сетевого мониторинга. Помимо стандартных функций сбора, фильтрации и поиска пакетов, а также построения отчетов, программа Iris The Network Traffic Analyzer предлагает уникальные возможности для реконструирования данных. От себя отмечу, что помимо вылавливания незаконных подключений, программы имеют возможность вызывать разнообразные утилиты Windows. К примеру Ping, но в Windows обложке. Очень удобно. У меня эти проги находятся на клетчатом загрузочном CD диске Windows 2003 Server.

Оценка за ответ эксперту Роман: 3 баллов

Отвечает	Артем
	Вопрос хороший! но советую прежде браться за такое перелопатить не мало материала! Код предоставлять не буду! дам только направление! Изучи Winsoc там много есть чего! И самый простой способ решить твой вопрос это постоя нно следить за всеми апи адресами на локальной машине а остальное довольно сложно вычичлить какая прога что имеенно использует и кто безсспросу пытается залезьть!

Оценка за ответ эксперту Артем: 3 баллов

Отвечает

visualprogs@yandex.ru

Прийдется тебе юзать Winsock - может быть. А так в двух словах, нужно как то программно следить за портами. Скорее всего если ты новичек, то будет сложнова то реализовать это, что то типо файрвола! Лучше возьмись за что нить по проще. Или ищи инфу по Винсоку Использование Winsock контрола Введение Этот текст является вольным переводом из MSDN и демонстрирует возможности обмена данными по сети при помощи компонента Winsock. Кое-что дополнено и исправлена одна ошибка из сэмпла MSDN из-за которой передача шла только в одну сторону. Использование компонента Winsock Компонент WinSock позволяет соединиться с удаленной машиной и обменяться с ней данными, используя UDP (User Datagram Protocol) или TCP (Transmission Control Protocol). Оба протокола могут быть использованы при создании клиент-серверных приложений. Также, как и Timer control, WinSock control является невидимым во время выполнения программы. Как им пользоваться? - создать приложение-клиент, которое будет собирать информацию перед отсылкой ее на центральный сервер; - создать приложение-сервер, которое будет выполнять роль сборщика и хранителя информации от различных клиентских приложений; - создать "chat"-приложение. Выбор протокола. Когда планируется использование а WinSock, необходимо решить какой протокол будет использоваться - TCP или UDP. Основное отличие между ними заключается в способе организации связи: Соединение основанное на TCP протоколе, похоже на телефонное - пользователь сначала должен установить соединение, прежде чем что-либо передавать. Соединение основанное на UDP протоколе, похоже на передачу голосом, сообщение передается от одного компьютера к другому, но не ясно, слышат ли они друг друга. Вдобавок, максимальный размер предаваемых данных устанавливается сетью. Возможности приложения которое Вы создаете будет зависеть от протокола, который Вы изберете. Вот несколько вопросов которые могут помочь Вам выбрать подходящий протокол: Будет ли приложение требовать уведомления от сервера или клиента, когда данные передаются или получаются? Если будет, то TCP протокол требует установленного соединения между передатчиком и приемником данных. Будут ли передаваемые данные достаточно тяжелыми (например изображения или звуковые файлы)? Если соединение было установлено, TCP протокол будет его поддерживать и гарантируется целостность передаваемых данных. Такое соединение, из-за потребности в большем количестве вычислительных ресурсов, может сделать его более медленным. Будут ли данные передаваться порциями или за одну сессию? Например, если Вы создаете приложение, которое сообщает каким-то компьютерам, о том, что какие-то задачи уже выполнены, то UDP протокол более подходящий. UDP протокол также блучше подходит для передачи небольшого количества данных. Установка протокола. Чтобы установить протокол, который будет использовать ваше приложение Вы должны в дизайн-тайме в окне свойств выбрать свойство Protocol и установить его sckTCPProtocol или sckUDPProtocol. Это можно также сделать программно: Winsock1.Protocol = sckTCPProtocol Определение имени компьютера. Чтобы установить связь с удаленным компьютером, Вы должны знать либо его IP-адресс, либо его имя. Основы TCP соединения. Когда создается приложение, которое использует TCP протокол первое, что Вы должны решить, это чем будет ваше приложение клиентом или сервером. Если Вы создаете приложение-сервер, значит ваше приложение будет слушать указанный порт. Когда приложение-клиент подаст запрос на соединение, приложение-сервер может принять запрос и таким образом установить соединение. Если соединение установлено, приложение-клиент и приложение сервер могут свободно обмениваться данными. Следующие шаги позволят Вам создать элементарное приложение-сервер: Для создания TCP сервера - Создайте новый Standard EXE проект. - Замените имя формы по умолчанию на frmServer. - В свойстве формы caption наберите "TCP Server" - В меню Project\Components добавьте Microsoft Winsock Conrol 6.0 - Перетащите иконку компонента Winsock с панели инструментов и разместите ее на форме; измените имя компонента на tcpServer. Добавьте на форму два Текстбокс элемента. В свойстве Name первого текстового поля наберите txtSendData, а второго txtOutput. Добавьте в форму следующий код: Private Sub Form_Load() 'Задать номер порта по которому будет осуществляться 'обмен данными, присвоив значение свойству LocalPort 'Вызвать метод Listen. tcpServer.LocalPort = 1001 tcpServer.Listen frmClient.Show 'Показать форму клиента End Sub Private Sub tcpServer_ConnectionRequest (ByVal requestID As Long) ' Проверяется свойство State, было ли завершено ' предыдущее соединение. Если не завершено, ' то перед установлением нового соединения, ' старое закрывается принудительно. If tcpServer.State <> sckClosed Then tcpServer.Close ' Принятие запроса Accept с параметром requestID ' на установление соедиения. tcpServer.Accept requestID End Sub Private Sub txtSendData_Change() ' Текстовое поле txtSendData ' содержит данные для передачи. Все символы, ' которые будут вводиться в это текстовое поле, будут единой ' строкой посылаться приложению-клиенту, используя метод SendData. tcpServer.SendData txtSendData.Text End Sub Private Sub tcpServer_DataArrival (ByVal bytesTotal As Long) ' Декларируется переменная-буфер для получаемых данных. ' Вызывается метод GetData и свойству Text ' текстового поля txtOutput, присваивается значение переменной- ' буфера. Dim strData As String tcpServer.GetData strData txtOutput.Text = strData End Sub Описанные выше действия, выполненные Вами, приведут к созданию простого приложения-сервера. Но для того чтобы полностью выполнить задачу, необходимо создать еще и приложение-клиент. Для создания TCP приложения-клиента Добавьте новую форму в проект и назовите ее frmClient. Измените свойство формы caption на "TCP Client". Перетащите и разместите компонент Winsock на форму и измените его свойство name на "tcpClient". - Добавьте два Текстбокс-контрола на форму frmClient. - Имя первого установите txtSend, а второго txtOutput. - Перетащите на форму CommandButton и установите его свойство name в "cmdConnect". - Измените свойство caption этой кнопки на "Connect". Добавьте следующий код в форму. Важно!!! Будьте внимательны при установке свойства RemoteHost. Оно должно соответствовать либо IP-адресу вашего компьютера, либо его "Дружественному имени" (см. Пуск\Настройка\Панель управления\Сеть) выберите вкладку "Идентификация". Текст из поля "Имя компьютера" и будет так называемым дружественным именем, которым можно заменять IP-адрес. Сам же IP-адрес, можно посмотреть, если выбрать закладку "Конфигурация" в списке выбрать TCP/IP, нажать кнопку "Свойства" и выбрать закладку IP-адрес. Private Sub Form_Load() ' Имя Winsock-компонента tcpClient. ' Указывая имя удаленного компьютера можно ' указывать IP-адрес (например: "121.111.1.1") или ' дружественное имя, как в нижеприведенном коде. tcpClient.RemoteHost = "RemoteComputerName" 'или "121.111.1.1" tcpClient.RemotePort = 1001 End Sub Private Sub cmdConnect_Click() ' Вызвать метод Connect для создания соединения tcpClient.Connect End Sub Private Sub txtSend_Change() tcpClient.SendData txtSend.Text End Sub Private Sub tcpClient_DataArrival (ByVal bytesTotal As Long) Dim strData As String tcpClient.GetData strData txtOutput.Text = strData End Sub Сохраните проект в отдельной директории. Код приведенный выше - это простейшее клиент-серверное приложение. Чтобы попробовать, как это все работает на одной машине в связке, имитирующей межмашинное соединение, значение свойства RemoteHost приложения-клиента должно соответствовать дружественному имени или IP-адресу вашего компьютера. Запустите проект и нажмите кнопку "Connect". После этого наберите текст внутри текстового поля txtSendData на каждой форме и убедитесь, что тот же самый текст появится в текстовом поле txtOutput другой формы. Если Вы хотите, попробовать, как приложения будут осуществлять связь между двумя компьютерами, то Вам прийдется произвести следующие действия: - Удалить из кода формы приложения-сервера строку frmClient.Show. - В окне Project Explorer щелкнуть правой кнопкой мыши на форме frmClient.frm и в появившемся меню выбрать Remove frmClient.frm после чего сохранить проект под именем Server1. - Открыть первый вариант проекта и таким же образом удалить из проекта уже форму frmServer.frm. - Создать exe модуль для frmClient-а и переписать его на удаленный компьютер и запустить его там. Примечание: если на удаленном компьютере не установлен VB будьте готовы к тому, что вам потребуется переписать на него из WINDOWS\SYSTEM\mswinsck.ocx и зарегистрировать его при помощи команды WINDOWS\SYSTEM\regsvr32.exe mswinsck.ocx Если приложение будет требовать какие-то дополнительные dll модули перепишите их со своей машины на удаленную. - На своей машине, откройте проект Server и запустите его. - На клиентской машине нажмите кнопку Connect и наберите текст внутри текстового поля txtSendData на каждой форме и убедитесь, что тот же самый текст появится в текстовом поле txtOutput в приложении, запущенном на другом компьютере. Обработка более чем одного запроса на установление соединения. Приложение-сервер, которое мы создавали сначала может обработать только один запрос на соединение. Тем не менее, существует возможность обработать несколько запросов на соединение, используя тот же самый управляющий элемент как один из массива управляющих элементов. В этом случае, необязательно закрывать соединение - просто создайте новый вариант управляющего элемента (использовав его свойство Index) и вызовите метод Accept для этого нового варианта управляющего элемента. В приведенном ниже тексте программы, свойству Index, размещенного на форме Winsock-компонента sckServer, присваивается значение 0, таким образом, управляющий элемент становится частью массива управляющих элементов. В разделе Declarations описана локальная переменная intMax. Когда для формы происходит событие Load, переменной intMax присваивается значение 0 и свойству LocalPort первого элемента массива управляющих элементов присваивается значение 1001. Только после того, как вызывается метод Listen этого управляющего элемента, он начинает слушать указанный порт. Когда поступает новый запрос на соединение, осуществляется проверка значения Index и равно ли оно 0 (значение элемента, который слушает порт). Таким образом, элемент который слушает порт, будет приращивать переменную intMax и использовать значение этой переменной для создания нового элемента массива. Этот новый элемент будет использоваться для обработки запроса на соединение. Private intMax As Long Private Sub Form_Load() intMax = 0 sckServer(0).LocalPort = 1001 sckServer(0).Listen End Sub Private Sub sckServer_ConnectionRequest (Index As Integer, ByVal requestID As Long) If Index = 0 Then intMax = intMax + 1 Load sckServer(intMax) sckServer(intMax).LocalPort = 0 sckServer(intMax).Accept requestID Load txtData(intMax) End If End Sub

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Вопрос # 201	Плиз, подскажите, как программным методом поместить свою программу в автозагрузку, только не через "пуск >>> программы >>> автозагрузка",как другие проги (например, аська) - просто ставишь галочку и всё. Какую процедуру/функцию надо выполнить?
[Ответить]

Отвечает	anton
	Добавить её в реестр, в раздел загрузки.

Оценка за ответ эксперту anton: 3 баллов

Отвечает	haemmid
	Помню только что это делается через реестр, но никогда особо этим не интересовался...

Оценка за ответ эксперту haemmid: 3 баллов

Отвечает	vlad_t_kiev@mail.ru
	Private Sub Command1_Click() 'Запись в реестр Set Reg = CreateObject("WScript.Shell") Reg.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Имя моей проги", "G:\SystemConlrol.exe" End Sub Private Sub Command2_Click() 'Удаление из реестра Set Reg = CreateObject("WScript.Shell") Reg.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Имя моей проги" End Sub

Оценка за ответ эксперту vlad_t_kiev@mail.ru: 5 баллов

Отвечает

Роман

В этом вопросе сразу стоит определиться для чего это нужно. Если необходимо просто добавить или удалить уже установленную программу в автозагрузке, то лучше всего просто воспользоваться утилитой Customizer XP. В меню Startup Manager, можно настроить параметры автозапуска программ. Причём есть возможность добавления путём помещения ярлыка в автозагрузку, а так же вариант нахождения нужной информации в реестре. И самое главное, почему я рекомендую эту программу, в ней можно ставить или убирать галочки, для контроля над автозагрузкой. Если галочку убрать, то сам элемент не стирается, и в последующем его можно безболезненно включить обратно. Так же существует возможность переносить ярлык из автозагрузки в реестр и обратно. Программный же способ нужен только для мастеров установки и уж точно там не нужны никакие галочки, поэтому я не стану заострять на этом внимания.

Оценка за ответ эксперту Роман: 2 баллов

Отвечает	Александр Шапошников
	Private Sub Command1_Click() 'Запись в реестр Set Reg = CreateObject("WScript.Shell") Reg.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Имя твоей проги", "Путь к твоей проге" End Sub Private Sub Command2_Click() 'Удаление из реестра Set Reg = CreateObject("WScript.Shell") Reg.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Имя твоей проги" End Sub

Оценка за ответ эксперту Александр Шапошников: 5 баллов

Отвечает	Артем
	Все просто Нужен реестр. Изучи что такое реестр Windows! Потом ты узнаешь какие ключи именно ты хочешь использовать! потом Api функции по работе с реестром и все!

Оценка за ответ эксперту Артем: 3 баллов

Отвечает

visualprogs@yandex.ru

'// Объявления '// Функции Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long '// Константы Const HKEY_CURRENT_USER = &H80000001 Const KEY_ALL_ACCESS = &H3F Const REG_SZ As Long = 1 '// Добавление программы в автозагрузку: Public Sub AddToAutostart() Dim Result As Long Dim Retval As Long Dim sPath As String '// Определяем путь к программе If Right(App.Path, 1) = "\" Then sPath = App.Path & App.EXEName & ".exe" Else sPath = App.Path & "\" & App.EXEName & ".exe" End If '// Манипулятор ключа Retval = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", 0, KEY_ALL_ACCESS, Result) '// Записываем в автозагрузку RegSetValueEx Result, App.Title, 0, REG_SZ, ByVal sPath, Len(sPath) RegCloseKey Result '// Закрытие ключа End Sub '// Удаление из автозагрузки: Public Sub DeleteFromAutostart() Dim Retval As Long Dim Result As Long '// Манипулятор ключа Retval = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows\Current Version\Run", 0, KEY_ALL_ACCESS, Result) '// Удаляем параметр RegDeleteValue Result, App.Title RegCloseKey Result '// Закрытие ключа End Sub

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Вопрос # 202	Подскажите, как узнать, находится сейчас юзер в Интернете или нет?
[Ответить]

Отвечает

visualprogs@yandex.ru

В сети есть пример создания прог типа ICQ: Lan ICQ Client, я даже связывался с автором, но он боьше не поддерживает проект, так вот как там реилизовано, по щелчку на нике идет проверка: Private Sub List1_DblClick() 'Тыкаем мышкой два раза по listbox и коннектимся к выбранному компу If List1 = "" Then MsgBox "Выберети Компьютер!", vbExclamation Exit Sub End If If frmSysTray.TCPClient.state <> sckClosed Then frmSysTray.TCPClient.Close frmSysTray.TCPClient.RemotePort = 38164 frmSysTray.TCPClient.Connect userIP(List1.ListIndex + 1) RemoteCompName = List1 End Sub

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Вопрос # 203	Здравствуйте! Как спрятать программу из списка задач? Есть одна проблема - у меня WinXP. Если можно - с примерчиком.
[Ответить]

Отвечает	anton
	Написать где-нибуть: App.TaskVisible = False

Оценка за ответ эксперту anton: 5 баллов

Отвечает	vlad_t_kiev@mail.ru
	Private Sub Form_Load() App.TaskVisible = False End Sub

Оценка за ответ эксперту vlad_t_kiev@mail.ru: 5 баллов

Отвечает

Александр Шапошников

Данный пример покажет, как можно спрятать вашу программу из панели задач, а затем показать. Обратите внимание на функцию SetWindowPos - во время показа формы вы можете установить место появления формы, а также новые размеры формы. Разместите на форме 3 элемента CommandButton и элемент Timer. При нажатии на Command1 программа прячется как из панели задач, так и из видимых программ. Событие Timer1_Timer через 5 секунд покажет вашу програаму. При нажатии на Command2 программа удаляется из панели задач, но остается видимой, нажатие на Command3 покажет вашу программу в панели задач. Одна странность: при нажатии второй раз на Command2 программа будет показана на панели задач. Const WS_EX_APPWINDOW = &H40000 Const GWL_style="(-16)" Const GWL_EXstyle="(-20)" Const SW_HIDE = 0 Const SW_NORMAL = 1 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Const SWP_SHOWWINDOW = &H40 Const SWP_HIDEWINDOW = &H80 Dim ret& Private Sub Command1_Click() 'Этот код спрячет вашу программу из панели задач, также спрячет саму форму ret = SetWindowPos(Form1.hwnd, 0, Form1.Left, Form1.Top, Form1.Width, Form1.Height, SWP_HIDEWINDOW) Timer1.Enabled = True End Sub Private Sub Form_Load() Timer1.Interval = 5000 End Sub Private Sub Timer1_Timer() 'Этот код покажет вашу форму через 5 секунд ret = SetWindowPos(Form1.hwnd, 0, 0, 0, 500, 500, SWP_SHOWWINDOW) End Sub Private Sub Command2_Click() 'событие спрячет вашу прогу из панели задач. Программа остается видимой ShowWindow Form1.hwnd, SW_HIDE ret = GetWindowLong(Form1.hwnd, GWL_EXSTYLE) SetWindowLong Form1.hwnd, GWL_EXSTYLE, ret Xor WS_EX_APPWINDOW ShowWindow Form1.hwnd, SW_NORMAL Timer1.Enabled = False End Sub Private Sub Command3_Click() 'событие покажет программу в панели задач ShowWindow Form1.hwnd, SW_HIDE ret = GetWindowLong(Form1.hwnd, GWL_EXSTYLE) SetWindowLong Form1.hwnd, GWL_EXSTYLE, ret Or WS_EX_APPWINDOW ShowWindow Form1.hwnd, SW_NORMAL Timer1.Enabled = False End Sub

Оценка за ответ эксперту Александр Шапошников: 5 баллов

Отвечает	visualprogs@yandex.ru
	Как сделать невидимую программу Private Declare Function RegisterServiceProcess Lib "kernel32.dll" _ (ByVal dwProcessId As Long, ByVal dwType As Long) As Long Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long Private Sub Form_Load() Call RegisterServiceProcess(GetCurrentProcessId, 1) End Sub

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Вопрос # 204

Как надоело набирать код вручную, хотелось бы знать, не пробовал ли кто исправить это досадное недоразумение и если пробовал, то как? Вот, к примеру, Add-in (в переводе - врезка) для VisualBasic существуют повсеместно, и в VisualStudio 6 и в VisualStudio 7, так же MSOfficeимеет свои особые возможности, особенно такой продукт как Access. Если соединить базу данных с VisualStudio 7 (которая по совместительству называется NET), это же даёт уникальные возможности. К тому же там есть специально созданные для этой цели Wizard’sAdd-in. Предположим такую ситуацию, у меня куча событий вызова от кнопок. Если бы мне надо было в каждую из них автоматически вписать соответствующую функцию вывода звука, то есть определить звуковую схему, то это сколько времени понадобилось бы на эту простейшую операцию, а ведь эти дополнительные функции не единственные. Код всё более и более запутывается, а ведь в программе главное порядок. Или взять автоматический ввод инструкций, причём не в виде текста, а именно как элемент какого-либо списка (древовидного, обычного и так далее). То есть, нужна синхронизация кода и списков, а, следовательно, не обойтись без лексического преобразователя. Вообще существует огромное количество игр с удобным интерфейсом, и ни одной серьёзной системы программирования с такими же особенностями. VisualStudio 7 обрёл много замечательных нововведений по сравнению с VisualStudio 6. Но даже теперь в нём нет автоматизированного ввода инструкций, и предкомпиляционной проверки на допустимость. Легче ведь запретить вводить код неправильно, чем потом проверять ошибки программиста. Ещё один пример VBScript. Конечно, можно использовать PowerEditorи другие подобные программы. Однако это не лучший выход, код то по прежнему существует, он не упорядочен и не сгруппирован. Переход по нему занимает уйму времени. Особо больная проблема поиска функций. Вот тут недавно писали о программном решении сжатия базы данных в Access, а ведь этого не понадобилось бы, не запихни разработчики библиотеки вызов в «RunCommandCompactDataBase», то есть вызов не самой функции, а так сказать через функцию менеджер-функций. Устранение этой проблемы возможно, если бы были введены дополнительные ссылки на различные варианты вызова процедур. За частую не хватает такого способа группировки функций как подразделение его на модули и классы в библиотеках. Следовательно, необходимо считать существующие в библиотеках функции и распределить их по особой системе, в наиболее удобном порядке. Таких способов будет великое множество, но действительно удобных окажется не так уж и много, а следовательно такое вполне по силам. Общий вывод, отказаться от кода путём его запрятывания куда подальше. Присылайте примеры и ссылки на них.

[Ответить]

Отвечает	visualprogs@yandex.ru
	А может просто использовать массив кнопок, не нужно будет прописывать одно и то же.

Оценка за ответ эксперту visualprogs@yandex.ru: 3 баллов

Вопрос # 205	Как сделать !!!полупрозрачную!!! форму по маске из BMP файла? Если цвет точки чёрный, то часть формы не прозрачна, белый-прозрачна. Оттенки серого - степень прозрачности. Примернр так, как в Windows Vista 5270. Заранее благодарен.
[Ответить]

Отвечает

Роман

Ответ однозначен, нужно использовать DirectX, захватить handle окна, и управлять функциями перерисовки. Это довольно таки сложная задача, а объём занимаемого кода будет очень велик, во всяком случае, подобные примеры описаны в книгах по программированию, и для достижения этой цели приходится прочитывать не одну сотню страниц. А суммарный объём знаний программиста должен составлять тысячи страниц и понятий. Одним словом задача для профи, ведь тот кто работает с альфа поверхностью по большому счёту им и является.

Оценка за ответ эксперту Роман: 3 баллов

Отвечает	Андрей Горбоконь
	Для того чтобы получить прозрачное изображение, надо выполнить ряд API функций: к примеру, _как в проэкте который я привяжу к письму_.

Скачать приложенный к ответу файл >>>

Оценка за ответ эксперту Андрей Горбоконь: 3 баллов

Отвечает

visualprogs@yandex.ru

НУ и тебе поможем: 1 форма, на ней Check1, Slider1, Command1. Значит установил флажок и ведешь слайдером - меняешь прозрачность формы! До предела пока форму вообще не видно. Код формы: Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Declare Function UpdateLayeredWindow Lib "user32" (ByVal hwnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hDCSrc As Long, pptSrc As Any, crKey As Long, ByVal pblend As Long, ByVal dwFlags As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Const GWL_EXstyle="(-20)" Private Const LWA_COLORKEY = &H1 Private Const LWA_ALPHA = &H2 Private Const ULW_COLORKEY = &H1 Private Const ULW_ALPHA = &H2 Private Const ULW_OPAQUE = &H4 Private Const WS_EX_LAYERED = &H80000 Public Function isTransparent(ByVal hwnd As Long) As Boolean On Error Resume Next Dim Msg As Long Msg = GetWindowLong(hwnd, GWL_EXSTYLE) If (Msg And WS_EX_LAYERED) = WS_EX_LAYERED Then isTransparent = True Else isTransparent = False End If If Err Then isTransparent = False End If End Function Public Function MakeTransparent(ByVal hwnd As Long, Perc As Integer) As Long Dim Msg As Long On Error Resume Next If Perc < 0 Or Perc > 255 Then MakeTransparent = 1 Else Msg = GetWindowLong(hwnd, GWL_EXSTYLE) Msg = Msg Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, Msg SetLayeredWindowAttributes hwnd, 0, Perc, LWA_ALPHA MakeTransparent = 0 End If If Err Then MakeTransparent = 2 End If End Function Public Function MakeOpaque(ByVal hwnd As Long) As Long Dim Msg As Long On Error Resume Next Msg = GetWindowLong(hwnd, GWL_EXSTYLE) Msg = Msg And Not WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, Msg SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHA MakeOpaque = 0 If Err Then MakeOpaque = 2 End If End Function Private Sub Check1_Click() If Check1.Value = vbChecked Then Slider1.Enabled = True MakeTransparent Me.hwnd, Slider1.Value Else Slider1.Enabled = False MakeOpaque Me.hwnd End If End Sub Private Sub Command1_Click() End End Sub Private Sub Form_Load() Slider1.Enabled = False Slider1.Value = 255 End Sub Private Sub Slider1_Scroll() MakeTransparent Me.hwnd, Slider1.Value End Sub

Оценка за ответ эксперту visualprogs@yandex.ru: 5 баллов

Вопрос # 206	Я из базы данных получаю набор записей в виде объекта Recordset. Подскажите, как лучше организовать отображение полей объекта Recordset в полях формы, а затем значения полей формы сохранить в полях объекта Recordset. Пишу на VB. Заранее благодарен!
[Ответить]

Отвечает

Роман

Если хочешь добиться скорости, то напиши SQL-запрос в поле формы на Recordset. Это даст максимальную скорость и синхронизацию данных. Не вздумай пытаться заполнять поля путём цикла с добавлением записи. Такое решение свёдет на нет всё преимущества базы данных Access, мы ведь о ней говорим надеюсь. Если же форма не в Access, а в VB.Net, то решение тоже самое. Существуют некие элементы способные подключаться к базам через SQL-запросы. Они обычно имеют в своём названии слово Grid, а свойство подключения называется источником данных. Сначала подключается база с помощью одного элемента. Этот элемент подключается к другому элементу, который и отображает саму таблицу. Вся технология подобных действий подробна описана в MSDN.

Оценка за ответ эксперту Роман: 4 баллов