Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Access Новый топик    Ответить
Топик располагается на нескольких страницах: Ctrl  назад   1 [2]      все
 Re: Определить количество подключенных мониторов  [new]
vmag
Member

Откуда: MP
Сообщений: 4029
Adilby
некоторые покупатели не доверяют кассиру и хотят видеть что там мутится))

Да ерунда всё это, тот кто не доверяет смотрит потом в чек...
Ну... так ... немного престижа, но в основном понты...
Зато:
ноут + монитор... заманчиво... прикручивайте всё шурупами к столу намертво или на эпоксидку...
типичная ситуация:
- ноут на прилавке (а тут еще и монитор)
- клиент говорит кассиру: а покажите ка вон тот набор отверток вверху на стеллаже...
- продавец берет табуреточку, тянется за отвертками и слышит звон колокольчика на двери - Бздынь...
- оборачивается - ни клиента... ни ноутбука...

Если уж ставить монитор, то крутить на нем клипы с красивыми формами, чтоб мужикам на кассе в авоську
просрочку докладывать...

p/c/ реально за мою практику ушло 6 ноутов у клиентов
5 май 21, 16:05    [22318876]     Ответить | Цитировать Сообщить модератору
 Re: Определить количество подключенных мониторов  [new]
old_joy
Member

Откуда:
Сообщений: 187
Adilby,

MoveWindow
6 май 21, 07:18    [22319093]     Ответить | Цитировать Сообщить модератору
 Re: Определить количество подключенных мониторов  [new]
ЦЦа
Member

Откуда:
Сообщений: 73
Adilby
А теперь можно ли командно открыть всплывающую форму именно на втором мониторе?
old_joy
Было бы еще интересно получить и разрешение мониторов.
+
Класс MonitorEnumProcData:
Option Explicit

Public Left As Long
Public Top As Long
Public Right As Long
Public Bottom As Long
Public PelsWidth As Long
Public PelsHeight As Long
Public BitsPerPel As Long
Public DisplayFrequency As Long
Public MonitorFlags As MonitorInfoFlags
Public NextMon As MonitorEnumProcData 'ссылка на характеристики следующего монитора
Модуль:
Option Explicit

Private Enum BOOL
    FALSE_BOOL = 0&
    TRUE_BOOL = 1&
End Enum

#If VBA7 Then
Private Const NULL_PTR As LongPtr = 0
#Else
Private Const NULL_PTR As Long = 0
#End If

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

#If VBA7 Then
Private Declare PtrSafe Function EnumDisplayMonitors Lib "user32" ( _
    ByVal hDC As LongPtr, lprcClip As Any, ByVal lpfnEnum As LongPtr, _
    dwData As MonitorEnumProcData) As BOOL
#Else
Private Declare Function EnumDisplayMonitors Lib "user32" ( _
    ByVal hDC As Long, lprcClip As Any, ByVal lpfnEnum As Long, _
    dwData As MonitorEnumProcData) As BOOL
#End If

Public Enum MonitorInfoFlags
    MONITORINFOF_PRIMARY = 1&
End Enum

'  size of a device name string
Private Const CCHDEVICENAME = 32

Private Type DEVICE_NAMEW
    szName(0 To CCHDEVICENAME * 2 - 1) As Byte
End Type

Private Type MONITORINFOEXW
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
    szDevice As DEVICE_NAMEW
End Type

#If VBA7 Then
Private Declare PtrSafe Function GetMonitorInfoW Lib "user32" ( _
    ByVal hMonitor As LongPtr, lpmi As Any) As BOOL
#Else
Private Declare Function GetMonitorInfoW Lib "user32" ( _
    ByVal hMonitor As Long, lpmi As Any) As BOOL
#End If

'  size of a form name string
Private Const CCHFORMNAME = 32

Private Type FORM_NAMEW
    szName(0 To CCHFORMNAME * 2 - 1) As Byte
End Type

Private Type DEVMODEW
    dmDeviceName As DEVICE_NAMEW
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As FORM_NAMEW
    dmUnusedPadding As Integer
    dmBitsPerPel As Long
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
'#if(WINVER >= 0x0400)
    dmICMMethod As Long
    dmICMIntent As Long
    dmMediaType As Long
    dmDitherType As Long
    dmReserved1 As Long
    dmReserved2 As Long
'  #if (WINVER >= 0x0500) || (_WIN32_WINNT >= _WIN32_WINNT_NT4)
    dwPanningWidth As Long
    dwPanningHeight As Long
'  #endif
'#endif /* WINVER >= 0x0400 */
End Type

Private Const ENUM_CURRENT_SETTINGS As Long = -1
Private Const ENUM_REGISTRY_SETTINGS As Long = -2

Private Enum EnumDisplaySettingsFlags
    EDS_DEFAULT = &H0&
    EDS_RAWMODE = &H2&
    EDS_ROTATEDMODE = &H4&
End Enum

#If VBA7 Then
Private Declare PtrSafe Function EnumDisplaySettingsExW Lib "user32" ( _
    lpszDeviceName As Any, ByVal iModeNum As Long, lpDevMode As DEVMODEW, _
    Optional ByVal dwFlags As EnumDisplaySettingsFlags = EDS_DEFAULT) As BOOL
#Else
Private Declare Function EnumDisplaySettingsExW Lib "user32" ( _
    lpszDeviceName As Any, ByVal iModeNum As Long, lpDevMode As DEVMODEW, _
    Optional ByVal dwFlags As EnumDisplaySettingsFlags = EDS_DEFAULT) As BOOL
#End If

#If VBA7 Then
Private Declare PtrSafe Function MoveWindow Lib "user32" ( _
    ByVal hWnd As LongPtr, ByVal X As Long, ByVal Y As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long, _
    ByVal bRepaint As BOOL) As BOOL
Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
    ByVal hWnd As LongPtr, lpRect As RECT) As BOOL
#Else
Private Declare Function MoveWindow Lib "user32" ( _
    ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, _
    ByVal nWidth As Long, ByVal nHeight As Long, _
    ByVal bRepaint As BOOL) As BOOL
Private Declare Function GetWindowRect Lib "user32" ( _
    ByVal hWnd As Long, lpRect As RECT) As BOOL
#End If

#If VBA7 Then
Private Function MonitorEnumProc(ByVal hMonitor As LongPtr, _
                                 ByVal hDC As LongPtr, rcBounds As RECT, _
                                 Data As MonitorEnumProcData) As BOOL
#Else
Private Function MonitorEnumProc(ByVal hMonitor As Long, _
                                 ByVal hDC As Long, rcBounds As RECT, _
                                 Data As MonitorEnumProcData) As BOOL
#End If
    Dim ThisData As MonitorEnumProcData
    Set ThisData = New MonitorEnumProcData
    ThisData.Left = rcBounds.Left
    ThisData.Top = rcBounds.Top
    ThisData.Right = rcBounds.Right
    ThisData.Bottom = rcBounds.Bottom
    
    Dim bResult As BOOL
    Dim mi As MONITORINFOEXW
    mi.cbSize = LenB(mi)
    bResult = GetMonitorInfoW(hMonitor, mi)
    If bResult = FALSE_BOOL Then MonitorEnumProc = FALSE_BOOL: Exit Function
    ThisData.MonitorFlags = mi.dwFlags
    
    Dim dm As DEVMODEW
    dm.dmSize = LenB(dm)
    bResult = EnumDisplaySettingsExW(mi.szDevice, ENUM_CURRENT_SETTINGS, dm)
    If bResult <> FALSE_BOOL Then
        ThisData.PelsWidth = dm.dmPelsWidth
        ThisData.PelsHeight = dm.dmPelsHeight
        ThisData.BitsPerPel = dm.dmBitsPerPel
        ThisData.DisplayFrequency = dm.dmDisplayFrequency
    End If
    
    'Составляем односвязный список мониторов с характеристиками
    If Data Is Nothing Then
        Set Data = ThisData
    Else
        Dim CurrData As MonitorEnumProcData
        Set CurrData = Data
        Do Until CurrData.NextMon Is Nothing
           Set CurrData = CurrData.NextMon
        Loop
        Set CurrData.NextMon = ThisData
    End If
    
    MonitorEnumProc = TRUE_BOOL
End Function

#If VBA7 Then
Private Function MoveWindowToSecondMonitor( _
    ByVal hWnd As LongPtr, _
    Optional ByVal X As Long, Optional ByVal Y As Long) As Boolean
#Else
Private Function MoveWindowToSecondMonitor( _
    ByVal hWnd As Long, _
    Optional ByVal X As Long, Optional ByVal Y As Long) As Boolean
#End If
    Dim Data As MonitorEnumProcData
    Dim bResult As BOOL
    bResult = EnumDisplayMonitors(NULL_PTR, ByVal NULL_PTR, _
                                  AddressOf MonitorEnumProc, Data)
    
    If Data Is Nothing Then Exit Function
    If Data.NextMon Is Nothing Then Exit Function 'выходим, если нет второго монитора
    
    Dim rcWnd As RECT
    bResult = GetWindowRect(hWnd, rcWnd)
    With Data.NextMon
        bResult = MoveWindow(hWnd, .Left + X, .Top + Y, _
                             rcWnd.Right - rcWnd.Left, _
                             rcWnd.Bottom - rcWnd.Top, _
                             TRUE_BOOL)
    End With
    MoveWindowToSecondMonitor = bResult <> FALSE_BOOL
End Function

Public Sub RunMe() 'Тестовая процедура - разместить активную (всплывающую) форму на втором мониторе
    MoveWindowToSecondMonitor Screen.ActiveForm.hWnd, 200, 100
End Sub
13 май 21, 19:49    [22321817]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: Ctrl  назад   1 [2]      все
Все форумы / Microsoft Access Ответить