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

Как расположить несколько чисел в порядке возрастания?

Вопрос:

Как расположить несколько чисел в порядке возрастания?

Ответ:

Можно сделать это следующим образом (данный код необходимо разместить в любом модуле)

Option Explicit

' Этот тип данных можно было не создавать,
' но я не нашёл другого способа делать ссылки на
' массив
' В этом случае можно ссылаться на массив по
' индексу переменной SArr

Private Type SortArray
   A() As Double
End Type
Dim SArr(1 To 2) As SortArray

Public Sub Sort(SortArr() As Double, ReadyArr() As Double)
' Данные берутся из массива SortArr и помещаются
' в массив ReadyArr

   ReDim SArr(1).A(UBound(SortArr)) 'Главный массив
   ReDim SArr(2).A(UBound(SortArr)) 'Временный массив

   Dim int1 As Integer
   Dim int2 As Integer
   For int1 = 1 To 2
       For int2 = 0 To UBound(SortArr)
           SArr(int1).A(int2) = SortArr(int2)
       Next int2
   Next int1
' Сначала временный и главный массивы содержат
' одинаковые данные
   JoinSort 0, UBound(SortArr), 1, 2 'Сортируем
   For int2 = 0 To UBound(SArr(1).A)
       ReadyArr(int2) = SArr(1).A(int2)
   Next int2
End Sub

Private Sub JoinSort(p As Integer, r As Integer, _
           arr1 As Integer, arr2 As Integer)
   Dim Q As Integer
' p-начало сортируемого массива
' r-его конец
' arr1 и arr2 - это ссылки на главный
' и временный массивы
' Q-середина массива

' Если массив состоит из одного элемента
' или он пустой, выходим
   If p >= r Then Exit Sub

' Находим середину массива
   Q = Int((p + r) / 2)
' Сортируем левую часть
   JoinSort p, Q, arr2, arr1

' Сортируем правую часть
   JoinSort Q + 1, r, arr2, arr1

' Объединяем обе части
   SortCon p, Q, r, arr2, arr1

End Sub

Private Sub SortCon(p As Integer, Q As Integer, r As Integer, _
       arr As Integer, Result As Integer)
'p-начало сортируемого массива
'Q-середина сортируемого массива
'r-конец сортируемого массива
'arr-ссылка на массив с данными
'Result-ссылка на массив, куда будут помещены данные

   Dim i As Integer, j As Integer, k As Integer
   i = p 'индекс, следящий за левой частью
   j = Q + 1 'индекс, следящий за правой частью
   k = p 'индекс, следящий за позицией в массиве-приёмнике

' Пока одна из частей не закончилась
   While i <= Q And j <= r

' Если значение в левой части меньше
       If SArr(arr).A(i) < SArr(arr).A(j) Then

' помещаем его в массив-приёмник
' и увеличиваем левый индекс на 1
           SArr(Result).A(k) = SArr(arr).A(i)
           i = i + 1

' иначе помещаем в массив-приёмник правое значение
' и увеличиваем правый индекс на 1
       Else
           SArr(Result).A(k) = SArr(arr).A(j)
           j = j + 1
       End If

' увеличиваем на 1 индекс массива-приёмника
       k = k + 1
   Wend

' Здесь одна из частей закончилась.
' Просто переписываем значения из оставшейся части
' в массив-приёмеик

' Если остались данные в левом массиве
   While i <= Q

' переписываем их, увеличивая каждый раз левый индекс
' и индекс массива-приёмника
       SArr(Result).A(k) = SArr(arr).A(i)
       i = i + 1
       k = k + 1
   Wend

' иначе проделываем тоже самое с провой частью
   While j <= r
       SArr(Result).A(k) = SArr(arr).A(j)
       j = j + 1
       k = k + 1
   Wend
End Sub

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

наверх

---

Как использовать в VB отчёты из "1C Предприятие"?

Вопрос:

В программах 1С очень удобные отчеты. можно ли их прицепить к своей программе на VB? И можно ли их таскать со свой программой (без установки всего предприятия). Я пробовал добавить ссылку на Moxel.dll, ругается.

Ответ:

Я видел на сайте Микрософта в разделе Office Extensions (конкурс там такой) модуль, который позволяет читать данные 1C в Excel. Поглядите, может быть он там еще есть? Думаю, что должно помочь.

Шатрыкин Иван

наверх

---

Проблема с Package & Deployment Wizard.

Вопрос:

При установке любой программы (после её закабинечивания мастером упаковки) пишет "неверные линии" в файле Setup.LST как раз там, где указан путь распаковываемых файлов. После сообщения о фатальной ошибке установка ПО прекращается.

Ответ:

Одно из решений проблемы - при создании дистрибутива измените системные языковые настройки Windows на американский формат. Второе решение - почитать
статью "Package & Deployment Wizard. Досадная ошибка" на сайте www.vbnet.ru.

Шатрыкин Иван

наверх

---

Как сделать некоторые участки формы прозрачными?

Вопрос:

Как сделать некоторые участки формы прозрачными (чтобы через них можно было видеть Рабочий стол) в VB?

Ответ:

Устал повторять, что на сайте www.vbnet.ru есть моя статья про создание таких окон.
http://www.vbnet.ru/articles/showarticle.asp?id=22
Почитайте! Там все рассказывается.

Шатрыкин Иван

наверх

---

Как получить аргументы командной строки?

Вопрос:

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

Ответ:

Можно, и очень просто.

Private Sub Main()
Dim strArg As String

   strArg = Command()
End Sub

Вот и все.
Пример подразумевает, что Main - это стартовая процедура проекта, ну а сами аргументы в переменной strArg. И помните, что в окне свойств проекта Вы можете задавать параметры запуска для отладки в среде.

Sergey Y. Tkachev

наверх

---

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

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

Вопросы:

---

Автор вопроса: C...R...a...S...H

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

   Как мне сделать отмену изменений в textboxe?

---

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

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

   Подскажите аналог Api - ExtFloodFill в VB.net.

---

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

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

   Использую клавиатурный хук из комплекта DanLib, и появляется такая пробемма, при нажатии на доп клавишу Play, или другую подобную комп наглухо виснет, а происходит это если на экране Winamp активен, если нет то все нормально. Может кто знает что делать? Если у кого есть рабочий глобальный хук на систему зоделитесь кодом.

---

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

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

   Как пользоваться api-шной функцикй waveoutgetvolume?

---

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

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

   Как программно создать в реестре параметр DROWD?

---

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

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

   Как можно определить наличие у мыши третьей, четвертой кнопки, колесика, второго колесика? И как со всем этим добром работать?

---

Ответы:

---

Вопрос:

   Как сделать, чтобы датчик случайных чисел выдавал целые числа в заданных интевалах (например, от 1 до 30)?

Ответ:

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

Int((<верхняяГраница> - <нижняяГраница>+ 1) * Rnd + <нижняяГраница>)
         <ВерхняяГраница> представляет максимальное число в диапазоне,
         а <нижняяГраница> минимальное число в диапазоне

---

Вопрос:

   Как средствами VB зарегистрировать в Windows библиотеку DLL и проверить, что она зарегистрирована?

Ответ:

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

Запускай REGSVR32 <путь\имя библиотеки>.

---

Вопрос:

   Как в VBA создать DLL?

Ответ:

Автор ответа: C...R...a...S...H

Никак.

---

Вопрос:

   Как запретить пользователю изменять размеры стандартной MDI формы (640*480) и разворачивать ее на весь экран? Изменять размеры после "ресайза" не предлагать.

Ответ:

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

Свойства формы Borderstyle и maxbutton.

---

Ответ:

Автор ответа: Gernovich Valentin

Поищи в интернете статьи на тему "Сабкласинг" обычно в примерах описывается как раз тема изменения размера формы.

Примерный код
Создаеш модуль с текстом:

Option Explicit

Private Const GWL_WNDPROC = -4
Private Const WM_GETMINMAXINFO = &H24

Private Type POINTAPI
     x As Long
     y As Long
End Type

Private Type MINMAXINFO
     ptReserved As POINTAPI
     ptMaxSize As POINTAPI
     ptMaxPosition As POINTAPI
     ptMinTrackSize As POINTAPI
     ptMaxTrackSize As POINTAPI
End Type

Dim lpPrevWndProc As Long
Dim gHW As Long

Private Type Resize
     xMin As Single
     yMin As Single
     xMax As Single
     yMax As Single
End Type

Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Sub CopyMemoryToMinMaxInfo Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub CopyMemoryFromMinMaxInfo Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, ByVal cbCopy As Long)
Dim rResize As Resize

Public Sub Hook(ByVal wHWND As Long, Optional ByVal X_Min As Single = 0, Optional ByVal Y_Min As Single = 0, Optional ByVal X_Max As Single = 0, Optional ByVal Y_Max As Single = 0)
     'Стартуем сабклассинг
     gHW = wHWND 'запомним хэндл, чтобы воспользоваться им при остановке классинга
     rResize.xMax = X_Max
     rResize.yMax = Y_Max
     rResize.xMin = X_Min
     rResize.yMin = Y_Min
     lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub Unhook()
     Dim temp As Long
     'Останавливаем сабклассинг
     temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub

Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MinMax As MINMAXINFO

     'Проверка, ресайзим ли мы окно
     If uMsg = WM_GETMINMAXINFO Then
         'Необходимо для заголовка child MDI окна (когда развернуто на весь экран)
         WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
         'получаем заданные по умолчанию параметры настройки Минимакса
         CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax)

         'Определяем новый минимальный размер окна
         'Если не присвоить какое-либо значение в MinMax.ptMinTrackSize.x(y), то
         'При ресайзе это значение будет игнорироваться. Тоже самое и для максимальног значения
         If rResize.xMin <> 0 Then MinMax.ptMinTrackSize.x = rResize.xMin
         If rResize.yMin <> 0 Then MinMax.ptMinTrackSize.y = rResize.yMin

         'Определяем новый максимальный размер окна
         If rResize.xMax <> 0 Then MinMax.ptMaxTrackSize.x = rResize.xMax
         If rResize.yMax <> 0 Then MinMax.ptMaxTrackSize.y = rResize.yMax

         'Копируем нашу структуру обратно
         CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax)

         WindowProc = DefWindowProc(hw, uMsg, wParam, lParam)
     Else
         WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
     End If
End Function



Далее в форме

Private Sub Form_Load()
     'стартуем САБКЛАССИНГ "Размера формы"
     Максимальные размеры по ширине и высоте экрана минимальные 200 на 300
     Hook Me.hwnd, 200, 300, (Screen.Width / Screen.TwipsPerPixelX) - 4, (Screen.Height / Screen.TwipsPerPixelY) - 120
End Sub


Private Sub Form_Unload(Cancel As Integer)
     'ВНИМАНИЕ НЕОБХОДИМО ОСТАНОВИТЬ САБКЛАССИНГ "Размера формы"
     Unhook
End Sub

---

Ответ:

Автор ответа: Куприянов Дмитрий

Где-то в Инете лежит ActiveX, который при помещении на форму позволяет задавать диапазон допустимых размеров формы.

---

Вопрос:

     На форме есть CommandButton1 и Label1.
  Необходимо добавить CommandButton2 при нажатии CommandButton1:

Dim Mycmd as Control
Private Sub CommandButton1_Click()

     Set Mycmd = Controls.Add("MSForms.CommandButton.1") ', CommandButton2, Visible)
     Mycmd.Left = 18
     Mycmd.Top = 150
     Mycmd.Width = 175
     Mycmd.Height = 20
     Mycmd.Caption = "This is fun." & Mycmd.Name
     
End Sub

Private Sub UserForm_AddControl(ByVal Control As _
     MSForms.Control)
     Label1.Caption = "Control was Added."
End Sub

  Что и как исправить в программе (выдает: несоответствие типов)?

Ответ:

Автор ответа: Куприянов Дмитрий

Если сильно не заморачиваться, то сделай сразу вторую кнопку, но невидимой, а в нужный момент ее покажешь и все.

---

Вопрос:

   А как программно сделать моё окно активным? Me.SetFocus - не помогает... Пробовал АПИ GetFocus, SetFocus, SetActiveWindow - тоже самое... Может кто подскажет?

Ответ:

Автор ответа: Сан Саныч

Есть АПИ ф-ия SetForegroundWindow. В ней надо передать хендл окна которое надо установить текущим.

---

Ответ:

Автор ответа: Веселов Даниил Анатольевич

AppActivate "Название окна"

---

Вопрос:

   Как создавать заставки? Если можно с примерчиком.

Ответ:

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

На http://www.vbnet.ru/ была статья про то, как создавать заставки.

---

Ответ:

Автор ответа: Куприянов Дмитрий

Сначала из шаблонов втыкаешь заготовку в свой проект. Оформляешь его по-своему. А затем в модуле пишешь

Option Explicit
Public Sub Main
         'показать заставку
         frmSplash.Show
         DoEvents
         'выполняем подготовительные действия
         ……
         'Убрать заставку и начать работу
         Unload frmSplash
         frmMain.Show
End Sub

---

---

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

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

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

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

наверх