Простите великодушно! Совсем про рассылку забыл.
Читайте!

Книги

		Переход на VB .NET. Стратегии, концепции, код (цена ~ 158 руб.) Эта книга была задумана как одна из первых книг о .NET, которая ознакомит читателя с основными идеями новой архитектуры и подготовит его к знакомству с более детальной литературой, например документацией Microsoft и ее толкованиями, которая неизбежно появится на рынке. Она поможет вам взглянуть на эту технологию с позиций ваших собственных рабочих планов и быстро освоить те концепции, которые покажутся необычными для большинства прогр...
		Автор(ы): Дан Эпплман, Издательство: Питер, 2002 г.
		Программирование на VB.NET. Учебный курс (цена ~ 119 руб.) Эта книга является вводным курсом по изучению языка программирования Visual Basic .NET. Даны основные принципы объектно-ориентированного программирования в контексте языка VB .NET, поскольку без хорошей подготовки в этой области невозможно в полной мере пользоваться всеми преимуществами VB .NET. Изложены азы всех аспектов языка, которыми должен владеть любой профессиональный разработчик VB .NET
		Автор(ы): Г. Корнелл, Дж. Моррисон, Издательство: Питер, 2002 г.
		VB.NET для разработчиков (цена ~ 125 руб.) Основная задача книги - быстро ознакомить разработчиков Visual Basic с изменениями в .NET Framework. Программисты, использующие Java, C++, Delphi или другие инструменты разработки приложений и интересующиеся Visual Basic или технологией .NET Framework, также найдут эту книгу полезной. Хотя книга посвящена Visual Basic.NET, ее основная цель - продемонстрировать взаимодействие Visual Basic и ...
		Автор(ы): Кит Франклин, Издательство: Вильямс, 2002 г.

Остальные книги о VB можно найти здесь.

наверх

---

Определение координат позиции курсора в TextBox

Добавьте на форму элемент TextBox.

Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function GetCaretPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim XPos As Long
Dim YPos As Long
XPos = GetTCursX
YPos = GetTCursY
Me.Caption = "X: " & XPos & " Y: " & YPos
End Sub
Public Function GetTCursX() As Long
Dim pt As POINTAPI
GetCaretPos pt
GetTCursX = pt.X
End Function
Public Function GetTCursY() As Long
Dim pt As POINTAPI
GetCaretPos pt
GetTCursY = pt.Y
End Function

наверх

---

Определить количество строк в ComboBox

Расположите на форме элемент ComboBox, элемент TextBox и 2 элемента CommandButton. Добавьте в ваш проект модуль.

'КОД МОДУЛЯ

Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private lpPrevWndProc As Long
Public lHookedhWnd As Long
Public iListItems As Integer
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const LB_GETITEMHEIGHT = &H1A1
Private Const WM_CTLCOLORLISTBOX = &H134
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Sub Hook()
lpPrevWndProc = SetWindowLong(lHookedhWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub Unhook()
Dim lRetVal As Long
lRetVal = SetWindowLong(lHookedhWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg _
As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
Select Case uMsg
Case WM_CTLCOLORLISTBOX
Dim rc As RECT
Dim lItemHeight As Long
Dim lListHeight As Long
Static bIgnore As Boolean
Const LIST_ITEMS As Long = 20
If Not bIgnore Then
With rc
lItemHeight = SendMessage(lParam, LB_GETITEMHEIGHT, 0, ByVal 0&)
lListHeight = lItemHeight * iListItems + 2
Call GetWindowRect(lParam, rc)
bIgnore = True
Call MoveWindow(lParam, .Left, .Top, (.Right - .Left), lListHeight, True)
bIgnore = False
End With
End If
Case Else
End Select
End Function

'КОД ФОРМЫ

Private Sub Command1_Click()
Command1.Enabled = Not (Command1.Enabled)
Command2.Enabled = Not (Command2.Enabled)
Hook
End Sub
Private Sub Command2_Click()
Command1.Enabled = Not (Command1.Enabled)
Command2.Enabled = Not (Command2.Enabled)
Unhook
End Sub
Private Sub Form_Load()
Command2.Enabled = False
Text1 = "2"
Command1.Caption = "Установить"
Command2.Caption = "Восстановить"
Dim i As Integer
For i = 1 To 51
Combo1.AddItem "Num " & i
Next
iListItems = 2
lHookedhWnd = Combo1.hWnd
End Sub
Private Sub Text1_Change()
iListItems = Val(Text1)
If iListItems < 1 Then
iListItems = 1
End If
End Sub

наверх

---

Изменение длины ComboBox

Данный пример покажет, как можно ограничить длину любого элемента (в количестве символов) ComboBox.

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

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const EM_LIMITTEXT = &HC5
Const GW_CHILD = 5

Private Sub Command1_Click()
'установить длину элемента - 4 символа
SendMessage GetWindow(Combo1.hwnd, GW_CHILD), EM_LIMITTEXT, 4, ByVal 0
End Sub

наверх

---

Разноцветный баттон

Этот код покажет, как изменяется цвет кнопки при передвижении над ней курсора.
Добавьте 1 Command Button. Установите свойство Style кнопки в 1 - Graphical.

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Public Sub sysControlHighLight(ctl As Control, X As Single, Y As Single, OriginalBackColor As Long, NewBackColor As Long)
Dim HitTest As Long
On Error Resume Next
HitTest = ctl.hwnd
If Err.Number <> 0 Then Exit Sub
With ctl
If (X > .Width) Or (Y > .Height) Then
ReleaseCapture
.BackColor = OriginalBackColor
Else
SetCapture .hwnd
.BackColor = NewBackColor
End If
End With
On Error GoTo 0
End Sub
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'замените 'vbGreen' и 'vbRed' на нужный вам цвет
sysControlHighLight Command1, X, Y, vbGreen, vbRed
End Sub
Private Sub Form_Load()
'замените на такой же цвет, как и предыдущий 'vbGreen'
Command1.BackColor = vbGreen
End Sub

наверх

---

Использование Images вместо CommandButton

Очень часто вместо обычных кнопок используются картинки. Т.е. существует всего три картинки - одна на которую будут жать (img1), вторая отжатая (img2) и третья нажатая (img3) (img2 и img3 - невидимы). Делаем это так:

Private Sub Form_Load()
'при загрузке формы картинка 1 принимает вид картинки 2 (отжатая)
img1.Picture = img2.Picture
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'при нажатии мышкой на картинку 1, она принимает вид картинки 3 (нажатая)
img1.Picture = img3.Picture
End Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'при отпускании кнопки мышки картинка 1, она снова принимает вид картинки 2 (отжатая)
img1.Picture = img2.Picture
End Sub

Этот приём знает каждый... Но есть в нём один недостаток, а именно: при серии непрерывных кликов на объект картинка почему-то реагирует через раз. Т.е. то нажмётся, то не нажмётся. Так вот вот сам совет :-) : чтобы этого избежать в событие Image1_MouseDown нужно вставить строку

SendKeys "A"

Т.е. картинке одновременно посылается нажатая клавиша. Почему так, понять не могу сам. Но в скобках, конечно же, не важна буква "A" - там может стоять и В и С. Главное само событие. Если кто-нибудь может дать этому вразумительное объяснение - давайте! Заранее благодарю!

наверх

---

Размножить на форме картинку

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

Для данного примера нам потребуется поставить на форму объект Image, привязать к нему рисунок, который хотим размножить на всю форму.

Private Sub Form_Paint()
Dim X As Integer, Y As Integer
Dim ImgWidth As Integer
Dim ImgHeight As Integer
Dim FrmWidth As Integer
Dim FrmHeight As Integer

'использование Image1 в PaintPicture methods:
ImgWidth = Image1.Width
ImgHeight = Image1.Height
FrmWidth = Form1.Width
FrmHeight = Form1.Height

'залить целую форму (Метод 1)
For X = 0 To FrmWidth Step ImgWidth
For Y = 0 To FrmHeight Step ImgHeight
PaintPicture Image1, X, Y
Next Y
Next X

'залить левый край (Метод 2)
'For Y = 0 To FrmHeight Step ImgHeight
'PaintPicture Image1, 0, Y
'Next Y

End Sub
'Для того чтобы залить только левый край снимите комментарий с метода2 и поставьте на метод1.

наверх

---

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

BalloonMessage for MS Agent


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

наверх

---

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

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

Вопросы:

---

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

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

   У меня вопрос, как узнать список расшаренных ресурсов с определенного ip.

---

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

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

   Как сделать screenshot экрана и передать его через WinSock, да еще и прочитать его, когда удаленный комп его примет?

---

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

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

   Работа с Winsock:
1. У меня есть Project1... в нём на форме есть Picture Box, как из этого пикчера переслать ияображение на Profect2... тоже в пикчер!!!
2. Как пересылать файлы?

---

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

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

   Как в VB подключить к Data базу Access 2000 и при этом защищенную паролем на открытие?

---

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

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

   Как отправить письмо из VB-кода? Для этого API-функция какая есть? Причем со вложенным файлом (письмо)...

---

Автор вопроса: Алексей

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

   Кто-нить сталкивался с многопоточностью? Если есть такие, то может у кого есть код, который организует несколько УПРАВЛЯЕМЫХ потоков. Если есть у кого доки по многопоточности скиньте плз мне на мыло.

---

Автор вопроса: Сергей

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

   Что-то я ничего не понимаю...
Форматирую колонку с датами

.Col = 2
For i = 1 To .Rows - 1
.Row = i
.Text = Format(.Text, "dd.mm.yyyy hh:nn")
Next

А на форме получаю:
   - если dd > mm , то все OK!
   - усли dd < mm , то получаю mm.dd.yyyy hh:nn

Такая пересортица получается, что и не поймешь какая всеже здесь дата!!!
Может я что-то не то делаю?

---

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

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

   Есть прога - локальный чат, который использует широковещательные пакеты. так вот, надо написать прогу, которая слушает порт (на котором сидит этот чат) и принимает не только "свои" пакеты с сообщениями, но и "чужие". Короче говоря, че-то типа сниффера! Как это можно организовать?

---

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

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

   У меня такой вопрос, а можно ли сделать пинговальщик (или что-то вроде этого) удалённого компьютера и чтобы он рботал без соединения с интернетом?

---

Автор вопроса: Лев

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

   Я делаю VB-программу, которая должна работать как background process, т.е. на заднем плане. И из этой программы мне нужно в определенный момент вызвать на передний план (foreground) окно другой программы.
Трудность в том, что в системе имеется ограничение - Windows 98/Me, Windows 2000/XP: The system restricts which processes can set the foreground window. A process can set the foreground window only if one of the following conditions is true:

   a.. The process is the foreground process.
   b.. The process was started by the foreground process.

И далее еще несколько условий, ни одно из условий в моем случае не выполняется.
Знает ли кто-нибудь как это сделать?

---

Автор вопроса: Andrushin Sergey

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

   Как создать подключ в реестре при помощи RegCreateKey, постоянно происходит ошибка, не могу понять в чём дело.
  
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long.

---

Автор вопроса: Сергей

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

   Есть вопрос. Даже два.
1. Для сжимания базы ранее использовал DAO :
     
     Set fs = CreateObject("Scripting.FileSystemObject") 'Создаем файловую систему
     tmpMDB = fs.GetTempName 'Получаем временный файл
     DBEngine.CompactDatabase Base, tmpMDB, dbLangCyrillic 'Сжимаем базу данных
     fs.CopyFile tmpMDB, Base, True 'Переписываем файл
     Kill tmpMDB 'Удаляем временный файл

     А как это же сделать в ADO ??? В справке ACCESS 2000 ничего не нашел.

  2. Для формы открыт один Recordset на MDB-файл. Мне его нужно сжать.
     Для того чтобы отсоединится от базы использую

         rstTEL.Close
         Set rstVED = Nothing

     Не помогает. Как же от нее отсоединится???

---

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

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

   Как нписать спектроанализатор (как в Winamp'е), т.е. как получить параметры звуковго потока, или как написать плагин к Winamp'у.

---

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

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

   Как скопировать файл по WinSock'у?

---

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

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

   В Excel программа на VBA. Моя процедура вешается на событие BeforeDoubleClick (Sub Worksheet_BeforeDoubleClick), как сделать так что бы после завершения моей процедуры DoubleClick не отрабатывался? или может есть другой способ для вызова моей процедуры по DoubleClick?

---

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

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

   1) Как в Data Bound Grid менять кол-во колонок без заполнения сетки?
2) Использую базу данных MDB(Acces), элементы Data и Data Bound Grid.
    Как редактировать базу?

---

Автор вопроса: Ильдар

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

   Как можно создать метку (Label) во время работы программы, и как можно ее удалить. Причем добавление и удаление по возможности неограниченного количества Labelов за один запуск программы и по возможности чтобы они были систематизированы.

---

Автор вопроса: Сергей Перехода

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

   Не мог бы мне кто-нибудь подсказать, как работать с числами в двоичной, 16-ричной, 8-ричной системами счисления. Может быть, в бэйсике есть какие-нибудь операции и функции для работы с ними?

---

Ответы:

---

Вопрос:

   Я хочу создать в реестре значение типа DWORD равное = 1, а оно мне создаёт 31(в шестнадцатеричной) и 49 (в десятичной). Привожу код. Подскажите пожайлуста где ошибка?

Private Sub PiZdA_Click()
Dim hREn As Long, IDenT As Long, znak As String
hREn = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\", 0, KEY_ALL_ACCESS, IDenT)
znak = 1
Print znak
Call RegSetValueEx(IDenT, "NoDesktop", 0, REG_DWORD, ByVal znak, 4)
End Sub

Ответ:

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

Не могу объяснить в чем суть, но код будет выглядеть так:

Dim hREn As Long, IDenT As Long, znak As String
hREn = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\", 0, KEY_ALL_ACCESS, IDenT)
'Вместо 1 можешь подставить любую другую цифру.
znak = Chr(1)
Print znak
Call RegSetValueEx(IDenT, "NoDesktop", 0, REG_DWORD, ByVal znak, 4)

---

Вопрос:

   Есть у меня проблема не как не могу решить её.
Есть textbox когда я его закриваю с помащи свойства Locked от изменений то не получается можно его изменить с помащи меню которое выходит нажав на правую кнопку мышки и мне надо это убрать.

Ответ:

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

Сделай так:

text1.enabled=false

Если этот вариант не подходит, то напиши - отвечу как убрать это меню

---

Ответ:

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

Убери locked и пиши:

Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

---

Вопрос:

   У меня такой вопрос: Как вызвать меню файла (т.е. как в проводнике, когда щелкаешь по нему правой кнопкой) в собственной программе.

Ответ:

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

Используй PopupMenu(имя меню) в событии Mouse_Down.

---

Вопрос:

   Есть ли способ сделать так, чтобы при выполнении определенного условия программа удалила сама себя с диска или что-нибудь в этом роде...?

Ответ:

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

Если надо удалит с диска саму прогу, то единственный выход здесь - это написать bat файл, который будет сносить екзкшник и прописать его выполнение в автозагрузку (желательно в реестр). При перезагрузки машины файл будет удален. Кстати говоря, bat файл умеет удалять сам себя.

---

Ответ:

Автор ответа: Артем Кривокрисенко

Насколько мне известно, удалить программу, которая в данный момент выполняется, нельзя.

---

Ответ:

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

На трояны потянуло ;-)

'--------

создать bat-файл

--------
Open App.Path + "\Delself.bat" For Output As #1
Print #1, "@echo off"
Print #1, ":try"
Print #1, "del " + App.EXEName + ".exe"
Print #1, "if exist " + App.EXEName + ".exe goto try"
Print #1, "del " + App.Path + "\Delself.bat"
Close #1
'-----------------------------------------
Shell App.Path + "\Delself.bat", vbHide

---

Вопрос:

   На форме поместил timer, progressbar. Мне надо, чтобы progressbar, дойдя до значения 85, двигался в обратную сторону.

Ответ:

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

Ну и что такого - если дошли до 85 ставим флаг, что в последствии надо идти назад. Потом проверям флаг и делаем что надо

Private Sub Timer1_Timer()
Static Down As Boolean
If Down Then
progressbar1.value = progressbar1.value - 1
Exit Sub
End If
progressbar1.value= progressbar1.value+ 1
If progressbar1.value>= 85 Then Down = True
End Sub

---

Ответ:

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

Пользуйся:

Dim flag As Integer

Private Sub Form_Load()
flag = 1
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
If flag = 1 Then
     ProgressBar1.Value = ProgressBar1.Value + 1
Else
     ProgressBar1.Value = ProgressBar1.Value - 1
End If
If ProgressBar1.Value = 85 Then
     flag = 0
End If
If ProgressBar1.Value = 0 Then
     flag = 1
End If
End Sub

---

Ответ:

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

Dim CS As Boolean

Private Sub Timer1_Timer()
If CS = False Then ProgressBar1 = ProgressBar1 + 1 Else ProgressBar1 = ProgressBar1 - 1
If ProgressBar1 = 85 Then CS = True
If ProgressBar1 = 0 Then Timer1.Enabled = False
End Sub

---

Вопрос:

   podskagyte please, kak sozdat *.ini file , zapisat w nego String dannyje , a potom po zagruzke application odchitat eti dannyje w textbox . sreda VB 6.0

Ответ:

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

Declare Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long

lpApplicationName - Значение раздела INI-файла
lpKeyName - Значение ключа
lpString - Устанавлимое строковое значение
lpFileName - Имя INI-файла

Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

lpApplicationName - Раздел-имя,заключенное в квадратные скобки [] и группирующее ключи и значения.
lpKeyName - Значение ключа.Ключ должен быть уникальным только внутри своего раздела.
lpDefault - Возвращаемое значение, если правильное(допустимое) значение не может читаться.
lpReturnedString - Строка фиксированной длины, получаемая при чтении любой строки файла или lpDefault.
nSize - Длина в символах переменной lpReturnedString.
lpFileName - Имя INI-файла для чтения.

Если файла не существует, то файл будет создан при записи в него

---

Вопрос:

   kak sdealat read / write registry key ? ne mogu najti primerow ? VB 6.0

Ответ:

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

Помести все это в модуль.
Ты получишь следующие функции: SaveString, GetString, SaveDword, GetDword, DeleteKey и DeleteValue


Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&

' Registry API prototypes

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA"
(ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA"
(ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA"
(ByVal Hkey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal
Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA"
(ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long,
lpType As Long, lpData As Any, lpcbData As Long) As Long
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
Public Const REG_SZ = 1 ' Unicode nul terminated
string
Public Const REG_DWORD = 4 ' 32-bit number

Public Sub SaveKey(Hkey As Long, strPath As String)
Dim keyhand&
r = RegCreateKey(Hkey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End Sub

Public Function GetString(Hkey As Long, strPath As String, strValue As
String)

Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&,
lDataBufSize)
If lValueType = REG_SZ Then
     strBuf = String(lDataBufSize, " ")
     lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf,
lDataBufSize)
     If lResult = ERROR_SUCCESS Then
         intZeroPos = InStr(strBuf, Chr$(0))
         If intZeroPos > 0 Then
             GetString = Left$(strBuf, intZeroPos - 1)
         Else
             GetString = strBuf
         End If
     End If
End If
End Function


Public Sub SaveString(Hkey As Long, strPath As String, strValue As String,
strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub


Function GetDword(ByVal Hkey As Long, ByVal strPath As String, ByVal
strValueName As String) As Long
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long

r = RegOpenKey(Hkey, strPath, keyhand)

  ' Get length/data type
lDataBufSize = 4

lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf,
lDataBufSize)

If lResult = ERROR_SUCCESS Then
     If lValueType = REG_DWORD Then
         GetDword = lBuf
     End If
'Else
' Call errlog("GetDWORD-" & strPath, False)
End If

r = RegCloseKey(keyhand)

End Function

Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal
strValueName As String, ByVal lData As Long)
     Dim lResult As Long
     Dim keyhand As Long
     Dim r As Long
     r = RegCreateKey(Hkey, strPath, keyhand)
     lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
     'If lResult <> error_success Then Call errlog("SetDWORD", False)
     r = RegCloseKey(keyhand)
End Function

Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
Dim r As Long
r = RegDeleteKey(Hkey, strKey)
End Function

Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String,
ByVal strValue As String)
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function

---

Вопрос:

   Как открыть файл (например 123.wav) из директории с утановленной программы?

   Можно так:
   
   Private Sub Form_Load()
   MediaPlayer1.FileName=Dir("123.wav")
   End Sub

Но если запускать прогу с ярлыка, то но будет искать его в директории, где находится ярлык! :(

Ответ:

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

чтобы получить путь, где лежит исполняемый файл надо использовать App.path - возвратит каталог с файлом без закрывающего слеша.

---

Ответ:

Автор ответа: Michael Fezulaev

MediaPlayer.Filename=App.Path + "\123.wav"

---

Ответ:

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

А ты так пробовал:

Private Sub Form_Load()
    MediaPlayer1.FileName= (app.Path & "\123.wav")
End Sub

---

Ответ:

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

App.Path - даёт директорию, в которой находится прога

---

Ответ:

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

Все просто

Private Sub Form_Load()
If Right(App.Path, 1) = "\" Then MediaPlayer1.FileName = Dir(App.Path & "123.wav") Else MediaPlayer1.FileName = Dir(App.Path & "\" & "123.wav")
End Sub

---

Ответ:

Автор ответа: Артем Кривокрисенко

App.path возвращает путь к исполняемому файлу (без последнего слэша)

---

Ответ:

Автор ответа: Мунгалов Андрей

А для этого есть такое свойство ярлыка как "Рабочая папка" в ней надо прописать дорогу до твоей директории.
Либо использовать функцию App.Path которая и возвращает дорогу где находиться программа.

---

---

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

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

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

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

наверх