Здравствуйте
У меня появилась следующая задача - необходимо задавать некие уставки на каждый час, каждого дня недели. Так же имеется необходимость оперативно менять их в любой момент.
Использовать я решил компонент vxGrid:
- компонент vxGrid не позволяет менять значения, но в basic-е имеется такой мощный инструмент как InputBox - им мы и воспользуемся.
Сделаем следующее:
- проверка вводимых данных на соответствие числовому значению. Так как вводимые данные имеют дробную часть вытекает следующая проблема - разделителем числа может быть как точка так и запятая;
- хранение уставок я решил реализовать в БД ms access;
- при щелчке на нужной ячейки вывести inputbox с помощью которого можно добавить\изменить данные
Приступим:
быстренько сваял вот такую табличку
Копируем файл бд proba.mdb в корень диска c:
(в реальных проектах надо конечно использовать для этих целей папку dynamics\app, путь к которой можно получить с помощью System.DocumentPath)
Создаем новый рисунок и добавляем следующие переменные:
Public Connect1 As New Connection
Public recJOURNAL As New Recordset
Public strQuery, MyValue
Public row, col
в событие Activated вводим следующий код:
Private Sub CFixPicture_Activated()
strQuery = "SELECT часы , понедельник, вторник, среда, четверг, пятница, суббота, воскресенье, праздники FROM будние where (часы > -1) and (часы < 24)"
If Connect1.State = 0 Then
Connect1.Provider = "Microsoft.Jet.oledb.4.0"
Connect1.Open "c:\proba.mdb"
End If
recJOURNAL.Open strQuery, Connect1, adOpenStatic, adLockReadOnly
Set vxGrid1.ADORecords = recJOURNAL
Connect1.Close
End Sub
Немного пройдемся по коду:
strQuery запрос выбирающий нужные нам данные,
Проверяем состояние подключения connect1 и при необходимости подключаемся.
С базы данных proba.mdb, запросом забираем нужные данные и помещаем в vxGrid.
Создаем событие vxGrid1_DblClick:
Private Sub vxGrid1_DblClick()
Dim Message, Title, Default
Dim c
On Error GoTo err_
row = vxGrid1.row
col = vxGrid1.col
If row = -1 Or col = -1 Then Exit Sub
c = vxGrid1.TextMatrix(row, col)
If col = 1 Then Exit Sub
Message = "Введите новое значение"
Title = "Запрос"
Default = c
MyValue = CDbl(InputBox(Message, Title, Default))
Call Write_BD
err_:
Exit Sub
End Sub
Смотрим что у нас тут:
On Error GoTo err_ - обработчик ошибок, при возникновение ошибки идем на метку err_
row = vxGrid1.row
col = vxGrid1.col
If row = -1 Or col = -1 Then Exit Sub
Получаем номер столбца и строки, если число отрицательное (т.е. ячейка не выбрана) - выход
If col = 1 Then Exit Sub
Не позволяем редактировать заголовки
MyValue = CDbl(InputBox(Message, Title, Default))
Выводим Inputbox и если введено не число, формируется ошибка и уходим на метку err_
Call Write_BD - процедура записи нового значения в бд, ниже привожу ее код:
Private Sub Write_BD()
strQuery = "SELECT часы , понедельник, вторник, среда, четверг, пятница, суббота, воскресенье, праздники FROM будние where (часы > -1) and (часы < 24)"
If Connect1.State = 0 Then
Connect1.Provider = "Microsoft.Jet.oledb.4.0"
Connect1.Open "c:\proba.mdb"
End If
recJOURNAL.Open strQuery, Connect1, adOpenStatic, adLockOptimistic
recJOURNAL.MoveFirst
For i = 0 To row - 2
recJOURNAL.MoveNext
Next i
On Error GoTo err_
recJOURNAL.Fields(col - 1).Value = MyValue
recJOURNAL.Update
Connect1.Close
Call CFixPicture_Activated
Exit Sub
err_:
MsgBox Error
Connect1.Close
End Sub
Скачать мнемосхему и файл бд - yandex
Комментариев нет:
Отправить комментарий