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

Книги

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

наверх

---

Получить координаты курсора

Добавьте на форму 2 элемента Label и 1 Timer. Вставьте следующий код:

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Dim z As POINTAPI

Private Sub Timer1_Timer()
GetCursorPos z
Label1 = "x: " & z.x
Label2 = "y: " & z.y
End Sub
Private Sub Form_Load()
Timer1.Interval = 1
End Sub

наверх

---

Центрирование курсора на элементе

Данный пример покажет, как можно переместить курсор мыши в центр элемента, который получает фокус.

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Sub focus()
If Me.BorderStyle = 0 Then
x& = Me.ActiveControl.Left \ Screen.TwipsPerPixelX + ((Me.ActiveControl.Width / 2) / Screen.TwipsPerPixelX) + (Me.Left / Screen.TwipsPerPixelX)
y& = Me.ActiveControl.Top \ Screen.TwipsPerPixelY + ((Me.ActiveControl.Height / 2) / Screen.TwipsPerPixelY) + (Me.Top / Screen.TwipsPerPixelY)
Else
x& = Me.ActiveControl.Left \ Screen.TwipsPerPixelX + ((Me.ActiveControl.Width / 2 + 60) / Screen.TwipsPerPixelX) + (Me.Left / Screen.TwipsPerPixelX)
y& = Me.ActiveControl.Top \ Screen.TwipsPerPixelY + ((Me.ActiveControl.Height / 2 + 360) / Screen.TwipsPerPixelY) + (Me.Top / Screen.TwipsPerPixelY)
End If
a& = SetCursorPos(x&, y&)
End Sub

Private Sub Command1_GotFocus()
Call focus
End Sub

Private Sub Text1_GotFocus()
Call focus
End Sub

Private Sub List1_GotFocus()
Call focus
End Sub

наверх

---

Проверить, существует ли мышь

Этот код покажет, есть ли мышь на компьютере

Const SM_CMOUSEBUTTONS = 43
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Function CheckMouse() As Boolean
If GetSystemMetrics(SM_CMOUSEBUTTONS) > 0 Then
CheckMouse = True
Else
CheckMouse = False
End If
End Function
Private Sub Form_Load()
MsgBox "Проверка мыши на существование: " & CheckMouse
End Sub

наверх

---

Получить количество кнопок мыши

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const SM_CMOUSEBUTTONS = 43
Private Sub Form_Load()
MsgBox (GetSystemMetrics(SM_CMOUSEBUTTONS))
End Sub

наверх

---

Поменять программно кнопки мыши

Для того, чтобы программно поменять местами кнопки мыши, вам достаточно объявить нижеследующую функцию SwapMouseButton:

Private Declare Function SwapMouseButton& Lib "user32" (ByVal bSwap As Long)

'Для программной замены вам достаточно использовать вышеприведенную функцию как:
SwapMouseButton& 1 'событие: кнопки поменялись местами
SwapMouseButton& 0 'событие: все вернулось в исходное состояние



наверх

---

Определить, какие клавиши мыши нажаты

Данный пример покажет, нажаты ли клавиши мыши момент загрузки формы. Обращение MButtonDown(I) вы можете использовать в любом месте вашей програамы, где I  = 1 (левая клавиша мыши), 2 (правая клавиша мыши) или 3 (средняя клавиша мыши)

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As KeyCodeConstants) As Integer

Public Function MButtonDown(btButton As Byte) As Boolean
Select Case btButton
Case Is = 1
MButtonDown = CBool(GetKeyState(vbKeyLButton) And &H8000)
Case Is = 2
MButtonDown = CBool(GetKeyState(vbKeyRButton) And &H8000)
Case Is = 3
MButtonDown = CBool(GetKeyState(vbKeyMButton) And &H8000)
End Select
End Function

Private Sub Form_Load()
If MButtonDown(1) Then MsgBox "Левая клавиша нажата!"
If MButtonDown(2) Then MsgBox "Правая клавиша нажата!"
If MButtonDown(3) Then MsgBox "Средняя клавиша нажата!"
End Sub

наверх

---

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

BalloonMessage for MS Agent


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

наверх

---

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

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

Вопросы:

---

Автор вопроса: Andrey Tyurin

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

   Подскажите, как прошуршать список ListView и найти отмеченные чеком или просто выделенные в режиме мультиселект строки.

---

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

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

   На форме имеется картинка "Image1", кнопки и всякое раяное. Вопрос как_распечатать_только эту картинку, а_не_всю_форму.

---

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

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

   Не удается синхронизировать курсоры в DirectSoundCaptureBuffer. Если кто знает объясните, как это сделать.

---

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

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

   Как повернуть изображение в графическом поле?

---

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

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

   Вопрос 1:
    Порскажите код, чтобы поместить иконку в трей (туда, где часики).
Вопрос 2:
    Порскажите код, чтобы программно уянать сколько у меня CD-ROM, CD-RW, DVD-ROM.

---

Ответы:

---

Вопрос:

   Пишу маленький макросик на VBA под Excel2002. В нём используется функция Str() для преобразования числа в строку. Числа считываются из ячеек, но иногда в ячейках попадается текст и появляется ошибка #13 "Type mismatch", поскольку я не знаю как проверить ячейку на наявность текста, а не чисел, чтобы исключить эту ситуацию, я в обработчике ошибок ставлю метку в которой проверяю равен ли код ошибки 13, если так, то перехожу к следующей строке программы. При возникновении такой ситуации первый раз (вместо числа попадается строка), программа продолжает выполняться, переходы по меткам проходят нормально, но при возникновении такой ситуации второй раз, программа останавливается и на экран выводится ошибка. Как заставить программу обходить эту ошибку постоянно (больше одного раза), в чём здесь может быть проблема?
Для наглядности привожу кусок своей программы:

Dim A As String
Dim B As Object
Dim C As Long
Dim R As Long
Dim CF As Long
Dim RF As Long
Dim CL As Long
Dim RL As Long

On Error GoTo Trouble1

      For C = CF To CL - 1
         For R = RF To RL - 1
             Set B = Cells(R, C)
             If Not B Is Nothing Then
                 A = Str$(Cells(R, C).Value)
                 Cells(R, C).Value = Trim$(A)
             End If
Trouble2:
         Next R
     Next C

     Exit Sub
Trouble1:
     If Err = 13 Then
     GoTo Trouble2
     Else:
     MsgBox "Неизвестная ошибка!"
     Exit Sub
     End If
     
End Sub

Ответ:

Автор ответа: Nechaev Sergey

В обработчике ошибок Trouble1 строку GoTo Trouble2 нужно заменить строкой Resume Trouble2. В Вашем же случае программа считает, что до сих пор находится в обработчике ошибок и вторая ошибка произошла уже в нем.

---

Вопрос:

   Пишу маленький макросик на VBA под Excel2002. В нём используется функция Str() для преобразования числа в строку. Числа считываются из ячеек, но иногда в ячейках попадается текст и появляется ошибка #13 "Type mismatch", поскольку я не знаю как проверить ячейку на наявность текста, а не чисел, чтобы исключить эту ситуацию, я в обработчике ошибок ставлю метку в которой проверяю равен ли код ошибки 13, если так, то перехожу к следующей строке программы. При возникновении такой ситуации первый раз (вместо числа попадается строка), программа продолжает выполняться, переходы по меткам проходят нормально, но при возникновении такой ситуации второй раз, программа останавливается и на экран выводится ошибка. Как заставить программу обходить эту ошибку постоянно (больше одного раза), в чём здесь может быть проблема?
Для наглядности привожу кусок своей программы:

Dim A As String
Dim B As Object
Dim C As Long
Dim R As Long
Dim CF As Long
Dim RF As Long
Dim CL As Long
Dim RL As Long

On Error GoTo Trouble1

      For C = CF To CL - 1
         For R = RF To RL - 1
             Set B = Cells(R, C)
             If Not B Is Nothing Then
                 A = Str$(Cells(R, C).Value)
                 Cells(R, C).Value = Trim$(A)
             End If
Trouble2:
         Next R
     Next C

     Exit Sub
Trouble1:
     If Err = 13 Then
     GoTo Trouble2
     Else:
     MsgBox "Неизвестная ошибка!"
     Exit Sub
     End If
     
End Sub

Ответ:

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

попробуй переписать так:

Dim A As String
Dim B As Object
Dim C As Long
Dim R As Long
Dim CF As Long
Dim RF As Long
Dim CL As Long
Dim RL As Long

On Error GoTo Trouble1

       For C = CF To CL - 1
          For R = RF To RL - 1
              Set B = Cells(R, C)
              A=""
              If Not B Is Nothing Then
                  A = Str$(Cells(R, C).Value)
                  If Len(A)>0 Then Cells(R, C).Value = Trim$(A)
              End If
          Next R
      Next C
      
      Exit Sub
      
Trouble1:
      If Err = 13 Then
           Resume Next
      Else
           MsgBox "Неизвестная ошибка!"
           Exit Sub
      End If
End Sub

P.S. Сам не пробовал, но должно работать :-)

---

Вопрос:

   Пишу маленький макросик на VBA под Excel2002. В нём используется функция Str() для преобразования числа в строку. Числа считываются из ячеек, но иногда в ячейках попадается текст и появляется ошибка #13 "Type mismatch", поскольку я не знаю как проверить ячейку на наявность текста, а не чисел, чтобы исключить эту ситуацию, я в обработчике ошибок ставлю метку в которой проверяю равен ли код ошибки 13, если так, то перехожу к следующей строке программы. При возникновении такой ситуации первый раз (вместо числа попадается строка), программа продолжает выполняться, переходы по меткам проходят нормально, но при возникновении такой ситуации второй раз, программа останавливается и на экран выводится ошибка. Как заставить программу обходить эту ошибку постоянно (больше одного раза), в чём здесь может быть проблема?
Для наглядности привожу кусок своей программы:

Dim A As String
Dim B As Object
Dim C As Long
Dim R As Long
Dim CF As Long
Dim RF As Long
Dim CL As Long
Dim RL As Long

On Error GoTo Trouble1

      For C = CF To CL - 1
         For R = RF To RL - 1
             Set B = Cells(R, C)
             If Not B Is Nothing Then
                 A = Str$(Cells(R, C).Value)
                 Cells(R, C).Value = Trim$(A)
             End If
Trouble2:
         Next R
     Next C

     Exit Sub
Trouble1:
     If Err = 13 Then
     GoTo Trouble2
     Else:
     MsgBox "Неизвестная ошибка!"
     Exit Sub
     End If
     
End Sub

Ответ:

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

Может, поможет следующий код : (переменную Sv опишешь сам как String)

Sv = TypeName(B.Value)
If Sv = "Integer" Or Sv = "Byte" Or Sv = "Single" Or Sv = "Long" Or Sv = "Double" Or Sv = "Empty" Then
...........
                    Else
...........
                    End If

Немножко громоздко, можна, по идее, сделать проверку на тип STring и т.д., но пока все работает и все OK!

---

Вопрос:

   Пишу маленький макросик на VBA под Excel2002. В нём используется функция Str() для преобразования числа в строку. Числа считываются из ячеек, но иногда в ячейках попадается текст и появляется ошибка #13 "Type mismatch", поскольку я не знаю как проверить ячейку на наявность текста, а не чисел, чтобы исключить эту ситуацию, я в обработчике ошибок ставлю метку в которой проверяю равен ли код ошибки 13, если так, то перехожу к следующей строке программы. При возникновении такой ситуации первый раз (вместо числа попадается строка), программа продолжает выполняться, переходы по меткам проходят нормально, но при возникновении такой ситуации второй раз, программа останавливается и на экран выводится ошибка. Как заставить программу обходить эту ошибку постоянно (больше одного раза), в чём здесь может быть проблема?
Для наглядности привожу кусок своей программы:

Dim A As String
Dim B As Object
Dim C As Long
Dim R As Long
Dim CF As Long
Dim RF As Long
Dim CL As Long
Dim RL As Long

On Error GoTo Trouble1

      For C = CF To CL - 1
         For R = RF To RL - 1
             Set B = Cells(R, C)
             If Not B Is Nothing Then
                 A = Str$(Cells(R, C).Value)
                 Cells(R, C).Value = Trim$(A)
             End If
Trouble2:
         Next R
     Next C

     Exit Sub
Trouble1:
     If Err = 13 Then
     GoTo Trouble2
     Else:
     MsgBox "Неизвестная ошибка!"
     Exit Sub
     End If
     
End Sub

Ответ:

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

Можно использовать такое условие:
If Not B Is Nothing And IsNumeric(B) Then ...

---

Вопрос:

   Пишу маленький макросик на VBA под Excel2002. В нём используется функция Str() для преобразования числа в строку. Числа считываются из ячеек, но иногда в ячейках попадается текст и появляется ошибка #13 "Type mismatch", поскольку я не знаю как проверить ячейку на наявность текста, а не чисел, чтобы исключить эту ситуацию, я в обработчике ошибок ставлю метку в которой проверяю равен ли код ошибки 13, если так, то перехожу к следующей строке программы. При возникновении такой ситуации первый раз (вместо числа попадается строка), программа продолжает выполняться, переходы по меткам проходят нормально, но при возникновении такой ситуации второй раз, программа останавливается и на экран выводится ошибка. Как заставить программу обходить эту ошибку постоянно (больше одного раза), в чём здесь может быть проблема?
Для наглядности привожу кусок своей программы:

Dim A As String
Dim B As Object
Dim C As Long
Dim R As Long
Dim CF As Long
Dim RF As Long
Dim CL As Long
Dim RL As Long

On Error GoTo Trouble1

      For C = CF To CL - 1
         For R = RF To RL - 1
             Set B = Cells(R, C)
             If Not B Is Nothing Then
                 A = Str$(Cells(R, C).Value)
                 Cells(R, C).Value = Trim$(A)
             End If
Trouble2:
         Next R
     Next C

     Exit Sub
Trouble1:
     If Err = 13 Then
     GoTo Trouble2
     Else:
     MsgBox "Неизвестная ошибка!"
     Exit Sub
     End If
     
End Sub

Ответ:

Автор ответа: Ян

Не майся дурью. Вставь проверку типа данных:
твоё

> A = Str$(Cells(R, C).Value)
> Cells(R, C).Value = Trim$(A)

Замени на

                    A = Cells(R, C).Value
                    If IsNumber(A) Then Cells(R, C).Value = Trim$(Str$(A))

---

Вопрос:

   Вопрос 1:
    Как соядать install-прогу с помощью VB6.
Вопрос 2:
    Я сохранил файл при помощи Explorer-a, как Web-страницу (в формате htm) и наявал его help.zzz. Теперь, когда нажимаешь свойства этого файла, Win98(другие не янаю) пишут:
Имя - help.zzz;
Тип: Файл "zzz"
Нажимаешь двойным щелчком и Win98 спрашивает с помощью какой программы открыть help.zzz файл.
Как сделать чтобы моя программа открывала help.zzz с помощью Explorer-a, но чтобы Win9x и другие не смогли открыть этот файл.

Ответ:

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

Относительно формата zzz:
Для примера возьмем форму, на ней есть кнопка и CommonDialog c именем dlgOpen. В код кнопки положи вот такое:
  
Private Sub Command1_Click()
     dlgOPen.ShowOpen
     If Right(dlgOPen.filename, 3) = "zzz" Then Shell ("c:\progra~1\Intern~1\iexplore.exe " + dlgOPen.filename)
End Sub

И наслаждайся результатом :-)))

---

Вопрос:

   Как остановить удаление файлов если их нет в папке?

Ответ:

Автор ответа: Дмитрий

перед удалением файла проверять его наличие в папке.
   Можно сделать через FSO или API.

     If fso.FileExists(fso.BuildPath(App.Path, "имя_файла.xxx")) Then
        Kill fso.BuildPath(App.Path, "BpaStat.log")
     End If

   Через API не помню...

---

Вопрос:

   Как добавить информацию ия reg файла в реестр бея всяких вопросов и уведомлений

Ответ:

Автор ответа: Nechaev Sergey

Добавление reg файла без уведомлений:

Shell "Regedit.exe /Y " & RegFileName, vbHide

Учтите, что программа продолжит выполнение, не ожидая завершения Regedit'а. Если Вас это не устраивает, добавьте после данной строки паузу в несколько секунд или используйте код, приостанавливающий выполнение программы до завершения Regedit.

---

Вопрос:

   Как добавить информацию ия reg файла в реестр бея всяких вопросов и уведомлений

Ответ:

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

Для этого используют ключ -s - Silent
Насколько я помню, деалется вот так:
regedit -s имя_файла.reg

---

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

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

Текст сообщения:

Ваше имя
E-mail для ответа

наверх