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


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 можно найти
    здесь.

    наверх


    Определить, использует ли компьютер большие или маленькие шрифты

    Данный пример покажет, какой размер шрифта установлен в настройках экрана. Данные опции устанавливаются через Панель Управления - Свойства Экрана - вкладка Настройка - кнопка Дополнительно - РазмерШрифта.

    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
    Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Const MM_TEXT = 1
    Private Type TEXTMETRIC
    tmHeight As Integer
    tmAscent As Integer
    tmDescent As Integer
    tmInternalLeading As Integer
    tmExternalLeading As Integer
    tmAveCharWidth As Integer
    tmMaxCharWidth As Integer
    tmWeight As Integer
    tmItalic As String * 1
    tmUnderlined As String * 1
    tmStruckOut As String * 1
    tmFirstChar As String * 1
    tmLastChar As String * 1
    tmDefaultChar As String * 1
    tmBreakChar As String * 1
    tmPitchAndFamily As String * 1
    tmCharSet As String * 1
    tmOverhang As Integer
    tmDigitizedAspectX As Integer
    tmDigitizedAspectY As Integer
    End Type

    Public Function SmallFonts() As Boolean
    Dim hdc As Long
    Dim hwnd As Long
    Dim PrevMapMode As Long
    Dim tm As TEXTMETRIC
    SmallFonts = True
    hwnd = GetDesktopWindow()
    hdc = GetWindowDC(hwnd)
    If hdc Then
    PrevMapMode = SetMapMode(hdc, MM_TEXT)
    GetTextMetrics hdc, tm
    PrevMapMode = SetMapMode(hdc, PrevMapMode)
    ReleaseDC hwnd, hdc
    If tm.tmHeight > 16 Then SmallFonts = False
    End If
    End Function

    Private Sub Form_Load()
    'В случае маленького фрифта вы получите сообщение "TRUE", иначе получите сообщение "FALSE".
    MsgBox SmallFonts
    End Sub

    наверх


    Получить имя шрифта заголовка активного окна

    Private Const LF_FACESIZE = 32
    Private Const SPI_GETNONCLIENTMETRICS = 41
    Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(1 To LF_FACESIZE) As Byte
    End Type
    Private Type NONCLIENTMETRICS
    cbSize As Long
    iBorderWidth As Long
    iScrollWidth As Long
    iScrollHeight As Long
    iCaptionWidth As Long
    iCaptionHeight As Long
    lfCaptionFont As LOGFONT
    iSMCaptionWidth As Long
    iSMCaptionHeight As Long
    lfSMCaptionFont As LOGFONT
    iMenuWidth As Long
    iMenuHeight As Long
    lfMenuFont As LOGFONT
    lfStatusFont As LOGFONT
    lfMessageFont As LOGFONT
    End Type
    Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
    Public Function ActiveTitleBarFontName()
    Dim s As String
    Dim i As Byte
    Dim ncm As NONCLIENTMETRICS
    Dim sdfont As StdFont
    ncm.cbSize = Len(ncm)
    If SystemParametersInfo(41, ncm.cbSize, ncm, 0) Then
    s = StrConv(ncm.lfCaptionFont.lfFaceName, vbUnicode)
    i = InStr(s, vbNullChar)
    If i > 0 Then s = Left(s, i - 1)
    End If
    ActiveTitleBarFontName = s
    End Function

    Private Sub Form_Load()
    MsgBox ActiveTitleBarFontName
    End Sub

    наверх


    Как узнать значения кодовых таблиц

    Как известно, Windows использует в своей работе две кодовые таблицы, которые мы обычно называем DOS и Windows, но формально они именуются OEM и ANSI. Довольно многие функции обработки строковых переменных зависят от значения кодовых таблиц, установленных при инсталляции системы, которые можно определить с помощью функций API:

    Private Declare Function GetACP Lib "kernel32" () As Long
    Private Declare Function GetOEMCP Lib "kernel32" () As Long
    Private Sub Form_Load()
    MsgBox "ACP = " & GetACP & vbCrLf & "OEMCP = " & GetOEMCP
    End Sub

    В принципе значения кодовых таблиц можно менять уже после инсталляции Windows. Мы не советуем злоупотреблять этим, но такая коррекция может быть полезной при тестировании и анализе работы программ. Параметры ACP и OEMCP хранятся в разделе HKEY_Local_Machine/System/CurrentControlSet/Control/Nls/Codepage файла Реестра и редактируются с помощью утилиты REGEDIT.EXE. Для их активизации нужно перезагрузить Windows.

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

    OEMCP = 866 (Russian), 437 (US — default), 850 (International), 855 (Cyrilic)
    ACP = 1250 (Eastern European), 1251 (Cyrilic & Russian), 1252 (US & Western European), 1200 (Unicode)

    © 1999, Андрей Колесов, Ольга Павлова

    'КОД ФОРМЫ

    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

    наверх


    Получить список запущенных приложений

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

    Const TH32CS_SNAPPROCESS As Long = 2&
    Const MAX_PATH As Integer = 260
    Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
    End Type
    Private Declare Function CreateToolhelpSnapshot Lib "Kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
    Private Declare Function ProcessFirst Lib "Kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    Private Declare Function ProcessNext Lib "Kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
    Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)

    Private Sub Command1_Click()
    List1.Clear
    Dim hSnapShot As Long
    Dim uProcess As PROCESSENTRY32
    Dim r As Long
    hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    If hSnapShot = 0 Then
    Exit Sub
    End If
    uProcess.dwSize = Len(uProcess)
    r = ProcessFirst(hSnapShot, uProcess)
    Do While r
    List1.AddItem uProcess.szExeFile
    r = ProcessNext(hSnapShot, uProcess)
    Loop
    Call CloseHandle(hSnapShot)
    End Sub

    наверх


    Получить список запущенных процессов

    Расположите на форме 2 элемента CommandButton и элемент ListBox.

    ВАЖНОЕ ПРИМЕЧАНИЕ: БУДЬТЕ АККУРАТНЫ ПРИ ИСПОЛЬЗОВАНИИ ЭТОГО ПРИМЕРА

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Const GW_HWNDFIRST = 0
    Const GW_HWNDNEXT = 2
    Const WM_CLOSE = &H10
    Const WM_QUIT = &H12
    Dim CurrWnd As String
    Dim ListItem As String
    Dim Length As String

    Sub GetTaskList()
    CurrWnd = GetWindow(Me.hwnd, GW_HWNDFIRST)
    Do While CurrWnd <> 0
    Length = GetWindowTextLength(CurrWnd)
    ListItem = Space(Length + 1)
    Length = GetWindowText(CurrWnd, ListItem, Length + 1)
    If Length <> 0 Then
    List1.AddItem ListItem
    End If
    CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
    DoEvents
    Loop
    End Sub

    Private Sub Command1_Click()
    List1.Clear
    GetTaskList
    End Sub

    Private Sub Command2_Click()
    hW = FindWindow(vbNullString, List1.Text & Chr(0))
    PostMessage hW, WM_QUIT, 0, 0
    End Sub

    Private Sub Form_Load()
    Left = (Screen.Width - Width) \ 2
    Top = (Screen.Height - Height) \ 2
    GetTaskList
    Command1.Caption = "получить список"
    Command2.Caption = "Закрыть приложение"
    End Sub

    наверх


    Использование функции Environ

    В Бэйсике есть одна ОЧЕНЬ полезная, но многими забытая функция Environ! Она возвращает имена и содержание всех переменных среды операционной системы!!! Так, например, чтобы получить директорию Windows, совсем не надо прибегать к API-функции GetWindowsDirectory!!!!!! А получить её можно так:
    A = Environ ("windir")
    Но и это ещё не всё! Также можно получить следующие перменные:

    A = Environ ("TMP") 'директория временных файлов TEMP
    A = Environ ("BLASTER") 'координаты звуковой карты
    A = Environ ("PATH") 'пути, объявленные в autoexec.bat

    НО И ЭТО ВСЁ ЕЩЁ НЕ ВСЁ!!!

    'Добавьте на форму элементы TextBox (установите свойство Multiline=True) и CommandButton. Скопируйте следующий код, запустите программу, нажмите на кнопку...

    Private Sub Command1_Click()
    m = 1
    Do
    EnvString = Environ(m)
    Text1.Text = Text1.Text & vbNewLine & Environ(m)
    m = m + 1
    Loop Until EnvString = ""
    End Sub


    наверх


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

    BalloonMessage for MS Agent

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

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

    наверх


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

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

    Вопросы:


    Автор вопроса:
    Владимир

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

           Есть код работы с базой открытой таким образом
               
         Dim db1 As Database
         Dim rs1 As Recordset

         Dim strDBName1 As String
         Dim strRSName1 As String

         strDBName1 = App.Path & "\фигня.mdb"
         strRSName1 = "фигня1"

         Set db1 = DBEngine.OpenDatabase(strDBName1)
         Set rs1 = db1.OpenRecordset(strRSName1, dbOpenDynaset)

         таблица Фигня1 имеет пару полей
         Хочу чтобы при выборе в Combobox на форме значения, оно находилось в таблице и к другому числовому полю таблицы добавлялось число из текстбокса лежащего на форме


    Автор вопроса: Артем Белоусов

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

       Подскажите пожалуйста, как проверить есть ли связь с интернет


    Автор вопроса: Геннадий

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

       Как из VB поменять screensaver (из имеющихся)


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

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

       Подскажите, пожалуйста, как программно отключиться от интернета.


    Автор вопроса: P@Ssword

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

       Можно ли уянать яначения свойств контролов на форме, получаемые ими при яагруяке, после ияменения этих самых яначений, но бея переяагруяки формы?


    Автор вопроса: P@Ssword

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

       Как уянать, что по такому-то IP-адресу на таком-то порту висит моя программа?


    Автор вопроса: @LEXis

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

       В текстовом документе нужно от определенного слова до еще одного слова выделить этот блок и скопировать в буфер. Как это осуществить?


    Автор вопроса: Иван

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

       Вояможно ли программно соядать файл MS Access? Если можно, то как? И как соядавать в ней таблицы?


    Автор вопроса: Анатолий

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

       У меня есть главная форма, на ней две подч-ые формы. При перемещении по записям 1-й подч. формы скрытое поле имеет данные [поле14]=Forms![Должности]![пф Должности].[Form]![Номер]и показывает номер текущей записи. Этот номер используется для сортировки 2-й подч-й формы, которая имеет подчиненное поле с главной формой (чтобы включить автоподстановку).Проблема: Вначале происходит событие Enter 1-й подч-й формы, где у меня есть Requery 2-й подч-й формы. Не работает, т.к. [поле14]обновляется после того, как обновилась 2-я п.ф. (события Enter 1-й пф.) Пробовал поле14 cделать свободным, а в макрос 1-й пф формы вставить me.поле14=...(все, как выше). Далее на событие Changе [поле14] в макрос написал Requery 2-й подч-й формы. Т.е. теперь вначале обновляем поле14 (номер записи), а затем пф2. ... Не работает!




    Ответы:


    Вопрос:

       Как спрятать программу в SysTray и сделать для не? там иконку?

    Ответ:

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

    Ну не знаю как делают все ,а я пользуюсь контролом (systray.ocx). Если надо напиши я дам, или найди в инете там их туевы хучи. А вообще это все через API.


    Вопрос:

       У меня есть MDI форма, у которой есть дочерняя форма с расположенным на ней элементом Data. Мне нужно, чтобы при загрузке программы была видна только MDI форма. Но как только я присваиваю программным путем свойству DataBaseName какое-то значение, то дочерняя форма тут же выскакивает на экран. Как от этого избавиться?

    Ответ:

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

    Попробуй после присвоения значения свойству DataBaseName написать
      
    имя_дочерней_формы.hide
      
    (у меня работает)


    Вопрос:

       Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

    Ответ:

    Автор ответа: Kurt Haeldar

    При запуске проги можно инициализировать какую-либо переменную, а затем в событии таймера увеличивать ее значение на 1. Там же нужно проверять это значение. Если оно равно нужному количеству запусков таймера, то этот таймер отключется.
    Если все это написать как код, то получится вроде этого:
      
    Private sub Timer1_Timer()
    k = k + 1
    if k = 2 then Timer1.Enabled = False
    End Sub


    Вопрос:

       Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

    Ответ:

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

    Используй у таймера свойство Enabled=False


    Вопрос:

       Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

    Ответ:

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

    Напиши в таймере после всех действий timer1.enabled=false т.е. 1 раз исполняет и останавливается. А чтобы 2 раза делал напиши следующее

    Dim a as byte' может в VB раньш 6 версии нет типа BYTE тогда пиши INTEGER

    Private Sub Timer1_Timer()
    'твой код вставляй сюда
    a=a+1
    if a =2 then timer1.enabled=false
    'При следующем запуске надо a = 0
    End Sub


    Вопрос:

       Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

    Ответ:

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

    Option Explicit
      
    Dim Counter As Integer

    Private Sub Timer1_Timer()
      
    If Counter > 2 Then
       Timer1.Enabled = False
       Exit Sub
    End If
    Counter = Counter + 1
      
    End Sub


    Вопрос:

       Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

    Ответ:

    Автор ответа: P@Ssword

    В событии Timer пишешь:

    Static Count As Long
             Count = Count + 1
             if Count > 2 Then Timer1.Enabled = False


    Вопрос:

       Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

    Ответ:

    Автор ответа: Медведев Эдуард

    Решение очень простое...
    в таймере пишешь:

    х=х+1
    if x=1 then timer1.interval=0' х=1 если один раз,х =2 для двух...
      
    или просто игнор

    if x=2 then exit sub


    Вопрос:

       Подскажите как остановить таймер,что бы он сработал один раз или два и остановился.

    Ответ:

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

    Вам придется определить какую-либо глобальную переменную в разделе Declaration или на уровне модуля. К примеру...

    Dim Check as Integer

    А в событии таймера timer1_timer()...

    Check = Check + 1
    If Check > 2 Then Timer1.Enabled = False

    Пожалуй, все!
    Советую вам посмотреть страницу, посвященную элементу Timer - http://vbnet.ru/faq/showtopic.asp?id=261


    Вопрос:

       Уважаемые программисты, подскажите каким способом лучше всего разбить ботьшой файл на маленькие, размером 1,44 Mb средствами VB 6.0 а затем их же склеить! Спасибо!

    Ответ:

    Автор ответа: P@Ssword

    Разбить можно так:

    const size as long = 1457664 ' Это длина одного блока в байтах

    sub Расчленить(File1 as string, File2 as string)
    dim ind as long
    dim buffer(0 to size - 1) as byte

         open file1 for binary as #1
         for ind = 0 to iif(lof(1) mod size, lof(1) \ size - 1, lof(1) \ size)
             get #1, , buffer
             open file2 & "." & ind for binary as #2
             put #2, , buffer
             close #2
         next ind
         close #1
    end sub

    Соответственно, объединять в обратном порядке, но здесь желательно знать кол-во фрагМЕНТОВ:

    sub Объединить(File1 as string, File2 as string, Фрагментов as long)
    dim ind as long
    dim buffer(0 to size - 1) as byte

         open file1 for binary as #1
         for ind = 0 to Фрагментов
             open file2 & "." & ind for binary as #2
             get #2, , buffer
             put #1, , buffer
             close #2
         next ind
         close #1
    end sub


    Вопрос:

          Нужна помощь! У меня такой вопрос: в моей программе есть форма с настройками и при нажатии кнопки применить происходит следущее:

        Private Sub Command2_Click()
         If Check1.Value = 1 Then cbdend = 1 'открыть вначале работы
         If Check2.Value = 1 Then cbdtim = 1 'открыть в конце работы
          sbdh = Text2.Text 'имя
          sbdm = Text3.Text 'фамилия
         If Check3.Value = 1 Then arcpro = 1 'есть архив
         If Check4.Value = 1 Then arcend = 1 'нет архива
          pathbd = Text1.Text 'путь к файлам
         End Sub

       Вот так формируются переменные на основе моих настроек и как их теперь записать в файл "setup.ini" в дирректории моей программы, а потом считать их оттуда при следующей загрузке программы? Спасибо!

    Ответ:

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

    Поместить в модуль!!!


    'Работа с INI-файлами
    '====================
      
    'Для чтения значения из INI-файла вызовите функцию:
    'ReadINI(File, Heading, Section)
      
    'Для записи значения в INI-файл вызовите функцию:
    'WriteINI(File, Heading, Section, Value)
      
    'File - путь к INI-файлу
    'Heading - название раздела
    'Section - название параметра
    'Value - значение параметра
      
    Option Explicit
      
    Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As Any, ByVal lsString As Any, ByVal lplFilename As String) As Long
    Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPriviteProfileIntA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
    Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
      
    Global File
    Global ApplicName
    Global Keyname
    Global Value
      
    Public Function WriteINI(File As String, Heading As String, Section As String, Value As String)
      
    On Error Resume Next
      
    Dim lpApplicName As String, lpFileName As String, lpKeyName As String, lpString As String
    Dim U As Long
      
    lpApplicName = Heading
    lpKeyName = Section
    lpString = Value
    lpFileName = File
    U = WritePrivateProfileString(lpApplicName, lpKeyName, lpString, lpFileName)
    If U <> 0 Then
       Store = "Success"
    End If
      
    End Function
      
    Public Function ReadINI(File As String, Heading As String, Section As String)
      
    On Error Resume Next
      
    Dim X As Long
    Dim Temp As String * 50
    Dim lpApplicName As String, lpKeyName As String, lpDefault As String, lpFileName As String
      
    lpApplicName = Heading
    lpKeyName = Section
    lpDefault = no
    lpFileName = File
    X = GetPrivateProfileString(lpApplicName, lpKeyName, lpDefault, Temp, Len(Temp), lpFileName)
      
    If X <> 0 Then
       ReadINI = GetInput(Trim(Temp))
    End If
      
    End Function
      
    Public Function GetInput(Inp As String) As String
      
    On Error Resume Next
      
    Dim P As Integer
    P = InStr(1, Inp, Chr(0))
    If P <> 0 Then Inp = Left(Inp, P - 1)
    GetInput = Inp
      
    End Function


    Вопрос:

       Как изменить яркость картинки ?
    В NT добиваюсь результата с помощью API- функций StretchBlt, SetStretchBltMode, GetColorAdjustment, SetColorAdjustment, GetStretchBltMode
    А в Win9x/ME функции GetColorAdjustment, SetColorAdjustment не поддерживаются.
    Кто нибудь знает как обойтись без них?

    Ответ:

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

    Не знаю какой у тебя там win9x но в моем все прекрасно работает. Синтаксис проверь.


    Вопрос:

       Такой код для добавления 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, форма просто становится активной. Объясните, пожалуйста, что здесь можно исправить или подскажите другой способ.

    Ответ:

    Автор ответа: P@Ssword

    Есть принципиально другое предложение (ему не страшен даже form.hide - проверял):

    Private Const MOD_ALT = &H1
    Private Const MOD_CONTROL = &H2
    Private Const MOD_SHIFT = &H4
    Private Const PM_REMOVE = &H1
    Private Const WM_HOTKEY = &H312

    Private Type POINTAPI
         x As Long
         y As Long
    End Type

    Private Type Msg
         hWnd As Long
         Message As Long
         wParam As Long
         lParam As Long
         time As Long
         pt As POINTAPI
    End Type

    Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
    Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
    Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare Function WaitMessage Lib "user32" () As Long

    Private bCancel As Boolean

    Private Sub ProcessMessages()
         Dim Message As Msg
         ' повторяем до тех пор, пока переменной bCancel не будет присвоено True
         Do While Not bCancel
             ' ожидаем "оконного" события
             WaitMessage
             ' проверяем, что это HOTKEY - сообщение
             If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE)
    Then
                 ' здесь включаем в дело фантазию.....
                 MsgBox "Однако"
             End If
             ' обрабатываем остальные события
             DoEvents
         Loop
    End Sub

    Private Sub Form_Load()
    Dim ret As Long

         bCancel = False
         ' регистрируем горячую клавишу Ctrl-F
         ret = RegisterHotKey(Me.hWnd, &HBFFF&, MOD_CONTROL, vbKeyF)

         ' показываем форму
         Show
         ' обрабатываем сообщения горячей клавиши
         ProcessMessages
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
         ' прерываем обработку сообщений
         bCancel = True
         ' отрегистрируемся от горячих клавиш :)
         UnregisterHotKey Me.hWnd, &HBFFF&
    End Sub


    Вопрос:

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

    Ответ:

    Автор ответа: P@Ssword

    Весь прикол в том, что TabStrip не предоставляет контейнер для элементов, он просто рисует красивую рамочку и закладочки :-) Так что есть два выхода:

    -- Выход первый. Сложнее. Продолжаем использовать TabStrip. На форму для каждого таба кладём по одному контейнеру (например, Frame). Далее в событии Click по TabStrip показываем нужный Frame, остальные при этом пряча. В общем, если с утра просто необходимо размять руки на клавиатуре, то можно сделать такой проект. Но для тех, кто занимается продуктивным трудом, а не расходом калорий, придумали другое решение. Итак, способ номер два.

    ++ Выход второй. Прошу любить и жаловать, Micro$oft Tabbed Dialog Control 6.0. Клик на нужный таб, поклали контролы, клик на следующий таб... Чертовски удобная штука. Им бы ещё раскраску изменить - вообще идеально. Да ладно, чё мечтать - MacroHard всё-таки...


    Вопрос:

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

    Ответ:

    Автор ответа: Кирилл

    Тот MSDN 2002, что ты купил предназначен для .NET и только. STUDIO 6.0 работает с MSDN 2001 года. На Митино он есть, но 450р на золоте. С 2002 работать можно, но вручную, что очень неудобно


    Вопрос:

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

    Ответ:

    Автор ответа: P@Ssword

    Просто в событии формы Form_Resize проверяешь состояние формы и, если она свёрнута, убираешь её с экрана:

    if Me.WindowState = vbMinimized then
             Unload Me или Me.Visible = false
    end if

    Так же можно делать и при попытке закрытия формы (нажатия на кнопку Х):

    private sub Form_Unload(cancel as integer)
             Me.WindowState = vbMinimized ' Сворачиваем окно,
             Me.Visible = false ' затем его убираем
    end sub


    Вопрос:

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

    Ответ:

    Автор ответа: P@Ssword

    Свойство Picture - это объект типа IPictureDisp, а не путь к файлу. Это кому интересно. А теперь к вопросу о слонах. Картинки из файла загружает, в частности, функция LoadPicture. Так что надо просто написать:

    Set Image1.Picture = LoadPicture("Ю:\картинка.жэпэгэ")


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

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

    наверх


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

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