Голосование:
Ваш голос отсылается по E-mail владельцу сайта, после чего голоса анализируются и на отдельной странице выводятся результаты.
Нет тем.
Доска почёта:
Sergey Y. Tkachev
Кононенко Роман
Kirill
Ссылки:
Несколько слов от автора:
Новый выпуск...
Читайте!
Читайте!
Содержание выпуска
- Книги
- Как воспроизвести звук и видео
- Получить информацию из тэга MP3-файла
- Как изменить разрешение экрана
- Функции для работы с джойстиком
- Пример создания базы данных кодом
- Сохранение файла в БД и получение его обратно из БД
- Вопрос/Ответ
Книги
Остальные книги о VB можно найти здесь.
наверх
Как воспроизвести звук и видео
'Вариант 1
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Private Sub Form_Click()
Dim res
res = mciExecute("Play C:\Путь_до_файла")
End Sub
'Вообще, для того, что бы воспроизвести аудио или видео файл, можно воспользоваться элементом управления Microsoft Multimedia Control, но при этом вместе с вашим приложением придется таскать файл MCI32.OCX, а это лишних 193 кб, приведенный же выше код гораздо меньше. Прим. все вышесказанное касается только тех случаев, когда вам необходимо просто проиграть какой-то звуковой файл из программы.
'Вариант 2
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Sub Form_Load()
Dim x As Long
x = PlaySound("C:\Путь_до_файла", 0, &H1 Or &H10)
End Sub
'Вариант 3
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Sub Form_Load()
Dim x As Long
x = sndPlaySound("C:\Путь_до_файла", &H1 Or &H10)
End Sub
наверх
Получить информацию из тэга MP3-файла
Private Sub Form_Load()
Dim fNum As Integer
Dim sTagIdent As String * 3
Dim sTitle As String * 30
Dim sArtist As String * 30
Dim sAlbum As String * 30
Dim sYear As String * 4
Dim sComment As String * 30
fNum = FreeFile
'Замените ярлык 'c:\MySong.mp3' любым вашим файлом.
Open "c:\MySong.mp3" For Binary As fNum
Seek #fNum, LOF(fNum) - 127
Get #fNum, , sTagIdent
If sTagIdent = "TAG" Then
Get #fNum, , sTitle
Get #fNum, , sArtist
Get #fNum, , sAlbum
Get #fNum, , sYear
Get #fNum, , sComment
End If
Close #fNum
MsgBox sTitle & "," & sArtist & "," & sAlbum & "," & sYear & "," & sComment
End Sub
наверх
Как изменить разрешение экрана
Вызов функции: ChangeResolution 640, 480 (В данном случае меняется разрешение экрана на 640*480)
Вы должны понимать, что ваш монитор должен поддерживать задаваемое разрешение
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CCFORMNAME = 32
Const CCDEVICENAME = 32
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public Sub ChangeResolution(iWidth As Single, iHeight As Single)
Dim DevM As DEVMODE
Dim a As Boolean
Dim i As Long
Dim b As Long
i = 0
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight
b = ChangeDisplaySettings(DevM, 0)
End Sub
Private Sub Command1_Click()
ChangeResolution 640, 480
End Sub
наверх
Функции для работы с джойстиком
В частности, этот пример покажет, есть ли у вас джойстик (1) или нет (0). Расположите на форме элемент CommandButton.
Const JOY_BUTTON1 = &H1
Const JOY_BUTTON2 = &H2
Const JOY_BUTTON3 = &H4
Const JOY_BUTTON4 = &H8
Private Type JOYINFO
X As Long
Y As Long
Z As Long
Buttons As Long
End Type
Private Const JOYERR_BASE = 160
Private Const JOYERR_NOERROR = (0)
Private Const JOYERR_NOCANDO = (JOYERR_BASE + 6)
Private Const JOYERR_PARMS = (JOYERR_BASE + 5)
Private Const JOYERR_UNPLUGGED = (JOYERR_BASE + 7)
Private Const MAXPNAMELEN = 32
Private Type JOYCAPS
wMid As Integer
wPid As Integer
szPname As String * MAXPNAMELEN
wXmin As Long
wXmax As Long
wYmin As Long
wYmax As Long
wZmin As Long
wZmax As Long
wNumButtons As Long
wPeriodMin As Long
wPeriodMax As Long
End Type
Private Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As JOYCAPS, ByVal uSize As Long) As Long
Private Declare Function joyGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function joyGetPos Lib "winmm.dll" (ByVal uJoyID As Long, pji As JOYINFO) As Long
Private Function GetJoyMin(ByVal joy As Integer, ji As JOYINFO) As Boolean
Dim jc As JOYCAPS
If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
GetJoyMin = False
Else
ji.X = jc.wXmin
ji.Y = jc.wYmin
ji.Z = jc.wZmin
ji.Buttons = jc.wNumButtons
GetJoyMin = True
End If
End Function
Private Function GetJoyMax(ByVal joy As Integer, ji As JOYINFO) As Boolean
Dim jc As JOYCAPS
If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
GetJoyMax = False
Else
ji.X = jc.wXmax
ji.Y = jc.wYmax
ji.Z = jc.wZmax
ji.Buttons = jc.wNumButtons
GetJoyMax = True
End If
End Function
Private Function GetJoystick(ByVal joy As Integer, ji As JOYINFO) As Boolean
If joyGetPos(joy, ji) <> JOYERR_NOERROR Then
GetJoystick = False
Else
GetJoystick = True
End If
End Function
' If IsConnected is False then it returns the number of
' joysticks the driver supports. (But may not be connected)
' If IsConnected is True the it returns the number of
' joysticks present and connected.
' IsConnected is true by default.
Public Function IsJoyPresent(Optional IsConnected As Variant) As Long
Dim ic As Boolean
Dim i As Long
Dim j As Long
Dim ret As Long
Dim ji As JOYINFO
ic = IIf(IsMissing(IsConnected), True, CBool(IsConnected))
i = joyGetNumDevs
If ic Then
j = 0
Do While i > 0
i = i - 1 'Joysticks id's are 0 and 1
If joyGetPos(i, ji) = JOYERR_NOERROR Then
j = j + 1
End If
Loop
IsJoyPresent = j
Else
IsJoyPresent = i
End If
End Function
Private Sub Command1_Click()
MsgBox IsJoyPresent
End Sub
наверх
Пример создания базы данных кодом
Для начала вам необходимо подключить (меню Project->References) Microsoft DAO 2.5/3.51 Compatibility Library
Вставьте следующий код, запустите проект. Если вы еще не сохранили проект, то база создаться в папке, куда вы проинсталировали VB (по умолчанию - C:\Program Files\Microsoft Visual Studio\VB98).
Private Sub Form_Load()
Dim dbFile As String
' Проверяет наличие файла, имеющего имя, которое будет присвоено новой базе данных. Если есть такая база, то новая база не создается, если нет то вызывается функция и база создается.
If Dir(App.Path & "\kadrs.Mdb") <> "" Then
dbFile = App.Path & "\kadrs.Mdb"
Else:
dbFile = dbgreit()
End If
End Sub
Public Function dbgreit()
Dim dbkadr As Database, NewWs As Workspace 'Описание БД и рабочей области
Dim dbOpts As Long, dbName As String, tbWorker As TableDef
Dim tbFam As TableDef, Rel1 As Relation ' Описание таблицы и отношения
Dim Ind1, Ind2, Ind3, Ind4, Ind5 As Index'Описание индексов
Dim Fin, Fr, Fin2, Fin3, Fr2, Fin4, Fr3, Fin5, Fr4 As Field
Dim Fin6, Fr5, Fin7, Fr6, Fin8, Fr7, Frel As Field
Dim Ind9 As Index, Fs1, Fs2 As Field
ReDim F(1 To 54) As Field ' Описание полей табл. Worker
ReDim P(1 To 10) As Field ' Описание полей табл. Family
' Строковая переменная, указывающая на файл БД находящийся по тому же пути, что и файл программы.
dbName = App.Path & "\kadrs.Mdb"
Set NewWs = DBEngine.Workspaces(0)' Создание рабочей области
dbOpts = dbVersion35 + dnEncrypt ' Параметры БД - версия Jet-машины 3,5 и кодирование.
Set dbkadr = NewWs.CreateDatabase(dbName, dbLangCyrillic, dbOpts) ' Создание рускоязычной БД
' добавление таблицы с именем Worker в БД
Set tbWorker = dbkadr.CreateTableDef("Worker")
' добавление таблицы с именем Family в БД
Set tbFam = dbkadr.CreateTableDef("Family")
' Создание и описание счетчика с именем Код (табл. Worker)
Set Fin = tbWorker.CreateField("Код", dbLong) ' Создание поля в таблице с именем Код
Set Frel = tbWorker.CreateField("Number", dbLong) ' Создаем в таблице поле связи
Fin.Attributes = dbAutoIncrField ' Атрибуты поля - автоинкремент
tbWorker.Fields.Append Fin ' Добавляем поля в таблицу
tbWorker.Fields.Append Frel
' Первичный ключ таблицы Worker (индекс по полю Number)
Set Ind1 = tbWorker.CreateIndex("Number")
Ind1.Primary = True ' Устанавливаем свойство ключа - первичный ключ
Set Frel = Ind1.CreateField("Number", dbLong) ' Создаем индексное поле аналогичное полю связи из таблицы
Ind1.Fields.Append Frel ' Добавляем его к индексу
tbWorker.Indexes.Append Ind1 ' Добавляем индекс к таблице
' Описание остальных полей (табл. Worker)
Set F(1) = tbWorker.CreateField("Фамилия", dbText, 50) ' Создание текстового поля размером 50 символов
Set F(2) = tbWorker.CreateField("Имя", dbText, 50)
Set F(3) = tbWorker.CreateField("Отчество", dbText, 50)
Set F(4) = tbWorker.CreateField("Дата рождения", dbDate) ' Создание поля даты
Set F(5) = tbWorker.CreateField("Национальность", dbText, 50)
Set F(6) = tbWorker.CreateField("Должность", dbText, 150)
Set F(7) = tbWorker.CreateField("СемПоложение", dbText, 20)
Set F(8) = tbWorker.CreateField("Телефон", dbText, 15)
Set F(9) = tbWorker.CreateField("ДатаЗап", dbDate)
Set F(10) = tbWorker.CreateField("Образование", dbText, 90)
Set F(11) = tbWorker.CreateField("Телефон2", dbText, 15)
Set F(12) = tbWorker.CreateField("Профессия", dbText, 200)
Set F(13) = tbWorker.CreateField("Серия", dbText, 10)
Set F(14) = tbWorker.CreateField("Номер", dbText, 10)
Set F(15) = tbWorker.CreateField("Кем выдан", dbText, 200)
Set F(16) = tbWorker.CreateField("ДатаВыдачи", dbDate)
Set F(17) = tbWorker.CreateField("Место рождения", dbText, 250)
Set F(18) = tbWorker.CreateField("Индекс", dbText, 10)
Set F(19) = tbWorker.CreateField("Улица", dbText, 100)
Set F(20) = tbWorker.CreateField("Город", dbText, 100)
Set F(21) = tbWorker.CreateField("Область", dbText, 100)
Set F(22) = tbWorker.CreateField("Район", dbText, 100)
Set F(23) = tbWorker.CreateField("УчЗав", dbText, 200)
Set F(24) = tbWorker.CreateField("ДатаОк1", dbDate)
Set F(25) = tbWorker.CreateField("УчЗав2", dbText, 200)
Set F(26) = tbWorker.CreateField("ДатаОк2", dbDate)
Set F(27) = tbWorker.CreateField("СпецПоД", dbText, 200)
Set F(28) = tbWorker.CreateField("Квалификация", dbText, 200)
Set F(29) = tbWorker.CreateField("НомД", dbText, 50)
Set F(30) = tbWorker.CreateField("УчЗван", dbText, 200)
Set F(31) = tbWorker.CreateField("ОКОДТ", dbText, 10)
Set F(32) = tbWorker.CreateField("ОКСО", dbText, 10)
Set F(33) = tbWorker.CreateField("ГрУч", dbText, 30)
Set F(34) = tbWorker.CreateField("КатУч", dbText, 30)
Set F(35) = tbWorker.CreateField("Состав", dbText, 150)
Set F(36) = tbWorker.CreateField("Звание", dbText, 200)
Set F(37) = tbWorker.CreateField("ВУС", dbText, 50)
Set F(38) = tbWorker.CreateField("Годность", dbText, 100)
Set F(39) = tbWorker.CreateField("Военкомат", dbText, 200)
Set F(40) = tbWorker.CreateField("СпецУч", dbText, 50)
Set F(41) = tbWorker.CreateField("НомСтрах", dbText, 40)
Set F(42) = tbWorker.CreateField("Date1", dbDate)
Set F(43) = tbWorker.CreateField("Date2", dbDate)
Set F(44) = tbWorker.CreateField("Date3", dbDate)
Set F(45) = tbWorker.CreateField("Date4", dbDate)
Set F(46) = tbWorker.CreateField("Date5", dbDate)
Set F(47) = tbWorker.CreateField("Date6", dbDate)
Set F(48) = tbWorker.CreateField("Date7", dbDate)
Set F(49) = tbWorker.CreateField("Date8", dbDate)
Set F(50) = tbWorker.CreateField("Date9", dbDate)
Set F(51) = tbWorker.CreateField("Date10", dbDate)
Set F(52) = tbWorker.CreateField("Причина", dbText, 200)
Set F(53) = tbWorker.CreateField("Date11", dbDate)
Set F(54) = tbWorker.CreateField("Стат", dbText, 200)
' Создание индекса для сортировки по фамилиям и именам (по алфавиту)
Set Ind9 = tbWorker.CreateIndex("Name") ' Создание индекса с именем Name
Ind9.Unique = False ' Индекс не уникальный - значения могут повторяться
Set Fs1 = Ind9.CreateField("Фамилия")
Set Fs2 = Ind9.CreateField("Имя")
Ind9.Fields.Append Fs1
Ind9.Fields.Append Fs2
tbWorker.Indexes.Append Ind9
' Создание и описание счетчика с именем Код (табл. Family) аналогично таблице Worker
Set Fin2 = tbFam.CreateField("Код", dbLong)
Fin2.Attributes = dbAutoIncrField
tbFam.Fields.Append Fin2
' Первичный ключ таблицы Family
Set Ind2 = tbFam.CreateIndex("Код")
Ind2.Primary = True
Set Fin2 = Ind2.CreateField("Код", dbLong)
Ind2.Fields.Append Fin2
tbFam.Indexes.Append Ind2
' Описание остальных полей (табл. Family)
Set P(1) = tbFam.CreateField("Номер", dbLong)
Set P(2) = tbFam.CreateField("Кто", dbText, 20)
Set P(3) = tbFam.CreateField("Фамилия", dbText, 50)
Set P(4) = tbFam.CreateField("Имя", dbText, 50)
Set P(5) = tbFam.CreateField("Отчество", dbText, 50)
Set P(6) = tbFam.CreateField("Год рождения", dbText)
' Добавление полей в таблиу Worker
For i = 1 To 54
tbWorker.Fields.Append F(i)
Next i
' Добавление полей в таблиу Family
For i = 1 To 6
tbFam.Fields.Append P(i)
Next i
' Добавление таблицы Worker в БД
dbkadr.TableDefs.Append tbWorker
' Добавление таблицы Family в БД
dbkadr.TableDefs.Append tbFam
' Создание объекта Relation (связь, отношение) с именем first
Set Rel1 = dbkadr.CreateRelation("first")
' Установка свойств отношения
Rel1.Table = "Worker" ' Первичная (мастер) таблица отношения
Rel1.ForeignTable = "Family" ' Подчиненная таблица
Rel1.Attributes = dbRelationDeleteCascade ' Разрешить каскадное удаление данных из второй таблицы, когда удаляются связанные данные из первой
' Создание поля отношения и установка свойств
Set Fr = Rel1.CreateField("Number") ' Создание поля отношения с именем Number, в первой таблице должно быть поле с таким же именем.
Fr.ForeignName = "Номер" ' Поле отношения во второй таблице Номер.
' Добавление поля к объекту "отношение" и сам объект "отношение" к БД
Rel1.Fields.Append Fr
dbkadr.Relations.Append Rel1
' Закрытие БД
dbkadr.Close
MsgBox "Поздравляем! Вы впервые запустили программу. На Вашем диске была создана БД. Нажмите кнопку Выход, затем запустите программу снова и приступайте к работе."
End Function
наверх
Сохранение файла в БД и получение его обратно из БД
Данный пример показывает как можно сохранить двоичный файл (*.EXE, Документ MS Word и т.п.) в БД и, затем, загрузить его обратно из БД. В примере используется ADO, поэтому для работы примеру потребуется указать Reference на Microsoft Active Data Objects. Тип поля БД, в которое будет сохраняться файл, должен быть BINARY (в MS Access - OLE OBJECT).
Public Function SaveFileToDB(ByVal FileName As String, RS As Object, FieldName As String) As Boolean
Dim iFileNum As Integer
Dim lFileLength As Long
Dim abBytes() As Byte
Dim iCtr As Integer
On Error GoTo ErrorHandler
If Dir(FileName) = "" Then Exit Function
If Not TypeOf RS Is ADODB.Recordset Then Exit Function
'считать файл в массив
iFileNum = FreeFile
Open FileName For Binary Access Read As #iFileNum
lFileLength = LOF(iFileNum)
ReDim abBytes(lFileLength)
Get #iFileNum, , abBytes()
'поместить содержимое массива в БД
RS.Fields(FieldName).AppendChunk abBytes()
Close #iFileNum
SaveFileToDB = True
ErrorHandler:
End Function
Public Function LoadFileFromDB(FileName As String, _
RS As Object, FieldName As String) As Boolean
Dim iFileNum As Integer
Dim lFileLength As Long
Dim abBytes() As Byte
Dim iCtr As Integer
On Error GoTo ErrorHandler
If Not TypeOf RS Is ADODB.Recordset Then Exit Function
iFileNum = FreeFile
Open FileName For Binary As #iFileNum
lFileLength = LenB(RS(FieldName))
abBytes = RS(FieldName).GetChunk(lFileLength)
Put #iFileNum, , abBytes()
Close #iFileNum
LoadFileFromDB = True
ErrorHandler:
End Function
'-----------------------
'Пример использования #1
'-----------------------
Dim sConn As String
Dim oConn As New ADODB.Connection
Dim oRs As New ADODB.Recordset
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyDb.MDB;Persist Security Info=False"
oConn.Open sConn
oRs.Open "SELECT * FROM MYTABLE", oConn, adOpenKeyset, adLockOptimistic
oRs.AddNew
SaveFileToDB "C:\MyDocuments\MyDoc.Doc", oRs, "MyFieldName"
oRs.Update
oRs.Close
'-----------------------
'Пример использования #2
'-----------------------
Dim sConn As String
Dim oConn As New ADODB.Connection
Dim oRs As New ADODB.Recordset
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyDb.MDB;Persist Security Info=False"
oConn.Open sConn
oRs.Open "SELECT * FROM MyTable", oConn, adOpenKeyset, adLockOptimistic
LoadFileFromDB "C:\MyDocuments\MyDoc.Doc", oRs, "MyFieldName"
oRs.Close
Источник: http://www.relib.com/code.asp?id=444
наверх
Мои программы
BalloonMessage for MS Agent
Автор: Шатрыкин Иван. Соавтор: Павел Сурменок.
наверх
Вопрос/Ответ
Автор вопроса: SMM
Ответ ожидается по этому адресу
1. Есть код блокировки кнопки "Пуск":
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Public Sub EnableStartButton(Optional Enabled As Boolean = True)
'this will enable/disable any window with a little modifaction
Dim lHwnd As Long
'найти hWnd
lHwnd& = FindWindowEx(FindWindow("Shell_TrayWnd", ""), 0&, "Button", vbNullString)
'call the enablewindow api and do the what needs to be done
Call EnableWindow(lHwnd&, CLng(Enabled))
End Sub
Private Sub Command1_Click()
EnableStartButton False 'Кнопка ПУСК заблокирована
End Sub
Private Sub Command2_Click()
EnableStartButton True 'Кнопка ПУСК не заблокирована
End Sub
но он не блокирует нажатие кнопки Windows и Ctrl+Esc.
Подскажите, как это исправить.
2. Есть две формы, как сделать, что бы первая форма появлялась внутри другой в строго определённом месте.
Автор вопроса: EL
Ответ ожидается по этому адресу
Подскажите, как выполнить поиск строки в тексте HTML-я, загруженного в компонент WebBrowser. Как это делается в IE5 я уже знаю, а под 4?
Автор вопроса: Rutshtein Alex
Ответ ожидается по этому адресу
Как создать на форме список, типа Alt-Tab, чтобы в нём были все запущенные программы (не процессы) и по нажатию на какой-либо элемент активной становилась указанная программа?
Автор вопроса: Duke
Ответ ожидается по этому адресу
1.Как проиграть WAV и MP3 музон со скоростью 200% от нормальной (в 2 раза быстрее) и 50% скорости от нормальной (т.е. 2 раз медленнее) это надо сделать на VB6
2.Как при помощи VB6 сохранить BMP рисунок в JPG формате
3.У меня такая фигня: я пытался эмулировать нажатие NUMLOCK, SCROLL...,CAPS... таким образом ими мигать но шо то не робить, они не мигают, а мерцают тускло очень. Как заставить их мигать
Автор вопроса: Rusty Angles
Ответ ожидается по этому адресу
Вопрос 1
(VB.NET) Видел программу, которая используя dos-овский архиватор, находящийся в том же каталоге, распаковывала файлы, но при этом не видно было окна доса..
Как это можно сделать?
И еще.. как использовать DLL-библиотеки, и как узнавать ихние возможности с помошью WinDasm32?
Вопрос 2
(VB.NET) Добавил я в проект bmp файл, как ресурс, теперь он появился в окошке с права с верху, как его использовать, как ссылаться на него?
Автор вопроса: Андрей
Ответ ожидается по этому адресу
Подскажите, для чего испольяуется модуль.
Автор вопроса: Dimka
Ответ ожидается по этому адресу
Как можно использовать обхекты не стандартные в бейсике 6.0 а те которые используются в системе. допустим в ХР.
Можно ли подключить обьекты из системы в бейсик?
Автор вопроса: Alexander Bondarenko
Ответ ожидается по этому адресу
У меня на форме картинка PictureBox в ней нарисованны фигурки методами Line,Circule и.т.д я хочу програмно передвигать эти рисунки восстонавливя все то что было под ними т.е.
1) сохраняю то, что было до рисунка
2) рисую новый рисунок
надо передвинуть
Автор вопроса: Сергей
Ответ ожидается по этому адресу
Как можно записать в файл открытый рисунок (в picture box) не используя функцию SavePicture, а потом его открыть. Файл должен быть примерно такого типа:
type My_Type
txt as string 'Для записи инфы
pic 'Для записи картинки
end type
Автор вопроса: Gala
Ответ ожидается по этому адресу
Каким образом скопировать файл на vbscript в директорию на IIS-СЕРВЕР?
создаю объект:
Set fs = CreateObject "Scripting.FileSystemObject")
теперь копирую, допустим
fs.CopyFile "C:\org\gerb3.gif", "C:\Inetpub\wwwroot\gerb3.gif"
но ведь мне надо указать url?
Автор вопроса: Дина
Ответ ожидается по этому адресу
Где можно найти ответ, по интерфейсу Excel - ияменить подсветку активной строки в таблицах (плохо видно - бледнющая серость)
Автор вопроса: vovan
Ответ ожидается по этому адресу
Подскажите плз. как из-под VB получить доступ к БД Paradox (v4.x,5.x)
Автор вопроса: Николай
Ответ ожидается по этому адресу
Ищу профессионального программиста.
Нужна программа для работы с модемом (автоответчик, баяа данных и т.д).
Подробности и стоимость обсудим по "мылу".
Автор вопроса: Error
Ответ ожидается по этому адресу
Как определть объём жесткого диска и скока на это болванчике занято места.
Автор вопроса: Костик
Ответ ожидается по этому адресу
Что надо записать в коде чтобы из моей программы открывался какой-либо файл (например в формате HTML) и чтобы он открывался с любого диска, но по определённому пути.
Например:
Сommand1 - кнопка открывающая программу, а "Любой диск:\Мои документы\index.html" - путь к файлу
Ответы:
Вопрос:
Нужно присвоить некоторые значения, ещё не загруженой дочерней форме, так, чтобы она на это ни как не отриагировала, т.е. осталась не загруженой.
Ответ:
Автор ответа: Sergey Y. Tkachev
Понимаешь, нельзя присвоить значения незагруженой форме. Можно только спрятаной. Но загрузить её тебе всё равно придётся.
Допустим, у тебя есть в форме (например, frmDocument) какая-то публичная переменная, например
Public MyVar As Integer
Из материнской формы делаешь:
Dim fDocument As frmDocument
Set fDocument = New frmDocument
Load fDocument
fDocument.MyVar = 15
'Форма ещё невидима!
fDocument.Show
Вот и всё. ТОЛЬКО!!! НЕ ЗАБУДЬ!!!
Обязательно поставь свойство материнской формы AutoShowChildren = False
Иначе - покажется сразу.
Вопрос:
Нужно присвоить некоторые значения, ещё не загруженой дочерней форме, так, чтобы она на это ни как не отриагировала, т.е. осталась не загруженой.
Ответ:
Автор ответа: Иван
Если форма не загружена, то ей ничего передать нельзя.
А данные можно получить например при загрузке формы по Form_Load.
Пусть форма при загрузке считывает нужные переменные.
То есть:
================
...
'скидываем переменную в буфер
bufVar = MyVar
...
================
Sub Form_Load()
...
'считываем из буфера
MyFormVar = bufVar
...
End Sub
===============
Вопрос:
Как сделать так, чтобы при нажатии клавиш Alt+Ctrl+Del не вылетало меню, либо в списке не было моей программы?
Ответ:
Автор ответа: Rafis
Это можно сделать с помощью 2 айпияек.
Расположи на форме 2 кнопки и напиши следующий код:
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Sub Command1_Click()
RegisterServiceProcess GetCurrentProcessId, 1 'Спрятать
End Sub
Private Sub Command2_Click()
RegisterServiceProcess GetCurrentProcessId, 0 'Показать
End Sub
Нажатие первой кнопки прячет программу из списка, а вторая показывает.
Вопрос:
Как сделать так, чтобы при нажатии клавиш Alt+Ctrl+Del не вылетало меню, либо в списке не было моей программы?
Ответ:
Автор ответа: Kurt Haeldar
О блокировке трех клавиш ответ прямо из предыдущего выпуска рассылки:
'ВАРИАНТ 1
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_SCREENSAVERRUNNING = 97&
Public Sub AllowKeys(bParam As Boolean)
Dim lRetVal As Long, bOld As Boolean
lRetVal = SystemParametersInfo(SPI_SCREENSAVERRUNNING, bParam, bOld, 0&)
End Sub
Private Sub Form_Load()
Call AllowKeys(True) 'блокировка сочетаний
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call AllowKeys(False) 'разблокировка сочетаний
End Sub
'ВАРИАНТ 2
'без дополнительной подпрограммы
'Добавьте два элемента CommandButton. Первая кнопка блокирует сочетание клавиш, вторая - разрешает.
Const SPI_SCREENSAVERRUNNING = 97
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Sub Command1_Click()
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, "1", 0)
End Sub
Private Sub Command2_Click()
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, "1", 0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, "1", 0)
End Sub
А вот насчет скрытия проги есть API функция RegisterServiceProcess
Объявление:
Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Параметры:
dwProcessId - идентификатор процесса, который нужно скрыть или наоборот, показать. Можно поставить NULL для текущего процесса.
dwType - само действие. Скрыть (сдеалть сервисом) или показать (сделать не-сервисом)
Действия могут быть такими:
RSP_SIMPLE_SERVICE - Зарегистрировать как сервис
RSP_UNREGISTER_SERVICE - Зарегистрировать как не-сервис.
Вопрос:
Как сделать так, чтобы при нажатии клавиш Alt+Ctrl+Del не вылетало меню, либо в списке не было моей программы?
Ответ:
Автор ответа: Dmitry Gavrilov
Взято кажется с http://www.nppdnepr.com/
Как спрятать программу от таск мэнаджера?
Ecли кoмy-нибyдь нyжнo пpятaть cвoи пpoгpaммы в oкнe пo Ctrl+Alt+Del, тo мoжнo вocпoльзoвaтьcя вызoвoм RegisterServiceProcess из Kernel32.dll :
===Cut From HELP ===
DWORD RegisterServiceProcess( DWORD dwProcessId, DWORD dwType );
Parameters
dwProcessId
Specifies the identifier of the process to register as a service process. Specifies NULL to register the current process.
dwType
Specifies whether the service is to be registered or unregistered. This parameter can be one of the following values.
Value Meaning
RSP_SIMPLE_SERVICE Registers the process as a service process.
RSP_UNREGISTER_SERVICE Unregisters the process as a service process.
#define RSP_SIMPLE_SERVICE 0x00000001
#define RSP_UNREGISTER_SERVICE 0x00000000
Return Value
The return value is 1 if successful or 0 if an error occurs.
===Cut===
Ha VB этo :
Private Sub Form_Load()
Dim x
x = RegisterServiceProcess(0, 1)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim x
x = RegisterServiceProcess(0, 0)
End Sub
Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
Вопрос:
Подскажите ,пожалуйста, код формы чтобы из однога окна при нажатии кнопки запускалось другое?
Ответ:
Автор ответа: Kurt Haeldar
Для скрытия первой формы и показа второй есть соответственно действия hide и show.
Private Sub Command1_Click()
form1.hide ' скрываем первую форму
form2.show ' показываем вторую форму
End Sub
Вопрос:
Подскажите адрес где можно прочитать как делаются DLL на VB ?
Ответ:
Автор ответа: Носов Максим
http://mik-seite.narod.ru/artikles/dll.htm
Вопрос:
Как в WinNT/Win2000/WinXP сделать так, чтобы при нажатии на Ctrl-Alt-Del ничего не происходило (яапретить Ctrl-Alt-Del)? Для Windows 95/98/ME подходит:
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
, но в NT/2000/XP это не работает.
Ответ:
Автор ответа: P@Ssword
В Win2k Ctrl-Alt-Del - это системная комбинация, которая вызывает меню блокировки, смены пароля и т.д. Кроме того, эту комбинацию надо нажимать при вводе пароля для повышения безопасности (т.е. эта комбинация монопольно используется системой), поэтому, я думаю, понятно, что заблокировать её невозможно.
Вопрос:
Не могу влить в TextBox текст большого объема (65кб).Текст меньшего объема вливает без проблемм.
Ответ:
Автор ответа: P@Ssword
И не вольёшь. А если будешь пытаться - прорвёт (^_^). TextBox не понимает тексты длиной более (65536|32768, нужное подчеркнуть) символов. Используй RichTextBox.
Вопрос:
В текстовом документе нужно от определенного слова до еще одного слова выделить этот блок и скопировать в буфер. Как это осуществить?
Ответ:
Автор ответа: Duke
Если я правильно понял то надо в буфер затолкать выделенный текст.
Поставь Textbox(Text1) и Commandbutton(Command1)
'.........
Private Sub Command1_Click()
Clipboard.SetText (Text1.SelText)
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 можно найти здесь.
наверх
Как воспроизвести звук и видео
'Вариант 1
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
Private Sub Form_Click()
Dim res
res = mciExecute("Play C:\Путь_до_файла")
End Sub
'Вообще, для того, что бы воспроизвести аудио или видео файл, можно воспользоваться элементом управления Microsoft Multimedia Control, но при этом вместе с вашим приложением придется таскать файл MCI32.OCX, а это лишних 193 кб, приведенный же выше код гораздо меньше. Прим. все вышесказанное касается только тех случаев, когда вам необходимо просто проиграть какой-то звуковой файл из программы.
'Вариант 2
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Sub Form_Load()
Dim x As Long
x = PlaySound("C:\Путь_до_файла", 0, &H1 Or &H10)
End Sub
'Вариант 3
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Sub Form_Load()
Dim x As Long
x = sndPlaySound("C:\Путь_до_файла", &H1 Or &H10)
End Sub
наверх
Получить информацию из тэга MP3-файла
Private Sub Form_Load()
Dim fNum As Integer
Dim sTagIdent As String * 3
Dim sTitle As String * 30
Dim sArtist As String * 30
Dim sAlbum As String * 30
Dim sYear As String * 4
Dim sComment As String * 30
fNum = FreeFile
'Замените ярлык 'c:\MySong.mp3' любым вашим файлом.
Open "c:\MySong.mp3" For Binary As fNum
Seek #fNum, LOF(fNum) - 127
Get #fNum, , sTagIdent
If sTagIdent = "TAG" Then
Get #fNum, , sTitle
Get #fNum, , sArtist
Get #fNum, , sAlbum
Get #fNum, , sYear
Get #fNum, , sComment
End If
Close #fNum
MsgBox sTitle & "," & sArtist & "," & sAlbum & "," & sYear & "," & sComment
End Sub
наверх
Как изменить разрешение экрана
Вызов функции: ChangeResolution 640, 480 (В данном случае меняется разрешение экрана на 640*480)
Вы должны понимать, что ваш монитор должен поддерживать задаваемое разрешение
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CCFORMNAME = 32
Const CCDEVICENAME = 32
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public Sub ChangeResolution(iWidth As Single, iHeight As Single)
Dim DevM As DEVMODE
Dim a As Boolean
Dim i As Long
Dim b As Long
i = 0
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight
b = ChangeDisplaySettings(DevM, 0)
End Sub
Private Sub Command1_Click()
ChangeResolution 640, 480
End Sub
наверх
Функции для работы с джойстиком
В частности, этот пример покажет, есть ли у вас джойстик (1) или нет (0). Расположите на форме элемент CommandButton.
Const JOY_BUTTON1 = &H1
Const JOY_BUTTON2 = &H2
Const JOY_BUTTON3 = &H4
Const JOY_BUTTON4 = &H8
Private Type JOYINFO
X As Long
Y As Long
Z As Long
Buttons As Long
End Type
Private Const JOYERR_BASE = 160
Private Const JOYERR_NOERROR = (0)
Private Const JOYERR_NOCANDO = (JOYERR_BASE + 6)
Private Const JOYERR_PARMS = (JOYERR_BASE + 5)
Private Const JOYERR_UNPLUGGED = (JOYERR_BASE + 7)
Private Const MAXPNAMELEN = 32
Private Type JOYCAPS
wMid As Integer
wPid As Integer
szPname As String * MAXPNAMELEN
wXmin As Long
wXmax As Long
wYmin As Long
wYmax As Long
wZmin As Long
wZmax As Long
wNumButtons As Long
wPeriodMin As Long
wPeriodMax As Long
End Type
Private Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As JOYCAPS, ByVal uSize As Long) As Long
Private Declare Function joyGetNumDevs Lib "winmm.dll" () As Long
Private Declare Function joyGetPos Lib "winmm.dll" (ByVal uJoyID As Long, pji As JOYINFO) As Long
Private Function GetJoyMin(ByVal joy As Integer, ji As JOYINFO) As Boolean
Dim jc As JOYCAPS
If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
GetJoyMin = False
Else
ji.X = jc.wXmin
ji.Y = jc.wYmin
ji.Z = jc.wZmin
ji.Buttons = jc.wNumButtons
GetJoyMin = True
End If
End Function
Private Function GetJoyMax(ByVal joy As Integer, ji As JOYINFO) As Boolean
Dim jc As JOYCAPS
If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
GetJoyMax = False
Else
ji.X = jc.wXmax
ji.Y = jc.wYmax
ji.Z = jc.wZmax
ji.Buttons = jc.wNumButtons
GetJoyMax = True
End If
End Function
Private Function GetJoystick(ByVal joy As Integer, ji As JOYINFO) As Boolean
If joyGetPos(joy, ji) <> JOYERR_NOERROR Then
GetJoystick = False
Else
GetJoystick = True
End If
End Function
' If IsConnected is False then it returns the number of
' joysticks the driver supports. (But may not be connected)
' If IsConnected is True the it returns the number of
' joysticks present and connected.
' IsConnected is true by default.
Public Function IsJoyPresent(Optional IsConnected As Variant) As Long
Dim ic As Boolean
Dim i As Long
Dim j As Long
Dim ret As Long
Dim ji As JOYINFO
ic = IIf(IsMissing(IsConnected), True, CBool(IsConnected))
i = joyGetNumDevs
If ic Then
j = 0
Do While i > 0
i = i - 1 'Joysticks id's are 0 and 1
If joyGetPos(i, ji) = JOYERR_NOERROR Then
j = j + 1
End If
Loop
IsJoyPresent = j
Else
IsJoyPresent = i
End If
End Function
Private Sub Command1_Click()
MsgBox IsJoyPresent
End Sub
наверх
Пример создания базы данных кодом
Для начала вам необходимо подключить (меню Project->References) Microsoft DAO 2.5/3.51 Compatibility Library
Вставьте следующий код, запустите проект. Если вы еще не сохранили проект, то база создаться в папке, куда вы проинсталировали VB (по умолчанию - C:\Program Files\Microsoft Visual Studio\VB98).
Private Sub Form_Load()
Dim dbFile As String
' Проверяет наличие файла, имеющего имя, которое будет присвоено новой базе данных. Если есть такая база, то новая база не создается, если нет то вызывается функция и база создается.
If Dir(App.Path & "\kadrs.Mdb") <> "" Then
dbFile = App.Path & "\kadrs.Mdb"
Else:
dbFile = dbgreit()
End If
End Sub
Public Function dbgreit()
Dim dbkadr As Database, NewWs As Workspace 'Описание БД и рабочей области
Dim dbOpts As Long, dbName As String, tbWorker As TableDef
Dim tbFam As TableDef, Rel1 As Relation ' Описание таблицы и отношения
Dim Ind1, Ind2, Ind3, Ind4, Ind5 As Index'Описание индексов
Dim Fin, Fr, Fin2, Fin3, Fr2, Fin4, Fr3, Fin5, Fr4 As Field
Dim Fin6, Fr5, Fin7, Fr6, Fin8, Fr7, Frel As Field
Dim Ind9 As Index, Fs1, Fs2 As Field
ReDim F(1 To 54) As Field ' Описание полей табл. Worker
ReDim P(1 To 10) As Field ' Описание полей табл. Family
' Строковая переменная, указывающая на файл БД находящийся по тому же пути, что и файл программы.
dbName = App.Path & "\kadrs.Mdb"
Set NewWs = DBEngine.Workspaces(0)' Создание рабочей области
dbOpts = dbVersion35 + dnEncrypt ' Параметры БД - версия Jet-машины 3,5 и кодирование.
Set dbkadr = NewWs.CreateDatabase(dbName, dbLangCyrillic, dbOpts) ' Создание рускоязычной БД
' добавление таблицы с именем Worker в БД
Set tbWorker = dbkadr.CreateTableDef("Worker")
' добавление таблицы с именем Family в БД
Set tbFam = dbkadr.CreateTableDef("Family")
' Создание и описание счетчика с именем Код (табл. Worker)
Set Fin = tbWorker.CreateField("Код", dbLong) ' Создание поля в таблице с именем Код
Set Frel = tbWorker.CreateField("Number", dbLong) ' Создаем в таблице поле связи
Fin.Attributes = dbAutoIncrField ' Атрибуты поля - автоинкремент
tbWorker.Fields.Append Fin ' Добавляем поля в таблицу
tbWorker.Fields.Append Frel
' Первичный ключ таблицы Worker (индекс по полю Number)
Set Ind1 = tbWorker.CreateIndex("Number")
Ind1.Primary = True ' Устанавливаем свойство ключа - первичный ключ
Set Frel = Ind1.CreateField("Number", dbLong) ' Создаем индексное поле аналогичное полю связи из таблицы
Ind1.Fields.Append Frel ' Добавляем его к индексу
tbWorker.Indexes.Append Ind1 ' Добавляем индекс к таблице
' Описание остальных полей (табл. Worker)
Set F(1) = tbWorker.CreateField("Фамилия", dbText, 50) ' Создание текстового поля размером 50 символов
Set F(2) = tbWorker.CreateField("Имя", dbText, 50)
Set F(3) = tbWorker.CreateField("Отчество", dbText, 50)
Set F(4) = tbWorker.CreateField("Дата рождения", dbDate) ' Создание поля даты
Set F(5) = tbWorker.CreateField("Национальность", dbText, 50)
Set F(6) = tbWorker.CreateField("Должность", dbText, 150)
Set F(7) = tbWorker.CreateField("СемПоложение", dbText, 20)
Set F(8) = tbWorker.CreateField("Телефон", dbText, 15)
Set F(9) = tbWorker.CreateField("ДатаЗап", dbDate)
Set F(10) = tbWorker.CreateField("Образование", dbText, 90)
Set F(11) = tbWorker.CreateField("Телефон2", dbText, 15)
Set F(12) = tbWorker.CreateField("Профессия", dbText, 200)
Set F(13) = tbWorker.CreateField("Серия", dbText, 10)
Set F(14) = tbWorker.CreateField("Номер", dbText, 10)
Set F(15) = tbWorker.CreateField("Кем выдан", dbText, 200)
Set F(16) = tbWorker.CreateField("ДатаВыдачи", dbDate)
Set F(17) = tbWorker.CreateField("Место рождения", dbText, 250)
Set F(18) = tbWorker.CreateField("Индекс", dbText, 10)
Set F(19) = tbWorker.CreateField("Улица", dbText, 100)
Set F(20) = tbWorker.CreateField("Город", dbText, 100)
Set F(21) = tbWorker.CreateField("Область", dbText, 100)
Set F(22) = tbWorker.CreateField("Район", dbText, 100)
Set F(23) = tbWorker.CreateField("УчЗав", dbText, 200)
Set F(24) = tbWorker.CreateField("ДатаОк1", dbDate)
Set F(25) = tbWorker.CreateField("УчЗав2", dbText, 200)
Set F(26) = tbWorker.CreateField("ДатаОк2", dbDate)
Set F(27) = tbWorker.CreateField("СпецПоД", dbText, 200)
Set F(28) = tbWorker.CreateField("Квалификация", dbText, 200)
Set F(29) = tbWorker.CreateField("НомД", dbText, 50)
Set F(30) = tbWorker.CreateField("УчЗван", dbText, 200)
Set F(31) = tbWorker.CreateField("ОКОДТ", dbText, 10)
Set F(32) = tbWorker.CreateField("ОКСО", dbText, 10)
Set F(33) = tbWorker.CreateField("ГрУч", dbText, 30)
Set F(34) = tbWorker.CreateField("КатУч", dbText, 30)
Set F(35) = tbWorker.CreateField("Состав", dbText, 150)
Set F(36) = tbWorker.CreateField("Звание", dbText, 200)
Set F(37) = tbWorker.CreateField("ВУС", dbText, 50)
Set F(38) = tbWorker.CreateField("Годность", dbText, 100)
Set F(39) = tbWorker.CreateField("Военкомат", dbText, 200)
Set F(40) = tbWorker.CreateField("СпецУч", dbText, 50)
Set F(41) = tbWorker.CreateField("НомСтрах", dbText, 40)
Set F(42) = tbWorker.CreateField("Date1", dbDate)
Set F(43) = tbWorker.CreateField("Date2", dbDate)
Set F(44) = tbWorker.CreateField("Date3", dbDate)
Set F(45) = tbWorker.CreateField("Date4", dbDate)
Set F(46) = tbWorker.CreateField("Date5", dbDate)
Set F(47) = tbWorker.CreateField("Date6", dbDate)
Set F(48) = tbWorker.CreateField("Date7", dbDate)
Set F(49) = tbWorker.CreateField("Date8", dbDate)
Set F(50) = tbWorker.CreateField("Date9", dbDate)
Set F(51) = tbWorker.CreateField("Date10", dbDate)
Set F(52) = tbWorker.CreateField("Причина", dbText, 200)
Set F(53) = tbWorker.CreateField("Date11", dbDate)
Set F(54) = tbWorker.CreateField("Стат", dbText, 200)
' Создание индекса для сортировки по фамилиям и именам (по алфавиту)
Set Ind9 = tbWorker.CreateIndex("Name") ' Создание индекса с именем Name
Ind9.Unique = False ' Индекс не уникальный - значения могут повторяться
Set Fs1 = Ind9.CreateField("Фамилия")
Set Fs2 = Ind9.CreateField("Имя")
Ind9.Fields.Append Fs1
Ind9.Fields.Append Fs2
tbWorker.Indexes.Append Ind9
' Создание и описание счетчика с именем Код (табл. Family) аналогично таблице Worker
Set Fin2 = tbFam.CreateField("Код", dbLong)
Fin2.Attributes = dbAutoIncrField
tbFam.Fields.Append Fin2
' Первичный ключ таблицы Family
Set Ind2 = tbFam.CreateIndex("Код")
Ind2.Primary = True
Set Fin2 = Ind2.CreateField("Код", dbLong)
Ind2.Fields.Append Fin2
tbFam.Indexes.Append Ind2
' Описание остальных полей (табл. Family)
Set P(1) = tbFam.CreateField("Номер", dbLong)
Set P(2) = tbFam.CreateField("Кто", dbText, 20)
Set P(3) = tbFam.CreateField("Фамилия", dbText, 50)
Set P(4) = tbFam.CreateField("Имя", dbText, 50)
Set P(5) = tbFam.CreateField("Отчество", dbText, 50)
Set P(6) = tbFam.CreateField("Год рождения", dbText)
' Добавление полей в таблиу Worker
For i = 1 To 54
tbWorker.Fields.Append F(i)
Next i
' Добавление полей в таблиу Family
For i = 1 To 6
tbFam.Fields.Append P(i)
Next i
' Добавление таблицы Worker в БД
dbkadr.TableDefs.Append tbWorker
' Добавление таблицы Family в БД
dbkadr.TableDefs.Append tbFam
' Создание объекта Relation (связь, отношение) с именем first
Set Rel1 = dbkadr.CreateRelation("first")
' Установка свойств отношения
Rel1.Table = "Worker" ' Первичная (мастер) таблица отношения
Rel1.ForeignTable = "Family" ' Подчиненная таблица
Rel1.Attributes = dbRelationDeleteCascade ' Разрешить каскадное удаление данных из второй таблицы, когда удаляются связанные данные из первой
' Создание поля отношения и установка свойств
Set Fr = Rel1.CreateField("Number") ' Создание поля отношения с именем Number, в первой таблице должно быть поле с таким же именем.
Fr.ForeignName = "Номер" ' Поле отношения во второй таблице Номер.
' Добавление поля к объекту "отношение" и сам объект "отношение" к БД
Rel1.Fields.Append Fr
dbkadr.Relations.Append Rel1
' Закрытие БД
dbkadr.Close
MsgBox "Поздравляем! Вы впервые запустили программу. На Вашем диске была создана БД. Нажмите кнопку Выход, затем запустите программу снова и приступайте к работе."
End Function
наверх
Сохранение файла в БД и получение его обратно из БД
Данный пример показывает как можно сохранить двоичный файл (*.EXE, Документ MS Word и т.п.) в БД и, затем, загрузить его обратно из БД. В примере используется ADO, поэтому для работы примеру потребуется указать Reference на Microsoft Active Data Objects. Тип поля БД, в которое будет сохраняться файл, должен быть BINARY (в MS Access - OLE OBJECT).
Public Function SaveFileToDB(ByVal FileName As String, RS As Object, FieldName As String) As Boolean
Dim iFileNum As Integer
Dim lFileLength As Long
Dim abBytes() As Byte
Dim iCtr As Integer
On Error GoTo ErrorHandler
If Dir(FileName) = "" Then Exit Function
If Not TypeOf RS Is ADODB.Recordset Then Exit Function
'считать файл в массив
iFileNum = FreeFile
Open FileName For Binary Access Read As #iFileNum
lFileLength = LOF(iFileNum)
ReDim abBytes(lFileLength)
Get #iFileNum, , abBytes()
'поместить содержимое массива в БД
RS.Fields(FieldName).AppendChunk abBytes()
Close #iFileNum
SaveFileToDB = True
ErrorHandler:
End Function
Public Function LoadFileFromDB(FileName As String, _
RS As Object, FieldName As String) As Boolean
Dim iFileNum As Integer
Dim lFileLength As Long
Dim abBytes() As Byte
Dim iCtr As Integer
On Error GoTo ErrorHandler
If Not TypeOf RS Is ADODB.Recordset Then Exit Function
iFileNum = FreeFile
Open FileName For Binary As #iFileNum
lFileLength = LenB(RS(FieldName))
abBytes = RS(FieldName).GetChunk(lFileLength)
Put #iFileNum, , abBytes()
Close #iFileNum
LoadFileFromDB = True
ErrorHandler:
End Function
'-----------------------
'Пример использования #1
'-----------------------
Dim sConn As String
Dim oConn As New ADODB.Connection
Dim oRs As New ADODB.Recordset
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyDb.MDB;Persist Security Info=False"
oConn.Open sConn
oRs.Open "SELECT * FROM MYTABLE", oConn, adOpenKeyset, adLockOptimistic
oRs.AddNew
SaveFileToDB "C:\MyDocuments\MyDoc.Doc", oRs, "MyFieldName"
oRs.Update
oRs.Close
'-----------------------
'Пример использования #2
'-----------------------
Dim sConn As String
Dim oConn As New ADODB.Connection
Dim oRs As New ADODB.Recordset
sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyDb.MDB;Persist Security Info=False"
oConn.Open sConn
oRs.Open "SELECT * FROM MyTable", oConn, adOpenKeyset, adLockOptimistic
LoadFileFromDB "C:\MyDocuments\MyDoc.Doc", oRs, "MyFieldName"
oRs.Close
Источник: http://www.relib.com/code.asp?id=444
наверх
Мои программы
BalloonMessage for MS Agent
BalloonMessage for Microsoft Agent реализует диалог программы с
пользователем, используя при этом технологию Microsoft Agent. OCX реализует три
типа диалоговых окон: InputBox, MsgBox и MsgLabels.
Автор: Шатрыкин Иван. Соавтор: Павел Сурменок.
наверх
Вопрос/Ответ
Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.
Вопросы:Автор вопроса: SMM
Ответ ожидается по этому адресу
1. Есть код блокировки кнопки "Пуск":
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Public Sub EnableStartButton(Optional Enabled As Boolean = True)
'this will enable/disable any window with a little modifaction
Dim lHwnd As Long
'найти hWnd
lHwnd& = FindWindowEx(FindWindow("Shell_TrayWnd", ""), 0&, "Button", vbNullString)
'call the enablewindow api and do the what needs to be done
Call EnableWindow(lHwnd&, CLng(Enabled))
End Sub
Private Sub Command1_Click()
EnableStartButton False 'Кнопка ПУСК заблокирована
End Sub
Private Sub Command2_Click()
EnableStartButton True 'Кнопка ПУСК не заблокирована
End Sub
но он не блокирует нажатие кнопки Windows и Ctrl+Esc.
Подскажите, как это исправить.
2. Есть две формы, как сделать, что бы первая форма появлялась внутри другой в строго определённом месте.
Автор вопроса: EL
Ответ ожидается по этому адресу
Подскажите, как выполнить поиск строки в тексте HTML-я, загруженного в компонент WebBrowser. Как это делается в IE5 я уже знаю, а под 4?
Автор вопроса: Rutshtein Alex
Ответ ожидается по этому адресу
Как создать на форме список, типа Alt-Tab, чтобы в нём были все запущенные программы (не процессы) и по нажатию на какой-либо элемент активной становилась указанная программа?
Автор вопроса: Duke
Ответ ожидается по этому адресу
1.Как проиграть WAV и MP3 музон со скоростью 200% от нормальной (в 2 раза быстрее) и 50% скорости от нормальной (т.е. 2 раз медленнее) это надо сделать на VB6
2.Как при помощи VB6 сохранить BMP рисунок в JPG формате
3.У меня такая фигня: я пытался эмулировать нажатие NUMLOCK, SCROLL...,CAPS... таким образом ими мигать но шо то не робить, они не мигают, а мерцают тускло очень. Как заставить их мигать
Автор вопроса: Rusty Angles
Ответ ожидается по этому адресу
Вопрос 1
(VB.NET) Видел программу, которая используя dos-овский архиватор, находящийся в том же каталоге, распаковывала файлы, но при этом не видно было окна доса..
Как это можно сделать?
И еще.. как использовать DLL-библиотеки, и как узнавать ихние возможности с помошью WinDasm32?
Вопрос 2
(VB.NET) Добавил я в проект bmp файл, как ресурс, теперь он появился в окошке с права с верху, как его использовать, как ссылаться на него?
Автор вопроса: Андрей
Ответ ожидается по этому адресу
Подскажите, для чего испольяуется модуль.
Автор вопроса: Dimka
Ответ ожидается по этому адресу
Как можно использовать обхекты не стандартные в бейсике 6.0 а те которые используются в системе. допустим в ХР.
Можно ли подключить обьекты из системы в бейсик?
Автор вопроса: Alexander Bondarenko
Ответ ожидается по этому адресу
У меня на форме картинка PictureBox в ней нарисованны фигурки методами Line,Circule и.т.д я хочу програмно передвигать эти рисунки восстонавливя все то что было под ними т.е.
1) сохраняю то, что было до рисунка
2) рисую новый рисунок
надо передвинуть
Автор вопроса: Сергей
Ответ ожидается по этому адресу
Как можно записать в файл открытый рисунок (в picture box) не используя функцию SavePicture, а потом его открыть. Файл должен быть примерно такого типа:
type My_Type
txt as string 'Для записи инфы
pic 'Для записи картинки
end type
Автор вопроса: Gala
Ответ ожидается по этому адресу
Каким образом скопировать файл на vbscript в директорию на IIS-СЕРВЕР?
создаю объект:
Set fs = CreateObject "Scripting.FileSystemObject")
теперь копирую, допустим
fs.CopyFile "C:\org\gerb3.gif", "C:\Inetpub\wwwroot\gerb3.gif"
но ведь мне надо указать url?
Автор вопроса: Дина
Ответ ожидается по этому адресу
Где можно найти ответ, по интерфейсу Excel - ияменить подсветку активной строки в таблицах (плохо видно - бледнющая серость)
Автор вопроса: vovan
Ответ ожидается по этому адресу
Подскажите плз. как из-под VB получить доступ к БД Paradox (v4.x,5.x)
Автор вопроса: Николай
Ответ ожидается по этому адресу
Ищу профессионального программиста.
Нужна программа для работы с модемом (автоответчик, баяа данных и т.д).
Подробности и стоимость обсудим по "мылу".
Автор вопроса: Error
Ответ ожидается по этому адресу
Как определть объём жесткого диска и скока на это болванчике занято места.
Автор вопроса: Костик
Ответ ожидается по этому адресу
Что надо записать в коде чтобы из моей программы открывался какой-либо файл (например в формате HTML) и чтобы он открывался с любого диска, но по определённому пути.
Например:
Сommand1 - кнопка открывающая программу, а "Любой диск:\Мои документы\index.html" - путь к файлу
Ответы:
Вопрос:
Нужно присвоить некоторые значения, ещё не загруженой дочерней форме, так, чтобы она на это ни как не отриагировала, т.е. осталась не загруженой.
Ответ:
Автор ответа: Sergey Y. Tkachev
Понимаешь, нельзя присвоить значения незагруженой форме. Можно только спрятаной. Но загрузить её тебе всё равно придётся.
Допустим, у тебя есть в форме (например, frmDocument) какая-то публичная переменная, например
Public MyVar As Integer
Из материнской формы делаешь:
Dim fDocument As frmDocument
Set fDocument = New frmDocument
Load fDocument
fDocument.MyVar = 15
'Форма ещё невидима!
fDocument.Show
Вот и всё. ТОЛЬКО!!! НЕ ЗАБУДЬ!!!
Обязательно поставь свойство материнской формы AutoShowChildren = False
Иначе - покажется сразу.
Вопрос:
Нужно присвоить некоторые значения, ещё не загруженой дочерней форме, так, чтобы она на это ни как не отриагировала, т.е. осталась не загруженой.
Ответ:
Автор ответа: Иван
Если форма не загружена, то ей ничего передать нельзя.
А данные можно получить например при загрузке формы по Form_Load.
Пусть форма при загрузке считывает нужные переменные.
То есть:
================
...
'скидываем переменную в буфер
bufVar = MyVar
...
================
Sub Form_Load()
...
'считываем из буфера
MyFormVar = bufVar
...
End Sub
===============
Вопрос:
Как сделать так, чтобы при нажатии клавиш Alt+Ctrl+Del не вылетало меню, либо в списке не было моей программы?
Ответ:
Автор ответа: Rafis
Это можно сделать с помощью 2 айпияек.
Расположи на форме 2 кнопки и напиши следующий код:
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Sub Command1_Click()
RegisterServiceProcess GetCurrentProcessId, 1 'Спрятать
End Sub
Private Sub Command2_Click()
RegisterServiceProcess GetCurrentProcessId, 0 'Показать
End Sub
Нажатие первой кнопки прячет программу из списка, а вторая показывает.
Вопрос:
Как сделать так, чтобы при нажатии клавиш Alt+Ctrl+Del не вылетало меню, либо в списке не было моей программы?
Ответ:
Автор ответа: Kurt Haeldar
О блокировке трех клавиш ответ прямо из предыдущего выпуска рассылки:
'ВАРИАНТ 1
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_SCREENSAVERRUNNING = 97&
Public Sub AllowKeys(bParam As Boolean)
Dim lRetVal As Long, bOld As Boolean
lRetVal = SystemParametersInfo(SPI_SCREENSAVERRUNNING, bParam, bOld, 0&)
End Sub
Private Sub Form_Load()
Call AllowKeys(True) 'блокировка сочетаний
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call AllowKeys(False) 'разблокировка сочетаний
End Sub
'ВАРИАНТ 2
'без дополнительной подпрограммы
'Добавьте два элемента CommandButton. Первая кнопка блокирует сочетание клавиш, вторая - разрешает.
Const SPI_SCREENSAVERRUNNING = 97
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Sub Command1_Click()
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, "1", 0)
End Sub
Private Sub Command2_Click()
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, "1", 0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, "1", 0)
End Sub
А вот насчет скрытия проги есть API функция RegisterServiceProcess
Объявление:
Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Параметры:
dwProcessId - идентификатор процесса, который нужно скрыть или наоборот, показать. Можно поставить NULL для текущего процесса.
dwType - само действие. Скрыть (сдеалть сервисом) или показать (сделать не-сервисом)
Действия могут быть такими:
RSP_SIMPLE_SERVICE - Зарегистрировать как сервис
RSP_UNREGISTER_SERVICE - Зарегистрировать как не-сервис.
Вопрос:
Как сделать так, чтобы при нажатии клавиш Alt+Ctrl+Del не вылетало меню, либо в списке не было моей программы?
Ответ:
Автор ответа: Dmitry Gavrilov
Взято кажется с http://www.nppdnepr.com/
Как спрятать программу от таск мэнаджера?
Ecли кoмy-нибyдь нyжнo пpятaть cвoи пpoгpaммы в oкнe пo Ctrl+Alt+Del, тo мoжнo вocпoльзoвaтьcя вызoвoм RegisterServiceProcess из Kernel32.dll :
===Cut From HELP ===
DWORD RegisterServiceProcess( DWORD dwProcessId, DWORD dwType );
Parameters
dwProcessId
Specifies the identifier of the process to register as a service process. Specifies NULL to register the current process.
dwType
Specifies whether the service is to be registered or unregistered. This parameter can be one of the following values.
Value Meaning
RSP_SIMPLE_SERVICE Registers the process as a service process.
RSP_UNREGISTER_SERVICE Unregisters the process as a service process.
#define RSP_SIMPLE_SERVICE 0x00000001
#define RSP_UNREGISTER_SERVICE 0x00000000
Return Value
The return value is 1 if successful or 0 if an error occurs.
===Cut===
Ha VB этo :
Private Sub Form_Load()
Dim x
x = RegisterServiceProcess(0, 1)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim x
x = RegisterServiceProcess(0, 0)
End Sub
Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
Вопрос:
Подскажите ,пожалуйста, код формы чтобы из однога окна при нажатии кнопки запускалось другое?
Ответ:
Автор ответа: Kurt Haeldar
Для скрытия первой формы и показа второй есть соответственно действия hide и show.
Private Sub Command1_Click()
form1.hide ' скрываем первую форму
form2.show ' показываем вторую форму
End Sub
Вопрос:
Подскажите адрес где можно прочитать как делаются DLL на VB ?
Ответ:
Автор ответа: Носов Максим
http://mik-seite.narod.ru/artikles/dll.htm
Вопрос:
Как в WinNT/Win2000/WinXP сделать так, чтобы при нажатии на Ctrl-Alt-Del ничего не происходило (яапретить Ctrl-Alt-Del)? Для Windows 95/98/ME подходит:
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
, но в NT/2000/XP это не работает.
Ответ:
Автор ответа: P@Ssword
В Win2k Ctrl-Alt-Del - это системная комбинация, которая вызывает меню блокировки, смены пароля и т.д. Кроме того, эту комбинацию надо нажимать при вводе пароля для повышения безопасности (т.е. эта комбинация монопольно используется системой), поэтому, я думаю, понятно, что заблокировать её невозможно.
Вопрос:
Не могу влить в TextBox текст большого объема (65кб).Текст меньшего объема вливает без проблемм.
Ответ:
Автор ответа: P@Ssword
И не вольёшь. А если будешь пытаться - прорвёт (^_^). TextBox не понимает тексты длиной более (65536|32768, нужное подчеркнуть) символов. Используй RichTextBox.
Вопрос:
В текстовом документе нужно от определенного слова до еще одного слова выделить этот блок и скопировать в буфер. Как это осуществить?
Ответ:
Автор ответа: Duke
Если я правильно понял то надо в буфер затолкать выделенный текст.
Поставь Textbox(Text1) и Commandbutton(Command1)
'.........
Private Sub Command1_Click()
Clipboard.SetText (Text1.SelText)
End Sub
'.........
Если я не правильно понял напиши поподробнее.
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.