Голосование:
Голосования сайта VBNet.Ru. Результаты голосований передаются на сайт. Проследите, что есть соединение с интернетом.
Ссылки:
Несколько слов от автора:
Новый выпуск. Обращаю Ваше внимание: на нашем сайте VBNet.Ru новый дизайн. Так что заходите, не пожалеете.
Читайте!
Читайте!
Содержание выпуска
- Книги
- Конкурс!!!
- Как скопировать данные из одного ListBox в другой ListBox или ComboBox
- Определение, какая item находится под курсором мышки в листбоксе
- Сканировать ListBox в поисках элемента
- Пример поиска в ListBox'е
- Автоматическое выделение элемента в ListBox'е
- Какой элемент выделен? (по номеру)
- Вопрос/Ответ
Книги
Остальные книги о VB можно найти здесь.
наверх
Конкурс!!!
Сайт PocketGames.ru приглашает принять участие в конкурсе на разработку игр для устройств на базе платформ PocketPC и других мобильных платформ.
Конкурс проходит с 20 декабря 2002 г., по 10 февраля 2003 г. Принимаются игры не только для PocketPC, но и для других мобильных платформ.
Первое место приносит победителю: PocketPC
Второе и третье места: флэш-накопитель (USB-брелок).
Поощрительные бонусы (каждому участнику конкурса): 1 месяц (или 10 тыс., что истечет раньше) показов баннеров на сайте PocketGames.ru, 1 тыс. показов в Handy Banner Network, а также публикация ссылки на компанию в каталоге разработчиков и на программы (на каждую) в каталоге игр, обзор любой программы по выбору автора.
Разработка не требует "живого" устройства, достаточно эмулятора из SDK. Информация о том, где найти SDK и эмуляторы находится в статье http://www.pocketgames.ru/article.php?sid=160.
Удачный повод разобраться с новой платформой для Visual Basic!
наверх
Как скопировать данные из одного ListBox в другой ListBox или ComboBox
Добавьте на форму 2 ListBox, 1 ComboBox и 2 CommandButton
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Sub Command1_Click()
Dim success As Long
success = CopyListToList(List1, List2)
End Sub
Private Sub Command2_Click()
Dim success As Long
success = CopyListToCombo(List1, Combo1)
If success Then Combo1.ListIndex = 0
End Sub
Private Function CopyListToList(source As ListBox, target As ListBox) As Long
Dim c As Long
Const LB_GETCOUNT = &H18B
Const LB_GETTEXT = &H189
Const LB_ADDSTRING = &H180
Dim numitems As Long
Dim sItemText As String * 255
numitems = SendMessageLong(source.hWnd, LB_GETCOUNT, 0&, 0&)
If numitems > 0 Then
For c = 0 To numitems - 1
Call SendMessageStr(source.hWnd, LB_GETTEXT, c, ByVal sItemText)
Call SendMessageStr(target.hWnd, LB_ADDSTRING, 0&, ByVal sItemText)
Next
End If
numitems = SendMessageLong(target.hWnd, LB_GETCOUNT, 0&, 0&)
CopyListToList = numitems
End Function
Private Function CopyListToCombo(source As ListBox, target As ComboBox) As Long
Dim c As Long
Const LB_GETCOUNT = &H18B
Const LB_GETTEXT = &H189
Const CB_GETCOUNT = &H146
Const CB_ADDSTRING = &H143
Dim numitems As Long
Dim sItemText As String * 255
numitems = SendMessageLong(source.hWnd, LB_GETCOUNT, 0&, 0&)
If numitems > 0 Then
For c = 0 To numitems - 1
Call SendMessageStr(source.hWnd, LB_GETTEXT, c, ByVal sItemText)
Call SendMessageStr(target.hWnd, CB_ADDSTRING, 0&, ByVal sItemText)
Next
End If
numitems = SendMessageLong(target.hWnd, CB_GETCOUNT, 0&, 0&)
CopyListToCombo = numitems
End Function
Private Sub Form_Load()
List1.AddItem "1"
List1.AddItem "2"
List1.AddItem "3"
End Sub
наверх
Определение, какая item находится под курсором мышки в листбоксе
Часто, бывает нужда в определении элемента, над которым пользователь держит мышку. Как наиболее тривиальное применение - вывод дополнительной информации или подсказки в статус бар, причем контекстно зависимой от элемента. Или, например, показ текущего элемента в другом листбоксе. Бэйсик сам не дает нам такой функциональности, но к счастью, используя API функцию SendMessage() и константу LB_ITEMFROMPOINT такая возможность у нас появляется.
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
'LB_ITEMFROMPOINT - это сообщение будет извлекать индекс (начиная с 0)
'Обьявляем эту константу там же
Private Const LB_ITEMFROMPOINT = &H1A9
'Координаты мыши будут передаваться в параметр lParam , и значение этих координат должно быть в пикселях . VB cвои значения выдает в твипсах, соотвественно мы должны позаботиться о конвертации перед передачей этих значений в API функцию.
'Это можно сделать так: ((YPosition * 65536) + XPosition))
'Ну, и наконец, SendMessage() может возвращать вам два типа значений.
'Если функция определяет, что указатель мыши находится над листбоксом - то она вернет номер индекса листбокса.
'Если мышка в другом месте, то функция вернет значение равного старшему слову координаты плюс 65537. Собственно достаточно будет проверить на соотвествие возвращаемый индекс.
'Вряд ли кто то будет держать в листбоксе столько элементов.
'Итак, нижеследующий код показывает как это все написать.
Private Sub Form_Load()
List1.AddItem "11"
List1.AddItem "22"
List1.AddItem "33"
List1.AddItem "44"
End Sub
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim P As Long
Dim XPosition As Long, YPosition As Long
XPosition = CLng(X / Screen.TwipsPerPixelX)
YPosition = CLng(Y / Screen.TwipsPerPixelY)
P = SendMessage(List1.hWnd, LB_ITEMFROMPOINT, 0, ByVal ((YPosition * 65536) + XPosition))
If P < List1.ListCount Then
MsgBox "текущее значение индекса - : " & P
End If
End Sub
наверх
Сканировать ListBox в поисках элемента
Добавьте на форму элементы ListBox и TextBox. Набирая в TextBox'е, к примеру, цифры "229" вы попадете на первый элемент ЛистБокса, содержащий эти цифры. В данном примере вы попадете на элемент "2291".
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Const LB_FINDSTRING = &H18F
Private Sub Form_Load()
List1.AddItem "111"
List1.AddItem "222"
List1.AddItem "228"
List1.AddItem "2291"
List1.AddItem "2293"
List1.AddItem "2297"
End Sub
Private Sub Text1_Change()
List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
End Sub
наверх
Пример поиска в ListBox'е
Данный пример отсеит все неподходящие по критерию элементы одного ListBox'а в другой.
Расположите на форме элементы TextBox и 2 элемента ListBox (смотри рисунок)
Private Sub Text1_Change()
intPlacement = Len(Text1)
strFind = UCase(Text1.Text)
List1.Clear
For intResult = 0 To List2.ListCount
intSearchResult = InStr(UCase(Left(List2.List(intResult), intPlacement)), strFind)
If intSearchResult > 0 Then List1.AddItem List2.List(intResult)
Next intResult
End Sub
Private Sub Form_Load()
Text1.Text = ""
With List2
.AddItem "МП-Ком правда"
.AddItem "Tanya"
.AddItem "Shannon"
.AddItem "Московская правда"
.AddItem "Московский комсомолец"
.AddItem "Московские новости"
.AddItem "Johnny"
.AddItem "Mike"
.AddItem "Derek"
.AddItem "Scotty"
.AddItem "МП-Сов Рос"
.AddItem "Scott"
.AddItem "Tyna"
.AddItem "Diana"
.AddItem "Chris"
.AddItem "Stanley"
.AddItem "Kamal"
.AddItem "МП-Куряд"
End With
End Sub
наверх
Автоматическое выделение элемента в ListBox'е
Данный пример покажет, как можно автоматически выделить строчку в элементе ListBox, при прохождении над ним курсора мыши.
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Const LB_GETITEMHEIGHT = &H1A1
Private Sub Form_Load()
List1.AddItem "aaa"
List1.AddItem "bbb"
List1.AddItem "ccc"
List1.AddItem "ddd"
List1.AddItem "eee"
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
List1.ListIndex = -1
End Sub
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ItemHeight As Integer
ItemHeight = SendMessage(List1.hWnd, LB_GETITEMHEIGHT, 0, 0)
Y = min(((Y / Screen.TwipsPerPixelY) \ ItemHeight) + List1.TopIndex, List1.ListCount - 1)
Label1.Caption = "Выделен элемент " & Y
List1.ListIndex = Y
End Sub
Function min(X As Integer, Y As Integer) As Integer
If X > Y Then min = Y Else min = X
End Function
наверх
Какой элемент выделен? (по номеру)
Добавьте на форму элементы ListBox и CommandButton
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const LB_GETCURSEL = &H188
Private Sub Form_Load()
List1.AddItem "11"
List1.AddItem "22"
List1.AddItem "33"
End Sub
Private Sub Command1_Click()
Print "Выделен элемент под номером: " & SendMessage(List1.hwnd, LB_GETCURSEL, 0&, 0&)
End Sub
наверх
Мои программы
BalloonMessage for MS Agent
Автора: Шатрыкин Иван и Павел Сурменок.
наверх
Вопрос/Ответ
Автор вопроса: Alexey
Ответ ожидается по этому адресу
У меня такой вопрс: Как сделать паузу в выполнении программы. Я помню в обычном бейсике это sleep(в секундах) или delay (в миллисекундах). А как сделать то же самое в VB 6.0?
Автор вопроса: Alexbor
Ответ ожидается по этому адресу
Мне хотелось бы во время индикации процесса выполнения показывать тематический avi-файл, пока идет копирование, но авишник выполняется только один раз, может кто в курсе как его в этот момент зациклить до команды close MCI-устройства.
Автор вопроса: timshv@graffiti.net
Ответ ожидается по этому адресу
Как сделать мигающей иконку приложения в трее, подобно в ICQ?
У меня проблема в следующем: не знаю как сделать невидимой иконку
приложения или подставить пустую иконку не обращаясь к файлу иконки на
диске.
Автор вопроса: shadow
Ответ ожидается по этому адресу
Как определить какая раскладка клавиатуры включена в данный момент в активном окне?
Если так:
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private Sub Form_Load()
Dim KeybLayoutName As String
KeybLayoutName = String(9, 0)
GetKeyboardLayoutName KeybLayoutName
Tetx1.Text = CStr(CLng(Left$(KeybLayoutName, _
InStr(1, KeybLayoutName, Chr(0)) - 1)))
End Sub
,
то определяется раскладка моей формы.
Автор вопроса: Андрюха
Ответ ожидается по этому адресу
Здрасте, у меня несколько вопросиков.
1. Видел в одной проге при запуске формы о программе, Шрифт текста плавно меняет цвет с темно синего на ярко голубой и обратно, может кто знает как это делается? Если не трудно намыльте пример.
2. Можно ли в ListWiev добавить пустую строку, и удалить текущую, (ту в которой находиться курсор. Ни нашел ни одного примера.
3. Откуда можно считать информацию об адресе последнего сохраненного файла Word.dox в случае с екселем понятно, в реестре он прописывает конкретный адрес открытым шрифтом, а вот Word облазил весь реестр не нашел.
Автор вопроса: PRGR
Ответ ожидается по этому адресу
Вот надо составить список имён в Textbox'е. Т.е. пользователь набирает имя, щёлкает Enter и прога загружает нужную форму.
Автор вопроса: Michael Fezulaev
Ответ ожидается по этому адресу
Есть textbox мне нужна сделать так что-бы когда его свойства Locked=true то правая кнопка мышки не показавала меню
Ответы:
Вопрос:
Есть файл Avi, ножно сунуть его в прогу ,чтобы не тоскать его отдельно. Кто-нибудь знает как ??? Мои эксперементы с ole обламилсь:((((((((( если ,конечно, ole это то ,что нужно.
Ответ:
Автор ответа: -=CBK=-CRaSH
Попробуй подключить AVI как ресурс
Вопрос:
Кто-нить скажите как подключить ресурс к проэкту???
Ответ:
Автор ответа: Иващенко Алексей
В проекте делаешь Project->Add File... Дальше выбираешь свой Res файл. А в программе используешь при помощи функций - LoadResPicture,LoadResString, LoadResData
Вопрос:
Как для Windows 98/XP на форме запустить avi-файл?
Ответ:
Автор ответа: Иващенко Алексей
Маленькие не компрессированные Avi - компонент Animation
Полноценные Avi (и вообще всю мультимедию) - компонент MMControl
Вопрос:
у меня имеется рисунок, очень большого размера (3000 х 4000), мне надо его разместить на форме, в маленьком размере (300 х 400), а также кнопку по нажитии, которой картинка бы увеличивалась, причем что бы она не залазила за форму, а появлялись ползунки, которыми можно было просмотреть невидимую часть рисунка.
Ответ:
Автор ответа: P@Ssword
На форму кладётся контейнер (любой, напр. ПикчеБокс), в него - два ползунка и Image. У Image свойство Stretch = True. Когда нужен зум, делаешь Stretch = False и пи ивентам ползунков двигаешь Image (напр., Image.Move (HScroll.Value, VScroll.Value).
Вопрос:
Необходимо создать контрольную сумму к строке текста, строка состоит из русских символов.
Подскажите как это можно сделать CRC и после проверить ее.
Ответ:
Автор ответа: P@Ssword
У меня это оформлено как модуль класса, для подсчёта - GetStringCRC32:
Dim CRCTable(0 To 255) As Long
Private Sub Class_Initialize()
Dim Ind As Long, Ind2 As Long
Dim CRC As Long, Bit As Long
Const Polynomial As Long = &HEDB88320
For Ind = 0 To 255
CRC = Ind
For Ind2 = 0 To 7
Bit = CRC And &H1
CRC = ((CRC And &HFFFFFFFE) \ &H2) And &H7FFFFFFF
If Bit = &H1 Then CRC = CRC Xor Polynomial
Next Ind2
CRCTable(Ind) = CRC
Next Ind
End Sub
Function AddCRC(ByteAry() As Byte, ByVal CRC As Long) As Long
Dim Ind As Long
For Ind = 0 To UBound(ByteAry)
CRC = (((CRC And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor
CRCTable((CRC And &HFF) Xor ByteAry(Ind))
Next Ind
AddCRC = CRC
End Function
Function InvertCRC(ByVal CRC As Long) As Long
CRC = CRC Xor &HFFFFFFFF
InvertCRC = CRC
End Function
Function GetStringCRC32(Str As String) As Long
Dim CRC As Long
Dim BAry() As Byte
BAry = Str
CRC = AddCRC(BAry, &HFFFFFFFF)
CRC = InvertCRC(CRC)
GetStringCRC32 = CRC
End Function
Вопрос:
Скачал исходник ричтекстбокса, добавил его в проект, все отлично работает,но когда попытался скомпилить проект мне сказали что нужна двоичная совместимость. Я ставил совместимость и со скачанным контролом и с тем который сам скомпилил(отдельно от моего проекта контрол компилится без вопросов), все равно выдается сообщение что нужна двоичная совместимость.
Ответ:
Автор ответа: Иващенко Алексей
Поставь эту совместимость в обоих проектах
Вопрос:
Можно ли сделать так, чтобы при старте программы данные из определённого файла записывальсь в событие, например cmd1_click ()
И как это сделать?
Ответ:
Автор ответа: P@Ssword
Надо использовать Windows Scripting Host. При загрузке читаешь исходник на VBScript из файла, а в cmd1_click () исполняешь его.
Вопрос:
Может кто из Вас знает, как замерять время меньше 1 мс?? Пробовал через Sleep - и замерял его через timeGetTime - то он даже 1 мс не держит если указать "Sleep 1" (а гдето 2-5 мс выходит), а если Sleep 0.5 - то уже ближе к 1 мс, но всё равно он как-то глючит. Его мининимум может быть только 0.1 или 0.5, а если больше чем 0.6 - то около 2-6 мс!
Может кто подскажет, как тут быть?
В Свойствах системы откопал ресурсы системного таймера (там 4 регистра - от &H40 до &H43). Подключился к ним - но вот закономерность нарастания немогу никак вдуплить!
Может есть ещё какито АПИ ф-ции или какието счётчики или таймера?????
Ответ:
Автор ответа: P@Ssword
...он даже 1 мс не держит если указать "Sleep 1" (а гдето 2-5 мс
выходит)...
А время, затраченное на вызов функций, высчитывалось?
...а если Sleep 0.5...
Насколько я понял, Sleep - это API-функция. Если так, то любой API-Viewer Вам скажет, что она принимает целочисленный параметр. Похоже, что Sleep получал ноль, а те миллисекунды - это время на вызов самих функций.
Вопрос:
Может кто-нибудь знает как в MSChart сделать гладкий график?
Ответ:
Автор ответа: P@Ssword
От своего предложения я не отказываюсь - можно интерполировать результаты в плавный график, а затем добавить его в MSChart.
Вопрос:
Как объединить три переменные в одно выражение, а не текст. например я пишу прогу калькулятор. У меня есть три переменные
Znak=+, -,*,/
x= 1-е число
y= 2-е
как мне записать с помощью этих переменных 2+4, например?
Как объединить x, Znak и y?
Ответ:
Автор ответа: Игорь Станиславович
Тогда уже лучше так:
select case znak
case "-"
rez = x - y
case "+"
rez = x + y
case "*"
rez = x * y
case "/"
rez = x / y
end select
x нужно чтобы было объявлено как double, тоже самое с x и rez.
Ответ:
Автор ответа: Loki
Создай еще одну переменную.
Типа Suma
Suma=x & Znak & y
Ответ:
Автор ответа: Sacha
Если нужно, чтобы прога складывала числа, например 2 + 2=4, то нужно создать Label c именем Label1), TextBox с именем Text1, TextBox с именем Text2 и кнопку с именем Command1. Потом нухно записать в код кнопки следующий код:
Private Sub Command1_Click()
Label1.Caption = Val(Text1) + Val(Text2)
End Sub
Кажись, всё.
Ответ:
Автор ответа: ViTal
Dim result As String
rezult = CStr(x) & Znak & CStr(y)
Вопрос:
Где можно найти значение констант для API, если в API Text Viewer их нет.
У меня MNSD januari 2002, но и там не могу найти!
Ответ:
Автор ответа: Владимир Кирко
На http://www.allapi.net/agnet/apiviewer.shtml лежит ApiViewer с описаниями:
констант - 55634 штук,
фунций - 4813 штук,
подпр. - 1708 штук,
типов - 457 штук.
Может в ём найдете?
Ответ:
Автор ответа: Андрей Щёкин
Лучший способ - набери имя константы на www.ya.ru или www.google.com.
Если стоит VC - посмотри в поддиректории Include, файл winuser.h.
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по 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 можно найти здесь.
наверх
Конкурс!!!
Сайт PocketGames.ru приглашает принять участие в конкурсе на разработку игр для устройств на базе платформ PocketPC и других мобильных платформ.
Конкурс проходит с 20 декабря 2002 г., по 10 февраля 2003 г. Принимаются игры не только для PocketPC, но и для других мобильных платформ.
Первое место приносит победителю: PocketPC
Второе и третье места: флэш-накопитель (USB-брелок).
Поощрительные бонусы (каждому участнику конкурса): 1 месяц (или 10 тыс., что истечет раньше) показов баннеров на сайте PocketGames.ru, 1 тыс. показов в Handy Banner Network, а также публикация ссылки на компанию в каталоге разработчиков и на программы (на каждую) в каталоге игр, обзор любой программы по выбору автора.
Разработка не требует "живого" устройства, достаточно эмулятора из SDK. Информация о том, где найти SDK и эмуляторы находится в статье http://www.pocketgames.ru/article.php?sid=160.
Удачный повод разобраться с новой платформой для Visual Basic!
наверх
Как скопировать данные из одного ListBox в другой ListBox или ComboBox
Добавьте на форму 2 ListBox, 1 ComboBox и 2 CommandButton
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Sub Command1_Click()
Dim success As Long
success = CopyListToList(List1, List2)
End Sub
Private Sub Command2_Click()
Dim success As Long
success = CopyListToCombo(List1, Combo1)
If success Then Combo1.ListIndex = 0
End Sub
Private Function CopyListToList(source As ListBox, target As ListBox) As Long
Dim c As Long
Const LB_GETCOUNT = &H18B
Const LB_GETTEXT = &H189
Const LB_ADDSTRING = &H180
Dim numitems As Long
Dim sItemText As String * 255
numitems = SendMessageLong(source.hWnd, LB_GETCOUNT, 0&, 0&)
If numitems > 0 Then
For c = 0 To numitems - 1
Call SendMessageStr(source.hWnd, LB_GETTEXT, c, ByVal sItemText)
Call SendMessageStr(target.hWnd, LB_ADDSTRING, 0&, ByVal sItemText)
Next
End If
numitems = SendMessageLong(target.hWnd, LB_GETCOUNT, 0&, 0&)
CopyListToList = numitems
End Function
Private Function CopyListToCombo(source As ListBox, target As ComboBox) As Long
Dim c As Long
Const LB_GETCOUNT = &H18B
Const LB_GETTEXT = &H189
Const CB_GETCOUNT = &H146
Const CB_ADDSTRING = &H143
Dim numitems As Long
Dim sItemText As String * 255
numitems = SendMessageLong(source.hWnd, LB_GETCOUNT, 0&, 0&)
If numitems > 0 Then
For c = 0 To numitems - 1
Call SendMessageStr(source.hWnd, LB_GETTEXT, c, ByVal sItemText)
Call SendMessageStr(target.hWnd, CB_ADDSTRING, 0&, ByVal sItemText)
Next
End If
numitems = SendMessageLong(target.hWnd, CB_GETCOUNT, 0&, 0&)
CopyListToCombo = numitems
End Function
Private Sub Form_Load()
List1.AddItem "1"
List1.AddItem "2"
List1.AddItem "3"
End Sub
наверх
Определение, какая item находится под курсором мышки в листбоксе
Часто, бывает нужда в определении элемента, над которым пользователь держит мышку. Как наиболее тривиальное применение - вывод дополнительной информации или подсказки в статус бар, причем контекстно зависимой от элемента. Или, например, показ текущего элемента в другом листбоксе. Бэйсик сам не дает нам такой функциональности, но к счастью, используя API функцию SendMessage() и константу LB_ITEMFROMPOINT такая возможность у нас появляется.
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
'LB_ITEMFROMPOINT - это сообщение будет извлекать индекс (начиная с 0)
'Обьявляем эту константу там же
Private Const LB_ITEMFROMPOINT = &H1A9
'Координаты мыши будут передаваться в параметр lParam , и значение этих координат должно быть в пикселях . VB cвои значения выдает в твипсах, соотвественно мы должны позаботиться о конвертации перед передачей этих значений в API функцию.
'Это можно сделать так: ((YPosition * 65536) + XPosition))
'Ну, и наконец, SendMessage() может возвращать вам два типа значений.
'Если функция определяет, что указатель мыши находится над листбоксом - то она вернет номер индекса листбокса.
'Если мышка в другом месте, то функция вернет значение равного старшему слову координаты плюс 65537. Собственно достаточно будет проверить на соотвествие возвращаемый индекс.
'Вряд ли кто то будет держать в листбоксе столько элементов.
'Итак, нижеследующий код показывает как это все написать.
Private Sub Form_Load()
List1.AddItem "11"
List1.AddItem "22"
List1.AddItem "33"
List1.AddItem "44"
End Sub
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim P As Long
Dim XPosition As Long, YPosition As Long
XPosition = CLng(X / Screen.TwipsPerPixelX)
YPosition = CLng(Y / Screen.TwipsPerPixelY)
P = SendMessage(List1.hWnd, LB_ITEMFROMPOINT, 0, ByVal ((YPosition * 65536) + XPosition))
If P < List1.ListCount Then
MsgBox "текущее значение индекса - : " & P
End If
End Sub
наверх
Сканировать ListBox в поисках элемента
Добавьте на форму элементы ListBox и TextBox. Набирая в TextBox'е, к примеру, цифры "229" вы попадете на первый элемент ЛистБокса, содержащий эти цифры. В данном примере вы попадете на элемент "2291".
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Const LB_FINDSTRING = &H18F
Private Sub Form_Load()
List1.AddItem "111"
List1.AddItem "222"
List1.AddItem "228"
List1.AddItem "2291"
List1.AddItem "2293"
List1.AddItem "2297"
End Sub
Private Sub Text1_Change()
List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
End Sub
наверх
Пример поиска в ListBox'е
Данный пример отсеит все неподходящие по критерию элементы одного ListBox'а в другой.
Расположите на форме элементы TextBox и 2 элемента ListBox (смотри рисунок)
Private Sub Text1_Change()
intPlacement = Len(Text1)
strFind = UCase(Text1.Text)
List1.Clear
For intResult = 0 To List2.ListCount
intSearchResult = InStr(UCase(Left(List2.List(intResult), intPlacement)), strFind)
If intSearchResult > 0 Then List1.AddItem List2.List(intResult)
Next intResult
End Sub
Private Sub Form_Load()
Text1.Text = ""
With List2
.AddItem "МП-Ком правда"
.AddItem "Tanya"
.AddItem "Shannon"
.AddItem "Московская правда"
.AddItem "Московский комсомолец"
.AddItem "Московские новости"
.AddItem "Johnny"
.AddItem "Mike"
.AddItem "Derek"
.AddItem "Scotty"
.AddItem "МП-Сов Рос"
.AddItem "Scott"
.AddItem "Tyna"
.AddItem "Diana"
.AddItem "Chris"
.AddItem "Stanley"
.AddItem "Kamal"
.AddItem "МП-Куряд"
End With
End Sub
наверх
Автоматическое выделение элемента в ListBox'е
Данный пример покажет, как можно автоматически выделить строчку в элементе ListBox, при прохождении над ним курсора мыши.
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Const LB_GETITEMHEIGHT = &H1A1
Private Sub Form_Load()
List1.AddItem "aaa"
List1.AddItem "bbb"
List1.AddItem "ccc"
List1.AddItem "ddd"
List1.AddItem "eee"
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
List1.ListIndex = -1
End Sub
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ItemHeight As Integer
ItemHeight = SendMessage(List1.hWnd, LB_GETITEMHEIGHT, 0, 0)
Y = min(((Y / Screen.TwipsPerPixelY) \ ItemHeight) + List1.TopIndex, List1.ListCount - 1)
Label1.Caption = "Выделен элемент " & Y
List1.ListIndex = Y
End Sub
Function min(X As Integer, Y As Integer) As Integer
If X > Y Then min = Y Else min = X
End Function
наверх
Какой элемент выделен? (по номеру)
Добавьте на форму элементы ListBox и CommandButton
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const LB_GETCURSEL = &H188
Private Sub Form_Load()
List1.AddItem "11"
List1.AddItem "22"
List1.AddItem "33"
End Sub
Private Sub Command1_Click()
Print "Выделен элемент под номером: " & SendMessage(List1.hwnd, LB_GETCURSEL, 0&, 0&)
End Sub
наверх
Мои программы
BalloonMessage for MS Agent
BalloonMessage for Microsoft Agent реализует диалог программы с
пользователем, используя при этом технологию Microsoft Agent. OCX реализует три
типа диалоговых окон: InputBox, MsgBox и MsgLabels.
Автора: Шатрыкин Иван и Павел Сурменок.
наверх
Вопрос/Ответ
Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.
Вопросы:Автор вопроса: Alexey
Ответ ожидается по этому адресу
У меня такой вопрс: Как сделать паузу в выполнении программы. Я помню в обычном бейсике это sleep(в секундах) или delay (в миллисекундах). А как сделать то же самое в VB 6.0?
Автор вопроса: Alexbor
Ответ ожидается по этому адресу
Мне хотелось бы во время индикации процесса выполнения показывать тематический avi-файл, пока идет копирование, но авишник выполняется только один раз, может кто в курсе как его в этот момент зациклить до команды close MCI-устройства.
Автор вопроса: timshv@graffiti.net
Ответ ожидается по этому адресу
Как сделать мигающей иконку приложения в трее, подобно в ICQ?
У меня проблема в следующем: не знаю как сделать невидимой иконку
приложения или подставить пустую иконку не обращаясь к файлу иконки на
диске.
Автор вопроса: shadow
Ответ ожидается по этому адресу
Как определить какая раскладка клавиатуры включена в данный момент в активном окне?
Если так:
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private Sub Form_Load()
Dim KeybLayoutName As String
KeybLayoutName = String(9, 0)
GetKeyboardLayoutName KeybLayoutName
Tetx1.Text = CStr(CLng(Left$(KeybLayoutName, _
InStr(1, KeybLayoutName, Chr(0)) - 1)))
End Sub
,
то определяется раскладка моей формы.
Автор вопроса: Андрюха
Ответ ожидается по этому адресу
Здрасте, у меня несколько вопросиков.
1. Видел в одной проге при запуске формы о программе, Шрифт текста плавно меняет цвет с темно синего на ярко голубой и обратно, может кто знает как это делается? Если не трудно намыльте пример.
2. Можно ли в ListWiev добавить пустую строку, и удалить текущую, (ту в которой находиться курсор. Ни нашел ни одного примера.
3. Откуда можно считать информацию об адресе последнего сохраненного файла Word.dox в случае с екселем понятно, в реестре он прописывает конкретный адрес открытым шрифтом, а вот Word облазил весь реестр не нашел.
Автор вопроса: PRGR
Ответ ожидается по этому адресу
Вот надо составить список имён в Textbox'е. Т.е. пользователь набирает имя, щёлкает Enter и прога загружает нужную форму.
Автор вопроса: Michael Fezulaev
Ответ ожидается по этому адресу
Есть textbox мне нужна сделать так что-бы когда его свойства Locked=true то правая кнопка мышки не показавала меню
Ответы:
Вопрос:
Есть файл Avi, ножно сунуть его в прогу ,чтобы не тоскать его отдельно. Кто-нибудь знает как ??? Мои эксперементы с ole обламилсь:((((((((( если ,конечно, ole это то ,что нужно.
Ответ:
Автор ответа: -=CBK=-CRaSH
Попробуй подключить AVI как ресурс
Вопрос:
Кто-нить скажите как подключить ресурс к проэкту???
Ответ:
Автор ответа: Иващенко Алексей
В проекте делаешь Project->Add File... Дальше выбираешь свой Res файл. А в программе используешь при помощи функций - LoadResPicture,LoadResString, LoadResData
Вопрос:
Как для Windows 98/XP на форме запустить avi-файл?
Ответ:
Автор ответа: Иващенко Алексей
Маленькие не компрессированные Avi - компонент Animation
Полноценные Avi (и вообще всю мультимедию) - компонент MMControl
Вопрос:
у меня имеется рисунок, очень большого размера (3000 х 4000), мне надо его разместить на форме, в маленьком размере (300 х 400), а также кнопку по нажитии, которой картинка бы увеличивалась, причем что бы она не залазила за форму, а появлялись ползунки, которыми можно было просмотреть невидимую часть рисунка.
Ответ:
Автор ответа: P@Ssword
На форму кладётся контейнер (любой, напр. ПикчеБокс), в него - два ползунка и Image. У Image свойство Stretch = True. Когда нужен зум, делаешь Stretch = False и пи ивентам ползунков двигаешь Image (напр., Image.Move (HScroll.Value, VScroll.Value).
Вопрос:
Необходимо создать контрольную сумму к строке текста, строка состоит из русских символов.
Подскажите как это можно сделать CRC и после проверить ее.
Ответ:
Автор ответа: P@Ssword
У меня это оформлено как модуль класса, для подсчёта - GetStringCRC32:
Dim CRCTable(0 To 255) As Long
Private Sub Class_Initialize()
Dim Ind As Long, Ind2 As Long
Dim CRC As Long, Bit As Long
Const Polynomial As Long = &HEDB88320
For Ind = 0 To 255
CRC = Ind
For Ind2 = 0 To 7
Bit = CRC And &H1
CRC = ((CRC And &HFFFFFFFE) \ &H2) And &H7FFFFFFF
If Bit = &H1 Then CRC = CRC Xor Polynomial
Next Ind2
CRCTable(Ind) = CRC
Next Ind
End Sub
Function AddCRC(ByteAry() As Byte, ByVal CRC As Long) As Long
Dim Ind As Long
For Ind = 0 To UBound(ByteAry)
CRC = (((CRC And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor
CRCTable((CRC And &HFF) Xor ByteAry(Ind))
Next Ind
AddCRC = CRC
End Function
Function InvertCRC(ByVal CRC As Long) As Long
CRC = CRC Xor &HFFFFFFFF
InvertCRC = CRC
End Function
Function GetStringCRC32(Str As String) As Long
Dim CRC As Long
Dim BAry() As Byte
BAry = Str
CRC = AddCRC(BAry, &HFFFFFFFF)
CRC = InvertCRC(CRC)
GetStringCRC32 = CRC
End Function
Вопрос:
Скачал исходник ричтекстбокса, добавил его в проект, все отлично работает,но когда попытался скомпилить проект мне сказали что нужна двоичная совместимость. Я ставил совместимость и со скачанным контролом и с тем который сам скомпилил(отдельно от моего проекта контрол компилится без вопросов), все равно выдается сообщение что нужна двоичная совместимость.
Ответ:
Автор ответа: Иващенко Алексей
Поставь эту совместимость в обоих проектах
Вопрос:
Можно ли сделать так, чтобы при старте программы данные из определённого файла записывальсь в событие, например cmd1_click ()
И как это сделать?
Ответ:
Автор ответа: P@Ssword
Надо использовать Windows Scripting Host. При загрузке читаешь исходник на VBScript из файла, а в cmd1_click () исполняешь его.
Вопрос:
Может кто из Вас знает, как замерять время меньше 1 мс?? Пробовал через Sleep - и замерял его через timeGetTime - то он даже 1 мс не держит если указать "Sleep 1" (а гдето 2-5 мс выходит), а если Sleep 0.5 - то уже ближе к 1 мс, но всё равно он как-то глючит. Его мининимум может быть только 0.1 или 0.5, а если больше чем 0.6 - то около 2-6 мс!
Может кто подскажет, как тут быть?
В Свойствах системы откопал ресурсы системного таймера (там 4 регистра - от &H40 до &H43). Подключился к ним - но вот закономерность нарастания немогу никак вдуплить!
Может есть ещё какито АПИ ф-ции или какието счётчики или таймера?????
Ответ:
Автор ответа: P@Ssword
...он даже 1 мс не держит если указать "Sleep 1" (а гдето 2-5 мс
выходит)...
А время, затраченное на вызов функций, высчитывалось?
...а если Sleep 0.5...
Насколько я понял, Sleep - это API-функция. Если так, то любой API-Viewer Вам скажет, что она принимает целочисленный параметр. Похоже, что Sleep получал ноль, а те миллисекунды - это время на вызов самих функций.
Вопрос:
Может кто-нибудь знает как в MSChart сделать гладкий график?
Ответ:
Автор ответа: P@Ssword
От своего предложения я не отказываюсь - можно интерполировать результаты в плавный график, а затем добавить его в MSChart.
Вопрос:
Как объединить три переменные в одно выражение, а не текст. например я пишу прогу калькулятор. У меня есть три переменные
Znak=+, -,*,/
x= 1-е число
y= 2-е
как мне записать с помощью этих переменных 2+4, например?
Как объединить x, Znak и y?
Ответ:
Автор ответа: Игорь Станиславович
Тогда уже лучше так:
select case znak
case "-"
rez = x - y
case "+"
rez = x + y
case "*"
rez = x * y
case "/"
rez = x / y
end select
x нужно чтобы было объявлено как double, тоже самое с x и rez.
Ответ:
Автор ответа: Loki
Создай еще одну переменную.
Типа Suma
Suma=x & Znak & y
Ответ:
Автор ответа: Sacha
Если нужно, чтобы прога складывала числа, например 2 + 2=4, то нужно создать Label c именем Label1), TextBox с именем Text1, TextBox с именем Text2 и кнопку с именем Command1. Потом нухно записать в код кнопки следующий код:
Private Sub Command1_Click()
Label1.Caption = Val(Text1) + Val(Text2)
End Sub
Кажись, всё.
Ответ:
Автор ответа: ViTal
Dim result As String
rezult = CStr(x) & Znak & CStr(y)
Вопрос:
Где можно найти значение констант для API, если в API Text Viewer их нет.
У меня MNSD januari 2002, но и там не могу найти!
Ответ:
Автор ответа: Владимир Кирко
На http://www.allapi.net/agnet/apiviewer.shtml лежит ApiViewer с описаниями:
констант - 55634 штук,
фунций - 4813 штук,
подпр. - 1708 штук,
типов - 457 штук.
Может в ём найдете?
Ответ:
Автор ответа: Андрей Щёкин
Лучший способ - набери имя константы на www.ya.ru или www.google.com.
Если стоит VC - посмотри в поддиректории Include, файл winuser.h.
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.