Голосование:
Голосования сайта VBNet.Ru. Результаты голосований передаются на сайт. Проследите, что есть соединение с интернетом.
Ссылки:
Несколько слов от автора:
Новый выпуск. Правзники прошли, с нетерпением жду следующих...
Читайте!
Читайте!
Содержание выпуска
- Книги
- Римские цифры
- Глобальное изменение размеров формы/контролов
- Получение анимированного курсора
- ListBox: Проверка дубликатности элементов списка
- CommonDialog: Просмотр списка директорий без использования контрола Common Dialog
- Вопрос/Ответ
Книги
Остальные книги о VB можно найти здесь.
наверх
Римские цифры
В Excel есть функция, выполняющая преобразование арабских цифр в римские, но ради 2 - 3 цифр подключать к проекту довольно большую библиотеку не стоит. Поборовши лень (частично) написал преобразование цифр до 50. На практике этого более чем достаточно, а кому мало, может сам дописать. С основными шрифтами получается неплохо.
Function RimDigital(intN As Integer) As String
Select Case intN
Case 1: RimDigital = "I"
Case 2: RimDigital = "II"
Case 3: RimDigital = "III"
Case 4: RimDigital = "IV"
Case 5: RimDigital = "V"
Case 6: RimDigital = "VI"
Case 7: RimDigital = "VII"
Case 8: RimDigital = "VIII"
Case 9: RimDigital = "IX"
Case 10: RimDigital = "X"
Case 11: RimDigital = "XI"
Case 12: RimDigital = "XII"
Case 13: RimDigital = "XIII"
Case 14: RimDigital = "XIV"
Case 15: RimDigital = "XV"
Case 16: RimDigital = "XVI"
Case 17: RimDigital = "XVII"
Case 18: RimDigital = "XVIII"
Case 19: RimDigital = "XIX"
Case 20: RimDigital = "XX"
Case 21: RimDigital = "XXI"
Case 22: RimDigital = "XXII"
Case 23: RimDigital = "XXIII"
Case 24: RimDigital = "XXIV"
Case 25: RimDigital = "XXV"
Case 26: RimDigital = "XXVI"
Case 27: RimDigital = "XXVII"
Case 28: RimDigital = "XXVIII"
Case 29: RimDigital = "XXIX"
Case 30: RimDigital = "XXX"
Case 31: RimDigital = "XXXI"
Case 32: RimDigital = "XXXII"
Case 33: RimDigital = "XXXIII"
Case 34: RimDigital = "XXXIV"
Case 35: RimDigital = "XXXV"
Case 36: RimDigital = "XXXVI"
Case 37: RimDigital = "XXXVII"
Case 38: RimDigital = "XXXVIII"
Case 39: RimDigital = "XXXIX"
Case 40: RimDigital = "XL"
Case 41: RimDigital = "XLI"
Case 42: RimDigital = "XLII"
Case 43: RimDigital = "XLIII"
Case 44: RimDigital = "XLIV"
Case 45: RimDigital = "XLV"
Case 46: RimDigital = "XLVI"
Case 47: RimDigital = "XLVII"
Case 48: RimDigital = "XLVIII"
Case 49: RimDigital = "XLIX"
Case 50: RimDigital = "L"
Case Else: RimDigital = intN
End Select
End Function
наверх
Глобальное изменение размеров формы/контролов
Отличный и бесподобный пример, автору которого надо выдавать приз за один из отличнейших примеров. К сожалению, я не знаю ни имени автора, ни сайта, разместившего в первоисточнике этот пример. Что делает пример? Ни много, ни мало, а код в зависимости от изменения размеров формы, меняет размеры всех контролов, расположенных на этой форме!!! Вам надо добавить на форму 2 элемента CommanButton и дополнительный модуль в программу. Запустите программу и попробуйте изменять размеры формы. Впечатляет? В любой момент нажмите на кнопку 1, измените размеры формы и нажмите на кнопку 2. Впечатляет?!?
'КОД ФОРМЫ
Private Sub Command1_Click()
SaveFormPosition Me
End Sub
Private Sub Command2_Click()
RestoreFormPosition Me
End Sub
Private Sub Form_Resize()
ResizeForm Me
End Sub
'КОД МОДУЛЯ
Option Explicit
Type ctrObj
Name As String
Index As Long
Parrent As String
Top As Long
Left As Long
Height As Long
Width As Long
ScaleHeight As Long
ScaleWidth As Long
End Type
Private FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private MaxForm As Long
Private MaxControl As Long
Private Function ActualPos(plLeft As Long) As Long
If plLeft < 0 Then ActualPos = plLeft + 75000 Else ActualPos = plLeft
End Function
Private Function FindForm(pfrmIn As Form) As Long
Dim i As Long
FindForm = -1
If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then FindForm = i: Exit Function
Next i
End If
End Function
Private Function AddForm(pfrmIn As Form) As Long
Dim FormControl As Control
Dim i As Long
ReDim Preserve FormRecord(MaxForm + 1)
FormRecord(MaxForm).Name = pfrmIn.Name
FormRecord(MaxForm).Top = pfrmIn.Top
FormRecord(MaxForm).Left = pfrmIn.Left
FormRecord(MaxForm).Height = pfrmIn.Height
FormRecord(MaxForm).Width = pfrmIn.Width
FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight
FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
AddForm = MaxForm
MaxForm = MaxForm + 1
For Each FormControl In pfrmIn
i = FindControl(FormControl, pfrmIn.Name)
If i < 0 Then i = AddControl(FormControl, pfrmIn.Name)
Next FormControl
End Function
Private Function FindControl(inControl As Control, inName As String) As Long
Dim i As Long
FindControl = -1
For i = 0 To (MaxControl - 1)
If ControlRecord(i).Parrent = inName Then
If ControlRecord(i).Name = inControl.Name Then
On Error Resume Next
If ControlRecord(i).Index = inControl.Index Then
FindControl = i
Exit Function
End If
On Error GoTo 0
End If
End If
Next i
End Function
Private Function AddControl(inControl As Control, inName As String) As Long
ReDim Preserve ControlRecord(MaxControl + 1)
On Error Resume Next
ControlRecord(MaxControl).Name = inControl.Name
ControlRecord(MaxControl).Index = inControl.Index
ControlRecord(MaxControl).Parrent = inName
If TypeOf inControl Is Line Then
ControlRecord(MaxControl).Top = inControl.Y1
ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
ControlRecord(MaxControl).Height = inControl.Y2
ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
Else
ControlRecord(MaxControl).Top = inControl.Top
ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
ControlRecord(MaxControl).Height = inControl.Height
ControlRecord(MaxControl).Width = inControl.Width
End If
On Error GoTo 0
AddControl = MaxControl
MaxControl = MaxControl + 1
End Function
Private Function PerWidth(pfrmIn As Form) As Long
Dim i As Long
i = FindForm(pfrmIn)
If i < 0 Then i = AddForm(pfrmIn)
PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth
End Function
Private Function PerHeight(pfrmIn As Form) As Single
Dim i As Long
i = FindForm(pfrmIn)
If i < 0 Then i = AddForm(pfrmIn)
PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight
End Function
Private Sub ResizeControl(inControl As Control, pfrmIn As Form)
Dim i As Long
Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
yRatio = PerHeight(pfrmIn)
xRatio = PerWidth(pfrmIn)
i = FindControl(inControl, pfrmIn.Name)
On Error GoTo Moveit
If inControl.Left < 0 Then
lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If
lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)
'
Moveit:
On Error GoTo MoveError1
If TypeOf inControl Is Line Then
If inControl.X1 < 0 Then
inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If
inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)
If inControl.X2 < 0 Then
inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
Else
inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
End If
inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
Else
If TypeOf inControl Is Timer Then GoTo subExit
inControl.Move lLeft, lTop, lWidth, lHeight
End If
GoTo subExit
'
MoveError1:
On Error GoTo MoveError2
inControl.Move lLeft, lTop, lWidth
GoTo subExit
'
MoveError2:
On Error GoTo subExit
inControl.Move lLeft, lTop
'
subExit:
On Error GoTo 0
End Sub
Public Sub ResizeForm(pfrmIn As Form)
Dim FormControl As Control
Dim isVisible As Boolean
If pfrmIn.Top < 30000 Then
isVisible = pfrmIn.Visible
pfrmIn.Visible = False
For Each FormControl In pfrmIn
ResizeControl FormControl, pfrmIn
Next FormControl
pfrmIn.Visible = isVisible
End If
End Sub
Public Sub SaveFormPosition(pfrmIn As Form)
Dim i As Long
If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then
FormRecord(i).Top = pfrmIn.Top
FormRecord(i).Left = pfrmIn.Left
FormRecord(i).Height = pfrmIn.Height
FormRecord(i).Width = pfrmIn.Width
Exit Sub
End If
Next i
AddForm (pfrmIn)
End If
End Sub
Public Sub RestoreFormPosition(pfrmIn As Form)
Dim i As Long
If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then
If FormRecord(i).Top < 0 Then
pfrmIn.WindowState = 2
ElseIf FormRecord(i).Top < 30000 Then
pfrmIn.WindowState = 0
pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top
pfrmIn.Width = FormRecord(i).Width
pfrmIn.Height = FormRecord(i).Height
Else
pfrmIn.WindowState = 1
End If
Exit Sub
End If
Next i
End If
End Sub
наверх
Получение анимированного курсора
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const GCL_HCURSOR = (-12)
Dim sCursorFile As String
Dim hCursor As Long
Dim hOldCursor As Long
Dim lReturn As Long
Private Sub Command1_Click()
hCursor = LoadCursorFromFile(sCursorFile)
hOldCursor = SetClassLong(Form1.hwnd, GCL_HCURSOR, hCursor)
End Sub
Private Sub Command2_Click()
lReturn = SetClassLong(Form1.hwnd, GCL_HCURSOR, hOldCursor)
End Sub
Private Sub Form_Load()
'не забудьте указать свой путь к анимированному курсору
sCursorFile = "C:\WIN\CURSORS\GLOBE.ANI"
End Sub
наверх
ListBox: Проверка дубликатности элементов списка
Иногда перед добавлением нового элемента требуется проверить, нет ли уже такой строчки...
Private Declare Function SendMessageByString Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Sub Command1_Click()
If SendMessageByString(List1.hWnd, &H1A2, -1, Text1.Text) = -1 Then
List1.AddItem Text1.Text
Else
MsgBox Text1.Text & "- такой элемент уже есть в списке"
End If
'www.relib.com
End Sub
наверх
CommonDialog: Просмотр списка директорий без использования контрола Common Dialog
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Function FolderDialogShow()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
zTitle = "Select Folder"
With tBrowseInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
FolderDialogShow = sBuffer
End If
End Function
Private Sub Command1_Click()
Text1 = FolderDialogShow
End Sub
наверх
Мои программы
BalloonMessage for MS Agent
Автора: Шатрыкин Иван и Павел Сурменок.
наверх
Вопрос/Ответ
Автор вопроса: Alex
Ответ ожидается по этому адресу
Как в программе на VB проигрывать музыкальные файлы в фоновом режиме?
Автор вопроса: afb
Ответ ожидается по этому адресу
1. Не могу установить ссылку на Microsoft Scripting Runtime(FileSystemObject). Хотя scrrun.dll лежит, пробовал вручную, тоже самое - пишет - "C:\WINDOWS\SYSTEM\SCRRUN.DLL не может загрузится", и в тоже время заносит его в "Сomponents| Управление".
2. Как обращаться к Temporary Internet Files, а точнее как его удалить(чистить)? Т.к FileSystemObject не удалось использовать, делал так-
On Error GoTo 2
Shell "DelTree /Y " + wd + "\TEMPOR~1\CONTENT.IE5", vbHide
GoTo 3
2 MsgBox "Ошибка удаления или отказ в доступе"
3
в последствии некоторая часть файлов удаляется и в списке процессов остаётся "Winoldap", возможно нужен подходящий ключ для DelTree, перепробовал все.
Буду рад любым советам.
Автор вопроса: Арбит Семен Владимирович
Ответ ожидается по этому адресу
Нуждаюсь в вашей помощи, самостоятельно решить вопрос не получается
Задача: Win9x, Win2K, WinXP; VBA, VB6.0 VB5.0
1.Есть бинарный файл-функция с входящими параметрами (это может быть и исполняемый файл exe или com), написанный на Ассемблере.
2.Этот файл загружается не с диска, а из массива программы на VB (VBA) в памать по выделенному адресу.
3.Этот файл надо запустить на исполнение из программы на VB причем передав ему параметры (как при запуске с диска из командной строки)
4.Определить ID процесса выполнения этого файла чтобы отследить момент завершения его работы и продолжить выполнение программы на VB
ПРОБЛЕМА с осуществлением пункта 3 и определением ID запущенного процесса. На сайте Olovyannikov + VB что-то не высмотрел нмчего(может слаб глазами стал...). Эта ссылка была дана в эхе ФИДО Дмитрием Милосердовым от 16.04.2003
Ответ прошу выслать на мой e-mail: arbit@barhan.poltava.ua
Автор вопроса: sla_237
Ответ ожидается по этому адресу
Подскажите пожалуйста, как мне получить телефон текущего (уже установленого) dial up соединения с интернетом? Если можно, кусочек кода.
Автор вопроса: Taras Prikhodko
Ответ ожидается по этому адресу
Как сделать, чтобы после первого запуска программа в дальнейшем запускалась автоматически?
Автор вопроса: Uncle Tom
Ответ ожидается по этому адресу
Как открыть файл exe из своей проги?
Автор вопроса: Виталик
Ответ ожидается по этому адресу
Как послать файл по E-mail (без Outlook). Среда VB 6.
Автор вопроса: Владимир
Ответ ожидается по этому адресу
Есть некая прога, отправляющая почту в автоматическом режиме. Как на VB перехватывать содержание писем для ведения архива корреспонденции?
Автор вопроса: Данила
Ответ ожидается по этому адресу
В Access есть возможность разграничения доступа к различным таблицам с помощью имени и пароля. Есть база с такой штукой. Как теперь в VB воспользоваться этими паролями? В книге написано, что пароль задается при инициализации рабочего места, но их пример не работает.
Автор вопроса: Maxim
Ответ ожидается по этому адресу
Что такое: Item, Trim, Replace, Space??
Для чего это, что они делают??
Автор вопроса: goodroman
Ответ ожидается по этому адресу
Привет, у меня несколько вопросов, касающихся Internet Transfer Controla: Программа качает файл по адресу Text1.Text в директорию Text2.text
Вот привожу код, вопросы после него:
Private Sub Command1_Click()
Inet1.Execute Text1.Text, "GET"
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim FUCK() As Byte
Dim NOF As Long
If State = 12 Then
NOF = FreeFile
Open Text2.Text For Binary Access Write As NOF
FUCK = Inet1.GetChunk(1024, icByteArray)
Do While LenB(CStr(FUCK)) > 0
Put NOF, , FUCK
FUCK = Inet1.GetChunk(1024, icByteArray)
Loop
Close NOF
MsgBox "OK"
End If
End Sub
1) почему, переменная FUCK объявляется как массив, хотя в коде программы массивом и не пахнет? Хотя если объявить просто объявить переменную (без () ), то программа не работает.
2) Как связано с нулём вот это выражение LenB(CStr(FUCK)) , ну то есть я понимаю, что оно делает и понимаю зачем, но как все эти преобразования связаны с файлом?
Ответы:
Вопрос:
Не подскажите,как из VB6 запустить программу(игру). Например у меня есть форма с кнопкой OK, я нажимаю и должна запуститься игрушка. Как прописать директорию, точнее как установить связь.
Ответ:
Автор ответа: Алексей Щербаков
Попробуй написать так Shell "файл", флаг посмотришь вроде vbNormalFocus.
Вопрос:
Как с помощью VB узнать подключен ты к сети, например Интернету?
Ответ:
Автор ответа: HoodWin
На сайте www.vbstreets.ru есть пример, который называется что - то вроде "inet timer", ну, вообщем, он ясно демонстрирует, как это узнать.
Вопрос:
Трижды вложенный цикл For по переменным i,j,k позволяет перебрать все возможные комбинации (i,j,k). А можно ли сделать для n-ого количества переменных. Может быть можно сделать это с помощью циклических ссылок на функцию, где описан один цикл For. Помогите очень нужно...
Ответ:
Автор ответа: P@Ssword
Private Sub Form_Click()
Dim Inds(0 To 2) As Long
Dim Pos As Long
Do
List1.AddItem Inds(2) & ":" & Inds(1) & ":" & Inds(0)
Pos = 0
Do
Inds(Pos) = Inds(Pos) + 1
If Inds(Pos) = 10 Then
Inds(Pos) = 0
Pos = Pos + 1
Else
Exit Do
End If
If Pos = 3 Then MsgBox "That's All!", vbInformation: Exit Sub
Loop
Loop
End Sub
Вопрос:
Как в VB передать данные по модему с одного компа на другой? Подскажите хотябы направление!
Ответ:
Автор ответа: HoodWin
Используй MS Winsock Control.
Вопрос:
Я хочу с удаленного компа, не зная системную папку винды (типо: c:\windows), скачть (из этой папки) файл (пусть будет win.ini).
Тако вот вопрос: Как определить системную папо4ку винды?
Ответ:
Автор ответа: HoodWin
Очень просто. Вот пример:
MsgBox Environ("WinDir")
Вопрос:
У меня два вопроса.
1. Как сделать так что бы кликать на файл из любого менеджера и что бы моя прога открыла его.
2. Нужен компонент или код что бы сделать красивое меню что - то вроде как программе Word.
Ответ:
Автор ответа: HoodWin
1. Можно ассоциировать определённый тип файла с твоей прогой. Вот пример с txt файлами:
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Const HKEY_CLASSES_ROOT = &H80000000
Const REG_SZ = 1
Const KEY_ALL_ACCESS = &H3F
Public Sub AsProgram(FileType As String)
Dim retval As Long
Dim Result As Long
Dim SA As SECURITY_ATTRIBUTES
Dim sPath As String
retval = RegCreateKeyEx(HKEY_CLASSES_ROOT, App.Title, 0, vbNullString, 0, KEY_ALL_ACCESS, SA, Result, &H1)
RegSetValueEx Result, "", 0, REG_SZ, ByVal App.Title, Len(App.Title)
retval = RegCreateKeyEx(HKEY_CLASSES_ROOT, FileType, 0, vbNullString, 0, KEY_ALL_ACCESS, SA, Result, &H1)
RegSetValueEx Result, "", 0, REG_SZ, ByVal App.Title, Len(App.Title)
If Right(App.Path, 1) = "\" Then
sPath = App.Path & App.EXEName & ".exe %1"
Else
sPath = App.Path & "\" & App.EXEName & ".exe %1"
End If
retval = RegCreateKeyEx(HKEY_CLASSES_ROOT, App.Title & "\shell\open\command", 0, vbNullString, 0, KEY_ALL_ACCESS, SA, Result, &H1)
RegSetValueEx Result, "", 0, REG_SZ, ByVal sPath, Len(sPath)
End Sub
Private Sub Command1_Click()
AsProgram ".txt"
End Sub
Только вот как узнать на какой именно файл кликнули?
2. Можно использовать компонент CoolBar из комплекта Microsoft Windows Common Controls-3 6.0 (sp5) (файл COMCT322.ocx)
Вопрос:
В Textе стоит математическое выражение, ну например text1="2+3". Можно ли его посчитать в переменной? А может кто знает, как в Микрософтском калькуляторе обрабатываются операторы сложения, умножения и т.д.?
Ответ:
Автор ответа: Matrix
1. Можно. Используй Left, Mid, Right. С помощью них отсей числа из text1, а потом делай с ними всё, что хочешь. Ну например, один из вариантов (это для двух чисел, для трех и более, а также если будут скобки код придется изменить):
Private strSign As String
Private Number1, Number2, Result
Private Sub Command1_Click()
For a = 1 To Len(Text1)
strSign = Mid(Text1.Text, a, 1)
If strSign = "+" Or strSign = "-" Or strSign = "/" Or strSign = "*" Then
Number1 = Val(Left(Text1, a - 1))
Number2 = Val(Right(Text1, Len(Text1) - a))
Select Case strSign
Case "+"
Result = Number1 + Number2
Case "-"
Result = Number1 - Number2
Case "/"
Result = Number1 / Number2
Case "*"
Result = Number1 * Number2
End Select
Exit Sub
End If
Next
End Sub
2.
Что значит обрабаьываются? Алгоритм тебя интересует или что? Как конкретно в Майкрософтовском не знаю, с другой стороны написан он наверняка на языке высокого уровня, который уже отвергает написание таких процедур как сложить, умножить, в ЯВУ эти функции уже есть.
А если тебя интересует стандартный алгоритм на низком уровне, то:
123+456= 123
+456
---
579
То есть все операции решаются путем сложения, умножения и т.д. чисел столбиком, как нас еще учили в начальных классах. Ессесно сначала машине сказали как посчитать, 1+1, 1+2 , 2-1, ... проверка на ноль при делении и т.д.
С помощью АСМа это всё предельно просто inc число, dec число, но это
уже другая песня
Вопрос:
Срочно необходимо сделать, чтобы при нажатии определенной комбинации клавиш при неактивном приложении, выполнялась заданая процедура.
Ответ:
Автор ответа: Артем Кривокрисенко
Используй АПИшку RegisterHotKey. Но при этом прийдется субклассить окно и ловить WM_HOTKEY.
Вопрос:
Как открыть дверцу Cd-Rom програмно?
Ответ:
Автор ответа: Sergey
Легко!
Public Declare Function GetVersion Lib "kernel32" () As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA"
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal
dwShareMode As Long, lpSecurityAttributes As Any, ByVal
dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal
hTemplateFile As Long) As Long
Public Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As
Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal
nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long,
lpBytesReturned As Long, lpOverlapped As Any) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As
Long) As Long
Public Const INVALID_HANDLE_VALUE = -1
Public Const OPEN_EXISTING = 3
Public Const FILE_FLAG_DELETE_ON_CLOSE = 67108864
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const IOCTL_STORAGE_EJECT_MEDIA = 2967560
Public Const VWIN32_DIOC_DOS_IOCTL = 1
Public Type DIOC_REGISTERS
reg_EBX As Long
reg_EDX As Long
reg_ECX As Long
reg_EAX As Long
reg_EDI As Long
reg_ESI As Long
reg_Flags As Long
End Type
**********************
Sub CD()
Dim hDrive As Long, DummyReturnedBytes As Long
Dim EjectDrive As String, DriveLetterAndColon As String
Dim RawStuff As DIOC_REGISTERS
EjectDrive = ("E:")
If Len(EjectDrive) Then
DriveLetterAndColon = UCase(Left$(EjectDrive & ":", 2))
If GetVersion >= 0 Then
hDrive = CreateFile("\\.\" & DriveLetterAndColon,
GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
If hDrive <> INVALID_HANDLE_VALUE Then
Call DeviceIoControl(hDrive, IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0,
0, DummyReturnedBytes, ByVal 0)
Call CloseHandle(hDrive)
End If
Else
hDrive = CreateFile("\\.\VWIN32", 0, 0, ByVal 0, 0,
FILE_FLAG_DELETE_ON_CLOSE, 0)
If hDrive <> INVALID_HANDLE_VALUE Then
RawStuff.reg_EAX = &H440D
RawStuff.reg_EBX = Asc(DriveLetterAndColon) - Asc("A") + 1
RawStuff.reg_ECX = &H49 Or &H800
Call DeviceIoControl(hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff,
LenB(RawStuff), RawStuff, LenB(RawStuff), DummyReturnedBytes, ByVal 0)
Call CloseHandle(hDrive)
End If
End If
End If
End Sub
Ответ:
Автор ответа: ShAdE
Ну сколько можно об одном и том же?
Ты знаешь что на www.Subscribe.ru хранится весь архив рассылки начиная с первого номера?!
берешь ReGet, тратишь пятнадцать минут на то чтоб создать список для закачки и после этого у тебя на компе будет весь курс начальной военой подготовки по ВБ в кратком изложении! ;-)
Комментарий автора: на http://vbnet.ru/subscribe лежит архив этой расылки в формате chm и в формате html.
Ответ:
Автор ответа: KAS (c)
Контролом MultiMediaControl:
MMC.Command="Eject"
Ответ:
Автор ответа: UPS!!!
Чтобы побаловаться с CD-ROM-ом используется функция mciSendString из библиотеки winmm.dll
В модуле
Public Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
На форме поставте две кнопки.
Private Sub Command1_Click()
Call mciSendString("Set CDAudio Door Open Wait", 0&, 0&, 0&)
End Sub
Private Sub Command2_Click()
Call mciSendString("Set CDAudio Door Closed Wait", 0&, 0&, 0&)
End Sub
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.
наверх
|
Переход на VB .NET. Стратегии, концепции, код (цена ~ 158 руб.) Эта книга была задумана как одна из первых книг о .NET, которая ознакомит читателя с основными идеями новой архитектуры и подготовит его к знакомству с более детальной литературой, например документацией Microsoft и ее толкованиями, которая неизбежно появится на рынке. Она поможет вам взглянуть на эту технологию с позиций ваших собственных рабочих планов и быстро освоить те концепции, которые покажутся необычными для большинства прогр... |
||
|
Автор(ы): Дан Эпплман, Издательство: Питер, 2002 г.
|
|||
|
Программирование на VB.NET. Учебный курс (цена ~ 119 руб.)
Эта книга является вводным курсом по
изучению языка программирования Visual Basic .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 можно найти здесь.
наверх
Римские цифры
Автор кода: Игорь
К сожалению, некоторые цифры общепринято видеть римскими, например, век не 21 а XXI.В Excel есть функция, выполняющая преобразование арабских цифр в римские, но ради 2 - 3 цифр подключать к проекту довольно большую библиотеку не стоит. Поборовши лень (частично) написал преобразование цифр до 50. На практике этого более чем достаточно, а кому мало, может сам дописать. С основными шрифтами получается неплохо.
Function RimDigital(intN As Integer) As String
Select Case intN
Case 1: RimDigital = "I"
Case 2: RimDigital = "II"
Case 3: RimDigital = "III"
Case 4: RimDigital = "IV"
Case 5: RimDigital = "V"
Case 6: RimDigital = "VI"
Case 7: RimDigital = "VII"
Case 8: RimDigital = "VIII"
Case 9: RimDigital = "IX"
Case 10: RimDigital = "X"
Case 11: RimDigital = "XI"
Case 12: RimDigital = "XII"
Case 13: RimDigital = "XIII"
Case 14: RimDigital = "XIV"
Case 15: RimDigital = "XV"
Case 16: RimDigital = "XVI"
Case 17: RimDigital = "XVII"
Case 18: RimDigital = "XVIII"
Case 19: RimDigital = "XIX"
Case 20: RimDigital = "XX"
Case 21: RimDigital = "XXI"
Case 22: RimDigital = "XXII"
Case 23: RimDigital = "XXIII"
Case 24: RimDigital = "XXIV"
Case 25: RimDigital = "XXV"
Case 26: RimDigital = "XXVI"
Case 27: RimDigital = "XXVII"
Case 28: RimDigital = "XXVIII"
Case 29: RimDigital = "XXIX"
Case 30: RimDigital = "XXX"
Case 31: RimDigital = "XXXI"
Case 32: RimDigital = "XXXII"
Case 33: RimDigital = "XXXIII"
Case 34: RimDigital = "XXXIV"
Case 35: RimDigital = "XXXV"
Case 36: RimDigital = "XXXVI"
Case 37: RimDigital = "XXXVII"
Case 38: RimDigital = "XXXVIII"
Case 39: RimDigital = "XXXIX"
Case 40: RimDigital = "XL"
Case 41: RimDigital = "XLI"
Case 42: RimDigital = "XLII"
Case 43: RimDigital = "XLIII"
Case 44: RimDigital = "XLIV"
Case 45: RimDigital = "XLV"
Case 46: RimDigital = "XLVI"
Case 47: RimDigital = "XLVII"
Case 48: RimDigital = "XLVIII"
Case 49: RimDigital = "XLIX"
Case 50: RimDigital = "L"
Case Else: RimDigital = intN
End Select
End Function
наверх
Глобальное изменение размеров формы/контролов
Отличный и бесподобный пример, автору которого надо выдавать приз за один из отличнейших примеров. К сожалению, я не знаю ни имени автора, ни сайта, разместившего в первоисточнике этот пример. Что делает пример? Ни много, ни мало, а код в зависимости от изменения размеров формы, меняет размеры всех контролов, расположенных на этой форме!!! Вам надо добавить на форму 2 элемента CommanButton и дополнительный модуль в программу. Запустите программу и попробуйте изменять размеры формы. Впечатляет? В любой момент нажмите на кнопку 1, измените размеры формы и нажмите на кнопку 2. Впечатляет?!?
'КОД ФОРМЫ
Private Sub Command1_Click()
SaveFormPosition Me
End Sub
Private Sub Command2_Click()
RestoreFormPosition Me
End Sub
Private Sub Form_Resize()
ResizeForm Me
End Sub
'КОД МОДУЛЯ
Option Explicit
Type ctrObj
Name As String
Index As Long
Parrent As String
Top As Long
Left As Long
Height As Long
Width As Long
ScaleHeight As Long
ScaleWidth As Long
End Type
Private FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private MaxForm As Long
Private MaxControl As Long
Private Function ActualPos(plLeft As Long) As Long
If plLeft < 0 Then ActualPos = plLeft + 75000 Else ActualPos = plLeft
End Function
Private Function FindForm(pfrmIn As Form) As Long
Dim i As Long
FindForm = -1
If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then FindForm = i: Exit Function
Next i
End If
End Function
Private Function AddForm(pfrmIn As Form) As Long
Dim FormControl As Control
Dim i As Long
ReDim Preserve FormRecord(MaxForm + 1)
FormRecord(MaxForm).Name = pfrmIn.Name
FormRecord(MaxForm).Top = pfrmIn.Top
FormRecord(MaxForm).Left = pfrmIn.Left
FormRecord(MaxForm).Height = pfrmIn.Height
FormRecord(MaxForm).Width = pfrmIn.Width
FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight
FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
AddForm = MaxForm
MaxForm = MaxForm + 1
For Each FormControl In pfrmIn
i = FindControl(FormControl, pfrmIn.Name)
If i < 0 Then i = AddControl(FormControl, pfrmIn.Name)
Next FormControl
End Function
Private Function FindControl(inControl As Control, inName As String) As Long
Dim i As Long
FindControl = -1
For i = 0 To (MaxControl - 1)
If ControlRecord(i).Parrent = inName Then
If ControlRecord(i).Name = inControl.Name Then
On Error Resume Next
If ControlRecord(i).Index = inControl.Index Then
FindControl = i
Exit Function
End If
On Error GoTo 0
End If
End If
Next i
End Function
Private Function AddControl(inControl As Control, inName As String) As Long
ReDim Preserve ControlRecord(MaxControl + 1)
On Error Resume Next
ControlRecord(MaxControl).Name = inControl.Name
ControlRecord(MaxControl).Index = inControl.Index
ControlRecord(MaxControl).Parrent = inName
If TypeOf inControl Is Line Then
ControlRecord(MaxControl).Top = inControl.Y1
ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
ControlRecord(MaxControl).Height = inControl.Y2
ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
Else
ControlRecord(MaxControl).Top = inControl.Top
ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
ControlRecord(MaxControl).Height = inControl.Height
ControlRecord(MaxControl).Width = inControl.Width
End If
On Error GoTo 0
AddControl = MaxControl
MaxControl = MaxControl + 1
End Function
Private Function PerWidth(pfrmIn As Form) As Long
Dim i As Long
i = FindForm(pfrmIn)
If i < 0 Then i = AddForm(pfrmIn)
PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth
End Function
Private Function PerHeight(pfrmIn As Form) As Single
Dim i As Long
i = FindForm(pfrmIn)
If i < 0 Then i = AddForm(pfrmIn)
PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight
End Function
Private Sub ResizeControl(inControl As Control, pfrmIn As Form)
Dim i As Long
Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
yRatio = PerHeight(pfrmIn)
xRatio = PerWidth(pfrmIn)
i = FindControl(inControl, pfrmIn.Name)
On Error GoTo Moveit
If inControl.Left < 0 Then
lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If
lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)
'
Moveit:
On Error GoTo MoveError1
If TypeOf inControl Is Line Then
If inControl.X1 < 0 Then
inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If
inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)
If inControl.X2 < 0 Then
inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
Else
inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
End If
inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
Else
If TypeOf inControl Is Timer Then GoTo subExit
inControl.Move lLeft, lTop, lWidth, lHeight
End If
GoTo subExit
'
MoveError1:
On Error GoTo MoveError2
inControl.Move lLeft, lTop, lWidth
GoTo subExit
'
MoveError2:
On Error GoTo subExit
inControl.Move lLeft, lTop
'
subExit:
On Error GoTo 0
End Sub
Public Sub ResizeForm(pfrmIn As Form)
Dim FormControl As Control
Dim isVisible As Boolean
If pfrmIn.Top < 30000 Then
isVisible = pfrmIn.Visible
pfrmIn.Visible = False
For Each FormControl In pfrmIn
ResizeControl FormControl, pfrmIn
Next FormControl
pfrmIn.Visible = isVisible
End If
End Sub
Public Sub SaveFormPosition(pfrmIn As Form)
Dim i As Long
If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then
FormRecord(i).Top = pfrmIn.Top
FormRecord(i).Left = pfrmIn.Left
FormRecord(i).Height = pfrmIn.Height
FormRecord(i).Width = pfrmIn.Width
Exit Sub
End If
Next i
AddForm (pfrmIn)
End If
End Sub
Public Sub RestoreFormPosition(pfrmIn As Form)
Dim i As Long
If MaxForm > 0 Then
For i = 0 To (MaxForm - 1)
If FormRecord(i).Name = pfrmIn.Name Then
If FormRecord(i).Top < 0 Then
pfrmIn.WindowState = 2
ElseIf FormRecord(i).Top < 30000 Then
pfrmIn.WindowState = 0
pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top
pfrmIn.Width = FormRecord(i).Width
pfrmIn.Height = FormRecord(i).Height
Else
pfrmIn.WindowState = 1
End If
Exit Sub
End If
Next i
End If
End Sub
наверх
Получение анимированного курсора
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const GCL_HCURSOR = (-12)
Dim sCursorFile As String
Dim hCursor As Long
Dim hOldCursor As Long
Dim lReturn As Long
Private Sub Command1_Click()
hCursor = LoadCursorFromFile(sCursorFile)
hOldCursor = SetClassLong(Form1.hwnd, GCL_HCURSOR, hCursor)
End Sub
Private Sub Command2_Click()
lReturn = SetClassLong(Form1.hwnd, GCL_HCURSOR, hOldCursor)
End Sub
Private Sub Form_Load()
'не забудьте указать свой путь к анимированному курсору
sCursorFile = "C:\WIN\CURSORS\GLOBE.ANI"
End Sub
наверх
ListBox: Проверка дубликатности элементов списка
Иногда перед добавлением нового элемента требуется проверить, нет ли уже такой строчки...
Private Declare Function SendMessageByString Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Sub Command1_Click()
If SendMessageByString(List1.hWnd, &H1A2, -1, Text1.Text) = -1 Then
List1.AddItem Text1.Text
Else
MsgBox Text1.Text & "- такой элемент уже есть в списке"
End If
'www.relib.com
End Sub
наверх
CommonDialog: Просмотр списка директорий без использования контрола Common Dialog
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Function FolderDialogShow()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
zTitle = "Select Folder"
With tBrowseInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
FolderDialogShow = sBuffer
End If
End Function
Private Sub Command1_Click()
Text1 = FolderDialogShow
End Sub
наверх
Мои программы
BalloonMessage for MS Agent
BalloonMessage for Microsoft Agent реализует диалог программы с
пользователем, используя при этом технологию Microsoft Agent. OCX реализует три
типа диалоговых окон: InputBox, MsgBox и MsgLabels.
Автора: Шатрыкин Иван и Павел Сурменок.
наверх
Вопрос/Ответ
Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.
Вопросы:Автор вопроса: Alex
Ответ ожидается по этому адресу
Как в программе на VB проигрывать музыкальные файлы в фоновом режиме?
Автор вопроса: afb
Ответ ожидается по этому адресу
1. Не могу установить ссылку на Microsoft Scripting Runtime(FileSystemObject). Хотя scrrun.dll лежит, пробовал вручную, тоже самое - пишет - "C:\WINDOWS\SYSTEM\SCRRUN.DLL не может загрузится", и в тоже время заносит его в "Сomponents| Управление".
2. Как обращаться к Temporary Internet Files, а точнее как его удалить(чистить)? Т.к FileSystemObject не удалось использовать, делал так-
On Error GoTo 2
Shell "DelTree /Y " + wd + "\TEMPOR~1\CONTENT.IE5", vbHide
GoTo 3
2 MsgBox "Ошибка удаления или отказ в доступе"
3
в последствии некоторая часть файлов удаляется и в списке процессов остаётся "Winoldap", возможно нужен подходящий ключ для DelTree, перепробовал все.
Буду рад любым советам.
Автор вопроса: Арбит Семен Владимирович
Ответ ожидается по этому адресу
Нуждаюсь в вашей помощи, самостоятельно решить вопрос не получается
Задача: Win9x, Win2K, WinXP; VBA, VB6.0 VB5.0
1.Есть бинарный файл-функция с входящими параметрами (это может быть и исполняемый файл exe или com), написанный на Ассемблере.
2.Этот файл загружается не с диска, а из массива программы на VB (VBA) в памать по выделенному адресу.
3.Этот файл надо запустить на исполнение из программы на VB причем передав ему параметры (как при запуске с диска из командной строки)
4.Определить ID процесса выполнения этого файла чтобы отследить момент завершения его работы и продолжить выполнение программы на VB
ПРОБЛЕМА с осуществлением пункта 3 и определением ID запущенного процесса. На сайте Olovyannikov + VB что-то не высмотрел нмчего(может слаб глазами стал...). Эта ссылка была дана в эхе ФИДО Дмитрием Милосердовым от 16.04.2003
Ответ прошу выслать на мой e-mail: arbit@barhan.poltava.ua
Автор вопроса: sla_237
Ответ ожидается по этому адресу
Подскажите пожалуйста, как мне получить телефон текущего (уже установленого) dial up соединения с интернетом? Если можно, кусочек кода.
Автор вопроса: Taras Prikhodko
Ответ ожидается по этому адресу
Как сделать, чтобы после первого запуска программа в дальнейшем запускалась автоматически?
Автор вопроса: Uncle Tom
Ответ ожидается по этому адресу
Как открыть файл exe из своей проги?
Автор вопроса: Виталик
Ответ ожидается по этому адресу
Как послать файл по E-mail (без Outlook). Среда VB 6.
Автор вопроса: Владимир
Ответ ожидается по этому адресу
Есть некая прога, отправляющая почту в автоматическом режиме. Как на VB перехватывать содержание писем для ведения архива корреспонденции?
Автор вопроса: Данила
Ответ ожидается по этому адресу
В Access есть возможность разграничения доступа к различным таблицам с помощью имени и пароля. Есть база с такой штукой. Как теперь в VB воспользоваться этими паролями? В книге написано, что пароль задается при инициализации рабочего места, но их пример не работает.
Автор вопроса: Maxim
Ответ ожидается по этому адресу
Что такое: Item, Trim, Replace, Space??
Для чего это, что они делают??
Автор вопроса: goodroman
Ответ ожидается по этому адресу
Привет, у меня несколько вопросов, касающихся Internet Transfer Controla: Программа качает файл по адресу Text1.Text в директорию Text2.text
Вот привожу код, вопросы после него:
Private Sub Command1_Click()
Inet1.Execute Text1.Text, "GET"
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim FUCK() As Byte
Dim NOF As Long
If State = 12 Then
NOF = FreeFile
Open Text2.Text For Binary Access Write As NOF
FUCK = Inet1.GetChunk(1024, icByteArray)
Do While LenB(CStr(FUCK)) > 0
Put NOF, , FUCK
FUCK = Inet1.GetChunk(1024, icByteArray)
Loop
Close NOF
MsgBox "OK"
End If
End Sub
1) почему, переменная FUCK объявляется как массив, хотя в коде программы массивом и не пахнет? Хотя если объявить просто объявить переменную (без () ), то программа не работает.
2) Как связано с нулём вот это выражение LenB(CStr(FUCK)) , ну то есть я понимаю, что оно делает и понимаю зачем, но как все эти преобразования связаны с файлом?
Ответы:
Вопрос:
Не подскажите,как из VB6 запустить программу(игру). Например у меня есть форма с кнопкой OK, я нажимаю и должна запуститься игрушка. Как прописать директорию, точнее как установить связь.
Ответ:
Автор ответа: Алексей Щербаков
Попробуй написать так Shell "файл", флаг посмотришь вроде vbNormalFocus.
Вопрос:
Как с помощью VB узнать подключен ты к сети, например Интернету?
Ответ:
Автор ответа: HoodWin
На сайте www.vbstreets.ru есть пример, который называется что - то вроде "inet timer", ну, вообщем, он ясно демонстрирует, как это узнать.
Вопрос:
Трижды вложенный цикл For по переменным i,j,k позволяет перебрать все возможные комбинации (i,j,k). А можно ли сделать для n-ого количества переменных. Может быть можно сделать это с помощью циклических ссылок на функцию, где описан один цикл For. Помогите очень нужно...
Ответ:
Автор ответа: P@Ssword
Private Sub Form_Click()
Dim Inds(0 To 2) As Long
Dim Pos As Long
Do
List1.AddItem Inds(2) & ":" & Inds(1) & ":" & Inds(0)
Pos = 0
Do
Inds(Pos) = Inds(Pos) + 1
If Inds(Pos) = 10 Then
Inds(Pos) = 0
Pos = Pos + 1
Else
Exit Do
End If
If Pos = 3 Then MsgBox "That's All!", vbInformation: Exit Sub
Loop
Loop
End Sub
Вопрос:
Как в VB передать данные по модему с одного компа на другой? Подскажите хотябы направление!
Ответ:
Автор ответа: HoodWin
Используй MS Winsock Control.
Вопрос:
Я хочу с удаленного компа, не зная системную папку винды (типо: c:\windows), скачть (из этой папки) файл (пусть будет win.ini).
Тако вот вопрос: Как определить системную папо4ку винды?
Ответ:
Автор ответа: HoodWin
Очень просто. Вот пример:
MsgBox Environ("WinDir")
Вопрос:
У меня два вопроса.
1. Как сделать так что бы кликать на файл из любого менеджера и что бы моя прога открыла его.
2. Нужен компонент или код что бы сделать красивое меню что - то вроде как программе Word.
Ответ:
Автор ответа: HoodWin
1. Можно ассоциировать определённый тип файла с твоей прогой. Вот пример с txt файлами:
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Const HKEY_CLASSES_ROOT = &H80000000
Const REG_SZ = 1
Const KEY_ALL_ACCESS = &H3F
Public Sub AsProgram(FileType As String)
Dim retval As Long
Dim Result As Long
Dim SA As SECURITY_ATTRIBUTES
Dim sPath As String
retval = RegCreateKeyEx(HKEY_CLASSES_ROOT, App.Title, 0, vbNullString, 0, KEY_ALL_ACCESS, SA, Result, &H1)
RegSetValueEx Result, "", 0, REG_SZ, ByVal App.Title, Len(App.Title)
retval = RegCreateKeyEx(HKEY_CLASSES_ROOT, FileType, 0, vbNullString, 0, KEY_ALL_ACCESS, SA, Result, &H1)
RegSetValueEx Result, "", 0, REG_SZ, ByVal App.Title, Len(App.Title)
If Right(App.Path, 1) = "\" Then
sPath = App.Path & App.EXEName & ".exe %1"
Else
sPath = App.Path & "\" & App.EXEName & ".exe %1"
End If
retval = RegCreateKeyEx(HKEY_CLASSES_ROOT, App.Title & "\shell\open\command", 0, vbNullString, 0, KEY_ALL_ACCESS, SA, Result, &H1)
RegSetValueEx Result, "", 0, REG_SZ, ByVal sPath, Len(sPath)
End Sub
Private Sub Command1_Click()
AsProgram ".txt"
End Sub
Только вот как узнать на какой именно файл кликнули?
2. Можно использовать компонент CoolBar из комплекта Microsoft Windows Common Controls-3 6.0 (sp5) (файл COMCT322.ocx)
Вопрос:
В Textе стоит математическое выражение, ну например text1="2+3". Можно ли его посчитать в переменной? А может кто знает, как в Микрософтском калькуляторе обрабатываются операторы сложения, умножения и т.д.?
Ответ:
Автор ответа: Matrix
1. Можно. Используй Left, Mid, Right. С помощью них отсей числа из text1, а потом делай с ними всё, что хочешь. Ну например, один из вариантов (это для двух чисел, для трех и более, а также если будут скобки код придется изменить):
Private strSign As String
Private Number1, Number2, Result
Private Sub Command1_Click()
For a = 1 To Len(Text1)
strSign = Mid(Text1.Text, a, 1)
If strSign = "+" Or strSign = "-" Or strSign = "/" Or strSign = "*" Then
Number1 = Val(Left(Text1, a - 1))
Number2 = Val(Right(Text1, Len(Text1) - a))
Select Case strSign
Case "+"
Result = Number1 + Number2
Case "-"
Result = Number1 - Number2
Case "/"
Result = Number1 / Number2
Case "*"
Result = Number1 * Number2
End Select
Exit Sub
End If
Next
End Sub
2.
Что значит обрабаьываются? Алгоритм тебя интересует или что? Как конкретно в Майкрософтовском не знаю, с другой стороны написан он наверняка на языке высокого уровня, который уже отвергает написание таких процедур как сложить, умножить, в ЯВУ эти функции уже есть.
А если тебя интересует стандартный алгоритм на низком уровне, то:
123+456= 123
+456
---
579
То есть все операции решаются путем сложения, умножения и т.д. чисел столбиком, как нас еще учили в начальных классах. Ессесно сначала машине сказали как посчитать, 1+1, 1+2 , 2-1, ... проверка на ноль при делении и т.д.
С помощью АСМа это всё предельно просто inc число, dec число, но это
уже другая песня
Вопрос:
Срочно необходимо сделать, чтобы при нажатии определенной комбинации клавиш при неактивном приложении, выполнялась заданая процедура.
Ответ:
Автор ответа: Артем Кривокрисенко
Используй АПИшку RegisterHotKey. Но при этом прийдется субклассить окно и ловить WM_HOTKEY.
Вопрос:
Как открыть дверцу Cd-Rom програмно?
Ответ:
Автор ответа: Sergey
Легко!
Public Declare Function GetVersion Lib "kernel32" () As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA"
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal
dwShareMode As Long, lpSecurityAttributes As Any, ByVal
dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal
hTemplateFile As Long) As Long
Public Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As
Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal
nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long,
lpBytesReturned As Long, lpOverlapped As Any) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As
Long) As Long
Public Const INVALID_HANDLE_VALUE = -1
Public Const OPEN_EXISTING = 3
Public Const FILE_FLAG_DELETE_ON_CLOSE = 67108864
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const IOCTL_STORAGE_EJECT_MEDIA = 2967560
Public Const VWIN32_DIOC_DOS_IOCTL = 1
Public Type DIOC_REGISTERS
reg_EBX As Long
reg_EDX As Long
reg_ECX As Long
reg_EAX As Long
reg_EDI As Long
reg_ESI As Long
reg_Flags As Long
End Type
**********************
Sub CD()
Dim hDrive As Long, DummyReturnedBytes As Long
Dim EjectDrive As String, DriveLetterAndColon As String
Dim RawStuff As DIOC_REGISTERS
EjectDrive = ("E:")
If Len(EjectDrive) Then
DriveLetterAndColon = UCase(Left$(EjectDrive & ":", 2))
If GetVersion >= 0 Then
hDrive = CreateFile("\\.\" & DriveLetterAndColon,
GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
If hDrive <> INVALID_HANDLE_VALUE Then
Call DeviceIoControl(hDrive, IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0,
0, DummyReturnedBytes, ByVal 0)
Call CloseHandle(hDrive)
End If
Else
hDrive = CreateFile("\\.\VWIN32", 0, 0, ByVal 0, 0,
FILE_FLAG_DELETE_ON_CLOSE, 0)
If hDrive <> INVALID_HANDLE_VALUE Then
RawStuff.reg_EAX = &H440D
RawStuff.reg_EBX = Asc(DriveLetterAndColon) - Asc("A") + 1
RawStuff.reg_ECX = &H49 Or &H800
Call DeviceIoControl(hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff,
LenB(RawStuff), RawStuff, LenB(RawStuff), DummyReturnedBytes, ByVal 0)
Call CloseHandle(hDrive)
End If
End If
End If
End Sub
Ответ:
Автор ответа: ShAdE
Ну сколько можно об одном и том же?
Ты знаешь что на www.Subscribe.ru хранится весь архив рассылки начиная с первого номера?!
берешь ReGet, тратишь пятнадцать минут на то чтоб создать список для закачки и после этого у тебя на компе будет весь курс начальной военой подготовки по ВБ в кратком изложении! ;-)
Комментарий автора: на http://vbnet.ru/subscribe лежит архив этой расылки в формате chm и в формате html.
Ответ:
Автор ответа: KAS (c)
Контролом MultiMediaControl:
MMC.Command="Eject"
Ответ:
Автор ответа: UPS!!!
Чтобы побаловаться с CD-ROM-ом используется функция mciSendString из библиотеки winmm.dll
В модуле
Public Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
На форме поставте две кнопки.
Private Sub Command1_Click()
Call mciSendString("Set CDAudio Door Open Wait", 0&, 0&, 0&)
End Sub
Private Sub Command2_Click()
Call mciSendString("Set CDAudio Door Closed Wait", 0&, 0&, 0&)
End Sub
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.