Работа с мониторами

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
Drag
Обычный пользователь
Обычный пользователь
Аватара пользователя
 
Сообщения: 85
Зарегистрирован: 29.01.2005 (Сб) 23:54
Откуда: Москва

Работа с мониторами

Сообщение Drag » 14.08.2006 (Пн) 19:59

Возникла такая проблема. Надо на VB написать программу, которая переключает активный монитор и меняет на любом из мониторов разрешение экрана. Отсюда два вопроса - 1) Как в VB можно получить доступ к управлению несколькими мониторами?; 2) Как можно отловить переключение активного монитора? Видеокарта одна, поддерживает два монитора. В MSDN, как обычно, полно примером на С, и ни одного примера на VB :evil:
PS: Допускается использование DirectX

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2054
Зарегистрирован: 25.11.2002 (Пн) 20:03

Сообщение ALX_2002 » 15.08.2006 (Вт) 1:52

2 Drag: Ммм... Ну попробуй в коде на C разобраться или если совсем туго будет копипастни сюда, вдруг кто нить въедет. Обещаю оказать посильную помощь :)

Drag
Обычный пользователь
Обычный пользователь
Аватара пользователя
 
Сообщения: 85
Зарегистрирован: 29.01.2005 (Сб) 23:54
Откуда: Москва

Сообщение Drag » 15.08.2006 (Вт) 8:18

Спасибо, нашел :). Это нужна DLL'ка UltraMon.dll. Вот, если кому-то понадобится, то приложил миниатюрный инсталлятор, который регистрирует эту библиотеку и в установочную директорию засовывает два примерчика.
PS: Спасибо за моральную помощь :).
PSS: Пробовал я на С разобраться, но пару строк я просто не мог понять, а также несколько функций отсутсвовали в API Viewer, поэтому я не знал, как их объявить.
Вложения
setup.zip
(240.16 Кб) Скачиваний: 39

tsaMolotoff
Начинающий
Начинающий
Аватара пользователя
 
Сообщения: 12
Зарегистрирован: 12.08.2006 (Сб) 11:29

Сообщение tsaMolotoff » 15.08.2006 (Вт) 8:43

Есть такое(надо менять в ChangeDisp settings - смотри в MSHelp от Дельфи):

АПЯ:
Код: Выделить всё

Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Dim Wid&, Hei&, BPP&, Freq&
Public Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_DISPLAYFREQUENCY = &H400000

Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
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 String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type


Сам код:
Код: Выделить всё

Public Sub ChangeResolution(iWidth As Single, iHeight As Single, Optional sReturn As Boolean)
Dim DevM As DEVMODE
Dim a As Boolean
Dim i As Long
Dim b As Long
Dim sfreq As Long
i = 0
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until (a = False)

If NotFirstChange = False Then
    GetVideoMode Wid, Hei, BPP, Freq
'cDebug.StrWrite "Current Desktop mode was: " & CStr(Wid) + "x" + CStr(Hei)+   "x" + CStr(Freq) + " Hz"
NotFirstChange = True
End If
If sReturn = True Then
b = ChangeDisplaySettings(0, 0)
DevM.dmFields = DM_DISPLAYFREQUENCY
If DevM.dmDisplayFrequency <= 1 Then
DevM.dmDisplayFrequency = Freq
End If
b = ChangeDisplaySettings(DevM, 0)
If b = -2 Then
b = ChangeDisplaySettings(0, 0)
'cDebug.StrWrite "Default Refresh rate changing is unsucsessful!"
End If
Exit Sub
End If
' Testing video modes
Dim testFreq&
testFreq = Freq
Do
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_DISPLAYFREQUENCY
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight
If DevM.dmDisplayFrequency <> testFreq Then
DevM.dmDisplayFrequency = testFreq
End If
b = ChangeDisplaySettings(DevM, CDS_TEST)
If b <> 0 Then testFreq = testFreq - 5
Loop Until b = 0
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_DISPLAYFREQUENCY
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight
If DevM.dmDisplayFrequency <> testFreq Then
DevM.dmDisplayFrequency = testFreq
End If
b = ChangeDisplaySettings(DevM, 0)
If b = -2 Then
'cDebug.StrWrite "Default Refresh rate changing is unsucsessful!" _
            + " Trying to launch in 60 Hz mode"
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_DISPLAYFREQUENCY
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight
DevM.dmDisplayFrequency = 60
b = ChangeDisplaySettings(DevM, 0)
If b = -2 Then
MsgBox "Your Monitor does not support any" _
& Cstr(iWidth) & "x" & Cstr(iHeight) & "x" & modes!" _
        + vbCrLf + "Program will close immidiately!", vbOKOnly Or vbCritical
        End
        End If
End If
End Sub



Ну слегка поправить для ваших целей - смотрите MSHelp :arrow: ( not MSDN)
OnLine Shell - winner of citywide young programmers contest(2006), 2nd e of Republican young programmers contest(2006)


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: AhrefsBot, SemrushBot и гости: 80

    TopList