Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Access Новый топик    Ответить
 Выпадающий календарик с настраиваимым списком праздников (пример)  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Ещё одна поделка - календарик с примером.
В новых Access для поля типа Date по умолчанию появляется стандартный календарь в старых такого нет.
Особенность этого - настраиваемые из контекстного меню списки праздничных дней.
Хранятся в таблице.

[url=]https://www120.zippyshare.com/v/AEts2Gyh/file.html[/url]

PS.
Большой размер базы из-за дополнительных модулей:
- поддержка настраиваемых контекстных меню (clsContextMenu, clsContextMenuControl);
- групповой обработки событий для контролов (clsControlEventsTransfer, clsRelay);
- плавающих кнопок (clsFloatButton)
- и, - основная масса за счет набора модулей для использования картинок на контролах (в данном случае используются для вывода иконок в контекстное меню).
Дергаю из своих проектов - старался максимально обрезать всё, что непосредственно не нужно для работы примера, но без фанатизма поэтому наверняка осталось много "лишнего" кода.

PS. PS. как и ранее для тех кому это может быть нужно|интересно.
22 мар 19, 14:04    [21840762]     Ответить | Цитировать Сообщить модератору
 Re: Выпадающий календарик с настраиваимым списком праздников (пример)  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Обнаружил косяк при закрытии календарика крестиком - слетала дата в поле источника.
Лечится заменой в modDates.ShowDateSelector
HandleError:
    Result = False ' <- 0 = #12/30/1899#

на:
HandleError:
    Result = DateValue ' <- исходное значение селектора

sorry - издержки выдергивания кусков из разных мест
22 мар 19, 15:02    [21840868]     Ответить | Цитировать Сообщить модератору
 Re: Выпадающий календарик с настраиваимым списком праздников (пример)  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Еще одна старая, но благополучно забытая ошибка: неправильная нумерация недель года.
Лечится заменой в Form_frmDROP_Date.p_UpdateDays
strCap = DatePart("ww", DateAdd("d", BegDate, d))

на:
strCap = DatePart("ww", DateAdd("d", BegDate, d), , vbFirstJan1)
22 мар 19, 21:50    [21841349]     Ответить | Цитировать Сообщить модератору
 Re: Выпадающий календарик с настраиваимым списком праздников (пример)  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Вспомнил про еще один вариант с календарём который когда-то начинал, а потом задача отпала и так до ума и не довел - может тоже кому-то пригодится.
Лепилось для что-то вроде расписания отпусков. выглядит так:
Картинка с другого сайта.
пример запускается с формы Test_Vacations

исходный выпадающий календарик также присутствует выглядит так:
Картинка с другого сайта.
пример запускается с формы Test_Calendar

ссылка: https://www99.zippyshare.com/v/9IXpO5yf/file.html
26 мар 19, 10:32    [21843475]     Ответить | Цитировать Сообщить модератору
 Re: Выпадающий календарик с настраиваимым списком праздников (пример)  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 4366
iKaRus, ты свои примеры лучше размести на Программирование MsAccess, VB, VBA и ссылки туда дай. Там структура для примеров лучше заточена. Сейчас там вроде Joss заведует. Он здесь частенько бывает.
Тут, я боюсь, через некоторое время ссылки стухнут.

ИМХО.
26 мар 19, 12:09    [21843577]     Ответить | Цитировать Сообщить модератору
 Re: Выпадающий календарик с настраиваимым списком праздников (пример)  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Панург, Спасибо - так и сделал: http://am.rusimport.ru/MSAccess/download.aspx?id=837
26 мар 19, 12:46    [21843634]     Ответить | Цитировать Сообщить модератору
 Re: Выпадающий календарик с настраиваимым списком праздников (пример)  [new]
iKaRus
Member

Откуда:
Сообщений: 34
Найдена ошибка в позиционировании контекстного меню.
В результате переписана функция modDates.p_GetCtlLocation.
Цель функции - получить экранные размер и позицию контрола (в пикселях) для последующего позиционирования окон при помощи API.
Делалась на замену встроенной accLocation, которая не вполне корректно работает в ленточных формах (похоже accLocation к каждой строке добавляет высоту секции заголовка).
Толком не проверена но вроде бы в поставленной задаче работает корректно как в ленточной так и в обычной формах во всех видимых секциях.

Текст исправленной функции:
Private Function p_GetCtlLocation(Ctl As Access.Control, _
    Optional ByRef X, Optional ByRef Y, Optional ByRef W, Optional ByRef H) As Boolean
' получает экранные размер и позицию контрола (в пикселях)
Const c_strProcedure = "p_GetCtlLocation"
' v.0.2.1       : 15.04.2019 - исправлено позиционирование в секциях формы
'----------------
' в большинстве случаев отлично cработает ctl.accLocation X, Y, W, H, varChild,
' НО - в ленточной форме (покрайней мере в Access 2003) при расчете позиции по вертикали
' похоже он к каждой строке добавляет высоту секции заголовка
' из-за чего смещение от строки к строке возрастает
' поэтому считаем по-другому:
Dim lpPoint As POINTAPI
Dim dx As Long, dy As Long
Dim Result As Boolean

    Result = False
    On Error GoTo HandleError
' получаем экранные координаты (0;0) клиентской области формы
    With Ctl.PARENT.Form
        ClientToScreen .hWnd, lpPoint
' прибавляем расстояние от (0;0) до контрола
    ' по горизонтали
        If Not IsMissing(X) Then dx = .CurrentSectionLeft: X = lpPoint.X + TwipsToPixels(Ctl.Left + dx, DIRECTION_HORIZONTAL)
    ' по вертикали
        If Not IsMissing(Y) Then
            If Ctl.Section <> acHeader Then
            ' если это не заголовок формы
                ' для обычной формы добавляем высоты вышестоящих секций
                On Error Resume Next
                dy = .Section(acHeader).Height: If Err Then Err.Clear
                On Error GoTo HandleError
                Select Case Ctl.Section
                Case acDetail
                ' для ленточной формы добавляем расстояние от верхнего края формы
                    If (.DefaultView = 1 Or .DefaultView = 2) Then dy = .CurrentSectionTop
                Case acFooter
                    dy = dy + .Section(acDetail).Height
                End Select
            End If
            Y = lpPoint.Y + TwipsToPixels(Ctl.Top + dy, DIRECTION_VERTICAL)
        End If
        If Not IsMissing(W) Then W = TwipsToPixels(Ctl.Width, DIRECTION_HORIZONTAL)
        If Not IsMissing(H) Then H = TwipsToPixels(Ctl.Height, DIRECTION_VERTICAL)
    End With

    
    Result = True
HandleExit:
    p_GetCtlLocation = Result
    Exit Function
HandleError:
    Result = False
'    Dbg.Error Err.Number, Err.Description, _
'        Source:=c_strModule, Procedure:=c_strProcedure, LineNum:=Erl
    Err.Clear: Resume HandleExit
End Function


Обновленный модуль modDates во вложении.

К сообщению приложен файл (modDates.bas - 16Kb) cкачать
15 апр 19, 12:19    [21862272]     Ответить | Цитировать Сообщить модератору
 Re: Выпадающий календарик с настраиваимым списком праздников (пример)  [new]
iKaRus
Member

Откуда:
Сообщений: 34
перевыложил пример целиком: [url=]https://www89.zippyshare.com/v/r4snCDwC/file.html[/url]
7 июн 19, 09:36    [21904230]     Ответить | Цитировать Сообщить модератору
Все форумы / Microsoft Access Ответить