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

Книги

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

наверх

---

SHChangeIconDialog

Роман ВД:

в разделе про "Работа с элементами CommonDialog библиотеки Comdlg32.dll " Вы дали следующее объявление функции:

Private Declare Function SHChangeIconDialog Lib "Shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As String, ByVal Reserved As Long, lpIconIndex As Long) As Long

под win2000 (или везде ?) сие не пашет ! Т.е.: индекс иконки возвращает, но имя выбранного файла - нет (вернеее параметр остается неизменным). Кроме того, если определить параметры szFilename, lpIconIndex, выскакивает дурацкая ошибка: "не удается найти файл" & String(Len(szFilename),Chr$(0)) & "бяка" - куча крякозябликов.

Я проверил параметры - надо писать:

Private Declare Function SHChangeIconDialog Lib "Shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As String, BYREF Reserved As Long, lpIconIndex As Long) As Long

тогда можно и передавать имя файла и индекс, и примать их (ф-ция по ходу рабтает с WideString).

Пример:

Private Declare Function SHChangeIconDialog Lib "Shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As String, Reserved As Long, lpIconIndex As Long) As Long

Public Declare Function GetFGWin Lib "user32.dll" Alias "GetForegroundWindow" () As Long

...

Public Function ShowIcon(nIconIdx As Long, FileName As String)as Boolean Dim k As Long

     ShowIcon=False

     'добавить после каждого символа в имени файла нулевой символ
     FileName = AddNull(FileName)

     If SHChangeIconDialog(GetFGWin, FileName, k, nIconIdx) Then
         'убрать после каждого символа в имени файла нулевой символ
         FileName = DelNull(FileName)

         MsgBox FileName & ", " & nIconIdx & ", " & k
         ShowIcon=True
     End If
End Function

Private Function DelNull(ByVal StrNull As String) As String
Dim A As String, I As Long
     Do
         I = InStr(StrNull, Chr$(0))
         A = A & Left$(StrNull, I - 1)
         StrNull = Mid$(StrNull, I + 1)
     Loop Until I = 1 Or I = 0 Or StrNull = ""
     DelNull = A
End Function

Private Function AddNull(ByVal NotNullStr As String) As String
Dim A As String, I As Long, C As Long
     I = 1: C = Len(NotNullStr)
     While I <= C
         A = A & Mid$(NotNullStr, I, 1) & Chr$(0)
         I = I + 1
     Wend
     AddNull = A & String$(520 - Len(A), Chr$(0))
End Function

все работает (win2000, srvpack#2)


наверх

---

Спрятать/Показать кнопку "Пуск"

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
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 Sub Command1_Click()
'спрятать кнопку "Пуск"
OurParent& = FindWindow("Shell_TrayWnd", "")
OurHandle& = FindWindowEx(OurParent&, 0, "Button", vbNullString)
ShowWindow OurHandle&, 0
End Sub

Private Sub Command2_Click()
'показать кнопку "Пуск"
OurParent& = FindWindow("Shell_TrayWnd", "")
OurHandle& = FindWindowEx(OurParent&, 0, "Button", vbNullString)
ShowWindow OurHandle&, 5
End Sub

наверх

---

Установить скорость выпадания меню кнопки ПУСК

При запуске данного кода вам будет предложено набрать любую цифру от 1(быстрее) до 1000(медленнее), которая характеризует скорость выпадания меню.
Внимание! После применения данного кода возможна перезагрузка машины, для того, чтобы новые данные вступили в силу.

Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Private 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
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
Const REG_SZ = 1
Const REG_DWORD = 4

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

Private Sub Command1_Click()
On Error GoTo Error
A% = InputBox("Наберите число от 1 до 1000", "Скорость меню ПУСК")
If A% > 0 And A% < 1001 Then
B$ = CStr(A%)
'создание ключа MenuShowDelay в реестре
Call savestring(HKEY_CURRENT_USER, "Control Panel\Desktop", "MenuShowDelay", B$)
'перезагрузка машины
MsgBox "Reset your Computer", , "Changes are made"
t& = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)
Else
MsgBox "Not a valid number between 1 and 1000"
End If
Exit Sub
Error:
MsgBox "Invalid Data Input"
End Sub

наверх

---

Включить/выключить панель задач Windows

Добавьте на форму 2 CommandButton. Первая кнопка спрячет панель задач (там где расположена кнопка ПУСК), вторая - покажет.

'Вариант 1
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Private Sub Command1_Click()
hwnd1 = FindWindow("Shell_traywnd", "")
Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub
Private Sub Command2_Click()
hwnd1 = FindWindow("Shell_traywnd", "")
Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub


'Вариант 2
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Const SW_HIDE = 0
Const SW_SHOW = 5

Public Sub ApplicationBar(Visible As Boolean)
Dim hWnd As Long
hWnd = FindWindow("Shell_TrayWnd", "")
If Visible Then
ShowWindow hWnd, SW_SHOW
Else
ShowWindow hWnd, SW_HIDE
End If
EnableWindow hWnd, Visible
End Sub

Private Sub Command1_Click()
ApplicationBar False
End Sub

Private Sub Command2_Click()
ApplicationBar True
End Sub

наверх

---

Определение местоположение TaskBar

Данный пример покажет местоположение панели задач (там, где кнопка ПУСК :)))

Не забудьте расположите на форме элемент CommandButton.

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Const tBarClass = "Shell_TrayWnd"
Dim tBarHwnd As Long
Dim tBarRect As RECT

Private Sub Command1_Click()
' узнать handle ТаскБара
tBarHwnd = FindWindow(tBarClass, "")
If tBarHwnd = 0 Then
MsgBox "Указанное окно не найдено!", 0
Else
' Окно найдено, идет определение местоположения taskbar
GetWindowRect tBarHwnd, tBarRect
If tBarRect.Left = -2 And tBarRect.Top > -2 Then
' Taskbar внизу экрана
MsgBox "Taskbar is at the bottom of the screen.."
End If
If tBarRect.Left > -2 And tBarRect.Bottom = Screen.Height / Screen.TwipsPerPixelY + 2 Then
' Taskbar справа от экрана
MsgBox "Taskbar is aligned at the right of the screen.."
End If
If tBarRect.Bottom <> Screen.Height / Screen.TwipsPerPixelY + 2 And tBarRect.Right = Screen.Width / Screen.TwipsPerPixelX + 2 Then
' Taskbar сверху экрана
MsgBox "Taskbar is at the top of the screen.."
End If
If tBarRect.Right <> Screen.Width / Screen.TwipsPerPixelX + 2 And tBarRect.Bottom = Screen.Height / Screen.TwipsPerPixelY + 2 Then
' Taskbar слева от экрана
MsgBox "Taskbar is aligned at the left of the screen.."
End If
End If
End Sub

наверх

---

Очистить/показать содержимое корзины

Данный код вызывает окно "Очистить содержимое корзины?"

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

Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hWnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SHERB_NOPROGRESSUI = &H2
Const SW_SHOWNORMAL As Long = 1

Private Sub Command1_Click()
Call SHEmptyRecycleBin(Me.hWnd, "", SHERB_NOPROGRESSUI)
End Sub

Private Sub Command2_Click()
Dim success As Long
success = ShellExecute(h, "Open", "explorer.exe", "/root,::{645FF040-5081-101B-9F08-00AA002F954E}", 0&, SW_SHOWNORMAL)
End Sub

наверх

---

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

BalloonMessage for MS Agent


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

наверх

---

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

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

Вопросы:

---

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

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

   Как просматривать все картинки ия выбранной папки,открыв одну ия них.(Примерно как это делается в ACDSee)

---

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

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

   1.Как перевести из *.BMP >>> *.JPG и обратно ?
2.Как в ресурсы запихнуть *.jpg а потом их открыть ???

---

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

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

   Что известно о "регулярных выражениях" в VB? Где можно прочитать о классе VBScript_RegExp и о его специфике (по сравнению с регулярными выражениями в Perl, Planner и Snobol)?
P.S. MSDN не рекомендуйте - денег на него, увы, нет и не предвидится, к тому же по-аглицки не понимаю...

---

Автор вопроса: Андрей

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

   Что такое броузер объектов (вызываемый по F2) и для чего он нужен. Я там нашел HTMLFontElement (если установле MS HTML Objekt Library). Все мне это нужно для того чтобы изменить шрифт в Web Brawsere (или можно где-нибудь еще показать страницу с кодом HTML?) как в IE.

---

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

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

   Подскажите пожайлуста, как можно обратится к почтовым базам данных Outlook Express из VB:
- просмотреть структуру локальных папок;
- пролистать письма в папке на наличие ключевого слова.

---

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

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

   Как получить список запушенных файлов. Как отследить запуск конкретного файла

---

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

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

   У меня не получается загрузить изображение на кнопке програмно.Ни при помощи ImageList,ни при помощи LoadPicture. Аксес 97 пишет в обоих случаях,что не удается открыть файл и далее номер файла и он всегда разный.Что не так?

---

Автор вопроса: Roman V.Dorozhouckoph

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

   Я работаю под win2000. Функция SHChangeIconDialog: индекс иконки возвращает, но имя выбранного файла - нет (вернеее параметр остается неизменным), что не так?
пример:

Private Declare Function SHChangeIconDialog Lib "Shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As String, ByVal Reserved As Long, lpIconIndex As Long) As Long

Public Declare Function GetFGWin Lib "user32.dll" Alias "GetForegroundWindow" () As Long

Public Function ShowIcon()
Dim nIconIdx As Long, FileName As String

     FileName = String$(260, 0)
     If SHChangeIconDialog(GetFGWin, FileName, 0, nIconIdx) Then
         MsgBox FileName & ", " & nIconIdx
     End If
End Function

---

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

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

   Помогите с какого сайта скачать VB6

---

Автор вопроса: Олег

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

   Как вставить выбранную яапись ия Flex(Data)Grid в другую форму?

---

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

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

   Луди подскажите как мне из дос в вин кодировку и обратно.

---

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

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

      Вопрос по Ехелю ...
   Мне нужно выбрать значения ячеек из одного листа книги и сравнить их со значениями ячеек в другом листе той же книги. Вот, что у меня есть:

Private Sub CommandButton1_Click()
Dim cell As Range
Dim ans(200) As Integer
Dim err
err = 0
i = 0
'--------Перебор ячеек с вводимыми значениями-------
For Each cell In Range("B3:F42").Cells
     ans(i) = cell
     i = i + 1
Next cell
'--------Переход на лист с эталонными значениями----
Sheets("Лист2").Select
'--------Перебор ячеек с правильными значениями и сравнение-------
i = 0
For Each cell In Range("G1:K40").Cells
     If cell <> ans(i) Then
         err = err + 1
     End If
     i = i + 1
Next cell
'--------Возврат на лист с вводимыми значениями-----
Sheets("Лист1").Select
End Sub

   Происходит же следующее:
   - Он выбирает введенные значения с Листа1
   - Переходит на Лист2 (по крайней мере, на экране это видно)
   А вот диапазон G1:K40 он все равно берет с Листа1 (как бы насквозь Листа2). И, следовательно, сравнивает с пустыми ячейками.
   Так вот, собственно, сам вопрос: как сделать так, чтобы диапазон G1:K40 выбирался именно с Листа2, а не с Листа1?

---

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

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

   Можно ли в VB узнать о том, что работает винт(дублировать лампочку работы винта)...
Если да...
То как привязать к TextBoxs`у...
Например:
Когда заработал винт(начал чё нить читать)... то в TextBoxs`е высвечивается "ON", а когда винт находится в пассивном режиме-"OFF"

---

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

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

   Люди, подскажите, как ияменять реярешение экрана программно?

---

Ответы:

---

Вопрос:

   Есть Винда 3.1.
1) Как програмно узнать содержимое групп в диспетчере программ? (я имею ввиду как узнать какие ярлыки в группе).

2) Можно как то програмно поменять строку заголовка любого открытого окна?

Ответ:

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

     Расположи на форме List1(список всех открытых окон), Text1(новый заголовок окна). Двойным щелчком мыши по списку меняй заголовки на свои!!!
'Текст модуля
  
Option Explicit
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public HandleCol As New Collection
Public CaptCol As New Collection
Public ClassNameCol As New Collection
Public Function EnumWindowsProc(ByVal HandleW As Long, ByVal lPraram&) As Long
Dim TextW As String, LenTextW As Long, res As Long
HandleCol.Add HandleW
TextW = VBA.String$(255, vbNullChar)
LenTextW = VBA.Len(TextW)
res = GetWindowText(HandleW, TextW, LenTextW)
If res > 0 Then
TextW = VBA.Left(TextW, res)
CaptCol.Add TextW
End If
TextW = VBA.String$(255, vbNullChar)
LenTextW = VBA.Len(TextW)
res = GetClassName(HandleW, TextW, LenTextW)
If res > 0 Then
TextW = VBA.Left(TextW, res)
ClassNameCol.Add TextW
End If
EnumWindowsProc = 1
End Function
  
'Текст формы
Private Sub Form_Load()
On Error Resume Next
Dim item As Variant, res As Long
res = EnumWindows(AddressOf EnumWindowsProc, 0&)
res = 0
For Each item In CaptCol
List1.AddItem item
res = res + 1
If res > (CaptCol.Count - 1) Then Exit For
Next item
End Sub
Private Sub List1_DblClick()
a = FindWindow(vbNullString, List1.List(List1.ListIndex))
SetWindowText a, Text1.Text
List1.Clear
Form_Load
End Sub

---

Вопрос:

   Как лучше выполнять процедуру каждые 2 сек.? Я пользуюсь таймером, но переодически получаю "Msgsrv32 not responding". Может это не связано...

Ответ:

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

Скорее всего это не глюк таймера, а какого-то другого приожения, поскольку у меня такого никогда не возникало. Таймер исправно работает.

---

Вопрос:

   Как в VB6 зделать ссылку на файл (любой), чтобы его открыть (запустить)?
  
p.s. Хочу зделать Авторан для CD!

Ответ:

Автор ответа: Duke Nukem

Сделай LABEL чтоб при наведении на него менялся цвет и курсор а под ним напиши SHELL "PATCH\FILE" Если надо конкретней напиши лично мне

---

Вопрос:

   Как в VB6 зделать ссылку на файл (любой), чтобы его открыть (запустить)?
  
p.s. Хочу зделать Авторан для CD!

Ответ:

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

можно вопользоваться стандартным действием:

Shell ( в кавычках то, что будем запускать )

Вставить это нужно будет либо на кнопку, либо на то, что запускает нужное приложение.

---

Вопрос:

   А как сделать переяагруяку или выключение компьютера программно (у меня Visual Basic 6.0)?

Ответ:

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

Разместите в модуле:

    Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
      ByVal dwReserved As Long) As Long

    Public Const EWX_LOGOFF = 0
    Public Const EWX_SHUTDOWN = 1
    Public Const EWX_REBOOT = 2
    Public Const EWX_FORCE = 4

А это в коде:

    Dim s As Long

    'Так можно сделать Shut down
     s = ExitWindowsEx(EWX_SHUTDOWN, 0&)

    'Так можно сделать Log off
    s = ExitWindowsEx(EWX_LOGOFF, 0&)

    'А так Reboot
    s = ExitWindowsEx(EWX_REBOOT, 0&

---

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

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

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

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

наверх