Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

Visual Basic: новости сайтов, советы, примеры кодов. Выпуск 67.


Информационный Канал Subscribe.Ru

Visual Basic: новости сайтов, советы, примеры кодов.
Выпуск 67.


VBNet VBMania
Голосование:

Ваш голос отсылается по E-mail владельцу сайта, после чего голоса анализируются и на отдельной странице выводятся результаты.

Нет тем.

Рассылки Subscribe.Ru
Мир программирования на Visual BASIC 5.0 и HTML.
Новости сайта IgorykSoft и советы по программированию


Рассылки Subscribe.Ru
Старые игры

Доска почёта:

Sergey Y. Tkachev
Кононенко Роман
Kirill

Ссылки:

  • Улицы VB
  • Использование VB
  • Азбука VB
  • VB на русском
  • Улицы VB
  • Кирпичики VB
  • CообЧа VB
  • Snoozex Design
  • IgorykSoft
  • Господа!!! читайте MSDN!!!

    Несколько слов от автора:

       Новый выпуск...
    Читайте!


    Содержание выпуска




    Книги

    Переход на VB .NET. Стратегии, концепции, код (цена ~ 158 руб.)

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

    Автор(ы): Дан Эпплман, Издательство: Питер, 2002 г.


    Программирование на VB.NET. Учебный курс (цена ~ 119 руб.)

    Эта книга является вводным курсом по изучению языка программирования Visual Basic .NET. Даны основные принципы объектно-ориентированного программирования в контексте языка VB .NET, поскольку без хорошей подготовки в этой области невозможно в полной мере пользоваться всеми преимуществами VB .NET.
    Изложены азы всех аспектов языка, которыми должен владеть любой профессиональный разработчик VB .NET

    Автор(ы): Г. Корнелл, Дж. Моррисон, Издательство: Питер, 2002 г.


    VB.NET для разработчиков (цена ~ 125 руб.)

    Основная задача книги - быстро ознакомить разработчиков Visual Basic с изменениями в .NET Framework. Программисты, использующие Java, C++, Delphi или другие инструменты разработки приложений и интересующиеся Visual Basic или технологией .NET Framework, также найдут эту книгу полезной. Хотя книга посвящена Visual Basic.NET, ее основная цель - продемонстрировать взаимодействие Visual Basic и ...

    Автор(ы): Кит Франклин, Издательство: Вильямс, 2002 г.




    Остальные книги о VB можно найти
    здесь.

    наверх


    Минимизировать все окна

    Положите на форму 1 CommandButton

    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Const VK_LWIN = &H5B
    Const KEYEVENTF_KEYUP = &H2
    Private Sub Command1_Click()
    Call keybd_event(VK_LWIN, 0, 0, 0)
    Call keybd_event(&H4D, 0, 0, 0)
    Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
    End Sub

    наверх


    Примеры по работе с хранителем экрана

    Данный пример покажет, как можно определить "Загружен ли в данный момент хранитель экрана", а также запустить хранитель экрана. Данный пример еще можно дополнить ответом на вопрос "А как программно отключить хранитель экрана?". Я пока ответа не знаю.
    Если вы знаете ответ, напишите мне

    Расположите на форме 3 элемента CommandButton, элемент Timer.

    Нажмите на кнопку 2. Через несколько секунд запустится хранитель экрана. Через 6 секунд пошевелите мышкой, хранитель экрана закроется. И вы увидите на форме MsgBox с сообщением, была загружена заставка. При нажатии на кнопку 3 вы получите время, через которое запускается хранитель экрана.

    Const SPI_GETSCREENSAVEACTIVE = 16
    Const SPI_GETSCREENSAVETIMEOUT = 14
    Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

    '6 нижеследующих строчек нужны для запуска хранителя экрана
    Const WM_SYSCOMMAND = &H112&
    Const SC_SCREENSAVE = &HF140&
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Sub Command2_Click()
    Call SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
    End Sub

    'нажав на кнопку при незапущенном хранителе экрана вы получите сообщение "False"
    Private Sub Command1_Click()
    Dim blnReturn As Boolean
    Dim blnActive As Boolean
    Call SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, vbNull, blnReturn, 0)
    blnActive = blnReturn
    MsgBox blnActive
    Timer1.Enabled = False  'выключить таймер
    End Sub

    Private Sub Form_Load()
    Timer1.Interval = 5000 'установить временной интервал таймера 5 секунд
    Timer1.Enabled = True 'включить таймер
    End Sub

    Private Sub Timer1_Timer()
    Command1_Click 'имитурем нажатие на клавишу 1
    End Sub

    Private Sub Command3_Click()
    Dim intValue As Integer
    Call SystemParametersInfo(SPI_GETSCREENSAVETIMEOUT, vbNull, intValue, 0)
    MsgBox ("Скринсэйвер включается через " & intValue & " секунд.")
    End Sub

    наверх


    Получение сведений о зарегистрированных типах файлов в системе

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

    Расположите на форме элемент ListBox и элемент PictureBox. Для более наглядного отображения информации установите свойство .Sorted элемента ListBox как True.

    Option Explicit
    'Aaron Young http://www.pressenter.com/~ajyoung
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
    Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
    Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
    Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
    Private Const HKEY_CLASSES_ROOT = &H80000000
    Private aIcons() As String

    Private Sub Form_Load()
    Dim sType As String
    Dim sName As String
    Dim sFile As String
    Dim iIndex As Integer
    Dim lRegKey As Long
    Dim iFoundCount As Integer
    iIndex = 1
    iFoundCount = 1
    sType = Space(255)
    'Перечисление всех расширений
    Do While RegEnumKey(HKEY_CLASSES_ROOT, iIndex, ByVal sType, 255) = 0
    If Left(sType, 1) <> "." Then
    Else
    'Сохранение информации об иконке
    ReDim Preserve aIcons(iIndex - 1)
    sType = Left(sType, InStr(sType, Chr(0)) - 1)
    'Получить имя расширения, (к примеру - .zip = WinZip)
    If RegOpenKey(HKEY_CLASSES_ROOT, ByVal sType, lRegKey) = 0 Then
    sName = Space(255)
    Call RegQueryValueEx(lRegKey, ByVal "", 0&, 1, ByVal sName, 255)
    If InStr(sName, Chr(0)) Then sName = Left(sName, InStr(sName, Chr(0)) - 1)
    Call RegCloseKey(lRegKey)
    If Len(Trim(sName)) Then
    'Поиск иконки по умолчанию для расширения
    If RegOpenKey(HKEY_CLASSES_ROOT, sName & "\DefaultIcon\", lRegKey) = 0 Then
    sFile = Space(255)
    Call RegQueryValueEx(lRegKey, ByVal "", 0&, 1, ByVal sFile, 255)
    If InStr(sFile, Chr(0)) Then sFile = Left(sFile, InStr(sFile, Chr(0)) - 1)
    Call RegCloseKey(lRegKey)
    aIcons(iFoundCount - 1) = sFile
    End If
    End If
    End If
    List1.AddItem Left(sType & Space(10), 10) & " - " & sName
    iFoundCount = iFoundCount + 1
    End If
    sType = Space(255)
    iIndex = iIndex + 1
    Loop
    End Sub

    Private Sub List1_Click()
    Dim sFile As String
    Dim iIndex As Integer
    Dim lIcon As Long
    Picture1.Cls
    On Error GoTo IconErr
    'Получить иконку для данного типа расширения
    sFile = Left$(aIcons(List1.ListIndex), InStr(aIcons(List1.ListIndex), ",") - 1)
    iIndex = Val(Mid$(aIcons(List1.ListIndex), InStr(aIcons(List1.ListIndex), ",") + 1))
    lIcon = ExtractIcon(App.hInstance, sFile, iIndex)
    Call DrawIconEx(Picture1.hdc, 0, 0, lIcon, 32, 32, 0, 0, 3)
    IconErr:
    End Sub

    наверх


    Получение списка расширений, зарегистрированных в системе файлов

    Данный пример выведет в ваш ComboBox список всех расширений файлов, зарегистрированных в системе

    Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
    Function GetAllExts() As Variant
    Dim lRegResult As Long
    Dim lCounter As Long
    Dim hCurKey As Long
    Dim strBuffer As String
    Dim lDataBufferSize As Long
    Dim intZeroPos As Integer
    lCounter = 0
    lRegResult = RegOpenKey(&H80000000, "", hCurKey)
    Do
    lDataBufferSize = 255
    strBuffer = String(lDataBufferSize, " ")
    lRegResult = RegEnumKey(hCurKey, lCounter, strBuffer, lDataBufferSize)
    If lRegResult = 0& Then
    intZeroPos = InStr(strBuffer, Chr$(0))
    If Left(strBuffer, 1) = "." Then
    Form1.Combo1.AddItem LCase(Right(strBuffer, Len(strBuffer) - 1))
    End If
    lCounter = lCounter + 1
    Else
    Exit Do
    End If
    Loop
    End Function

    Private Sub Form_Load()
    GetAllExts
    End Sub

    наверх


    Получить описание любого файла: exe, dll или…

    или любого файла, если, конечно, вы сможете получить описание.

    Тестирование данного примера я провел на нескольких exe-файлах, некоторых системных библиотеках и даже обычных текстовых файлах. Для простоты проверки примера добавьте на форму элемент TextBox и элемент CommandButton. Естественно, в текстовое окно вы должны вставлять полный путь к проверяемому файлу.

    Но вот где хранятся эти описания, осталось для меня загадкой. Поиск в реестре ничего не дал...

    Вам понадобится дополнительный модуль.

    'КОД ФОРМЫ

    Private Sub Command1_Click()
    MsgBox GetFileDescription("c:\win\system\shell32.dll")
    'MsgBox GetFileDescription(Text1.Text)
    End Sub


    'КОД МОДУЛЯ

    Option Explicit
    Private Declare Function GetLocaleInfoA Lib "kernel32.dll" (ByVal lLCID As Long, ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As Long) As Long
    Private Declare Sub lstrcpyn Lib "kernel32.dll" (ByVal strDest As String, ByVal strSrc As Any, ByVal lBytes As Long)
    Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen As Long) As Long
    Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As Long, ByVal lpSize As Long, ByVal lpBuf As Long) As Long
    Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, lpBufPtr As Long, lLen As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
    Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long

    Public Function StringFromBuffer(buffer As String) As String
    Dim nPos As Long
    nPos = InStr(buffer, vbNullChar)
    If nPos > 0 Then
    StringFromBuffer = Left$(buffer, nPos - 1)
    Else
    StringFromBuffer = buffer
    End If
    End Function

    Public Function GetFileDescription(ByVal sFile As String) As String
    Dim lVerSize As Long
    Dim lTemp As Long
    Dim lRet As Long
    Dim bInfo() As Byte
    Dim lpBuffer As Long
    Dim sDesc As String
    Dim sKEY As String
    lVerSize = GetFileVersionInfoSize(sFile, lTemp)
    ReDim bInfo(lVerSize)
    If lVerSize > 0 Then
    lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VarPtr(bInfo(0)))
    If lRet <> 0 Then
    sKEY = GetNLSKey(bInfo)
    lRet = VerQueryValue(VarPtr(bInfo(0)), sKEY & "\FileDescription", lpBuffer, lVerSize)
    If lRet <> 0 Then
    sDesc = Space$(lVerSize)
    lstrcpyn sDesc, lpBuffer, lVerSize
    GetFileDescription = StringFromBuffer(sDesc)
    End If
    End If
    End If
    End Function

    Public Function GetNLSKey(byteVerData() As Byte) As String
    Static strLANGCP As String
    Dim lpBufPtr As Long
    Dim strNLSKey As String
    Dim fGotNLSKey As Integer
    Dim intOffset As Integer
    Dim lVerSize As Long
    Dim lTmp As Long
    Dim lBufLen As Long
    Dim lLCID As Long
    Dim strTmp As String
    On Error GoTo GNLSKCleanup
    If VerQueryValue(VarPtr(byteVerData(0)), "\VarFileInfo\Translation", lpBufPtr, lVerSize) <> 0 Then
    If Len(strLANGCP) = 0 Then
    lLCID = GetUserDefaultLCID()
    If lLCID > 0 Then
    strTmp = Space$(8)
    GetLocaleInfoA lLCID, 11, strTmp, 8
    strLANGCP = StringFromBuffer(strTmp)
    Do While Len(strLANGCP) < 4
    strLANGCP = "0" & strLANGCP
    Loop
    GetLocaleInfoA lLCID, 9, strTmp, 8
    strLANGCP = StringFromBuffer(strTmp) & strLANGCP
    Do While Len(strLANGCP) < 8
    strLANGCP = "0" & strLANGCP
    Loop
    End If
    End If
    If VerQueryValue(VarPtr(byteVerData(0)), strLANGCP, lTmp, lBufLen) <> 0 Then
    strNLSKey = strLANGCP
    Else
    For intOffset = 0 To lVerSize - 1 Step 4
    CopyMemory lTmp, ByVal lpBufPtr + intOffset, 4
    strTmp = Hex$(lTmp)
    Do While Len(strTmp) < 8
    strTmp = "0" & strTmp
    Loop
    strNLSKey = "\StringFileInfo\" & Right$(strTmp, 4) & Left$(strTmp, 4)
    If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then
    fGotNLSKey = True
    Exit For
    End If
    Next
    If Not fGotNLSKey Then
    strNLSKey = "\StringFileInfo\040904E4"
    If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then
    fGotNLSKey = True
    End If
    End If
    End If
    End If
    GNLSKCleanup:
    If fGotNLSKey Then
    GetNLSKey = strNLSKey
    End If
    End Function

    наверх


    Использование специальной клавиши клавиатуры

    На многих клавиатурах есть специальная кнопка со значком WINDOWS. Данный пример с помощью API функции эмулирует нажатие на эту клавишу и дополнительную клавишу, вызывая определенную процедуру в системе.

    В событии Form_Load() показан один пример: эмулирование нажатие клавиши ПУСК. В качестве параметра функции Launch вы можете использовать любую константу из StartMenuItems.

    Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Const VK_LWIN = &H5B, KEYEVENTF_KEYUP = &H2, VK_APPS = &H5D

    Public Enum StartMenuItems
    strtExplorer 'запустить ПРОВОДНИК
    strtFind 'окно "ПОИСК ФАЙЛОВ"
    strtMinimize 'минимизировать все окна
    strtRun 'вызвать окно "ЗАПУСК ПРОГРАММ" (ПУСК | ВЫПОЛНИТЬ...)
    strtStartMenu 'эмулировать нажатие клавиши ПУСК
    strtHelp 'вызвать справочную систему
    End Enum

    Public Sub Launch(func As StartMenuItems)
    Dim VK_ACTION As Long
    Select Case func
    Case strtExplorer: VK_ACTION = &H45
    Case strtFind: VK_ACTION = &H46
    Case strtMinimize: VK_ACTION = &H4D
    Case strtRun: VK_ACTION = &H52
    Case strtStartMenu: VK_ACTION = &H5B
    Case strtHelp: VK_ACTION = &H70
    End Select
    Call keybd_event(VK_LWIN, 0, 0, 0)
    Call keybd_event(VK_ACTION, 0, 0, 0)
    Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)
    End Sub

    Private Sub Form_Load()
    Call Launch(strtStartMenu)
    End Sub

    наверх


    Мои программы

    BalloonMessage for MS Agent

       BalloonMessage for Microsoft Agent реализует диалог программы с пользователем, используя при этом технологию Microsoft Agent. OCX реализует три типа диалоговых окон: InputBox, MsgBox и MsgLabels.

    Автор: Шатрыкин Иван. Соавтор: Павел Сурменок.

    наверх


    Вопрос/Ответ

    Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.

    Вопросы:


    Автор вопроса:
    darknez@mail.kz

    Ответ ожидается по этому адресу

       Такой код для добавления hotkey:

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
    Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Const WM_SETHOTKEY = &H32
    Private Const WM_SHOWWINDOW = &H18
    Private Const HK_SHIFTA = &H141 'Shift + A
    Private Const HK_SHIFTB = &H142 'Shift + B
    Private Const HK_CONTROLA = &H241 'Control + A
    Private Const HK_ALTZ = &H45A
    Private Sub Form_Load()
    'Позволить узнать windows какая горячая клавиша в вашем приложении
    erg& = SendMessage(Me.hwnd, WM_SETHOTKEY, HK_ALTZ, 0)
    If erg& <> 1 Then MsgBox "You need another hotkey", vbOKOnly, "Error"
    'Сказать windows что делать при нажатии на hotkey
    'в данном случае - показать окно программы
    erg& = DefWindowProc(Me.hwnd, WM_SHOWWINDOW, 0, 0)
    End Sub

    Так вот, я прячу программу через form.hide и показываю значок в трее, и этот hotkey не работает. А просто так, когда форма не спрятана, а просто неактивна, то какое сообщение не пиши в DefWindowProc, форма просто становится активной. Объясните, пожалуйста, что здесь можно исправить или подскажите другой способ.


    Автор вопроса: Миша

    Ответ ожидается по этому адресу

       В Delphi есть Qreport есть ли что-то подобное в VB?


    Автор вопроса: Vlad Lagutin

    Ответ ожидается по этому адресу

       Подскажите ,при создании нового проекта, ASP.NET WEBApplication указываю адрес http://localhost/WebApplication1 ,но NET выдает сообщение "Web Access Failed, " вобщем не может создать проект, может кто-то сталкивался с подобным ?


    Автор вопроса: Винокуров К

    Ответ ожидается по этому адресу

       Подскажите, как сделать чтобы на одной вкладке TabStrip была например кнопка, а на другой вкладке TextBox?


    Автор вопроса: Сергей

    Ответ ожидается по этому адресу

       Kак добавить ярлык в деректорию "Создать" в меню Windows.


    Автор вопроса: Passat

    Ответ ожидается по этому адресу

       ПОМОГИТЕ РАЗОБРАТЬСЯ С MSDN !!!
    У меня Visual Basic 6.0 и при попытке вызвать Справку выдает, что надо типа установить MSDN Library. Долго искал всеми расхваливаемый MSDN на CD-дисках и, наконец, купил на 3-х дисках. И что же?!!?! Они друг друга НЕ ВИДЯТ. VB6.0 при попытке установить ему МСДН говорит, что это не тот диск. А запуская Setup с дисков MSDN (даже после полной установке! - это около 2-х гигов), этот "товарищ" к VB не цепляется! Как мне их установить, чтоб в VB нормально справка работатала?!?!?


    Автор вопроса: Саша

    Ответ ожидается по этому адресу

       как при помоши BitBlt вставить рисунок не в picture a в image или как в Picture увеличить или уменьшить рисунок.


    Автор вопроса: Саша

    Ответ ожидается по этому адресу

       Как яяделать библеотеку так чтобы я набрав слово например abs. после точки выскочило меню с всеми процедурами и функциями. У меня получается так только когда я делаю Public классу и функции. Но мне не надо что бы это было Public , а только после набратия слова abs.




    Ответы:


    Вопрос:

       В SysTray создал иконку, нужно, чтобы когда я форму сворачиваю, она исчезала с экрана и панели задач, а оставалась лишь иконка в SysTray. А как ???

    Ответ:

    Автор ответа: slavik

    Form1.ShowInTaskbar=False


    Вопрос:

       В SysTray создал иконку, нужно, чтобы когда я форму сворачиваю, она исчезала с экрана и панели задач, а оставалась лишь иконка в SysTray. А как ???

    Ответ:

    Автор ответа: Rafis

    Это можно сделать отслеживая состояние формы. Ниже описан пример, когда форма сварачивается, то она станоовиться невидимой в Tra-e. вставьте в форму Timer и напишите следующий код:

    Private Sub Timer1_Timer()
    Timer1.Interval = 100
    If Form1.WindowState = 1 Then Form1.Visible = False
    End Sub


    Вопрос:

       В SysTray создал иконку, нужно, чтобы когда я форму сворачиваю, она исчезала с экрана и панели задач, а оставалась лишь иконка в SysTray. А как ???

    Ответ:

    Автор ответа: shuric

    Код модуля:

    Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As dwMess, lpData As NOTIFYICONDATA) As Long

    Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

    Public Enum dwMess
    NIM_ADD = &H0 ' Добавление иконки
    NIM_DELETE = &H2 ' Удаление иконки
    NIM_MODIFY = &H1 ' Изменение параметров иконки
    End Enum

    Type NOTIFYICONDATA
    cbSize As Long ' Размер переменной типа NOTIFYICONDATA
    hwnd As Long ' Указатель окна создающего иконку
    uID As Long ' Указатель на иконку в пределах приложения
    uFlags As uF ' Маска для следующих параметров
    uCallbackMessage As CallMess ' Возвращаемое событие
    hIcon As Long ' Указатель на изображение для иконки
    szTip As String * 64 ' Всплывающий над иконкой текст
    End Type

    Public Enum uF
    NIF_MESSAGE = &H1 ' Значение имеет uCallbackMessage
    NIF_ICON = &H2 ' Значение имеет hIcon
    NIF_TIP = &H4 ' Значение имеет szTip
    End Enum

    Public Enum CallMess
    WM_MOUSEMOVE = &H200
    WM_LBUTTONDOWN = &H201
    WM_LBUTTONUP = &H202
    WM_LBUTTONDBLCLK = &H203
    WM_RBUTTONDOWN = &H204
    WM_RBUTTONUP = &H205
    WM_RBUTTONDBLCLK = &H206
    WM_MBUTTONDOWN = &H207
    WM_MBUTTONUP = &H208
    WM_MBUTTONDBLCLK = &H209
    WM_SETFOCUS = &H7
    WM_KEYDOWN = &H100
    WM_KEYFIRST = &H100
    WM_KEYLAST = &H108
    WM_KEYUP = &H101
    End Enum

    Код формы:
    Необходимо добавить кнопку

    Dim NID As NOTIFYICONDATA
    Sub AddIcon()
    Dim IDLib As Long ' Указатель на библиотеку
    Dim IDIcon As Long ' Указатель на иконку
    Const IDMyIcon = 101 ' Идентификатор иконки внутри приложения
    Dim AddResult As Long ' Результат добавления иконки
    IDLib = GetModuleHandle("Project1.exe") ' Получаем hInstanse
    IDIcon = Me.Icon
    ' Заполняем структуру NID типа NOTIFYICONDATA
    NID.cbSize = Len(NID) ' Размер структуры
    NID.hwnd = Form1.hwnd ' Указатель на форму
    NID.uID = IDMyIcon ' Идентификатор иконки
    NID.uFlags = NIF_MESSAGE + NIF_ICON + NIF_TIP 'Указываем, что действующими являются поля uCallBackMessage, hIcon и szTip.
    NID.uCallbackMessage = WM_LBUTTONDOWN ' Указываем, что событием возвращаемым в форму является MouseDown с параметром Button = 2
    NID.hIcon = IDIcon ' Указатель на иконку в файле
    NID.szTip = Left$("MyIcon", 63) & Chr(0) ' Передаем всплывающую фразу "MyIcon", при этом обрезаем ее до 63 символов и добавляем 64-й символ с кодом ноль
    AddResult = Shell_NotifyIcon(NIM_ADD, NID) ' Вызываем функцию, через параметр dwMessage указываем, что следует добавить иконку, и передаем заполненный NID
    Me.Visible = False
    End Sub

    Sub DeleteIcon()
    Dim DeletResult As Long
    DeleteResult = Shell_NotifyIcon(NIM_DELETE, NID) ' Вызываем функцию, через dwMessage указываем, что следует удалить иконку, при этом, раз переменная NID описана на уровне модуля, не следует заполнять ее заново
    End Sub

    Private Sub Command1_Click()
    Call AddIcon
    End Sub

    Private Sub Form_Mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static bPressed As Boolean
    If X = 7695 Then ' SysTray Icon Events
    Shell_NotifyIcon NIM_DELETE, NID
    Form1.Visible = True
    End If
    End Sub


    Вопрос:

       В SysTray создал иконку, нужно, чтобы когда я форму сворачиваю, она исчезала с экрана и панели задач, а оставалась лишь иконка в SysTray. А как ???

    Ответ:

    Автор ответа: СЗШ ?7

    Для свойства ShowInTaskbar в форме задай значение False. А если нужно чтобы при старте форма на экране не отображалась то:

      Private Sub Form_Load()
        Me.Hide
      ' и помещаем иконку в SysTray
       ....
      End Sub


    Вопрос:

       Есть два TextBox. В каждом яаписывается какое-либо время. Например:
    TextBox1.text = "01:30:25"
    TextBox2.text = "02:01:30"
    Как вычислить TextBox2.text - TextBox1.text
    Может кто сталкивался с таким, подкиньте код пожалуйста. Бывает ли переменная типа Time (не timer) и каким обраяом проияводятся вычисления со временем?

    Ответ:

    Автор ответа: Vlad Lagutin

    Есть 2 способа:

    1. конвертировать время в формат datetime (1990.01.01 02.01.30 - 1990.01.01 01.30.25) получишь искомый результат

    2. перевод в минуты(секунды если есть сек.) после разницы обратно. например
              Time1 = "01:30"
              Time2 = "02:01"

    time2=(int(time2)*60 + (time2-int(time2) ) - перевод в минуты,
    time1=(int(time1)*60 + (time1-int(time1) )
    result=time2-time1
    result=int(result/60)+ (result-int(result/60)*60) /100


    Вопрос:

       Есть два TextBox. В каждом яаписывается какое-либо время. Например:
    TextBox1.text = "01:30:25"
    TextBox2.text = "02:01:30"
    Как вычислить TextBox2.text - TextBox1.text
    Может кто сталкивался с таким, подкиньте код пожалуйста. Бывает ли переменная типа Time (не timer) и каким обраяом проияводятся вычисления со временем?

    Ответ:

    Автор ответа: Rafis

    Вообще есть в ВБ6.0 функция TimeValue которая преобразовывает строку в формат времени. Вот ниже код который, который вычисляет сколько времени прошло.

    a="01:00:25"
    b="20:00:25"
    c= -TimeValue(b)+TimeValue(a)
    Msgbox c

    Внимание!!!! Ни в коем случае в 3 строке не меняйте значенеия TimeValue местами,например, следующий код уже небудет работать

    c=TimeValue(a) -TimeValue(b)


    Вопрос:

       Есть два TextBox. В каждом яаписывается какое-либо время. Например:
    TextBox1.text = "01:30:25"
    TextBox2.text = "02:01:30"
    Как вычислить TextBox2.text - TextBox1.text
    Может кто сталкивался с таким, подкиньте код пожалуйста. Бывает ли переменная типа Time (не timer) и каким обраяом проияводятся вычисления со временем?

    Ответ:

    Автор ответа: Alex

    Лови примерчик. На форме - две кнопки и текстбокс. Давишь сначала первую, с каким-то интервалом - вторую. В текстбоксе - интервал в секундах.

    Dim t As Date

    Private Sub Command1_Click()
       t = Time
    End Sub

    Private Sub Command2_Click()
       Text1 = Str((Time - t1) / 1000)
    End Sub


    Вопрос:

       В ListBox выбираю строку, в которой прописан путь к картинке, и Image.Picture присваиваю ее значение. Но программа пишет: несоответствие типа. Есть ли другой путь изменения картинки объекта Image?

    Ответ:

    Автор ответа: Rafis

    Просто ты неправильно присваиваешь путь к файлу.
    Надо не так:

    Image.Picture=("Путь_к_файлу")

    а вот так:

    Image.Picture = LoadPicture("Путь_к_файлу")


    Вопрос:

       В ListBox выбираю строку, в которой прописан путь к картинке, и Image.Picture присваиваю ее значение. Но программа пишет: несоответствие типа. Есть ли другой путь изменения картинки объекта Image?

    Ответ:

    Автор ответа: Alex

    Image1.Picture = LoadPicture(<путь к картинке>) End Sub

    Комментарии нужны? :)


    Вопрос:

       Где в Инете можно скачать учебник для начинающего програмиста?

    Ответ:

    Автор ответа: slavik

    Учебник целиком вряд ли, а вот почитать и поизучать исходники можно где угодно.
    Сходи сюда:
    http://vbrussian.com/VBR_Sites.asp


    Вопрос:

       1)как можно в одном окне просматривать и каталоги и файлы? Типа Dir и FileBox в одном. И вообще, кто-нибудь знает где можно найти исходники простенького файл-менеджера, а то изобретать велосипед нехота, устал я что-то :-)
    2)Как можно просматривать иконки из dll-файлов?

    Ответ:

    Автор ответа: Alex

      FileView X v1.0.0.7 For Visual Basic 6

      FolderView X v1.0.0.10 For Visual Basic 6

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


    Вопрос:

       Подскажите код как в VBA на форме поместить ссылку на E-mail или страничку.

    Ответ:

    Автор ответа: Игорь

    Вот ссылки:

    http://progs.biz/vb/samples/axlink/axlink01.shtml
    http://progs.biz/vb/samples/axlink/lessons/001.shtml
    ...
    http://progs.biz/vb/samples/axlink/lessons/006.shtml

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

    http://progs.biz/vb/api/lessons/005.shtml

    Там о создании гиперссылки с помощью API-функции ShellExecute.


    Можете заполнить эту форму, либо отослать вопрос СЮДА

    Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.
    Текст сообщения:
    Ваше имя
    E-mail для ответа

    наверх


    Выпуск подготовили:

    Сурменок Павел


    http://subscribe.ru/
    E-mail: ask@subscribe.ru
    Отписаться
    Убрать рекламу

    В избранное