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

Книги

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

наверх

---

ListBox / ComboBox - добавление массива данных

Данная процедура предназначена для добавления массива данных в элементы ListBox / ComboBox, используя АПИ-функции. Данная процедура работает быстрее, чем процедура, основанная на методе AddItem.

Для примера вам понадобится ComboBox и 2 элемента CommandButton. Вместо элемента ComboBox можно расположить ListBox, только не забудьте в событиях нажатия на CommandButton прописать тот контрол (ListBox / ComboBox), который вы расположите на форме.

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Const LB_ADDSTRING = &H180
Private Const LB_RESETCONTENT = &H184
Private Const CB_ADDSTRING = &H143
Private Const CB_RESETCONTENT = &H14B

Sub ArrayToListBox(ctrl As Object, arr As Variant, Optional clearIt As Boolean, _
Optional ByVal First As Variant, Optional ByVal Last As Variant)
Dim msgReset As Long
Dim msgAdd As Long
Dim hWnd As Long
Dim index As Long
If TypeOf ctrl Is ListBox Then
msgReset = LB_RESETCONTENT
msgAdd = LB_ADDSTRING
ElseIf TypeOf ctrl Is ComboBox Then
msgReset = CB_RESETCONTENT
msgAdd = CB_ADDSTRING
Else
Exit Sub
End If
If IsMissing(First) Then First = LBound(arr)
If IsMissing(Last) Then Last = UBound(arr)
' отменить перерисовку
hWnd = ctrl.hWnd
LockWindowUpdate hWnd
' очистить контрол, если требуется
If clearIt Then
SendMessage hWnd, msgReset, 0, 0
End If
' добавить элементы в контрол
For index = First To Last
SendMessage hWnd, msgAdd, 0, ByVal CStr(arr(index))
Next
LockWindowUpdate 0
End Sub

Private Sub Command1_Click()
'метод, основанный на АПИ-функциях
Dim d()
s = 10000: s1 = Timer
ReDim d(s)
For i = 1 To s: d(i) = i: Next
Call ArrayToListBox(Combo1, d(), True, 6, 4578)
s2 = Timer
MsgBox s2 - s1
End Sub

Private Sub Command2_Click()
'метод, основанный на методе AddItem
s = 10000: s1 = Timer
For i = 1 To s: Combo1.AddItem i: Next
s2 = Timer
MsgBox s2 - s1
End Sub

наверх

---

Форма: перемещение элементов формы

Добавьте данную процедуру в вашу программу, и вы сможете перемещать любой элемент, расположенный на форме, в любое место вашей формы.

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function ClipCursor Lib "user32" (lpRect As RECT) As Long
Private Declare Function ClipCursorByNum Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function InvalidateRectByNum Lib "user32" Alias "InvalidateRect" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long

' Перемещение любого контрола с помощью клавиатуры и правой клавиши мыши
'
' Для того, чтобы задействовать перемещение, вы должны в процедуру контрола MouseDown
' добавить несколько строчек кода. С помощью клавиши Ctrl и правой клавиши мыши
' вы можете перемещать любой контрол на форме
' Для примера:
' Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' If Button = vbRightButton And Shift = vbCtrlMask Then
' DragControl Command1
' End If
' End Sub

Sub DragControl(ctrl As Control)
Dim startButton As Integer
Dim startPoint As POINTAPI
Dim currPoint As POINTAPI
Dim contRect As RECT
Dim contScaleMode As Integer
' get mouse position and buttons pressed
GetCursorPos startPoint
If GetAsyncKeyState(vbLeftButton) Then startButton = vbLeftButton
If GetAsyncKeyState(vbRightButton) Then startButton = startButton Or vbRightButton
If GetAsyncKeyState(vbMiddleButton) Then startButton = startButton Or vbMiddleButton
' get container upper-left corner position
' in screen coordinates (currPoint is Zero)
ClientToScreen ctrl.Container.hwnd, currPoint
' get container size
GetClientRect ctrl.Container.hwnd, contRect
' convert to screen coordintes
contRect.Left = currPoint.X
contRect.Top = currPoint.Y
contRect.Right = contRect.Right + currPoint.X
contRect.Bottom = contRect.Bottom + currPoint.Y
' limit the cursor within the parent control
ClipCursor contRect
' get the ScaleMode that is active for the control
' this is the ScaleMode of its container, or it
' is vbTwips if its container does not support
' the ScaleMode property
On Error Resume Next
contScaleMode = vbTwips
' ignore next assignement if the container
' dows not support ScaleMode property
contScaleMode = ctrl.Container.ScaleMode
Do
' exit if all mouse buttons are released
If (startButton And vbLeftButton) = 0 Or GetAsyncKeyState(vbLeftButton) = 0 Then
If (startButton And vbRightButton) = 0 Or GetAsyncKeyState(vbRightButton) = 0 Then
If (startButton And vbMiddleButton) = 0 Or GetAsyncKeyState(vbMiddleButton) = 0 Then
Exit Do
End If
End If
End If
' get current mouse position
GetCursorPos currPoint
' move the control if they are different
If currPoint.X <> startPoint.X Or currPoint.Y <> startPoint.Y Then
' move the control
With ctrl.Parent
ctrl.Move ctrl.Left + .ScaleX(currPoint.X - startPoint.X, _
vbPixels, contScaleMode), ctrl.Top + .ScaleY(currPoint.Y - _
startPoint.Y, vbPixels, contScaleMode)
' refresh container
InvalidateRectByNum .hwnd, 0, False
.Refresh
End With
LSet startPoint = currPoint
End If
' allow background processing
DoEvents
Loop
' restore full mouse movement
ClipCursorByNum 0
End Sub

Private Sub Command1_Click()
MsgBox "привет"
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton And Shift = vbCtrlMask Then
DragControl Command1
End If
End Sub

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton And Shift = vbCtrlMask Then
DragControl List1
End If
End Sub

наверх

---

Форма: создание модальной формы

Если у вас в программе запущено несколько форм, и вам необходимо сделать одну форму более модальной :) по отношению к другим, используйте данную процедуру. Добавьте к вашему проекту еще 2 формы, а также расположите на форме 3 CommandButton.

Sub MakeModalForm(frm As Form, ByVal State As Boolean)
Static saveForms As Collection
Dim f As Form
If State Then
' disable all other forms in the project
' but remember which were enabled
Set saveForms = New Collection
For Each f In Forms
If Not (f Is frm) And frm.Enabled Then
saveForms.Add f
f.Enabled = False
End If
Next
ElseIf Not (saveForms Is Nothing) Then
' restore the Enabled property of other forms
For Each f In saveForms
f.Enabled = True
Next
Set saveForms = Nothing
End If
End Sub

Private Sub Command1_Click()
Form2.Show
Form3.Show
End Sub

Private Sub Command2_Click()
MakeModalForm Me, True
End Sub

Private Sub Command3_Click()
MakeModalForm Me, False
End Sub

Private Sub Form_Unload(Cancel As Integer)
MakeModalForm Me, False
End Sub

наверх

---

Форма: определение модальности формы

Все просто: проверка - модальная или не модальная форма

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Const GWL_style="(-16)"
Const WS_DISABLED = &H8000000

Function IsFormModal(frm As Form) As Boolean
' Функция возвращает True если форма модальная
' Если программа имеет одну видимую форму, функция возвратит True
Dim f As Form
For Each f In Forms
If Not (f Is frm) Then
If (GetWindowLong(f.hWnd, GWL_STYLE) And WS_DISABLED) = 0 Then
Exit Function
End If
End If
Next
IsFormModal = True
End Function

Private Sub Command4_Click()
MsgBox IsFormModal(Form1)
End Sub

наверх

---

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

BalloonMessage for MS Agent


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

наверх

---

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

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

Вопросы:

---

Автор вопроса: Голикова

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

   Кто нибудь делал свой FTP клиент, неполучается работать через прокси...
Я руководствовался данной статьей: http://www.vbip.com/wininet/wininet-ftp-command-01.asp
Подкажите ссылки

---

Автор вопроса: Костя

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

   Как удалить файл qwe.mdb (к примеру) програмно из VB.

---

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

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

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

---

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

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

   Есть БД baza.mdb. Открываю ее с помощью msadodc.ocx(Adodc1)
Как поставить на базу пароль и открыть ее с помощью Adodc1 ?

---

Автор вопроса: Роман

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

   У меня небольшой вопрос: как в MSExel с помощью средств VB залить определенную ячейку или диапазон ячеек каким-либо цветом.

---

Автор вопроса: Ворошилов Павел

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

   Я написал прогу Проводник, но хотел бы узнать как сделать у FileListBox, чтобы можно было открать из моего проводника любой файл.

---

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

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

   Нужно чтобы моя программа дописывала себя в конец .exe-фаила и при запуске обе программы работали нормально. Если можно немного кода.

---

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

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

   На форме есть TextBox control (имя: txtText) и CommandButton (имя: cmbCreate)
   При нажатии на кнопку надо создать еще 2 таких TextBoxа и поместить их рядом с существующим.
   Использую VB6.

---

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

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

   Как узнать ip-адрес интернет-сервера?

---

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

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

   Мне нужно каким-то образом обрабатывать дерево элементов. У каждого элемента есть несколько уникальных свойств. Я представляю это как массив (всю базу для свойств). Help me, please! Если есть исходники, примеры, рекомендации (особенно о работе с TreeView именно в этой ситуации), пишите mailto:kalmykov@uraltc.ru

---

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

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

   Подскажите где можно взять примеры с браузером файлов (типа панели FAR или Windows Commander - имеется в виду одну панель) ???

---

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

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

   Подскажите плиз, какие мне нужны функции, чтобы написать сканер клавы. Если можно то с описанием, хотя не обязательно.

---

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

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

   В проекте почему то стала форма черного цвета хотя при выполнении показывает тот цвет,который выбран в BackColor. Невозможно работать ни со цветом, ни с картинками, а при выполнении все нормально. Может у кого такое было?

---

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

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

   Подскажите, если кто знает, как разбить файл на часть, а потом собрать. Если это в VB вообще возможно.

---

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

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

   Создал ActiveX Control в котором поместил в массив Image 9 рисунков. При выполнении метода Next компонента отображение рисунков меняется.
Помещаю свой компонент на форму. Выполняю периодически метод Next. И через случайное количество вызова метода происходит как бы мерцание компонента.

Как бы избавится от сих бликов?

---

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

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

   Как можно подключить API функцию из DLL, находяшимся в папке с программой, в частности:
Public Declare Sub SaveToJpg1 Lib "savtojpg.dll" (ByVal hgd As Long, ByVal FileName As String, ByVal Height As Long, ByVal Width As Long)

---

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

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

   В Visual Data Manager нет русского шрифта.
Ставил четыре разных VB6.В самом VB есть в Manager нет.
Я новичок в этом деле. Где можно об этом узнать,или что нужно сделать.
В интернете ничего не нашел.

---

Ответы:

---

Вопрос:

   Подскажите кто знает как из VB6 определить текущую раскладку клавиатуры (русская или английская) и изменить эту расскладку в Windows

Ответ:

Автор ответа: Vladimir [PRC]

Объявляешь API функцию:

Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long

Затем вызываешь её для переключения раскладок клавиатуры:

ActivateKeyboardLayout 67699721, 0 - Чтобы печатать по английски
ActivateKeyboardLayout 68748313, 0 - Чтобы печатать по русски

Для определения текущей раскладки:

dim test as long
test = ActivateKeyboardLayout(67699721, 0)
ActivateKeyboardLayout test, 0

Если test = 67699721, то раскладка английская
Если test = 68748313, то раскладка русская

---

Ответ:

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

Для изменения раскладки можно использовать функцию

ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long

Вызывать её нужно следующим образом:

'// На русский
ActivateKeyboardLayout 68748313, 0
'// На английский
ActivateKeyboardLayout 67699721, 0
  
А для того чтобы узнать какая сейчас стоит раскладка нужно про помощи функции
  
GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long

записать значение в переменную и если число в переменной равно 68748313, то язык русский, 67699721 - английский.
Вот пример:

GetAdr = GetKeyboardLayout(0)
If GetAdr = 68748313 Then
MsgBox "Русская"
Else
MsgBox "Английская"
End if

---

Вопрос:

   Подскажите, как "научить" ComboBox корректно отбражать текст в Dos кодировке?

Ответ:

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

Перекодируй ее в Winows и все дела...
  
'----------------------------------------------------
' Модуль для перекодировки строковых переменных
' В. Язов начало 12.09.2001
'----------------------------------------------------
Option Explicit
Public Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Public Declare Function CharToOemBuff Lib "user32" Alias "CharToOemBuffA" (ByVal lpszSrc As String, ByVal lpszDst As String, ByVal cchDstLength As Long) As Long
  
  
Public Const WC_COMPOSITECHECK = &H200
Public Const WC_DEFAULTCHAR = &H40
Public Const WC_DISCARDNS = &H10
Public Const WC_SEPCHARS = &H20
  
Public Const CP_ACP = 0
Public Const CP_OEMCP = 1
Public Const CP_MACCP = 2
Public Const CP_THREAD_ACP = 3
Public Const CP_SYMBOL = 42
Public Const CP_UTF7 = 65000
Public Const CP_UTF8 = 65001
  
Public Const MB_PRECOMPOSED = &H1
Public Const MB_COMPOSITE = &H2
Public Const MB_USEGLYPHCHARS = &H4
Public Const MB_ERR_INVALID_CHARS = &H8
  
Public Declare Function WideCharToMultiByte Lib "kernel32" _
(ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As String, _
ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As String, _
ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As String, _
ByVal lpUsedDefaultChar As Long) As Long
Public Declare Function MultiByteToWideChar Lib "kernel32" _
(ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpMultiByteStr As String, _
ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As String, _
ByVal cchWideChar As Long) As Long
'=======================================================
' Publi Function
'=======================================================
'----------- Dos to Win ----------------------------
Public Function DosWin(ByVal sourcestring As String) As String
Dim code As Long
DosWin = Space$(Len(sourcestring)) 'получаем перекодированную строку
code = OemToChar(sourcestring, DosWin) 'Собственно перекодируем
End Function
'----------- Win to Dos ----------------------------
Public Function WinDos(ByVal sourcestring As String) As String
Dim code As Long
WinDos = Space$(Len(sourcestring)) 'получаем перекодированную строку
code = CharToOemBuff(sourcestring, WinDos, Len(WinDos)) 'Собственно перекодируем
End Function
'-------- Win в Кириллицу ----------------------
Public Function WinCyr(ByVal strSrc As String, ByVal sTipIsxodn As String) As String
'Моя вариация на тему Армена 24-9-2001
Const nTipWin As Long = 1251 'Win(Cyr) Значение исходной кодовой страницы
Dim nLen As Long 'Длина строчки
Dim strDst As String 'Для превода в Unicode
Dim strRet As String 'Для возврата из Unicode в Win
Dim nRet As Long 'Для возвращаемого кода API
Dim nTipIsxodn As Long 'Значение исходной кодовой страницы
nLen = Len(strSrc)
strDst = String(nLen * 2, Chr(0))
strRet = String(nLen * 2, Chr(0))
Select Case UCase$(sTipIsxodn)
Case "DOS"
nTipIsxodn = 866
Case "ISO"
nTipIsxodn = 28595
Case "KOI8-R"
nTipIsxodn = 20866
Case "KOI8-RU" 'Украина
nTipIsxodn = 21866
Case Else
MsgBox sTipIsxodn & vbCrLf & " Неизвестная кодировка!!!"
End Select
nRet = MultiByteToWideChar(nTipWin, MB_PRECOMPOSED, strSrc, nLen, strDst, nLen)
nRet = WideCharToMultiByte(nTipIsxodn, 0, strDst, nRet, strRet, nLen * 2, ByVal 0, 0)
WinCyr = Left(strRet, nRet)
End Function
'-------- Кириллица в Win ----------------------
Public Function CyrWin(ByVal strSrc As String, ByVal sTipIsxodn As String) As String
'Моя вариация на тему Армена
Const nTipWin As Long = 1251 'Win(Cyr) Значение исходной кодовой страницы
Dim nLen As Long 'Длина строчки
Dim strDst As String 'Для превода в Unicode
Dim strRet As String 'Для возврата из Unicode в Win
Dim nRet As Long 'Для возвращаемого кода API
Dim nTipIsxodn As Long 'Значение исходной кодовой страницы
nLen = Len(strSrc)
strDst = String(nLen * 2, Chr(0))
strRet = String(nLen * 2, Chr(0))
Select Case UCase$(sTipIsxodn)
Case "DOS"
nTipIsxodn = 866
Case "ISO"
nTipIsxodn = 28595
Case "KOI8-R"
nTipIsxodn = 20866
Case "KOI8-RU" 'Украина
nTipIsxodn = 21866
Case Else
MsgBox sTipIsxodn & vbCrLf & " Неизвестная кодировка!!!"
End Select
nRet = MultiByteToWideChar(nTipIsxodn, MB_PRECOMPOSED, strSrc, nLen, strDst, nLen)
nRet = WideCharToMultiByte(nTipWin, 0, strDst, nRet, strRet, nLen * 2, ByVal 0, 0)
CyrWin = Left(strRet, nRet)
End Function
'---- Функция получена от Армена Мнацаканяна -------------
Public Function ConvertString(ByVal strSrc As String, ByVal nFromCP As Long, ByVal nToCP As Long) As String
Dim nLen As Long
Dim strDst As String
Dim strRet As String
Dim nRet As Long
nLen = Len(strSrc)
strDst = String(nLen * 2, Chr(0))
strRet = String(nLen * 2, Chr(0))
nRet = MultiByteToWideChar(nFromCP, MB_PRECOMPOSED, strSrc, nLen, strDst, nLen)
nRet = WideCharToMultiByte(nToCP, 0, strDst, nRet, strRet, nLen * 2, ByVal 0, 0)
ConvertString = Left(strRet, nRet)
End Function

---

Вопрос:

   У меня небольшой вопрос: как на VBA в Excel'e сделать кнопку и, нажав на нее, записать содержимое ячеек в текстовый файл?

Ответ:

Автор ответа: ]...C...B...K...[C...R...a...S...H

Добавь панель Элементы управления
Создай кнопку
Кликни по ней 2 раза
В процедуре напиши

Dim i, j
Open "c:\1.txt" For Output As #1
For i = 1 To 40
For j = 1 To 40
Print #1, ActiveSheet.Cells(i, j)
Next j
Next i

---

Вопрос:

   Как в Visual Basice иметировать нажатие клавиш в другом приложении например клавишу "Enter"?

Ответ:

Автор ответа: KAS (c)

SendKeys "{Enter}",1

Передает нажатие клавиш активному приложению, а что бы сделать приложение активным:

AppActivate "Блокнот",1

Делает приложение Блокнот активным.

---

---

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

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

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

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

наверх