On Microsoft Windows 7 Professional Service Pack 1 code work perfectly - after run code, monitor is off, if i click any button on keyboard - monitor is on, in tray i see icon
Code: Select all
#PHYSICAL_MONITOR_DESCRIPTION_SIZE = 128
Structure PHYSICAL_MONITOR
hPhysicalMonitor.i
szPhysicalMonitorDescription.u[#PHYSICAL_MONITOR_DESCRIPTION_SIZE]
EndStructure
Prototype.l GetNumberOfPhysicalMonitorsFromHMONITOR_(hMonitor.i, *pdwNumberOfPhysicalMonitors.Long)
Prototype.l GetPhysicalMonitorsFromHMONITOR_(hMonitor.i, dwPhysicalMonitorArraySize.l, *pPhysicalMonitorArray.PHYSICAL_MONITOR)
Prototype.l DestroyPhysicalMonitors_(dwPhysicalMonitorArraySize.l, *pPhysicalMonitorArray.PHYSICAL_MONITOR)
Prototype.l SetVCPFeature_( hMonitor.i, bVCPCode.a, dwNewValue.i)
Global GetNumberOfPhysicalMonitorsFromHMONITOR_.GetNumberOfPhysicalMonitorsFromHMONITOR_
Global GetPhysicalMonitorsFromHMONITOR_.GetPhysicalMonitorsFromHMONITOR_
Global DestroyPhysicalMonitors_.DestroyPhysicalMonitors_
Global SetVCPFeature_.SetVCPFeature_
Global hMonitor.i
Global PhysicalMonitorArrayIndex.l
Global PhysicalMonitorArraySize.l
Global Dim PhysicalMonitorArray.PHYSICAL_MONITOR(0)
Global MonitorCapabilities.l
OpenLibrary(0, "Dxva2.dll")
GetNumberOfPhysicalMonitorsFromHMONITOR_ = GetFunction(0, "GetNumberOfPhysicalMonitorsFromHMONITOR")
GetPhysicalMonitorsFromHMONITOR_ = GetFunction(0, "GetPhysicalMonitorsFromHMONITOR")
DestroyPhysicalMonitors_ = GetFunction(0, "DestroyPhysicalMonitors")
SetVCPFeature_ =GetFunction(0, "SetVCPFeature")
; hMonitor = MonitorFromPoint_(0, #MONITOR_DEFAULTTOPRIMARY)
; If hMonitor
; If GetNumberOfPhysicalMonitorsFromHMONITOR_(hMonitor, @PhysicalMonitorArraySize) And PhysicalMonitorArraySize > 0
; ReDim PhysicalMonitorArray(PhysicalMonitorArraySize - 1)
; If GetPhysicalMonitorsFromHMONITOR_(hMonitor, PhysicalMonitorArraySize, @PhysicalMonitorArray())
; For PhysicalMonitorArrayIndex = 0 To PhysicalMonitorArraySize - 1
; ;SetVCPFeature_(PhysicalMonitorArray(PhysicalMonitorArrayIndex)\hPhysicalMonitor,$D6,4 )
; SetVCPFeature_(PhysicalMonitorArray(PhysicalMonitorArrayIndex)\hPhysicalMonitor,$E1,0 )
; Next
; DestroyPhysicalMonitors_(PhysicalMonitorArraySize, @PhysicalMonitorArray())
; EndIf
; EndIf
; EndIf
Global TimeOFF, Messaga.s,EscON
TimeOFF =60
MessagaON = 0
EscON = 0
ParameterCount.i = CountProgramParameters()
If ParameterCount.i <> 0
If Val(ProgramParameter(0)) > 0: TimeOFF = Val(ProgramParameter(0)): EndIf
If Val(ProgramParameter(1)) > 0: MessagaON = 1: EndIf
If Val(ProgramParameter(2)) > 0: EscON = 1: EndIf
EndIf
Procedure MonicOff()
hMonitor = MonitorFromPoint_(0, #MONITOR_DEFAULTTOPRIMARY)
If hMonitor
If GetNumberOfPhysicalMonitorsFromHMONITOR_(hMonitor, @PhysicalMonitorArraySize) And PhysicalMonitorArraySize > 0
ReDim PhysicalMonitorArray(PhysicalMonitorArraySize - 1)
If GetPhysicalMonitorsFromHMONITOR_(hMonitor, PhysicalMonitorArraySize, @PhysicalMonitorArray())
For PhysicalMonitorArrayIndex = 0 To PhysicalMonitorArraySize - 1
;SetVCPFeature_(PhysicalMonitorArray(PhysicalMonitorArrayIndex)\hPhysicalMonitor,$D6,4 )
; sams SetVCPFeature,[esi+PHYSICAL_MONITOR.hPhysicalMonitor],0E1h,0
SetVCPFeature_(PhysicalMonitorArray(PhysicalMonitorArrayIndex)\hPhysicalMonitor,$E1,0 )
Next
DestroyPhysicalMonitors_(PhysicalMonitorArraySize, @PhysicalMonitorArray())
EndIf
EndIf
EndIf
;SendMessage_(GetForegroundWindow_(), #WM_SYSCOMMAND, #SC_MONITORPOWER, 2)
GetCursorPos_(pt.POINT)
Mx = pt\x
My = pt\y
offM = 0
Repeat
If EscON = 1
If GetAsyncKeyState_(27)=-32767
offM = 1; esc = 27
Else
;SendMessage_(GetForegroundWindow_(), #WM_SYSCOMMAND, #SC_MONITORPOWER, 2)
EndIf
Else
For i = 5 To 255
If GetAsyncKeyState_(i)=-32767
offM = 1
Else
; SendMessage_(GetForegroundWindow_(), #WM_SYSCOMMAND, #SC_MONITORPOWER, 2)
EndIf
Next
EndIf
; GetCursorPos_(pt.POINT)
; If Mx <> pt\x Or My = pt\y
; ;SendMessage_(GetForegroundWindow_(), #WM_SYSCOMMAND, #SC_MONITORPOWER, 2)
; Mx = pt\x
; My = pt\y
; EndIf
Delay(1)
Until offM = 1
hMonitor = MonitorFromPoint_(0, #MONITOR_DEFAULTTOPRIMARY)
If hMonitor
If GetNumberOfPhysicalMonitorsFromHMONITOR_(hMonitor, @PhysicalMonitorArraySize) And PhysicalMonitorArraySize > 0
ReDim PhysicalMonitorArray(PhysicalMonitorArraySize - 1)
If GetPhysicalMonitorsFromHMONITOR_(hMonitor, PhysicalMonitorArraySize, @PhysicalMonitorArray())
For PhysicalMonitorArrayIndex = 0 To PhysicalMonitorArraySize - 1
;SetVCPFeature_(PhysicalMonitorArray(PhysicalMonitorArrayIndex)\hPhysicalMonitor,$D6,1 )
SetVCPFeature_(PhysicalMonitorArray(PhysicalMonitorArrayIndex)\hPhysicalMonitor,$E1,1 )
Next
DestroyPhysicalMonitors_(PhysicalMonitorArraySize, @PhysicalMonitorArray())
EndIf
EndIf
EndIf
;SendMessage_(GetForegroundWindow_(), #WM_SYSCOMMAND, #SC_MONITORPOWER, - 1)
EndProcedure
Procedure GetIdleTime()
Protected lipi.LASTINPUTINFO
lipi\cbSize = SizeOf(LASTINPUTINFO)
GetLastInputInfo_(@lipi)
sek.f = (GetTickCount_() - lipi\dwTime) / 1000
If sek>=TimeOFF
MonicOff()
EndIf
SetGadgetText(0, "Монитор будет потушен автоматически после " + StrD((TimeOFF - sek), 1) + " сек. простоя/бездействия! ")
EndProcedure
MonicOff()
Wh=50
Ww=250
OpenWindow(0, 0, 0, Ww, Wh, "", #PB_Window_BorderLess|#PB_Window_ScreenCentered)
SetClassLongPtr_(WindowID(0), #GCL_STYLE, $00020000)
TextGadget(0, 0, 0, Ww-0, Wh-0, "", #PB_Text_Center)
AddWindowTimer(0, 1, 200)
HideWindow(0, #True)
; Добавление значка в область уведомлений (SysTray)
AddSysTrayIcon(0, WindowID(0), CatchImage(0, ?Logo))
GetIdleTime()
If CreatePopupMenu(0) ; Начинается создание всплывающего Меню...
MenuItem(1, "Выход")
MenuBar()
MenuItem(2, "Погасить экран")
EndIf
StickyWindow(0,1)
If MessagaON>0
HideWindow(0, #False) ; Мессага для уведомления
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow : Break
Case #PB_Event_Timer
Debug Timer
GetIdleTime()
Case #PB_Event_SysTray
If EventType()=#PB_EventType_RightClick
DisplayPopupMenu(0, WindowID(0))
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case 1 :End
Case 2
MonicOff()
EndSelect
EndSelect
ForEver
CloseLibrary(0)
DataSection
Logo:
IncludeBinary "offmon.ico"
EndDataSection
Please, help me, why code do not properly work on Microsoft Windows 2004 (20H1)?
Thank You!