Голосование:
Голосования сайта VBNet.Ru. Результаты голосований передаются на сайт. Проследите, что есть соединение с интернетом.
Ссылки:
Несколько слов от автора:
Коды кончаются! Сегодня уже в рассылку пошли те коды, которые вы присылали по моему запросу. Материала хватит ещё на 3 недели. Так что, присылайте всё достойное для рассылки по тематике Visual Basic, .NET, ASP! Ссылка на меня внизу расылки.
Читайте!
Читайте!
Содержание выпуска
- Книги
- Определение формата данных буфера обмена
- Создание образа картинки
- Замена одних цветов другими
- Drag&Drop - контролы
- Автоматическое упорядочивание элементов списка в MSHFlexGrid
- Вопрос/Ответ
Книги
Остальные книги о VB можно найти здесь.
наверх
Определение формата данных буфера обмена
Не забудьте на форме разместить элемент ListBox и Command.
Private Declare Function CountClipboardFormats Lib "USER32" () As Long
Private Declare Function EnumClipboardFormats Lib "USER32" (ByVal wFormat As Long) As Long
Private Declare Function OpenClipboard Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "USER32" () As Long
Private Declare Function GetClipboardFormatName Lib "USER32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Enum EPredefinedClipboardFormatConstants
[_First] = 1
CF_TEXT = 1
CF_BITMAP = 2
CF_METAFILEPICT = 3
CF_SYLK = 4
CF_DIF = 5
CF_TIFF = 6
CF_OEMTEXT = 7
CF_DIB = 8
CF_PALETTE = 9
CF_PENDATA = 10
CF_RIFF = 11
CF_WAVE = 12
CF_UNICODETEXT = 13
CF_ENHMETAFILE = 14
CF_HDROP = 15
CF_LOCALE = 16
CF_MAX = 17
[_Last] = 17
End Enum
Private Property Get FormatName(ByVal lFormatId As Long) As String
Dim lSize As Long
Dim sBuf As String
Dim lR As Long
If (lFormatId >= EPredefinedClipboardFormatConstants.[_First] And lFormatId <= EPredefinedClipboardFormatConstants.[_Last]) Then
' For pre-defined formats, we have to make the text up ourselves:
Select Case lFormatId
Case CF_TEXT
FormatName = "Text"
Case CF_BITMAP
FormatName = "Bitmap Picture"
Case CF_METAFILEPICT
FormatName = "Meta-File Picture"
Case CF_SYLK
FormatName = "Microsoft Symbolic Link (SYLK) data."
Case CF_DIF
FormatName = "Software Arts' Data Interchange information."
Case CF_TIFF = 6
FormatName = "Tagged Image File Format (TIFF) Picture"
Case CF_OEMTEXT
FormatName = "Text (OEM)"
Case CF_DIB
FormatName = "DIB Bitmap Picture"
Case CF_PALETTE
FormatName = "Colour Palette"
Case CF_PENDATA
FormatName = "Pen Data"
Case CF_RIFF
FormatName = "RIFF Audio data"
Case CF_WAVE
FormatName = "Wave File"
Case CF_UNICODETEXT
FormatName = "Text (Unicode)"
Case CF_ENHMETAFILE
FormatName = "Enhanced Meta-File Picture"
Case CF_HDROP
FormatName = "File List"
Case CF_LOCALE
FormatName = "Text Locale Identifier"
End Select
Else
' For custom formats, we can ask the Clipboard for the registered name:
lSize = 255
sBuf = String$(lSize, 0)
lR = GetClipboardFormatName(lFormatId, sBuf, lSize)
If (lR <> 0) Then
FormatName = Left$(sBuf, lR)
End If
End If
End Property
Private Sub Command1_Click()
Dim lR As Long
Dim iCount As Long
List1.Clear
If (OpenClipboard(Me.hWnd)) Then
lR = EnumClipboardFormats(0)
If (lR <> 0) Then
Do
iCount = iCount + 1
List1.AddItem FormatName(lR)
List1.ItemData(List1.NewIndex) = lR
lR = EnumClipboardFormats(lR)
Loop While lR <> 0
End If
End If
CloseClipboard
End Sub
наверх
Создание образа картинки
Данный пример покажет, как можно создать образ (mask image) картинки. Образы маски полезны для эмуляции прозрачности, и для замены цветов в изображениях.
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Public Function CreateMaskImage(ByRef picFrom As PictureBox, ByRef picTo As PictureBox, Optional ByVal lTransparentColor As Long = -1) As Boolean
Dim lhDC As Long
Dim lhBmp As Long
Dim lhBmpOld As Long
' Make picTo the same size as picFrom and clear it:
With picTo
.Width = picFrom.Width
.Height = picFrom.Height
.Cls
End With
' Create a monochrome DC & Bitmap of the same size as the source picture:
lhDC = CreateCompatibleDC(0)
If (lhDC <> 0) Then
lhBmp = CreateCompatibleBitmap(lhDC, picFrom.ScaleWidth \ Screen.TwipsPerPixelX, picFrom.ScaleHeight \ Screen.TwipsPerPixelY)
If (lhBmp <> 0) Then
lhBmpOld = SelectObject(lhDC, lhBmp)
' Set the back 'colour' of the monochrome DC to the colour we wish to be transparent:
If (lTransparentColor = -1) Then lTransparentColor = picFrom.BackColor
SetBkColor lhDC, lTransparentColor
' Copy from the from picture to the monochrome DC to create the mask:
BitBlt lhDC, 0, 0, picFrom.ScaleWidth \ Screen.TwipsPerPixelX, picFrom.ScaleHeight \ Screen.TwipsPerPixelY, picFrom.hDC, 0, 0, SRCCOPY
' Now put the mask into picTo:
BitBlt picTo.hDC, 0, 0, picFrom.ScaleWidth \ Screen.TwipsPerPixelX, picFrom.ScaleHeight \ Screen.TwipsPerPixelY, lhDC, 0, 0, SRCCOPY
picTo.Refresh
' Clear up the bitmap we used to create the mask:
SelectObject lhDC, lhBmpOld
DeleteObject lhBmp
End If
' Clear up the monochrome DC:
DeleteObject lhDC
End If
End Function
Private Sub Command1_Click()
CreateMaskImage Picture1, Picture2
End Sub
Private Sub Form_Load()
Dim i As Long
Picture1.BackColor = &HFFFF00
With Picture1.Font
.Name = "Arial"
.Bold = True
.Italic = True
.Size = 12
End With
For i = 1 To 20
Picture1.ForeColor = QBColor(i Mod 15)
Picture1.Print "vbAccelerator Mask Demo"
Next i
End Sub
наверх
Замена одних цветов другими
Данный пример покажет, как можно заменить один цвет другим в картинке.
Private Type RECT
left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Const SRCAND = &H8800C6
Private Const SRCPAINT = &HEE0086
Private Const SRCINVERT = &H660046
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Sub ReplaceColor(ByRef picThis As PictureBox, ByVal lFromColour As Long, ByVal lToColor As Long)
Dim lW As Long
Dim lH As Long
Dim lMaskDC As Long, lMaskBMP As Long, lMaskBMPOLd As Long
Dim lCopyDC As Long, lCopyBMP As Long, lCopyBMPOLd As Long
Dim tR As RECT
Dim hBr As Long
' Cache the width & height of the picture:
lW = picThis.ScaleWidth \ Screen.TwipsPerPixelX
lH = picThis.ScaleHeight \ Screen.TwipsPerPixelY
' Create a Mono DC & Bitmap
If (CreateDC(picThis, lW, lH, lMaskDC, lMaskBMP, lMaskBMPOLd, True)) Then
' Create a DC & Bitmap with the same colour depth as the picture:
If (CreateDC(picThis, lW, lH, lCopyDC, lCopyBMP, lCopyBMPOLd)) Then
' Make a mask from the picture which is white in the replace colour area:
SetBkColor picThis.hDC, lFromColour
BitBlt lMaskDC, 0, 0, lW, lH, picThis.hDC, 0, 0, SRCCOPY
' Fill the colour DC with the colour we want to replace with
tR.Right = lW: tR.Bottom = lH
hBr = CreateSolidBrush(lToColor)
FillRect lCopyDC, tR, hBr
DeleteObject hBr
' Turn the colour DC black except where the mask is white:
BitBlt lCopyDC, 0, 0, lW, lH, lMaskDC, 0, 0, SRCAND
' Create an inverted mask, so it is black where the colour is to be replaced but white otherwise:
hBr = CreateSolidBrush(&HFFFFFF)
FillRect lMaskDC, tR, hBr
DeleteObject hBr
BitBlt lMaskDC, 0, 0, lW, lH, picThis.hDC, 0, 0, SRCINVERT
' AND the inverted mask with the picture. The picture
' goes black where the colour is to be replaced, but is
' unaffected otherwise.
SetBkColor picThis.hDC, &HFFFFFF
BitBlt picThis.hDC, 0, 0, lW, lH, lMaskDC, 0, 0, SRCAND
' Finally, OR the coloured item with the picture. Where
' the picture is black and the coloured DC isn't,
' the colour will be transferred:
BitBlt picThis.hDC, 0, 0, lW, lH, lCopyDC, 0, 0, SRCPAINT
picThis.Refresh
' Clear up the colour DC:
SelectObject lCopyDC, lCopyBMPOLd
DeleteObject lCopyBMP
DeleteObject lCopyDC
End If
' Clear up the mask DC:
SelectObject lMaskDC, lMaskBMPOLd
DeleteObject lMaskBMP
DeleteObject lMaskDC
End If
End Sub
Public Function CreateDC(ByRef picThis As PictureBox, ByVal lW As Long, ByVal lH As Long, ByRef lhDC As Long, ByRef lhBmp As Long, ByRef lhBmpOld As Long, Optional ByVal bMono As Boolean = False) As Boolean
If (bMono) Then
lhDC = CreateCompatibleDC(0)
Else
lhDC = CreateCompatibleDC(picThis.hDC)
End If
If (lhDC <> 0) Then
If (bMono) Then
lhBmp = CreateCompatibleBitmap(lhDC, lW, lH)
Else
lhBmp = CreateCompatibleBitmap(picThis.hDC, lW, lH)
End If
If (lhBmp <> 0) Then
lhBmpOld = SelectObject(lhDC, lhBmp)
CreateDC = True
Else
DeleteObject lhDC
lhDC = 0
End If
End If
End Function
Private Sub Command1_Click()
Static i As Integer
ReplaceColor Picture1, QBColor(i), &HFFFF&
i = i + 1
If (i > 15) Then
MsgBox "All colours replaced."
End If
End Sub
Private Sub Form_Load()
Dim i As Long
Dim x As Long, y As Long, w As Long, h As Long
Picture1.BackColor = &HFFFF00
For i = 1 To 200
x = Rnd * Picture1.ScaleWidth: y = Rnd * Picture1.ScaleHeight
w = Rnd * Picture1.ScaleWidth: h = Rnd * Picture1.ScaleHeight
Picture1.Line (x, y)-(x + w, y + h), QBColor(Rnd * 15), BF
Picture1.CurrentX = x: Picture1.CurrentY = y
Picture1.Print "vbAccelerator Mask Demo"
Next i
End Sub
наверх
Drag&Drop - контролы
Сначала создаем новый проект. На форме надо разместить 2 PictureBox. Один назовем ImgFolder, DragMode установим равным 0-manual, ну и в свойство Picture иконку папки впихнем. Второму PictureBox присвоим имя ImgTrash и в свойство назначим иконку корзины. У обоих PictureBox установите свойства AutoSize = True и BorderStyle = 0 - None.
Ну а теперь самое главное - Код !!!
'Инициализация
Const EmptyTrash = "Waste.ico"
Const FullTrash = "Recyfull.ico"
Dim MouseX, MouseY As Single
Dim IsTrash As Boolean
Dim Path As String
Option Explicit
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
'Окончание перетаскивания (с учетом поправки)
Source.Move (X - MouseX), (Y - MouseY)
End Sub
Private Sub Form_Load()
IsTrash = False
'Путь к иконкам можно задать по умолчанию:
'Path = "C:\Program Files\Microsoft Visual Studio"
'Path = Path & "\Common\Graphics\Icons\win95\"
'Но это не удобно и не у каждого юзера Visual Studio установлен
End Sub
Private Sub imgFolder_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'если нажата левая кнопка, то начинается перетаскивание
If Button = vbLeftButton Then
Call imgFolder.Drag(vbBeginDrag)
MouseX = X 'Показываем координаты на указателе мыши
MouseY = Y
End If
End Sub
Private Sub imgTrash_DblClick()
'Извлечение папки из корзины
imgFolder.Visible = True
IsTrash = True
'Задаем изображение пустой корзины
imgTrash.Picture = LoadPicture(Path & EmptyTrash)
End Sub
Private Sub imgTrash_DragDrop(Source As Control, X As Single, Y As Single)
Source.Visible = False 'конец перетаскивания папки в корзину
IsTrash = True
imgTrash.Picture = LoadPicture(Path & FullTrash) 'задаем изображение полной корзины
End Sub
наверх
Автоматическое упорядочивание элементов списка в MSHFlexGrid
Достаточно часто в программах бывает необходимо вывести частичный список сотрудников - для премирования, поощрения или наказания. При этом желательно вывести их в соответствии с занимаемыми должностями (директор, 1зам, и т.д.). Проблема в том, что список может требовать правки, и, при добавлении главбуха, он может оказаться в списке после уборщицы. Если сотрудников немного, их состав не меняется, то проблем нет - сортировка по индивидуальному номеру в порядке возрастания. В большой фирме, где к тому же сами должности могут добавляться и удаляться такой подход не оправдан. Можно, конечно, зашифровать должность как код должности и ввести поле подстановки в соответствующую таблицу, но кто этим будет заниматься, тем более с готовой БД?
Пример заполнения судовой роли для нашего яхт-клуба гарантирует, что матрос не будет в судовой роли стоять выше боцмана, или пассажир выше кока.
Предположим, что имеется список сотрудников (в данном случае моряков), из которого переносятся данные в MSHFlexGrid1, после чего вызывается следующая процедура
Private Sub RankCrwes()
Dim intRows As Integer
Dim intTemp As Integer, intY As Integer
Dim stRank(7) As String, stTabl(40, 2) As String '40 строк в переменной я беру с запасом - параметр индивидуальный, а 3 столбца _
это ID, ФИО и должность, взятые из списка
With Me.MSHFlexGrid1
'узнаем, сколько всего в списке вместе с добавленным, и, если больше одного, то продолжаем далее:
intRows = .Rows
If intRows = 1 Then Exit Sub
'заполняем массив чинами, в соответствии с которым будет упорядочиваться список. Если должностей слишком _
много, то легче перечислить их в отдельной таблице и заполнить открытием соответствующего Recordseta.
stRank(0) = "капитан"
stRank(1) = "старпом"
stRank(2) = "вахтенный рулевой"
stRank(3) = "радист"
stRank(4) = "боцман"
stRank(5) = "матрос"
stRank(6) = "кок"
stRank(7) = "пассажир"
' Начиная с последней строки MSHFlexGrid1все данные последовательно считываются в двухмерный массив stTabl в строгом _ соответствии порядку заполнения массива stRank. В данном примере до кока, чтобы пассажир был всегда последним. _
Если последний не обязателен, тогда For intTemp= 0 To 7 и пропустить последний блок Do While ... Loop
For intTemp = 0 To 6
Do While intRows > 0
'проверяется на совпадение каждый 3 столбец MSHFlexGrid1 - должность. При совпадении проводится запись в массив stTabl
If .TextArray((intRows - 1) * 3 + 2) = stRank(intTemp) Then
stTabl(intY, 2) = .TextArray((intRows - 1) * 3 + 2)
stTabl(intY, 1) = .TextArray((intRows - 1) * 3 + 1)
stTabl(intY, 0) = .TextArray((intRows - 1) * 3)
'после записи переводится строка в переменной-массиве
intY = intY + 1
End If
'в MSHFlexGrid1перевод на строку вверх
intRows = intRows - 1
Loop
'восстанавливается первоначальное значение переменной для дальнейшего анализа MSHFlexGrid1
intRows = .Rows
Next
'в этом блоке выбираются должности, не вошедшие в основной список, т.е. неважно в каком они порядке, _
лишь бы были после основных
Do While intRows > 0
Select Case .TextArray((intRows - 1) * 3 + 2)
Case stRank(0), stRank(1), stRank(2), stRank(3), stRank(4), stRank(5), stRank(6), stRank(7)
Case Else
stTabl(intY, 2) = .TextArray((intRows - 1) * 3 + 2)
stTabl(intY, 1) = .TextArray((intRows - 1) * 3 + 1)
stTabl(intY, 0) = .TextArray((intRows - 1) * 3)
intY = intY + 1
End Select
intRows = intRows - 1
Loop
intRows = .Rows
'если нужен последний (в данном случае - пассажир), то находим и его
Do While intRows > 0
If .TextArray((intRows - 1) * 3 + 2)=stRank(7) Then
stTabl(intY, 2) = .TextArray((intRows - 1) * 3 + 2)
stTabl(intY, 1) = .TextArray((intRows - 1) * 3 + 1)
stTabl(intY, 0) = .TextArray((intRows - 1) * 3)
intY = intY + 1
End If
intRows = intRows - 1
Loop
'очищаем уже полностью переписанный в stTabl MSHFlexGrid1
.Clear
.Rows = 0
'заполняем его по новому уже упорядочено. intY - 1 потому, что ранее единица была добавлена, _
но запись в переменную по исчерпании списка не сделана
For intRows = 0 To intY - 1
.AddItem stTabl(intRows, 0) & vbTab & stTabl(intRows, 1) & vbTab & stTabl(intRows, 2)
Next
End With
End Sub
наверх
Мои программы
BalloonMessage for MS Agent
Автора: Шатрыкин Иван и Павел Сурменок.
наверх
Вопрос/Ответ
Автор вопроса: Дмитрий
Ответ ожидается по этому адресу
Как с помощью VB узнать подключен ты к сети, например Интернету?
Автор вопроса: Сергей
Ответ ожидается по этому адресу
Подскажите пожалуйста как правильно записать файл с картинкой типа *.bmp, *.jpg в БД SQL Server.
Автор вопроса: Maxim
Ответ ожидается по этому адресу
Как в Вб.нет поменять стартовую процедуру?
Т.е. чтобы первой грузилась, например, form2 или main sub, как в вб6.
Автор вопроса: Петр
Ответ ожидается по этому адресу
Я использую в проекте VB видеокарту типа "Nuvision" и у меня возникли след. проблемы:
1. Не могу сделать Stretch, используя API-функцию StretchBlt
2. При вызове функций:
CapDriverConnect,
CapPreviewRate,
CapPreview,
CapOverlay
идёт только частичное заполнение фрейма.
Кто может посоветовать, видеокарту какого типа лучше использовать или есть какой-нибудь стандартный пакет для работы с видеокартой
Автор вопроса: Sergey
Ответ ожидается по этому адресу
Кто-нибудь знает, где можно найти листинг проги, которая запароливает
папки? Дайте ссылочку, плз.
Автор вопроса: Theba
Ответ ожидается по этому адресу
Как отследить события подключения и отключения соединения с провайдером для программы счета трафика?
Автор вопроса: IzoMicke
Ответ ожидается по этому адресу
Есть задумка программы, использующей Латиницу-1 и Латиницу-2; она должна выводить символы с диакритикой. Проблему можно коряво решить встраиванием Excel-таблицы в VB-форму. А есть ли в VB(6) контрол, который может такое сделать?
Автор вопроса: Alex
Ответ ожидается по этому адресу
Трижды вложенный цикл For по переменным i,j,k позволяет перебрать все возможные комбинации (i,j,k). А можно ли сделать для n-ого количества переменных. Может быть можно сделать это с помощью циклических ссылок на функцию, где описан один цикл For. Помогите очень нужно...
Автор вопроса: Alex
Ответ ожидается по этому адресу
Подскажите кто-нибудь программный код на VB для реализации задачи линейного программирования с помощью Симплекс-метода.
Автор вопроса: Виталик
Ответ ожидается по этому адресу
Прошу, кто знает, напишите код на VB6 или хотя бы подскажите, как отследить нажатие символьных и цифровых клавиш на клаве в любом приложении. Желательно чтобы потом конкретно знать где что нажималось.
Автор вопроса: Данила
Ответ ожидается по этому адресу
Требуется:
1) подключиться к интернету через созданное удалённое соединение
2) отправить серверу запрос вида
"http://www.magazin.ru/main/main.php?page=s_winners" и получить
сгенерированную страницу.
3) сохранить сгенерированную страницу в виде файла на винте
4) отключиться от интернета
Если уж не код, то хотя бы подскажите, какие объекты с этими задачами справятся.
Автор вопроса: UPS!!!
Ответ ожидается по этому адресу
Имеется на форме элемент WebBrowser, который чего-то там отображает.
Как автоматически (без вопросовпредложений по событию таймера, например) сделать отображаемую страничку доступной автономно (аналогично меню сохранить как... в Эксплорере)?
Вместе с картинками и без них?
Лучше, чем код ответа быть не может...
Автор вопроса: timshv@graffiti.net
Ответ ожидается по этому адресу
Установил MSDN 2003, а хэлп VB6 не может найти ссылку. Говорит переустановите MSDN Library. MSDN2000 работал без проблем.
Где можно указать бейсику чтобы он обращался к новой MSDN?
Автор вопроса: Николай
Ответ ожидается по этому адресу
Как в VB передать данные по модему с одного компа на другой? Подскажите хотябы направление!
Автор вопроса: i-sof@mail.ru
Ответ ожидается по этому адресу
Я хочу с удаленного компа, не зная системную папку винды (типо: c:\windows), скачть (из этой папки) файл (пусть будет win.ini).
Тако вот вопрос: Как определить системную папо4ку винды?
Автор вопроса: weeeer
Ответ ожидается по этому адресу
У меня два вопроса.
1. Как сделать так что бы кликать на файл из любого менеджера и что бы моя прога открыла его.
2. Нужен компонент или код что бы сделать красивое меню что - то вроде как программе Word.
Автор вопроса: Maxim
Ответ ожидается по этому адресу
Как проанализировать жесткий диск и записать все директории в файл?
Автор вопроса: Максим
Ответ ожидается по этому адресу
В Textе стоит математическое выражение, ну например text1="2+3". Можно ли его посчитать в переменной? А может кто знает, как в Микрософтском калькуляторе обрабатываются операторы сложения, умножения и т.д.?
Автор вопроса: Владимир
Ответ ожидается по этому адресу
Я использую Swiftsoft Multimedia Tools OCX v2.0. Файл у меня проигрывается через MMAudioPLayerX1. Подскажите чтобы проигрываемый файл выводился в какомто элементе управления и при нажатиина надпись он воспроизводиля снова. Так же в этом элементе управления может отображаться много названия файлов и пользователь кликом выбирает нужный ему файл для проослушивания.
Ответы:
Вопрос:
Не подскажите,как из VB6 запустить программу(игру). Например у меня есть форма с кнопкой OK, я нажимаю и должна запуститься игрушка. Как прописать директорию, точнее как установить связь.
Ответ:
Автор ответа: HoodWin
Вопрос:
Не подскажите,как из VB6 запустить программу(игру). Например у меня есть форма с кнопкой OK, я нажимаю и должна запуститься игрушка. Как прописать директорию, точнее как установить связь.
Ответ:
Самый простой способ запуска приложений - это
Shell filename, windowstyle
' где filename - полный путь к файлу; windowstyle - фокус и положение окна программы при включении, например, данный параметр может быть vbNormalFocus или др.
Вопрос:
Скажите, как с помощью VB6 можно сделать программу, осуществляющую связь через TCP/IP с помощью интернета.
Нужно чтобы моя прога слала текстовое сообщение на удаленный компьютер, а тот компьютер должен принять это сообщение и записать в переменную. Если нетрудно привидите кусочки кода клиента и сервера.
Ответ:
Автор ответа: •Creator•
Глянь-ка на www.vb.kiev.ua.
Вопрос:
Скажите, как сделать, чтобы моя прога определила мой IP когда я в сети. Это значение нужно присвоить какой либо переменной. Если нетрудно, приведите пример кода.
Ответ:
Автор ответа: 123
Расположите на форме компонент Winsock(Winsock1) через меню Project|Components - Microsoft Winsock Control 6.0
Private Sub Form_Load()
MsgBox Winsock1.LocalIP
End Sub
Ответ:
Автор ответа: Loki
Узнать IP своего компа из кода ты можешь взять пример на сайте www.vbrain.narod.ru и переписать его под свои нужды.
В этом примере можно узнать IP своего компа зная его имя или наоборот.
Вопрос:
Как можно ускорить открытие файла, если файл имеет произвольный доступ (Random)и содержит более ста тысяч записей?
Ответ:
Автор ответа: Alexander
Во-первых, не читать сразу весь файл.
Во-вторых, выполнять большую часть работы на серверной части (если работаем на сети). Особенно рекомендую использовать SQL-запросы или даже открытие таблицы с adTableDirect (зависит от ситуёвины).
В-третьих, для достижения и того, и другого одновременно, рекомендуется использовать грамотного "провайдера" (в терминах методов доступа Майкрософт). Сейчас для этого фирма рекомедует использовать метод доступа ADO, построенного не на ODBC, а на OLE DB, где, в частности, есть параметр "количество читаемых записей при обращении".
Вопрос:
1.Кто знает как на Visual Basic Script в документе HTML запрограммить чтение данных из файла, лежащего рядом (любые варианты).
2.Подскажите как передать хотябы переменную. Неплохо если поделитесь простыми примерами с Winsock'om на примере клиент-сервер... или дайте ссылки на общения, статьи, примеры...
Ответ:
Автор ответа: Артем Кривокрисенко
1. В свое время мне тоже нужно было сделать такое. Но, к сожалению, это сделать невозможно. Конечно, если вбскрипт выполняется локально, т.е. на компе и открыть файл нужно с компа, то поможет FSO, а вот если нужно загрузить файл с сервера, то, как я уже говорил, так нельзя.
Но я нашел выход из этой ситуации. Я подключал к html-странице скриптовый файл, к тором хранились нужные мне данные. Пиши на личку, проконсультую: Artyom_kr@zp.ukrtel.net
Вопрос:
Помогите мне, пожалуйста решить следующую проблему. Я создаю один DHTML проект, в котором мне требуется отослать почту со вложением файла. Как это сделать на HTML при помощи mailto:адрес@мыло.ру?subject="тема" а как нужно продолжить строку, чтобы вложть файл?
Ответ:
Автор ответа: Sergey
Я конечно могу ошибаться, но мне кажется что стандарт HTML поддерживает задавать только адресата, тему,копию и скрытую копию. Если раскопаешь что-то дополнительно,дай знать пожалуйста.
Ответ:
Автор ответа: Dimmer
А никак ты это не сделаешь, это по соображениям security отсутствует :( Но можно написать свой ActiveX на том же VB, реализующий через MAPI/CDO посылку файлов и все что угодно :)
Вопрос:
Пусть есть массив переменной длины
Dim vArr()
В циклическом процессе определяется число неких элементов (n) и делается
Redim vArr(n-1)
Вопрос: можно ли как-то программно возвратить vArr в исходное состояние, т.е. в то, в котором он был до первого ReDim'а?
Ответ:
Автор ответа: ViTal
Можно!
Пользуй: Erase vArr
Вопрос:
Подскажте пожалуйста как отловить нажатие на кнопку "свернуть" и "закрыть" , и не дать программе свернутся или закрытся , а выполнить какое то свое дествие. Если можно с примером , уже 3ю неделю мучаюсь , ниче не получается :(
Ответ:
Автор ответа: Андрюшин Евгений
Можно попробовать сделать так:
'Получим индентификатор системного меню окна
hMenu = GetSystemMenu(frmHwnd, 0&)
'Удалим первый элемент (Восстановить)
Call DeleteMenu(hMenu, 0, MF_BYCOMMAND)
'Удалим четвертый элемент (Развернуть)
Call DeleteMenu(hMenu, 4, MF_BYCOMMAND)
'Удалим третий элемент (Свернуть)
Call DeleteMenu(hMenu, 3, MF_BYCOMMAND)
и соответственно необходимо объявить API -функции и константы:
Public Declare Function GetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" Alias "DeleteMenu" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Const MF_BYCOMMAND = &H0&
Ответ:
Автор ответа: ViTal
Надо писать функцию-ловушку (hook), в которой отлавливать соответствующие сообщения (свернуть и закрыть).
Ответ:
Автор ответа: Anton
'форма
Dim LastState As Integer
Private Sub Form_Resize()
If Me.WindowState = 1 Then
Me.WindowState = LastState
MsgBox "min pressed"
End If
LastState = Me.WindowState
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = True
MsgBox "close pressed"
End Sub
Ответ:
Автор ответа: MAVR
Вот пример блокировки кнопки "свернуть" и "закрыть"
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Const MF_BYPOSITION = &H400&
Private Sub Form_Load()
Option1(0).Caption = "Восстановить"
Option1(1).Caption = "Переместить"
Option1(2).Caption = "Размер"
Option1(3).Caption = "Свернуть"
Option1(4).Caption = "Развернуть"
Option1(5).Caption = "?????????"
Option1(6).Caption = "Закрыть"
End Sub
Private Sub Option1_Click(Index As Integer)
Dim hSysMenu, lngResult As Long
hSysMenu = GetSystemMenu(Me.hwnd, True)
hSysMenu = GetSystemMenu(Me.hwnd, False)
lngResult = DeleteMenu(hSysMenu, Index, MF_BYPOSITION)
End Sub
Ответ:
Автор ответа: MAVR
Private Sub Form_QueryUnload(Cancel As _
Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu Then
Cancel = True
End If
End Sub
Ответ:
Автор ответа: Murat Shonov
По поводу кнопки закрыть это событие Unload или Query Unload, а вот отслеживать кнопочку свернуть можно только через АПИ функции.
Вопрос:
Как издать на PC-Speaker писк при помощи VB 6.0 для Windows 98/XP?
Ответ:
Автор ответа: ViTal
Для этого есть апи-функция:
Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Ответ:
Автор ответа: Anton
встроенная команда beep, либо смотри функцию api: beep, там можно указать частоту и длительность
Private Declare Function Beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по 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 можно найти здесь.
наверх
Определение формата данных буфера обмена
Не забудьте на форме разместить элемент ListBox и Command.
Private Declare Function CountClipboardFormats Lib "USER32" () As Long
Private Declare Function EnumClipboardFormats Lib "USER32" (ByVal wFormat As Long) As Long
Private Declare Function OpenClipboard Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "USER32" () As Long
Private Declare Function GetClipboardFormatName Lib "USER32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Enum EPredefinedClipboardFormatConstants
[_First] = 1
CF_TEXT = 1
CF_BITMAP = 2
CF_METAFILEPICT = 3
CF_SYLK = 4
CF_DIF = 5
CF_TIFF = 6
CF_OEMTEXT = 7
CF_DIB = 8
CF_PALETTE = 9
CF_PENDATA = 10
CF_RIFF = 11
CF_WAVE = 12
CF_UNICODETEXT = 13
CF_ENHMETAFILE = 14
CF_HDROP = 15
CF_LOCALE = 16
CF_MAX = 17
[_Last] = 17
End Enum
Private Property Get FormatName(ByVal lFormatId As Long) As String
Dim lSize As Long
Dim sBuf As String
Dim lR As Long
If (lFormatId >= EPredefinedClipboardFormatConstants.[_First] And lFormatId <= EPredefinedClipboardFormatConstants.[_Last]) Then
' For pre-defined formats, we have to make the text up ourselves:
Select Case lFormatId
Case CF_TEXT
FormatName = "Text"
Case CF_BITMAP
FormatName = "Bitmap Picture"
Case CF_METAFILEPICT
FormatName = "Meta-File Picture"
Case CF_SYLK
FormatName = "Microsoft Symbolic Link (SYLK) data."
Case CF_DIF
FormatName = "Software Arts' Data Interchange information."
Case CF_TIFF = 6
FormatName = "Tagged Image File Format (TIFF) Picture"
Case CF_OEMTEXT
FormatName = "Text (OEM)"
Case CF_DIB
FormatName = "DIB Bitmap Picture"
Case CF_PALETTE
FormatName = "Colour Palette"
Case CF_PENDATA
FormatName = "Pen Data"
Case CF_RIFF
FormatName = "RIFF Audio data"
Case CF_WAVE
FormatName = "Wave File"
Case CF_UNICODETEXT
FormatName = "Text (Unicode)"
Case CF_ENHMETAFILE
FormatName = "Enhanced Meta-File Picture"
Case CF_HDROP
FormatName = "File List"
Case CF_LOCALE
FormatName = "Text Locale Identifier"
End Select
Else
' For custom formats, we can ask the Clipboard for the registered name:
lSize = 255
sBuf = String$(lSize, 0)
lR = GetClipboardFormatName(lFormatId, sBuf, lSize)
If (lR <> 0) Then
FormatName = Left$(sBuf, lR)
End If
End If
End Property
Private Sub Command1_Click()
Dim lR As Long
Dim iCount As Long
List1.Clear
If (OpenClipboard(Me.hWnd)) Then
lR = EnumClipboardFormats(0)
If (lR <> 0) Then
Do
iCount = iCount + 1
List1.AddItem FormatName(lR)
List1.ItemData(List1.NewIndex) = lR
lR = EnumClipboardFormats(lR)
Loop While lR <> 0
End If
End If
CloseClipboard
End Sub
наверх
Создание образа картинки
Данный пример покажет, как можно создать образ (mask image) картинки. Образы маски полезны для эмуляции прозрачности, и для замены цветов в изображениях.
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Public Function CreateMaskImage(ByRef picFrom As PictureBox, ByRef picTo As PictureBox, Optional ByVal lTransparentColor As Long = -1) As Boolean
Dim lhDC As Long
Dim lhBmp As Long
Dim lhBmpOld As Long
' Make picTo the same size as picFrom and clear it:
With picTo
.Width = picFrom.Width
.Height = picFrom.Height
.Cls
End With
' Create a monochrome DC & Bitmap of the same size as the source picture:
lhDC = CreateCompatibleDC(0)
If (lhDC <> 0) Then
lhBmp = CreateCompatibleBitmap(lhDC, picFrom.ScaleWidth \ Screen.TwipsPerPixelX, picFrom.ScaleHeight \ Screen.TwipsPerPixelY)
If (lhBmp <> 0) Then
lhBmpOld = SelectObject(lhDC, lhBmp)
' Set the back 'colour' of the monochrome DC to the colour we wish to be transparent:
If (lTransparentColor = -1) Then lTransparentColor = picFrom.BackColor
SetBkColor lhDC, lTransparentColor
' Copy from the from picture to the monochrome DC to create the mask:
BitBlt lhDC, 0, 0, picFrom.ScaleWidth \ Screen.TwipsPerPixelX, picFrom.ScaleHeight \ Screen.TwipsPerPixelY, picFrom.hDC, 0, 0, SRCCOPY
' Now put the mask into picTo:
BitBlt picTo.hDC, 0, 0, picFrom.ScaleWidth \ Screen.TwipsPerPixelX, picFrom.ScaleHeight \ Screen.TwipsPerPixelY, lhDC, 0, 0, SRCCOPY
picTo.Refresh
' Clear up the bitmap we used to create the mask:
SelectObject lhDC, lhBmpOld
DeleteObject lhBmp
End If
' Clear up the monochrome DC:
DeleteObject lhDC
End If
End Function
Private Sub Command1_Click()
CreateMaskImage Picture1, Picture2
End Sub
Private Sub Form_Load()
Dim i As Long
Picture1.BackColor = &HFFFF00
With Picture1.Font
.Name = "Arial"
.Bold = True
.Italic = True
.Size = 12
End With
For i = 1 To 20
Picture1.ForeColor = QBColor(i Mod 15)
Picture1.Print "vbAccelerator Mask Demo"
Next i
End Sub
наверх
Замена одних цветов другими
Данный пример покажет, как можно заменить один цвет другим в картинке.
Private Type RECT
left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Const SRCAND = &H8800C6
Private Const SRCPAINT = &HEE0086
Private Const SRCINVERT = &H660046
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Sub ReplaceColor(ByRef picThis As PictureBox, ByVal lFromColour As Long, ByVal lToColor As Long)
Dim lW As Long
Dim lH As Long
Dim lMaskDC As Long, lMaskBMP As Long, lMaskBMPOLd As Long
Dim lCopyDC As Long, lCopyBMP As Long, lCopyBMPOLd As Long
Dim tR As RECT
Dim hBr As Long
' Cache the width & height of the picture:
lW = picThis.ScaleWidth \ Screen.TwipsPerPixelX
lH = picThis.ScaleHeight \ Screen.TwipsPerPixelY
' Create a Mono DC & Bitmap
If (CreateDC(picThis, lW, lH, lMaskDC, lMaskBMP, lMaskBMPOLd, True)) Then
' Create a DC & Bitmap with the same colour depth as the picture:
If (CreateDC(picThis, lW, lH, lCopyDC, lCopyBMP, lCopyBMPOLd)) Then
' Make a mask from the picture which is white in the replace colour area:
SetBkColor picThis.hDC, lFromColour
BitBlt lMaskDC, 0, 0, lW, lH, picThis.hDC, 0, 0, SRCCOPY
' Fill the colour DC with the colour we want to replace with
tR.Right = lW: tR.Bottom = lH
hBr = CreateSolidBrush(lToColor)
FillRect lCopyDC, tR, hBr
DeleteObject hBr
' Turn the colour DC black except where the mask is white:
BitBlt lCopyDC, 0, 0, lW, lH, lMaskDC, 0, 0, SRCAND
' Create an inverted mask, so it is black where the colour is to be replaced but white otherwise:
hBr = CreateSolidBrush(&HFFFFFF)
FillRect lMaskDC, tR, hBr
DeleteObject hBr
BitBlt lMaskDC, 0, 0, lW, lH, picThis.hDC, 0, 0, SRCINVERT
' AND the inverted mask with the picture. The picture
' goes black where the colour is to be replaced, but is
' unaffected otherwise.
SetBkColor picThis.hDC, &HFFFFFF
BitBlt picThis.hDC, 0, 0, lW, lH, lMaskDC, 0, 0, SRCAND
' Finally, OR the coloured item with the picture. Where
' the picture is black and the coloured DC isn't,
' the colour will be transferred:
BitBlt picThis.hDC, 0, 0, lW, lH, lCopyDC, 0, 0, SRCPAINT
picThis.Refresh
' Clear up the colour DC:
SelectObject lCopyDC, lCopyBMPOLd
DeleteObject lCopyBMP
DeleteObject lCopyDC
End If
' Clear up the mask DC:
SelectObject lMaskDC, lMaskBMPOLd
DeleteObject lMaskBMP
DeleteObject lMaskDC
End If
End Sub
Public Function CreateDC(ByRef picThis As PictureBox, ByVal lW As Long, ByVal lH As Long, ByRef lhDC As Long, ByRef lhBmp As Long, ByRef lhBmpOld As Long, Optional ByVal bMono As Boolean = False) As Boolean
If (bMono) Then
lhDC = CreateCompatibleDC(0)
Else
lhDC = CreateCompatibleDC(picThis.hDC)
End If
If (lhDC <> 0) Then
If (bMono) Then
lhBmp = CreateCompatibleBitmap(lhDC, lW, lH)
Else
lhBmp = CreateCompatibleBitmap(picThis.hDC, lW, lH)
End If
If (lhBmp <> 0) Then
lhBmpOld = SelectObject(lhDC, lhBmp)
CreateDC = True
Else
DeleteObject lhDC
lhDC = 0
End If
End If
End Function
Private Sub Command1_Click()
Static i As Integer
ReplaceColor Picture1, QBColor(i), &HFFFF&
i = i + 1
If (i > 15) Then
MsgBox "All colours replaced."
End If
End Sub
Private Sub Form_Load()
Dim i As Long
Dim x As Long, y As Long, w As Long, h As Long
Picture1.BackColor = &HFFFF00
For i = 1 To 200
x = Rnd * Picture1.ScaleWidth: y = Rnd * Picture1.ScaleHeight
w = Rnd * Picture1.ScaleWidth: h = Rnd * Picture1.ScaleHeight
Picture1.Line (x, y)-(x + w, y + h), QBColor(Rnd * 15), BF
Picture1.CurrentX = x: Picture1.CurrentY = y
Picture1.Print "vbAccelerator Mask Demo"
Next i
End Sub
наверх
Drag&Drop - контролы
Сначала создаем новый проект. На форме надо разместить 2 PictureBox. Один назовем ImgFolder, DragMode установим равным 0-manual, ну и в свойство Picture иконку папки впихнем. Второму PictureBox присвоим имя ImgTrash и в свойство назначим иконку корзины. У обоих PictureBox установите свойства AutoSize = True и BorderStyle = 0 - None.
Ну а теперь самое главное - Код !!!
'Инициализация
Const EmptyTrash = "Waste.ico"
Const FullTrash = "Recyfull.ico"
Dim MouseX, MouseY As Single
Dim IsTrash As Boolean
Dim Path As String
Option Explicit
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
'Окончание перетаскивания (с учетом поправки)
Source.Move (X - MouseX), (Y - MouseY)
End Sub
Private Sub Form_Load()
IsTrash = False
'Путь к иконкам можно задать по умолчанию:
'Path = "C:\Program Files\Microsoft Visual Studio"
'Path = Path & "\Common\Graphics\Icons\win95\"
'Но это не удобно и не у каждого юзера Visual Studio установлен
End Sub
Private Sub imgFolder_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'если нажата левая кнопка, то начинается перетаскивание
If Button = vbLeftButton Then
Call imgFolder.Drag(vbBeginDrag)
MouseX = X 'Показываем координаты на указателе мыши
MouseY = Y
End If
End Sub
Private Sub imgTrash_DblClick()
'Извлечение папки из корзины
imgFolder.Visible = True
IsTrash = True
'Задаем изображение пустой корзины
imgTrash.Picture = LoadPicture(Path & EmptyTrash)
End Sub
Private Sub imgTrash_DragDrop(Source As Control, X As Single, Y As Single)
Source.Visible = False 'конец перетаскивания папки в корзину
IsTrash = True
imgTrash.Picture = LoadPicture(Path & FullTrash) 'задаем изображение полной корзины
End Sub
наверх
Автоматическое упорядочивание элементов списка в MSHFlexGrid
Достаточно часто в программах бывает необходимо вывести частичный список сотрудников - для премирования, поощрения или наказания. При этом желательно вывести их в соответствии с занимаемыми должностями (директор, 1зам, и т.д.). Проблема в том, что список может требовать правки, и, при добавлении главбуха, он может оказаться в списке после уборщицы. Если сотрудников немного, их состав не меняется, то проблем нет - сортировка по индивидуальному номеру в порядке возрастания. В большой фирме, где к тому же сами должности могут добавляться и удаляться такой подход не оправдан. Можно, конечно, зашифровать должность как код должности и ввести поле подстановки в соответствующую таблицу, но кто этим будет заниматься, тем более с готовой БД?
Пример заполнения судовой роли для нашего яхт-клуба гарантирует, что матрос не будет в судовой роли стоять выше боцмана, или пассажир выше кока.
Предположим, что имеется список сотрудников (в данном случае моряков), из которого переносятся данные в MSHFlexGrid1, после чего вызывается следующая процедура
Private Sub RankCrwes()
Dim intRows As Integer
Dim intTemp As Integer, intY As Integer
Dim stRank(7) As String, stTabl(40, 2) As String '40 строк в переменной я беру с запасом - параметр индивидуальный, а 3 столбца _
это ID, ФИО и должность, взятые из списка
With Me.MSHFlexGrid1
'узнаем, сколько всего в списке вместе с добавленным, и, если больше одного, то продолжаем далее:
intRows = .Rows
If intRows = 1 Then Exit Sub
'заполняем массив чинами, в соответствии с которым будет упорядочиваться список. Если должностей слишком _
много, то легче перечислить их в отдельной таблице и заполнить открытием соответствующего Recordseta.
stRank(0) = "капитан"
stRank(1) = "старпом"
stRank(2) = "вахтенный рулевой"
stRank(3) = "радист"
stRank(4) = "боцман"
stRank(5) = "матрос"
stRank(6) = "кок"
stRank(7) = "пассажир"
' Начиная с последней строки MSHFlexGrid1все данные последовательно считываются в двухмерный массив stTabl в строгом _ соответствии порядку заполнения массива stRank. В данном примере до кока, чтобы пассажир был всегда последним. _
Если последний не обязателен, тогда For intTemp= 0 To 7 и пропустить последний блок Do While ... Loop
For intTemp = 0 To 6
Do While intRows > 0
'проверяется на совпадение каждый 3 столбец MSHFlexGrid1 - должность. При совпадении проводится запись в массив stTabl
If .TextArray((intRows - 1) * 3 + 2) = stRank(intTemp) Then
stTabl(intY, 2) = .TextArray((intRows - 1) * 3 + 2)
stTabl(intY, 1) = .TextArray((intRows - 1) * 3 + 1)
stTabl(intY, 0) = .TextArray((intRows - 1) * 3)
'после записи переводится строка в переменной-массиве
intY = intY + 1
End If
'в MSHFlexGrid1перевод на строку вверх
intRows = intRows - 1
Loop
'восстанавливается первоначальное значение переменной для дальнейшего анализа MSHFlexGrid1
intRows = .Rows
Next
'в этом блоке выбираются должности, не вошедшие в основной список, т.е. неважно в каком они порядке, _
лишь бы были после основных
Do While intRows > 0
Select Case .TextArray((intRows - 1) * 3 + 2)
Case stRank(0), stRank(1), stRank(2), stRank(3), stRank(4), stRank(5), stRank(6), stRank(7)
Case Else
stTabl(intY, 2) = .TextArray((intRows - 1) * 3 + 2)
stTabl(intY, 1) = .TextArray((intRows - 1) * 3 + 1)
stTabl(intY, 0) = .TextArray((intRows - 1) * 3)
intY = intY + 1
End Select
intRows = intRows - 1
Loop
intRows = .Rows
'если нужен последний (в данном случае - пассажир), то находим и его
Do While intRows > 0
If .TextArray((intRows - 1) * 3 + 2)=stRank(7) Then
stTabl(intY, 2) = .TextArray((intRows - 1) * 3 + 2)
stTabl(intY, 1) = .TextArray((intRows - 1) * 3 + 1)
stTabl(intY, 0) = .TextArray((intRows - 1) * 3)
intY = intY + 1
End If
intRows = intRows - 1
Loop
'очищаем уже полностью переписанный в stTabl MSHFlexGrid1
.Clear
.Rows = 0
'заполняем его по новому уже упорядочено. intY - 1 потому, что ранее единица была добавлена, _
но запись в переменную по исчерпании списка не сделана
For intRows = 0 To intY - 1
.AddItem stTabl(intRows, 0) & vbTab & stTabl(intRows, 1) & vbTab & stTabl(intRows, 2)
Next
End With
End Sub
наверх
Мои программы
BalloonMessage for MS Agent
BalloonMessage for Microsoft Agent реализует диалог программы с
пользователем, используя при этом технологию Microsoft Agent. OCX реализует три
типа диалоговых окон: InputBox, MsgBox и MsgLabels.
Автора: Шатрыкин Иван и Павел Сурменок.
наверх
Вопрос/Ответ
Здесь Вы можете задать вопрос, или ответить на уже имеющиеся вопросы.
Вопросы:Автор вопроса: Дмитрий
Ответ ожидается по этому адресу
Как с помощью VB узнать подключен ты к сети, например Интернету?
Автор вопроса: Сергей
Ответ ожидается по этому адресу
Подскажите пожалуйста как правильно записать файл с картинкой типа *.bmp, *.jpg в БД SQL Server.
Автор вопроса: Maxim
Ответ ожидается по этому адресу
Как в Вб.нет поменять стартовую процедуру?
Т.е. чтобы первой грузилась, например, form2 или main sub, как в вб6.
Автор вопроса: Петр
Ответ ожидается по этому адресу
Я использую в проекте VB видеокарту типа "Nuvision" и у меня возникли след. проблемы:
1. Не могу сделать Stretch, используя API-функцию StretchBlt
2. При вызове функций:
CapDriverConnect,
CapPreviewRate,
CapPreview,
CapOverlay
идёт только частичное заполнение фрейма.
Кто может посоветовать, видеокарту какого типа лучше использовать или есть какой-нибудь стандартный пакет для работы с видеокартой
Автор вопроса: Sergey
Ответ ожидается по этому адресу
Кто-нибудь знает, где можно найти листинг проги, которая запароливает
папки? Дайте ссылочку, плз.
Автор вопроса: Theba
Ответ ожидается по этому адресу
Как отследить события подключения и отключения соединения с провайдером для программы счета трафика?
Автор вопроса: IzoMicke
Ответ ожидается по этому адресу
Есть задумка программы, использующей Латиницу-1 и Латиницу-2; она должна выводить символы с диакритикой. Проблему можно коряво решить встраиванием Excel-таблицы в VB-форму. А есть ли в VB(6) контрол, который может такое сделать?
Автор вопроса: Alex
Ответ ожидается по этому адресу
Трижды вложенный цикл For по переменным i,j,k позволяет перебрать все возможные комбинации (i,j,k). А можно ли сделать для n-ого количества переменных. Может быть можно сделать это с помощью циклических ссылок на функцию, где описан один цикл For. Помогите очень нужно...
Автор вопроса: Alex
Ответ ожидается по этому адресу
Подскажите кто-нибудь программный код на VB для реализации задачи линейного программирования с помощью Симплекс-метода.
Автор вопроса: Виталик
Ответ ожидается по этому адресу
Прошу, кто знает, напишите код на VB6 или хотя бы подскажите, как отследить нажатие символьных и цифровых клавиш на клаве в любом приложении. Желательно чтобы потом конкретно знать где что нажималось.
Автор вопроса: Данила
Ответ ожидается по этому адресу
Требуется:
1) подключиться к интернету через созданное удалённое соединение
2) отправить серверу запрос вида
"http://www.magazin.ru/main/main.php?page=s_winners" и получить
сгенерированную страницу.
3) сохранить сгенерированную страницу в виде файла на винте
4) отключиться от интернета
Если уж не код, то хотя бы подскажите, какие объекты с этими задачами справятся.
Автор вопроса: UPS!!!
Ответ ожидается по этому адресу
Имеется на форме элемент WebBrowser, который чего-то там отображает.
Как автоматически (без вопросовпредложений по событию таймера, например) сделать отображаемую страничку доступной автономно (аналогично меню сохранить как... в Эксплорере)?
Вместе с картинками и без них?
Лучше, чем код ответа быть не может...
Автор вопроса: timshv@graffiti.net
Ответ ожидается по этому адресу
Установил MSDN 2003, а хэлп VB6 не может найти ссылку. Говорит переустановите MSDN Library. MSDN2000 работал без проблем.
Где можно указать бейсику чтобы он обращался к новой MSDN?
Автор вопроса: Николай
Ответ ожидается по этому адресу
Как в VB передать данные по модему с одного компа на другой? Подскажите хотябы направление!
Автор вопроса: i-sof@mail.ru
Ответ ожидается по этому адресу
Я хочу с удаленного компа, не зная системную папку винды (типо: c:\windows), скачть (из этой папки) файл (пусть будет win.ini).
Тако вот вопрос: Как определить системную папо4ку винды?
Автор вопроса: weeeer
Ответ ожидается по этому адресу
У меня два вопроса.
1. Как сделать так что бы кликать на файл из любого менеджера и что бы моя прога открыла его.
2. Нужен компонент или код что бы сделать красивое меню что - то вроде как программе Word.
Автор вопроса: Maxim
Ответ ожидается по этому адресу
Как проанализировать жесткий диск и записать все директории в файл?
Автор вопроса: Максим
Ответ ожидается по этому адресу
В Textе стоит математическое выражение, ну например text1="2+3". Можно ли его посчитать в переменной? А может кто знает, как в Микрософтском калькуляторе обрабатываются операторы сложения, умножения и т.д.?
Автор вопроса: Владимир
Ответ ожидается по этому адресу
Я использую Swiftsoft Multimedia Tools OCX v2.0. Файл у меня проигрывается через MMAudioPLayerX1. Подскажите чтобы проигрываемый файл выводился в какомто элементе управления и при нажатиина надпись он воспроизводиля снова. Так же в этом элементе управления может отображаться много названия файлов и пользователь кликом выбирает нужный ему файл для проослушивания.
Ответы:
Вопрос:
Не подскажите,как из VB6 запустить программу(игру). Например у меня есть форма с кнопкой OK, я нажимаю и должна запуститься игрушка. Как прописать директорию, точнее как установить связь.
Ответ:
Автор ответа: HoodWin
Вопрос:
Не подскажите,как из VB6 запустить программу(игру). Например у меня есть форма с кнопкой OK, я нажимаю и должна запуститься игрушка. Как прописать директорию, точнее как установить связь.
Ответ:
Самый простой способ запуска приложений - это
Shell filename, windowstyle
' где filename - полный путь к файлу; windowstyle - фокус и положение окна программы при включении, например, данный параметр может быть vbNormalFocus или др.
Вопрос:
Скажите, как с помощью VB6 можно сделать программу, осуществляющую связь через TCP/IP с помощью интернета.
Нужно чтобы моя прога слала текстовое сообщение на удаленный компьютер, а тот компьютер должен принять это сообщение и записать в переменную. Если нетрудно привидите кусочки кода клиента и сервера.
Ответ:
Автор ответа: •Creator•
Глянь-ка на www.vb.kiev.ua.
Вопрос:
Скажите, как сделать, чтобы моя прога определила мой IP когда я в сети. Это значение нужно присвоить какой либо переменной. Если нетрудно, приведите пример кода.
Ответ:
Автор ответа: 123
Расположите на форме компонент Winsock(Winsock1) через меню Project|Components - Microsoft Winsock Control 6.0
Private Sub Form_Load()
MsgBox Winsock1.LocalIP
End Sub
Ответ:
Автор ответа: Loki
Узнать IP своего компа из кода ты можешь взять пример на сайте www.vbrain.narod.ru и переписать его под свои нужды.
В этом примере можно узнать IP своего компа зная его имя или наоборот.
Вопрос:
Как можно ускорить открытие файла, если файл имеет произвольный доступ (Random)и содержит более ста тысяч записей?
Ответ:
Автор ответа: Alexander
Во-первых, не читать сразу весь файл.
Во-вторых, выполнять большую часть работы на серверной части (если работаем на сети). Особенно рекомендую использовать SQL-запросы или даже открытие таблицы с adTableDirect (зависит от ситуёвины).
В-третьих, для достижения и того, и другого одновременно, рекомендуется использовать грамотного "провайдера" (в терминах методов доступа Майкрософт). Сейчас для этого фирма рекомедует использовать метод доступа ADO, построенного не на ODBC, а на OLE DB, где, в частности, есть параметр "количество читаемых записей при обращении".
Вопрос:
1.Кто знает как на Visual Basic Script в документе HTML запрограммить чтение данных из файла, лежащего рядом (любые варианты).
2.Подскажите как передать хотябы переменную. Неплохо если поделитесь простыми примерами с Winsock'om на примере клиент-сервер... или дайте ссылки на общения, статьи, примеры...
Ответ:
Автор ответа: Артем Кривокрисенко
1. В свое время мне тоже нужно было сделать такое. Но, к сожалению, это сделать невозможно. Конечно, если вбскрипт выполняется локально, т.е. на компе и открыть файл нужно с компа, то поможет FSO, а вот если нужно загрузить файл с сервера, то, как я уже говорил, так нельзя.
Но я нашел выход из этой ситуации. Я подключал к html-странице скриптовый файл, к тором хранились нужные мне данные. Пиши на личку, проконсультую: Artyom_kr@zp.ukrtel.net
Вопрос:
Помогите мне, пожалуйста решить следующую проблему. Я создаю один DHTML проект, в котором мне требуется отослать почту со вложением файла. Как это сделать на HTML при помощи mailto:адрес@мыло.ру?subject="тема" а как нужно продолжить строку, чтобы вложть файл?
Ответ:
Автор ответа: Sergey
Я конечно могу ошибаться, но мне кажется что стандарт HTML поддерживает задавать только адресата, тему,копию и скрытую копию. Если раскопаешь что-то дополнительно,дай знать пожалуйста.
Ответ:
Автор ответа: Dimmer
А никак ты это не сделаешь, это по соображениям security отсутствует :( Но можно написать свой ActiveX на том же VB, реализующий через MAPI/CDO посылку файлов и все что угодно :)
Вопрос:
Пусть есть массив переменной длины
Dim vArr()
В циклическом процессе определяется число неких элементов (n) и делается
Redim vArr(n-1)
Вопрос: можно ли как-то программно возвратить vArr в исходное состояние, т.е. в то, в котором он был до первого ReDim'а?
Ответ:
Автор ответа: ViTal
Можно!
Пользуй: Erase vArr
Вопрос:
Подскажте пожалуйста как отловить нажатие на кнопку "свернуть" и "закрыть" , и не дать программе свернутся или закрытся , а выполнить какое то свое дествие. Если можно с примером , уже 3ю неделю мучаюсь , ниче не получается :(
Ответ:
Автор ответа: Андрюшин Евгений
Можно попробовать сделать так:
'Получим индентификатор системного меню окна
hMenu = GetSystemMenu(frmHwnd, 0&)
'Удалим первый элемент (Восстановить)
Call DeleteMenu(hMenu, 0, MF_BYCOMMAND)
'Удалим четвертый элемент (Развернуть)
Call DeleteMenu(hMenu, 4, MF_BYCOMMAND)
'Удалим третий элемент (Свернуть)
Call DeleteMenu(hMenu, 3, MF_BYCOMMAND)
и соответственно необходимо объявить API -функции и константы:
Public Declare Function GetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" Alias "DeleteMenu" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Const MF_BYCOMMAND = &H0&
Ответ:
Автор ответа: ViTal
Надо писать функцию-ловушку (hook), в которой отлавливать соответствующие сообщения (свернуть и закрыть).
Ответ:
Автор ответа: Anton
'форма
Dim LastState As Integer
Private Sub Form_Resize()
If Me.WindowState = 1 Then
Me.WindowState = LastState
MsgBox "min pressed"
End If
LastState = Me.WindowState
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = True
MsgBox "close pressed"
End Sub
Ответ:
Автор ответа: MAVR
Вот пример блокировки кнопки "свернуть" и "закрыть"
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Const MF_BYPOSITION = &H400&
Private Sub Form_Load()
Option1(0).Caption = "Восстановить"
Option1(1).Caption = "Переместить"
Option1(2).Caption = "Размер"
Option1(3).Caption = "Свернуть"
Option1(4).Caption = "Развернуть"
Option1(5).Caption = "?????????"
Option1(6).Caption = "Закрыть"
End Sub
Private Sub Option1_Click(Index As Integer)
Dim hSysMenu, lngResult As Long
hSysMenu = GetSystemMenu(Me.hwnd, True)
hSysMenu = GetSystemMenu(Me.hwnd, False)
lngResult = DeleteMenu(hSysMenu, Index, MF_BYPOSITION)
End Sub
Ответ:
Автор ответа: MAVR
Private Sub Form_QueryUnload(Cancel As _
Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu Then
Cancel = True
End If
End Sub
Ответ:
Автор ответа: Murat Shonov
По поводу кнопки закрыть это событие Unload или Query Unload, а вот отслеживать кнопочку свернуть можно только через АПИ функции.
Вопрос:
Как издать на PC-Speaker писк при помощи VB 6.0 для Windows 98/XP?
Ответ:
Автор ответа: ViTal
Для этого есть апи-функция:
Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Ответ:
Автор ответа: Anton
встроенная команда beep, либо смотри функцию api: beep, там можно указать частоту и длительность
Private Declare Function Beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Можете заполнить эту форму, либо отослать вопрос СЮДА
Форма для добавления нового вопроса в этот раздел. Информация отсылается по E-mail владельцу сайта.