Голосование:
Голосования сайта VBNet.Ru. Результаты голосований передаются на сайт. Проследите, что есть соединение с интернетом.
Ссылки:
Несколько слов от автора:
Новый выпуск!
Читайте!
Читайте!
Содержание выпуска
- Книги
- Генерация последовательности неповторяющихся чисел
- Проверить, находится ли указанный файл в кеше Internet Explorer
- ComboBox: автоматическое открывание списка
- Римские цифры
- Вопрос/Ответ
Книги
Остальные книги о VB можно найти здесь.
наверх
Генерация последовательности неповторяющихся чисел
Вторая версия примера для создания последовательности неповторяющихся чисел. Первый пример смотрите на этой странице.
Private Sub Form_Paint()
Dim genNum As Integer
Dim check As Boolean
Dim sNum 'число для задания верхней границы массива
sNum = 25
ReDim mass(sNum)
Randomize
For x = 1 To sNum
Do
genNum = Int((sNum - 1 + 1) * Rnd + 1)
For y = x To 1 Step -1
If genNum = mass(y) Then
check = False
Exit For
Else
check = True
End If
Next y
Loop Until check = True
If check = True Then
mass(x) = genNum
End If
Next x
For i = 1 To sNum
Print mass(i)
Next
' Coding by Anthony Ho Leong Mi <hlm_82@yahoo.com>
End Sub
наверх
Проверить, находится ли указанный файл в кеше Internet Explorer
Private Const ERROR_INSUFFICIENT_BUFFER = 122
Private Const eeErrorBase = 26720
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type INTERNET_CACHE_ENTRY_INFO
dwStructSize As Long
lpszSourceUrlName As String
lpszLocalFileName As String
CacheEntryType As String
dwUseCount As Long
dwHitRate As Long
dwSizeLow As Long
dwSizeHigh As Long
LastModifiedTime As FILETIME
ExpireTIme As FILETIME
LastAccessTime As FILETIME
LastSyncTime As FILETIME
lpHeaderInfo As Long
dwHeaderInfoSize As Long
lpszFileExtension As String
dwReserved As Long
End Type
Private Declare Function GetUrlCacheEntryInfo Lib "wininet.dll" Alias "GetUrlCacheEntryInfoA" (ByVal sUrlName As String, lpCacheEntryInfo As Any, lpdwCacheEntryInfoBufferSize As Long) As Long
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Public Function WinAPIError(ByVal lLastDLLError As Long) As String
Dim sBuff As String
Dim lCount As Long
sBuff = String$(256, 0)
lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
If lCount Then
WinAPIError = left$(sBuff, lCount)
End If
End Function
Public Function GetCacheEntryInfo(ByVal hWnd As Long, ByVal lpszUrl As String) As Boolean
Dim dwEntrySize As Long
Dim lpCacheEntry As INTERNET_CACHE_ENTRY_INFO
Dim dwTemp As Long
Dim lErr As Long
If (GetUrlCacheEntryInfo(lpszUrl, ByVal 0&, dwEntrySize)) = 0 Then
lErr = Err.LastDllError
If (lErr <> ERROR_INSUFFICIENT_BUFFER) Then
' Doesn't exist. Raise error containing reason:
Err.Raise eeErrorBase + 1, App.EXEName & ".mCacheEntry", WinAPIError(lErr)
GetCacheEntryInfo = False
Exit Function
Else
' It exists!
GetCacheEntryInfo = True
End If
End If
End Function
Private Sub Command1_Click()
On Error GoTo ErrorHandler
If (GetCacheEntryInfo(Me.hWnd, Text1.Text)) Then
MsgBox "URL In Cache.", vbInformation
Else
MsgBox "URL Not In Cache.", vbInformation
End If
Exit Sub
ErrorHandler:
MsgBox "URL Not in Cache [" & Err.Description & "]", vbInformation
End Sub
наверх
ComboBox: автоматическое открывание списка
Такая ситуация: вы активизируете элемент ComboBox, и курсорными стрелочками выбираете какой-либо элемент. При этом ниспадающий список у вас не появляется, а все элементы как бы прокручиваются в основном окне ComboBox. Так? Так! А данный пример позволяет вам автоматически открыть ниспадающий список ComboBox'а для выбора необходимой вам строчки.
Римские цифры
В выпуске рассылки за номером 157 был опубликован пример перевода арабских чисел в римские. Пример того, как делать не надо. Я хочу привести свой пример для перевода туда и обратно, по объему в полтора раза меньший, но с гораздо более широким диапазоном охвата.
Private Function ArabToRim(Number As Long) As String
Dim Ary()
Dim Num As Long
Dim Str As String
Dim Res As String
Dim Ind As Long
Ary = Array(1000, "M", 900, "CM", 500, "D", 400, "CD", _
100, "C", 90, "XC", 50, "L", 40, "XL", _
10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I")
While Number > 0
For Ind = 0 To UBound(Ary) - 1 Step 2
Num = Ary(Ind)
Str = Ary(Ind + 1)
While Num <= Number
Res = Res & Str
Number = Number - Num
Wend
Next Ind
Wend
ArabToRim = Res
End Function
Private Function RimToArab(Number As String) As Long
Dim Ary()
Dim Num As Long
Dim Str As String
Dim Res As Long
Dim Ind As Long
Ary = Array(1000, "M", 900, "CM", 500, "D", 400, "CD", _
100, "C", 90, "XC", 50, "L", 40, "XL", _
10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I")
While Len(Number) > 0
For Ind = 0 To UBound(Ary) - 1 Step 2
Num = Ary(Ind)
Str = Ary(Ind + 1)
While Str = Left$(Number, Len(Str))
Res = Res + Num
Number = Right$(Number, Len(Number) - Len(Str))
Wend
Next Ind
Wend
RimToArab = Res
End Function
Автор: P@Ssword
наверх
Мои программы
BalloonMessage for MS Agent
Автора: Шатрыкин Иван и Павел Сурменок.
наверх
Вопрос/Ответ
Автор вопроса: Костик
Ответ ожидается по этому адресу
Как можно сравнить дату создания двух файлов?
Если действовать таким образом:
If FileDateTime("file1.exe") < FileDateTime("file2.exe") Then ...
, то сравниваются часы создания файла в первую очередь.
Может кто знает, как более правильным образом можно сравнить дату создания файлов.
Автор вопроса: Andrey
Ответ ожидается по этому адресу
Подскажите пожалста, как работать с мопедом (модемом) т.е. как открыть порт, набрать номер, отправить, получить и т.д. Инет здесь не присутствует, (общение только между 2 мопедами) или есть у кого готовый OCX or Dll или ссылка (но я по моему ужо все возможные сайты облазил), за любую инфу ,большое спасибо!!!
Автор вопроса: Maxim
Ответ ожидается по этому адресу
Как отправить файл через интернет с помощью VB на почту?
Автор вопроса: IzoMicke
Ответ ожидается по этому адресу
Насчёт SHBrowseForFolder. Вопрос, на который пока что не получил ответа. В структуре BrowseInfo элемент pIDLRoot указывает на каталог, выше которого запрещено подниматься. Если это системная папка (~Program Files), то её ID заранее известен; а вот как получить ID произвольного каталога?
Автор вопроса: Дмитрий
Ответ ожидается по этому адресу
Как в VB воспроизвести звук (через звуковую карту) определенной частоты и амплитуды?
Автор вопроса: Аверьянов Валерий
Ответ ожидается по этому адресу
Я написал программу для Excel, которая проверяет содержимое буфера и показывает содержимое.
Для текста, файла bmp получается, а для wmf нет.
У меня 486 компьютер, VBA для Office 97.
Я не знаю точную структуру TPpaintStruct.
Раньше не писал на VB, но мой Excel перестал работать с мастером функций - закрывается и пришлось самому писать подобие мастера функций - у меня работа медицинская статистика - без формул не обойтись. Даже отрицательные цифры нельзя поставить.
Бэйсик очень понравился и теперь пишу програмки для учебы и удовольствия.
Автор вопроса: 001
Ответ ожидается по этому адресу
Подскажите, пожалуйста, с помощью каких средств создаются ASP страницы? Есть пресс документации, но нигде не сказано, где и как их собирать. Где можно запустить и посмотреть файлы с расширением *.ASP? Просто так Винда их ни чем не хочет открывать.
Автор вопроса: AlexyK
Ответ ожидается по этому адресу
Каким образом можно из VB-программы открыть Excel-евский файл и запустить на выполнение макрос-VB, встроенный в этот файл.
Автор вопроса: AlexSoft
Ответ ожидается по этому адресу
Есть проблема. При работе с TEXTBOX необходимо запретить любую вставку с буфера-только ввод с клавиатуры.
Автор вопроса: Oleks
Ответ ожидается по этому адресу
Подскажите кто знает как из VB6 определить текущую раскладку клавиатуры (русская или английская) и изменить эту расскладку в Windows
Автор вопроса: bold
Ответ ожидается по этому адресу
Как создать папку с общим доступом (расшаренную)... за любую инфу заранее СПАСИБО.
Ответы:
Вопрос:
У меня два вопроса.
1. Как сделать так что бы кликать на файл из любого менеджера и чтоб моя прога загрузила этот файл не просто ассоциировала определённый тип файла с моей прогой а загрузила его, что типа скажем при кликание путь и имя файла заносилась в переменую а потом прога загружал его
Кто нибудь помогите мне диплом сдавать скоро надо
2. Кто нибудь умеет пользоватся компонентом Menu Ehhancer2 уменя валяется пример но как картинки вставлять я без понятия пробовал разные штуки все бесполезно Может из за ОС глючит у меня XP
Ответ:
Автор ответа: Memphis
При установке твоей программы нужно сделать запись в реестре, соответствующую файлу, который должен быть ассоциирован с твоей программой. Если это текстовый файл, то в записи реестра HKEY_CLASSES_ROOT\txtfile\shell\open\command в параметр (default) необходимо внести строку:
Путь_к_твоей_программе\имя_твоей_программы.exe %1
Я, когда писал текстовый редактор, делал так:
C:\Program Files\WerwolfEditor\WerwolfEditor.exe %1
%1 - это имя файла, передающееся твоей программе через командную строку. Для того, чтобы при двойном щелчке из любого файлового менеджера загружался файл, ассоциированный с твоей программой, тебе в процедуре Form_Load() необходимо читать переменную Command(). В этой переменной хранится вышеуказанный параметр %1, который является именем файла. Но учти, что этот параметр передаётся в формате DOS (т.е. 8.3). В принципе программа будет нормально работать с таким форматом указания путей, но я предпочёл переделать его в нормальный формат Windows. Это делается API-функцией GetShortPathName. В рассылке когда-то была статья об этом, но я приведу этот пример, чтобы показать, как работает моя программа.
Option Explicit
Private Const MAX_PATH& = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved? As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function apiFindFirstFile _
Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA _
) As Long
Private Declare Function apiFindClose _
Lib "kernel32" _
Alias "FindClose" (ByVal hFindFile As Long) As Long
Private Declare Function apiGetShortPathName _
Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long _
) As Long
'Public Function fGetShortName(ByVal stLongPath As String) As String
' Dim stShortPath As String
' Dim lngBuffer As Long, lngRet As Long
' stShortPath = String$(MAX_PATH, 0)
' lngBuffer = Len(stShortPath)
' lngRet = apiGetShortPathName(stLongPath, stShortPath, lngBuffer)
' fGetShortName = Left(stShortPath, lngRet)
'End Function
Public Function fGetLongName(ByVal strFilename As String) As String
Dim lpFindFileData As WIN32_FIND_DATA
Dim strPath As String, lngRet As Long
Dim strFile As String, lngx As Long, lngY As Long
Dim strTmp As String
strTmp = ""
Do While Not lngRet = INVALID_HANDLE_VALUE
lngRet = apiFindFirstFile(strFilename, lpFindFileData)
strFile = Left$(lpFindFileData.cFileName, InStr(lpFindFileData.cFileName, vbNullChar) - 1)
If Len(strFilename) > 2 Then
strTmp = strFile & "\" & strTmp
strFilename = fParseDir(strFilename)
Else
strTmp = strFilename & "\" & strTmp
Exit Do
End If
Loop
fGetLongName = Left$(strTmp, Len(strTmp) - 1)
lngY = apiFindClose(lngRet)
End Function
Private Function fParseDir(strInFile As String) As String
Dim intLen As Long, boolFound As Boolean
Dim I As Integer, F As String, strDir As String
intLen = Len(strInFile)
If intLen > 0 Then
boolFound = False
For I = intLen To 1 Step -1
If Mid$(strInFile, I, 1) = "\" Then
F = Mid$(strInFile, I + 1)
strDir = Left$(strInFile, I - 1)
boolFound = True
Exit For
End If
Next I
End If
If boolFound Then
fParseDir = strDir
Else
fParseDir = strInFile
End If
End Function
Вышеуказанный код я поместил в отдельный модуль ShortLongNames. А в основном модуле программы (т.е. модуле главной формы, где, как я понимаю, у тебя находятся все элементы управления, отвечающие за отображение файла) нужно поместить следующий код:
Private Sub Form_Load()
Dim mstrFile As String
mstrFile = Command()
If (Len(mstrFile)) Then
LoadCommandFile mstrFile
End If
End Sub
Private Sub LoadCommandFile(mFileName As String)
On Error GoTo fixer
Dim sFile As String
sFile = fGetLongName(mFileName)
' здесь у тебя будет идти код, который будет производить загрузку файла и т.д.
' в моей программе здесь устанавливается имя файла для StatusBar'а (только имя, без пути),
' а текстовый файл загружается в RTF-поле.
' Далее следует обработчик ошибок. Он был мне нужен для того, чтобы в случае ошибки знать, где она произошла.
' А то постоянно приходится запускать программу в режиме Debug, а она у меня дай Бог здоровая... :-)
Exit Sub
fixer:
MsgBox "Ошибка в модуле загрузки файла из командной строки." & vbCrLf & Err.Number & ": " & Err.Description
End Sub
А запись в реестре, про которую я рассказал в самом начале, нужна для ассоциации файлов с твоей программой и для передачи того самого пресловутого параметра %1, который содержит имя файла, так нужное всем программистам.
Вопрос:
Возможно ли программным путем во время работы приложения развернуть и свернуть ComboBox?
Ответ:
Автор ответа: 1.info
В среде разработки - никак. Но после компиляции твоя программа может использовать стили из ХР. для этого необходимо поставить подключить библиотеку "windows common-controls", затем добавить в каталог программы файлик с именем ТвояПрограмма.exe.manifest такого содержания:
version="5.1.0.0"
name="Microsoft.Windows.Shell.Gina"
processorArchitecture="*"
type="win32"
/>
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
language="*"
processorArchitecture="*"
publicKeyToken="6595b64144ccf1df"
/>
После компиляции твоя прога выглядит как положено.
Только помни, что не все компоненты это подддерживают. Напр. DataList, DataCombo, DataGrid - остануться такими же как и в win2000. Бывают случаи, когда этот метод не проходит - прога вываливается с ошибкой при запуске. Могу только посоветовать поэкспериментировать с ссылками на библиотеки.
Вопрос:
Вопрос про макроподстановки. Есть в foxpro(и не только) такая фича:
a=1
b=3
s="a+b"
f=&s ' в итоге f=4, & - признак макроподстановки (указателя)
Есть ли в Басике что-либо подобное?
Ответ:
Автор ответа: AndroiD
См www.phoenixsoft.narod.ru статья "Скрипты в VB". (Information->Articles) Там же сэмпл по работе.
Ответ:
Автор ответа: Alexander
Не-а, как и Eval()
Но выкручиваются...
Вопрос:
Извините за назойливость... Я уже попрошайничал...
Как из *.BMP сделать *.JPG... если можно, примерчик...
Ответ:
Автор ответа: Memphis
На сервере www.sourceforge.net есть такой компонент: FreeImage. Скачай его: у него много всяких функций, в том числе и конвертер форматов (если не ошибаюсь, поддерживается около 10 форматов, а может быть и больше). Ещё один плюс этого компонента - он бесплатный. Есть у него, правда, некоторые глюки при отображении и масштабировании, но как конвертер - это просто отличная вещь.
Ответ:
Автор ответа: Alexander
По-моему, не грех воспользоваться бесплатной библиотекой GflSDK на сайте www.XnView.com.
Там и пример имеется.
Вопрос:
Как сделать, чтобы форму с BorderStyle=0 (без заголовка) можно было перемещать по экрану при нажатии мышкой (на событие MouseDown, например)
Ответ:
Автор ответа: Авраменко Сергей
Перемещение окна при помощи API Windows
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const LP_HT_CAPTION = 2
Private Declare Function ReleaseCapture Lib "user32" () 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
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim rc As Long
rc = ReleaseCapture
rc = SendMessage(hWnd, WM_NCLBUTTONDOWN, LP_HT_CAPTION, ByVal 0&)
End Sub
И ВСЁ!!!
Ответ:
Автор ответа: Роман
Public 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 Declare Sub ReleaseCapture Lib "user32" ()
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Private Sub "Контрол, за который таскаем"_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Возможность перетаскивать форму за что угодно
Dim lngReturnValue As Long
If Button = vbLeftButton Then
Call ReleaseCapture
lngReturnValue = SendMessage(Me.hwnd(перетаскиваем форму), WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Вопрос:
Такой вопрос, как мне получить только название файла? Если я использую ComDlg и присваиваю преременной FileName, то получаю полный адрес расположения файла а мне нужен только конец, то есть сам файл.
Ответ:
Автор ответа: Matrix
Можно так:
Dim f As Integer
f = Len(FileName)
Do While Mid(FileName, f, 1) <> "\"
f = f - 1
Loop
FileName = Right(FileName, Len(FileName) - f)
Ответ:
Автор ответа: Vladimir [PRC]
CommonDialog1.FileName - Диск + Путь + Имя файла
CommonDialog1.FileTitle - Только имя файла
Ответ:
Автор ответа: Alexander
Dim strArray() As String
Dim strFileName As String
strArray = Split(Text1.Text, "\")
strFileName = strArray(UBound(strArray))
' Так же можно использовать новую функцию InStrRev - чуть длиннее, но работает.
Ответ:
Автор ответа: Memphis
У того же самого CommonDialog есть свойство FileTItle. В этом свойстве хранится только имя файла без пути. Присваивай его любой String-переменной - и используй, как нравится!
Ответ:
Автор ответа: Роман
Dim sFile As String
Dim sFileName As String
Dim nCount As Integer
sFile = "c:\winnt\win.exe"
For nCount = Len(sFile) To 1 Step -1
If Mid$(sFile, nCount, 1) = "\" Then
sFileName = Right$(sFile, Len(sFile) - nCount)
Exit For
End If
Next
MsgBox sFile & vbCrLf & sFileName
Вопрос:
Как сделать программу невидимой в Ctrl+Alt+Delete???
Ответ:
Автор ответа: P@Ssword
Уж сколько раз твердили миру: App.TaskVisible = False
Property TaskVisible As Boolean
Member of VB.App
Returns/sets a value that determines if a task is visible in the task list.
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по 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 можно найти здесь.
наверх
Генерация последовательности неповторяющихся чисел
Вторая версия примера для создания последовательности неповторяющихся чисел. Первый пример смотрите на этой странице.
Private Sub Form_Paint()
Dim genNum As Integer
Dim check As Boolean
Dim sNum 'число для задания верхней границы массива
sNum = 25
ReDim mass(sNum)
Randomize
For x = 1 To sNum
Do
genNum = Int((sNum - 1 + 1) * Rnd + 1)
For y = x To 1 Step -1
If genNum = mass(y) Then
check = False
Exit For
Else
check = True
End If
Next y
Loop Until check = True
If check = True Then
mass(x) = genNum
End If
Next x
For i = 1 To sNum
Print mass(i)
Next
' Coding by Anthony Ho Leong Mi <hlm_82@yahoo.com>
End Sub
наверх
Проверить, находится ли указанный файл в кеше Internet Explorer
Private Const ERROR_INSUFFICIENT_BUFFER = 122
Private Const eeErrorBase = 26720
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type INTERNET_CACHE_ENTRY_INFO
dwStructSize As Long
lpszSourceUrlName As String
lpszLocalFileName As String
CacheEntryType As String
dwUseCount As Long
dwHitRate As Long
dwSizeLow As Long
dwSizeHigh As Long
LastModifiedTime As FILETIME
ExpireTIme As FILETIME
LastAccessTime As FILETIME
LastSyncTime As FILETIME
lpHeaderInfo As Long
dwHeaderInfoSize As Long
lpszFileExtension As String
dwReserved As Long
End Type
Private Declare Function GetUrlCacheEntryInfo Lib "wininet.dll" Alias "GetUrlCacheEntryInfoA" (ByVal sUrlName As String, lpCacheEntryInfo As Any, lpdwCacheEntryInfoBufferSize As Long) As Long
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private Const FORMAT_MESSAGE_FROM_STRING = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Public Function WinAPIError(ByVal lLastDLLError As Long) As String
Dim sBuff As String
Dim lCount As Long
sBuff = String$(256, 0)
lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
If lCount Then
WinAPIError = left$(sBuff, lCount)
End If
End Function
Public Function GetCacheEntryInfo(ByVal hWnd As Long, ByVal lpszUrl As String) As Boolean
Dim dwEntrySize As Long
Dim lpCacheEntry As INTERNET_CACHE_ENTRY_INFO
Dim dwTemp As Long
Dim lErr As Long
If (GetUrlCacheEntryInfo(lpszUrl, ByVal 0&, dwEntrySize)) = 0 Then
lErr = Err.LastDllError
If (lErr <> ERROR_INSUFFICIENT_BUFFER) Then
' Doesn't exist. Raise error containing reason:
Err.Raise eeErrorBase + 1, App.EXEName & ".mCacheEntry", WinAPIError(lErr)
GetCacheEntryInfo = False
Exit Function
Else
' It exists!
GetCacheEntryInfo = True
End If
End If
End Function
Private Sub Command1_Click()
On Error GoTo ErrorHandler
If (GetCacheEntryInfo(Me.hWnd, Text1.Text)) Then
MsgBox "URL In Cache.", vbInformation
Else
MsgBox "URL Not In Cache.", vbInformation
End If
Exit Sub
ErrorHandler:
MsgBox "URL Not in Cache [" & Err.Description & "]", vbInformation
End Sub
наверх
ComboBox: автоматическое открывание списка
Такая ситуация: вы активизируете элемент ComboBox, и курсорными стрелочками выбираете какой-либо элемент. При этом ниспадающий список у вас не появляется, а все элементы как бы прокручиваются в основном окне ComboBox. Так? Так! А данный пример позволяет вам автоматически открыть ниспадающий список ComboBox'а для выбора необходимой вам строчки.
Вам понадобится (кроме ComboBox)
элемент CheckBox
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 Const CB_GETEXTENDEDUI = &H156
Private Const CB_SETEXTENDEDUI = &H155
Public Property Let ComboExtendedUI(ByRef cboThis As ComboBox, ByVal bState As Boolean)
SendMessageLong cboThis.hwnd, CB_SETEXTENDEDUI, Abs(bState), 0
End Property
Public Property Get ComboExtendedUI(ByRef cboThis As ComboBox) As Boolean
ComboExtendedUI = (SendMessageLong(cboThis.hwnd, CB_GETEXTENDEDUI, 0, 0) <> 0)
End Property
Private Sub Check1_Click()
ComboExtendedUI(Combo1) = (Check1.Value = Checked)
End Sub
Private Sub Form_Load()
Dim i As Long
For i = 1 To 20
Combo1.AddItem "Test Item " & i
Next i
End Sub
наверх
Римские цифры
В выпуске рассылки за номером 157 был опубликован пример перевода арабских чисел в римские. Пример того, как делать не надо. Я хочу привести свой пример для перевода туда и обратно, по объему в полтора раза меньший, но с гораздо более широким диапазоном охвата.
Private Function ArabToRim(Number As Long) As String
Dim Ary()
Dim Num As Long
Dim Str As String
Dim Res As String
Dim Ind As Long
Ary = Array(1000, "M", 900, "CM", 500, "D", 400, "CD", _
100, "C", 90, "XC", 50, "L", 40, "XL", _
10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I")
While Number > 0
For Ind = 0 To UBound(Ary) - 1 Step 2
Num = Ary(Ind)
Str = Ary(Ind + 1)
While Num <= Number
Res = Res & Str
Number = Number - Num
Wend
Next Ind
Wend
ArabToRim = Res
End Function
Private Function RimToArab(Number As String) As Long
Dim Ary()
Dim Num As Long
Dim Str As String
Dim Res As Long
Dim Ind As Long
Ary = Array(1000, "M", 900, "CM", 500, "D", 400, "CD", _
100, "C", 90, "XC", 50, "L", 40, "XL", _
10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I")
While Len(Number) > 0
For Ind = 0 To UBound(Ary) - 1 Step 2
Num = Ary(Ind)
Str = Ary(Ind + 1)
While Str = Left$(Number, Len(Str))
Res = Res + Num
Number = Right$(Number, Len(Number) - Len(Str))
Wend
Next Ind
Wend
RimToArab = Res
End Function
Автор: P@Ssword
наверх
Мои программы
BalloonMessage for MS Agent
BalloonMessage for Microsoft Agent реализует диалог программы с
пользователем, используя при этом технологию Microsoft Agent. OCX реализует три
типа диалоговых окон: InputBox, MsgBox и MsgLabels.
Автора: Шатрыкин Иван и Павел Сурменок.
наверх
Вопрос/Ответ
Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.
Вопросы:Автор вопроса: Костик
Ответ ожидается по этому адресу
Как можно сравнить дату создания двух файлов?
Если действовать таким образом:
If FileDateTime("file1.exe") < FileDateTime("file2.exe") Then ...
, то сравниваются часы создания файла в первую очередь.
Может кто знает, как более правильным образом можно сравнить дату создания файлов.
Автор вопроса: Andrey
Ответ ожидается по этому адресу
Подскажите пожалста, как работать с мопедом (модемом) т.е. как открыть порт, набрать номер, отправить, получить и т.д. Инет здесь не присутствует, (общение только между 2 мопедами) или есть у кого готовый OCX or Dll или ссылка (но я по моему ужо все возможные сайты облазил), за любую инфу ,большое спасибо!!!
Автор вопроса: Maxim
Ответ ожидается по этому адресу
Как отправить файл через интернет с помощью VB на почту?
Автор вопроса: IzoMicke
Ответ ожидается по этому адресу
Насчёт SHBrowseForFolder. Вопрос, на который пока что не получил ответа. В структуре BrowseInfo элемент pIDLRoot указывает на каталог, выше которого запрещено подниматься. Если это системная папка (~Program Files), то её ID заранее известен; а вот как получить ID произвольного каталога?
Автор вопроса: Дмитрий
Ответ ожидается по этому адресу
Как в VB воспроизвести звук (через звуковую карту) определенной частоты и амплитуды?
Автор вопроса: Аверьянов Валерий
Ответ ожидается по этому адресу
Я написал программу для Excel, которая проверяет содержимое буфера и показывает содержимое.
Для текста, файла bmp получается, а для wmf нет.
У меня 486 компьютер, VBA для Office 97.
Я не знаю точную структуру TPpaintStruct.
Раньше не писал на VB, но мой Excel перестал работать с мастером функций - закрывается и пришлось самому писать подобие мастера функций - у меня работа медицинская статистика - без формул не обойтись. Даже отрицательные цифры нельзя поставить.
Бэйсик очень понравился и теперь пишу програмки для учебы и удовольствия.
Автор вопроса: 001
Ответ ожидается по этому адресу
Подскажите, пожалуйста, с помощью каких средств создаются ASP страницы? Есть пресс документации, но нигде не сказано, где и как их собирать. Где можно запустить и посмотреть файлы с расширением *.ASP? Просто так Винда их ни чем не хочет открывать.
Автор вопроса: AlexyK
Ответ ожидается по этому адресу
Каким образом можно из VB-программы открыть Excel-евский файл и запустить на выполнение макрос-VB, встроенный в этот файл.
Автор вопроса: AlexSoft
Ответ ожидается по этому адресу
Есть проблема. При работе с TEXTBOX необходимо запретить любую вставку с буфера-только ввод с клавиатуры.
Автор вопроса: Oleks
Ответ ожидается по этому адресу
Подскажите кто знает как из VB6 определить текущую раскладку клавиатуры (русская или английская) и изменить эту расскладку в Windows
Автор вопроса: bold
Ответ ожидается по этому адресу
Как создать папку с общим доступом (расшаренную)... за любую инфу заранее СПАСИБО.
Ответы:
Вопрос:
У меня два вопроса.
1. Как сделать так что бы кликать на файл из любого менеджера и чтоб моя прога загрузила этот файл не просто ассоциировала определённый тип файла с моей прогой а загрузила его, что типа скажем при кликание путь и имя файла заносилась в переменую а потом прога загружал его
Кто нибудь помогите мне диплом сдавать скоро надо
2. Кто нибудь умеет пользоватся компонентом Menu Ehhancer2 уменя валяется пример но как картинки вставлять я без понятия пробовал разные штуки все бесполезно Может из за ОС глючит у меня XP
Ответ:
Автор ответа: Memphis
При установке твоей программы нужно сделать запись в реестре, соответствующую файлу, который должен быть ассоциирован с твоей программой. Если это текстовый файл, то в записи реестра HKEY_CLASSES_ROOT\txtfile\shell\open\command в параметр (default) необходимо внести строку:
Путь_к_твоей_программе\имя_твоей_программы.exe %1
Я, когда писал текстовый редактор, делал так:
C:\Program Files\WerwolfEditor\WerwolfEditor.exe %1
%1 - это имя файла, передающееся твоей программе через командную строку. Для того, чтобы при двойном щелчке из любого файлового менеджера загружался файл, ассоциированный с твоей программой, тебе в процедуре Form_Load() необходимо читать переменную Command(). В этой переменной хранится вышеуказанный параметр %1, который является именем файла. Но учти, что этот параметр передаётся в формате DOS (т.е. 8.3). В принципе программа будет нормально работать с таким форматом указания путей, но я предпочёл переделать его в нормальный формат Windows. Это делается API-функцией GetShortPathName. В рассылке когда-то была статья об этом, но я приведу этот пример, чтобы показать, как работает моя программа.
Option Explicit
Private Const MAX_PATH& = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved? As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function apiFindFirstFile _
Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA _
) As Long
Private Declare Function apiFindClose _
Lib "kernel32" _
Alias "FindClose" (ByVal hFindFile As Long) As Long
Private Declare Function apiGetShortPathName _
Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long _
) As Long
'Public Function fGetShortName(ByVal stLongPath As String) As String
' Dim stShortPath As String
' Dim lngBuffer As Long, lngRet As Long
' stShortPath = String$(MAX_PATH, 0)
' lngBuffer = Len(stShortPath)
' lngRet = apiGetShortPathName(stLongPath, stShortPath, lngBuffer)
' fGetShortName = Left(stShortPath, lngRet)
'End Function
Public Function fGetLongName(ByVal strFilename As String) As String
Dim lpFindFileData As WIN32_FIND_DATA
Dim strPath As String, lngRet As Long
Dim strFile As String, lngx As Long, lngY As Long
Dim strTmp As String
strTmp = ""
Do While Not lngRet = INVALID_HANDLE_VALUE
lngRet = apiFindFirstFile(strFilename, lpFindFileData)
strFile = Left$(lpFindFileData.cFileName, InStr(lpFindFileData.cFileName, vbNullChar) - 1)
If Len(strFilename) > 2 Then
strTmp = strFile & "\" & strTmp
strFilename = fParseDir(strFilename)
Else
strTmp = strFilename & "\" & strTmp
Exit Do
End If
Loop
fGetLongName = Left$(strTmp, Len(strTmp) - 1)
lngY = apiFindClose(lngRet)
End Function
Private Function fParseDir(strInFile As String) As String
Dim intLen As Long, boolFound As Boolean
Dim I As Integer, F As String, strDir As String
intLen = Len(strInFile)
If intLen > 0 Then
boolFound = False
For I = intLen To 1 Step -1
If Mid$(strInFile, I, 1) = "\" Then
F = Mid$(strInFile, I + 1)
strDir = Left$(strInFile, I - 1)
boolFound = True
Exit For
End If
Next I
End If
If boolFound Then
fParseDir = strDir
Else
fParseDir = strInFile
End If
End Function
Вышеуказанный код я поместил в отдельный модуль ShortLongNames. А в основном модуле программы (т.е. модуле главной формы, где, как я понимаю, у тебя находятся все элементы управления, отвечающие за отображение файла) нужно поместить следующий код:
Private Sub Form_Load()
Dim mstrFile As String
mstrFile = Command()
If (Len(mstrFile)) Then
LoadCommandFile mstrFile
End If
End Sub
Private Sub LoadCommandFile(mFileName As String)
On Error GoTo fixer
Dim sFile As String
sFile = fGetLongName(mFileName)
' здесь у тебя будет идти код, который будет производить загрузку файла и т.д.
' в моей программе здесь устанавливается имя файла для StatusBar'а (только имя, без пути),
' а текстовый файл загружается в RTF-поле.
' Далее следует обработчик ошибок. Он был мне нужен для того, чтобы в случае ошибки знать, где она произошла.
' А то постоянно приходится запускать программу в режиме Debug, а она у меня дай Бог здоровая... :-)
Exit Sub
fixer:
MsgBox "Ошибка в модуле загрузки файла из командной строки." & vbCrLf & Err.Number & ": " & Err.Description
End Sub
А запись в реестре, про которую я рассказал в самом начале, нужна для ассоциации файлов с твоей программой и для передачи того самого пресловутого параметра %1, который содержит имя файла, так нужное всем программистам.
Вопрос:
Возможно ли программным путем во время работы приложения развернуть и свернуть ComboBox?
Ответ:
Автор ответа: 1.info
В среде разработки - никак. Но после компиляции твоя программа может использовать стили из ХР. для этого необходимо поставить подключить библиотеку "windows common-controls", затем добавить в каталог программы файлик с именем ТвояПрограмма.exe.manifest такого содержания:
name="Microsoft.Windows.Shell.Gina"
processorArchitecture="*"
type="win32"
/>
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
language="*"
processorArchitecture="*"
publicKeyToken="6595b64144ccf1df"
/>
После компиляции твоя прога выглядит как положено.
Только помни, что не все компоненты это подддерживают. Напр. DataList, DataCombo, DataGrid - остануться такими же как и в win2000. Бывают случаи, когда этот метод не проходит - прога вываливается с ошибкой при запуске. Могу только посоветовать поэкспериментировать с ссылками на библиотеки.
Вопрос:
Вопрос про макроподстановки. Есть в foxpro(и не только) такая фича:
a=1
b=3
s="a+b"
f=&s ' в итоге f=4, & - признак макроподстановки (указателя)
Есть ли в Басике что-либо подобное?
Ответ:
Автор ответа: AndroiD
См www.phoenixsoft.narod.ru статья "Скрипты в VB". (Information->Articles) Там же сэмпл по работе.
Ответ:
Автор ответа: Alexander
Не-а, как и Eval()
Но выкручиваются...
Вопрос:
Извините за назойливость... Я уже попрошайничал...
Как из *.BMP сделать *.JPG... если можно, примерчик...
Ответ:
Автор ответа: Memphis
На сервере www.sourceforge.net есть такой компонент: FreeImage. Скачай его: у него много всяких функций, в том числе и конвертер форматов (если не ошибаюсь, поддерживается около 10 форматов, а может быть и больше). Ещё один плюс этого компонента - он бесплатный. Есть у него, правда, некоторые глюки при отображении и масштабировании, но как конвертер - это просто отличная вещь.
Ответ:
Автор ответа: Alexander
По-моему, не грех воспользоваться бесплатной библиотекой GflSDK на сайте www.XnView.com.
Там и пример имеется.
Вопрос:
Как сделать, чтобы форму с BorderStyle=0 (без заголовка) можно было перемещать по экрану при нажатии мышкой (на событие MouseDown, например)
Ответ:
Автор ответа: Авраменко Сергей
Перемещение окна при помощи API Windows
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const LP_HT_CAPTION = 2
Private Declare Function ReleaseCapture Lib "user32" () 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
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim rc As Long
rc = ReleaseCapture
rc = SendMessage(hWnd, WM_NCLBUTTONDOWN, LP_HT_CAPTION, ByVal 0&)
End Sub
И ВСЁ!!!
Ответ:
Автор ответа: Роман
Public 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 Declare Sub ReleaseCapture Lib "user32" ()
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Private Sub "Контрол, за который таскаем"_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Возможность перетаскивать форму за что угодно
Dim lngReturnValue As Long
If Button = vbLeftButton Then
Call ReleaseCapture
lngReturnValue = SendMessage(Me.hwnd(перетаскиваем форму), WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Вопрос:
Такой вопрос, как мне получить только название файла? Если я использую ComDlg и присваиваю преременной FileName, то получаю полный адрес расположения файла а мне нужен только конец, то есть сам файл.
Ответ:
Автор ответа: Matrix
Можно так:
Dim f As Integer
f = Len(FileName)
Do While Mid(FileName, f, 1) <> "\"
f = f - 1
Loop
FileName = Right(FileName, Len(FileName) - f)
Ответ:
Автор ответа: Vladimir [PRC]
CommonDialog1.FileName - Диск + Путь + Имя файла
CommonDialog1.FileTitle - Только имя файла
Ответ:
Автор ответа: Alexander
Dim strArray() As String
Dim strFileName As String
strArray = Split(Text1.Text, "\")
strFileName = strArray(UBound(strArray))
' Так же можно использовать новую функцию InStrRev - чуть длиннее, но работает.
Ответ:
Автор ответа: Memphis
У того же самого CommonDialog есть свойство FileTItle. В этом свойстве хранится только имя файла без пути. Присваивай его любой String-переменной - и используй, как нравится!
Ответ:
Автор ответа: Роман
Dim sFile As String
Dim sFileName As String
Dim nCount As Integer
sFile = "c:\winnt\win.exe"
For nCount = Len(sFile) To 1 Step -1
If Mid$(sFile, nCount, 1) = "\" Then
sFileName = Right$(sFile, Len(sFile) - nCount)
Exit For
End If
Next
MsgBox sFile & vbCrLf & sFileName
Вопрос:
Как сделать программу невидимой в Ctrl+Alt+Delete???
Ответ:
Автор ответа: P@Ssword
Уж сколько раз твердили миру: App.TaskVisible = False
Property TaskVisible As Boolean
Member of VB.App
Returns/sets a value that determines if a task is visible in the task list.
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.