-->

طريقة تفعيل الوضع الليلي في ويندوز 10 Night light Mode Windows بضغطة واحدة من كليك يمين

    يحتاج العديد من المستخدمين إلى تفعيل الوضع الليلي للويندوز، وذلك لتغيير الروتين أو لإراحة العين أو لإضفاء جمالية على الويندوز، وأحيانا يحتاج المستخدم إلى التنقل بين الوضع الداكن والفاتح في ويندوز 10، ولكن خطوات التبديل قد تكون مملة بعض الشئ، في مقالنا هذا سنطرح لكم تعيين جهاز العرض للوقت الليلي في Windows 10.

    يمكنكم الاطلاع على شرح الخطوات للتنقل بين الوضع المظلم والوضع العادي للويندوز من خلال ميكروسوفت

    كيفية تفعيل الوضع الليلي أو الدارك مود على ويندوز 10؟

    لتفعيل الوضع المظلم في الويندوز لابد من الدخول إلى اعدادات الويندوز ومن ثم التعديل عليها، لكن سنقدم لكم طريقة تنشيط الوضع المظلم "دارك مود" في الويندوز بخطوة واحدة فقط، وذلك من خلال اسكريبت بسيط تقوم أنت بعمله شخصيا، وذلك بدون أي لغات برمجة، وبدون تحميل أي برامج وغيره، فقط سنحتاج إلى المفكرة ثم التطبيق العام للشرح.

    طريقة تفعيل الوضع المظلم

    طريقة تفعيل الوضع المظلم بالويندوز.

    كل ما عليك الأن هو نسخ الأكواد التالية وحفظها بالمفكرة بامتداد .VBS

    ----------------------------------------------------


    Option Explicit

    '~ On Error Resume Nex

    RequireAdmin

    Dim objReg

    Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

    RegWrite "HKCR\DesktopBackground\Shell\AppMode", "Icon", "REG_SZ", "themecpl.dll,-1"

    RegWrite "HKCR\DesktopBackground\Shell\AppMode", "MUIVerb", "REG_SZ", "HD Vision mode"

    RegWrite "HKCR\DesktopBackground\Shell\AppMode", "Position", "REG_SZ", "Bottom"

    RegWrite "HKCR\DesktopBackground\Shell\AppMode", "SubCommands", "REG_SZ", ""

    RegWrite "HKCR\DesktopBackground\Shell\AppMode\shell\001flyout", "MUIVerb", "REG_SZ", "Light theme"

    RegWrite "HKCR\DesktopBackground\Shell\AppMode\shell\001flyout", "Icon", "REG_SZ", "imageres.dll,-5411"

    RegWrite "HKCR\DesktopBackground\Shell\AppMode\shell\001flyout\command", "", "REG_SZ", "Reg Add HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize /v AppsUseLightTheme /t REG_DWORD /d 1 /f"

    RegWrite "HKCR\DesktopBackground\Shell\AppMode\shell\002flyout", "Icon", "REG_SZ", "imageres.dll,-5412"

    RegWrite "HKCR\DesktopBackground\Shell\AppMode\shell\002flyout", "MUIVerb", "REG_SZ", "Dark theme"

    RegWrite "HKCR\DesktopBackground\Shell\AppMode\shell\002flyout\command", "", "REG_SZ", "Reg Add HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize /v AppsUseLightTheme /t REG_DWORD /d 0 /f"

    Function RegWrite(reg_keyname, reg_valuename,reg_type,ByVal reg_value)

    Dim aRegKey, Return

    aRegKey = RegSplitKey(reg_keyname)

    If IsArray(aRegKey) = 0 Then

    RegWrite = 0

    Exit Function

    End If

    Return = RegWriteKey(aRegKey)

    If Return = 0 Then

    RegWrite = 0

    Exit Function

    End If

    Select Case reg_type

    Case "REG_SZ"

    Return = objReg.SetStringValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

    Case "REG_EXPAND_SZ"

    Return = objReg.SetExpandedStringValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

    Case "REG_BINARY"

    If IsArray(reg_value) = 0 Then reg_value = Array()

    Return = objReg.SetBinaryValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

    Case "REG_DWORD"

    If IsNumeric(reg_value) = 0 Then reg_value = 0

    Return = objReg.SetDWORDValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

    Case "REG_MULTI_SZ"

    If IsArray(reg_value) = 0 Then

    If Len(reg_value) = 0 Then

    reg_value = Array()

    Else

    reg_value = Array(reg_value)

    End If

    End If

    Return = objReg.SetMultiStringValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)


    'Case "REG_QWORD"

    'Return = oReg.SetQWORDValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

    Case Else

    RegWrite = 0

    Exit Function

    End Select

    If (Return <> 0) Or (Err.Number <> 0) Then

    RegWrite = 0

    Exit Function

    End If

    RegWrite = 1

    End Function

    Function RegWriteKey(RegKeyName)

    Dim Return

    If IsArray(RegKeyName) = 0 Then

    RegKeyName = RegSplitKey(RegKeyName)

    End If

    If (IsArray(RegKeyName) = 0) Or (UBound(RegKeyName) <> 1) Then

    RegWriteKey = 0

    Exit Function

    End If

    Return = objReg.CreateKey(RegKeyName(0),RegKeyName(1))

    If (Return <> 0) Or (Err.Number <> 0) Then

    RegWriteKey = 0

    Exit Function

    End If

    RegWriteKey = 1

    End Function

    Function RegDelete(reg_keyname, reg_valuename)

    Dim Return,aRegKey

    aRegKey = RegSplitKey(reg_keyname)

    If IsArray(aRegKey) = 0 Then

    RegDelete = 0

    Exit Function

    End If

    Return = objReg.DeleteValue(aRegKey(0),aRegKey(1),reg_valuename)

    If (Return <> 0) And (Err.Number <> 0) Then

    RegDelete = 0

    Exit Function

    End If

    RegDelete = 1

    End Function

    Function RegDeleteKey(reg_keyname)

    Dim Return,aRegKey

    aRegKey = RegSplitKey(reg_keyname)

    If IsArray(aRegKey) = 0 Then

    RegDeleteKey = 0

    Exit Function

    End If

    'On Error Resume Next

    Return = RegDeleteSubKey(aRegKey(0),aRegKey(1))

    'On Error Goto 0

    If Return = 0 Then

    RegDeleteKey = 0

    Exit Function

    End If

    RegDeleteKey = 1

    End Function

    Function RegDeleteSubKey(strRegHive, strKeyPath)

    Dim Return,arrSubkeys,strSubkey

        objReg.EnumKey strRegHive, strKeyPath, arrSubkeys

        If IsArray(arrSubkeys) <> 0 Then

            For Each strSubkey In arrSubkeys

                RegDeleteSubKey strRegHive, strKeyPath & "\" & strSubkey

            Next

        End If

    Return = objReg.DeleteKey(strRegHive, strKeyPath)

    If (Return <> 0) Or (Err.Number <> 0) Then

    RegDeleteSubKey = 0

    Exit Function

    End If

    RegDeleteSubKey = 1

    End Function

    Function RegSplitKey(RegKeyName)

    Dim strHive, strInstr, strLeft

    strInstr=InStr(RegKeyName,"\")

    If strInstr = 0 Then Exit Function

    strLeft=left(RegKeyName,strInstr-1)

    Select Case strLeft

    Case "HKCR","HKEY_CLASSES_ROOT" strHive = &H80000000

    Case "HKCU","HKEY_CURRENT_USER" strHive = &H80000001

    Case "HKLM","HKEY_LOCAL_MACHINE" strHive = &H80000002

    Case "HKU","HKEY_USERS" strHive = &H80000003

    Case "HKCC","HKEY_CURRENT_CONFIG" strHive = &H80000005

      Case Else Exit Function

    End Select

        RegSplitKey = Array(strHive,Mid(RegKeyName,strInstr+1))

    End Function

    Function RequireAdmin()

    Dim reg_valuename, WShell, Cmd, CmdLine, I

    GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")_

    .EnumValues &H80000003, "S-1-5-19\Environment",  reg_valuename

    If IsArray(reg_valuename) <> 0 Then

    RequireAdmin = 1

    Exit Function

    End If

    Set Cmd = WScript.Arguments

    For I = 0 to Cmd.Count - 1

    If Cmd(I) = "/admin" Then

    Wscript.Echo "To script you must have administrator rights!"

    'RequireAdmin = 0

    'Exit Function

    WScript.Quit

    End If

    CmdLine = CmdLine & Chr(32) & Chr(34) & Cmd(I) & Chr(34)

    Next

    CmdLine = CmdLine & Chr(32) & Chr(34) & "/admin" & Chr(34)


    Set WShell= WScript.CreateObject( "WScript.Shell")

    CreateObject("Shell.Application").ShellExecute WShell.ExpandEnvironmentStrings(_

    "%SystemRoot%\System32\WScript.exe"),Chr(34) & WScript.ScriptFullName & Chr(34) & CmdLine, "", "runas"

    WScript.Quit

    End Function

     

    ---------------------------------------------------

    بعد الحفظ في المفكرة قم بتسميتها "Add HD Vision mode.vbs"، يمكنك تغييرها كما تشاء

    هكذا قمت بإنشاء ملف فيجوال بيسيك سكريبت، يمكنك الضغط عليه مرتين لتفعليه، ثم قم بالانتقال الديسكتوب والاطلاع على كليك يمين ستجد أن هناك تبويب ظهر باسم HD Vision mode


    بالضغط عليه سيخيرك بين الوضعين؛ الوضع الليلي للويندوز والوضع الفاتح،وللعلم هذه الخطوة تعمل على ويندوز 10 بعد الإصدار 1903، فإذا كنت قد ثبت إصدار أقدم من الويندوز فلن يفعل الوضع المظلم إلا في بعض البرامج التي تدعم هذه الخاصية.

    طريقة إلغاء تبويب تفعيل الوضع المظلم بالويندوز من كليك يمين

    لحذف تبويب الاختيار بين الوضع الفاتح والليلي يمكنك ذلك عبر هذا الاسكريبت الذي نقوم بحفظه بنفس الطريقة للملف الأول.
    ------------------------------------------

    Option Explicit
    '~ On Error Resume Nex
    RequireAdmin
    Dim objReg
    Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    RegDeleteKey "HKCR\DesktopBackground\Shell\AppMode"
    Function RegWrite(reg_keyname, reg_valuename,reg_type,ByVal reg_value)
    Dim aRegKey, Return
    aRegKey = RegSplitKey(reg_keyname)
    If IsArray(aRegKey) = 0 Then
    RegWrite = 0
    Exit Function
    End If
    Return = RegWriteKey(aRegKey)
    If Return = 0 Then
    RegWrite = 0
    Exit Function
    End If
    Select Case reg_type
    Case "REG_SZ"
    Return = objReg.SetStringValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)
    Case "REG_EXPAND_SZ"
    Return = objReg.SetExpandedStringValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)
    Case "REG_BINARY"
    If IsArray(reg_value) = 0 Then reg_value = Array()
    Return = objReg.SetBinaryValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

    Case "REG_DWORD"
    If IsNumeric(reg_value) = 0 Then reg_value = 0
    Return = objReg.SetDWORDValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

    Case "REG_MULTI_SZ"
    If IsArray(reg_value) = 0 Then
    If Len(reg_value) = 0 Then
    reg_value = Array()
    Else
    reg_value = Array(reg_value)
    End If
    End If
    Return = objReg.SetMultiStringValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)

    'Case "REG_QWORD"
    'Return = oReg.SetQWORDValue(aRegKey(0),aRegKey(1),reg_valuename,reg_value)
    Case Else
    RegWrite = 0
    Exit Function
    End Select

    If (Return <> 0) Or (Err.Number <> 0) Then
    RegWrite = 0
    Exit Function
    End If
    RegWrite = 1
    End Function
    Function RegWriteKey(RegKeyName)
    Dim Return
    If IsArray(RegKeyName) = 0 Then
    RegKeyName = RegSplitKey(RegKeyName)
    End If

    If (IsArray(RegKeyName) = 0) Or (UBound(RegKeyName) <> 1) Then
    RegWriteKey = 0
    Exit Function
    End If
    Return = objReg.CreateKey(RegKeyName(0),RegKeyName(1))
    If (Return <> 0) Or (Err.Number <> 0) Then
    RegWriteKey = 0
    Exit Function
    End If
    RegWriteKey = 1
    End Function
    Function RegDelete(reg_keyname, reg_valuename)
    Dim Return,aRegKey
    aRegKey = RegSplitKey(reg_keyname)
    If IsArray(aRegKey) = 0 Then
    RegDelete = 0
    Exit Function
    End If
    Return = objReg.DeleteValue(aRegKey(0),aRegKey(1),reg_valuename)
    If (Return <> 0) And (Err.Number <> 0) Then
    RegDelete = 0
    Exit Function
    End If
    RegDelete = 1
    End Function

    Function RegDeleteKey(reg_keyname)
    Dim Return,aRegKey
    aRegKey = RegSplitKey(reg_keyname)
    If IsArray(aRegKey) = 0 Then
    RegDeleteKey = 0
    Exit Function
    End If
    'On Error Resume Next
    Return = RegDeleteSubKey(aRegKey(0),aRegKey(1))
    'On Error Goto 0
    If Return = 0 Then
    RegDeleteKey = 0
    Exit Function
    End If
    RegDeleteKey = 1
    End Function
    Function RegDeleteSubKey(strRegHive, strKeyPath)
    Dim Return,arrSubkeys,strSubkey
        objReg.EnumKey strRegHive, strKeyPath, arrSubkeys
        If IsArray(arrSubkeys) <> 0 Then
            For Each strSubkey In arrSubkeys
                RegDeleteSubKey strRegHive, strKeyPath & "\" & strSubkey
            Next
        End If
    Return = objReg.DeleteKey(strRegHive, strKeyPath)
    If (Return <> 0) Or (Err.Number <> 0) Then
    RegDeleteSubKey = 0
    Exit Function
    End If
    RegDeleteSubKey = 1
    End Function
    Function RegSplitKey(RegKeyName)
    Dim strHive, strInstr, strLeft
    strInstr=InStr(RegKeyName,"\")
    If strInstr = 0 Then Exit Function
    strLeft=left(RegKeyName,strInstr-1)
    Select Case strLeft
    Case "HKCR","HKEY_CLASSES_ROOT" strHive = &H80000000
    Case "HKCU","HKEY_CURRENT_USER" strHive = &H80000001
    Case "HKLM","HKEY_LOCAL_MACHINE" strHive = &H80000002
    Case "HKU","HKEY_USERS" strHive = &H80000003
    Case "HKCC","HKEY_CURRENT_CONFIG" strHive = &H80000005
      Case Else Exit Function
    End Select

        RegSplitKey = Array(strHive,Mid(RegKeyName,strInstr+1))
    End Function
    Function RequireAdmin()
    Dim reg_valuename, WShell, Cmd, CmdLine, I

    GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")_
    .EnumValues &H80000003, "S-1-5-19\Environment",  reg_valuename
    If IsArray(reg_valuename) <> 0 Then
    RequireAdmin = 1
    Exit Function
    End If
    Set Cmd = WScript.Arguments
    For I = 0 to Cmd.Count - 1
    If Cmd(I) = "/admin" Then
    Wscript.Echo "To script you must have administrator rights!"
    'RequireAdmin = 0
    'Exit Function
    WScript.Quit
    End If
    CmdLine = CmdLine & Chr(32) & Chr(34) & Cmd(I) & Chr(34)
    Next
    CmdLine = CmdLine & Chr(32) & Chr(34) & "/admin" & Chr(34)

    Set WShell= WScript.CreateObject( "WScript.Shell")
    CreateObject("Shell.Application").ShellExecute WShell.ExpandEnvironmentStrings(_
    "%SystemRoot%\System32\WScript.exe"),Chr(34) & WScript.ScriptFullName & Chr(34) & CmdLine, "", "runas"
    WScript.Quit
    End Function

    ---------------------------
    يمكننا تسمية الملف Remove HD Vision mode.vbs، وبعد تفعيله بالضغط عليه مرتين سيتم حذف تبويب التبديل بين الأوضاع من قائمة كليك يمين بالديسكتوب.
    وهكذا نكون قد تعلمنا كيفية التنقل بين الوضع الليلي والوضع الفاتح في ويندوز 10 بدون أي خطوات أو برامج طرف ثالث.


    شارك المقال
    Ibrahim
    كاتب ومحرر اخبار اعمل في موقع HD Boot .

    مقالات متعلقة

    إرسال تعليق