• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Thay đổi độ phân giải màn hình

Các thủ thuật về hệ thống, thư mục, tập tin và mạng
Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4763
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 517 time

Thay đổi độ phân giải màn hình

Gửi bàigửi bởi truongphu » T.Sáu 28/03/2008 8:35 pm

Thủ thuật: Thay đổi độ phân giải màn hình
Tác giả: sincos
Mô tả: Thay đổi độ phân giải của màn hình máy tính


Mã: Chọn hết

  1. Option Explicit
  2. Const WM_DISPLAYCHANGE = &H7E
  3. Const HWND_BROADCAST = &HFFFF&
  4. Const EWX_LOGOFF = 0
  5. Const EWX_SHUTDOWN = 1
  6. Const EWX_REBOOT = 2
  7. Const EWX_FORCE = 4
  8. Const CCDEVICENAME = 32
  9. Const CCFORMNAME = 32
  10. Const DM_BITSPERPEL = &H40000
  11. Const DM_PELSWIDTH = &H80000
  12. Const DM_PELSHEIGHT = &H100000
  13. Const CDS_UPDATEREGISTRY = &H1
  14. Const CDS_TEST = &H4
  15. Const DISP_CHANGE_SUCCESSFUL = 0
  16. Const DISP_CHANGE_RESTART = 1
  17. Const BITSPIXEL = 12
  18. Private Type DEVMODE
  19. dmDeviceName As String * CCDEVICENAME
  20. dmSpecVersion As Integer
  21. dmDriverVersion As Integer
  22. dmSize As Integer
  23. dmDriverExtra As Integer
  24. dmFields As Long
  25. dmOrientation As Integer
  26. dmPaperSize As Integer
  27. dmPaperLength As Integer
  28. dmPaperWidth As Integer
  29. dmScale As Integer
  30. dmCopies As Integer
  31. dmDefaultSource As Integer
  32. dmPrintQuality As Integer
  33. dmColor As Integer
  34. dmDuplex As Integer
  35. dmYResolution As Integer
  36. dmTTOption As Integer
  37. dmCollate As Integer
  38. dmFormName As String * CCFORMNAME
  39. dmUnusedPadding As Integer
  40. dmBitsPerPel As Integer
  41. dmPelsWidth As Long
  42. dmPelsHeight As Long
  43. dmDisplayFlags As Long
  44. dmDisplayFrequency As Long
  45. End Type
  46. Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
  47. Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
  48. Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
  49. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  50. Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As Long
  51. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  52. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  53. Dim OldX As Long, OldY As Long, nDC As Long
  54. Sub ChangeRes(X As Long, Y As Long, Bits As Long)
  55. Dim DevM As DEVMODE, ScInfo As Long, erg As Long, an As VbMsgBoxResult
  56. [color=#008000]'Get the info into DevM[/color]
  57. [color=#000080]erg = EnumDisplaySettings(0&, 0&, DevM)[/color]
  58. [color=#008000]'This is what we're going to change[/color]
  59. DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
  60. DevM.dmPelsWidth = X 'ScreenWidth
  61. DevM.dmPelsHeight = Y 'ScreenHeight
  62. DevM.dmBitsPerPel = Bits '(can be 8, 16, 24, 32 or even 4)
  63. [color=#008000]'Now change the display and check if possible[/color]
  64. [color=#000080]erg = ChangeDisplaySettings(DevM, CDS_TEST)[/color]
  65. [color=#008000]'Check if succesfull [/color]
  66. Select Case erg&
  67. Case DISP_CHANGE_RESTART
  68. an = MsgBox("You've to reboot", vbYesNo + vbSystemModal, "Info")
  69. If an = vbYes Then
  70. erg& = ExitWindowsEx(EWX_REBOOT, 0&)
  71. End If
  72. Case DISP_CHANGE_SUCCESSFUL
  73. [color=#000080]erg = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY) [/color]
  74. ScInfo = Y * 2 ^ 16 + X
  75. [color=#008000]'Notify all the windows of the screen resolution change [/color]
  76. SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal Bits, ByVal ScInfo
  77. MsgBox [color=#FF0000]"Everything's ok", [/color]vbOKOnly + vbSystemModal, [color=#FF0000]"It worked!" [/color]
  78. Case Else
  79. MsgBox "Mode not supported", vbOKOnly + vbSystemModal, "Error"
  80. End Select
  81. End Sub
  82. Private Sub Form_Load()
  83. [color=#008000]'KPD-Team 1999
  84. 'URL: http://www.allapi.net/
  85. 'E-Mail: mailto:KPDTeam@Allapi.net [/color]
  86. Dim nDC As Long
  87. [color=#008000]'retrieve the screen's resolution [/color]
  88. OldX = Screen.Width / Screen.TwipsPerPixelX
  89. OldY = Screen.Height / Screen.TwipsPerPixelY
  90. [color=#008000]'Create a device context, compatible with the screen[/color]
  91. nDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
  92. [color=#008000]'Change the screen's resolution [/color]
  93. ChangeRes 640, 480, GetDeviceCaps(nDC, BITSPIXEL)
  94. End Sub
  95. Private Sub Form_Unload(Cancel As Integer)
  96. [color=#008000]'restore the screen resolution[/color]
  97. ChangeRes OldX, OldY, GetDeviceCaps(nDC, BITSPIXEL)
  98. [color=#008000]'delete our device context[/color]
  99. DeleteDC nDC
  100. End Sub

Lời bàn của tphu:
Điều chỉnh tần số Refresh rate của Desktop (help)
gửi bởi gianghoplus
gianghoplus dùng cách đổi độ phân giải màn hình trong VBLib, nhưng nó cứ change Refresh rate về 60 Hertz nhìn rất đau mắt, ai biết sửa chỗ nào ko
Re: Điều chỉnh tần số Refresh rate của Desktop (help)
gửi bởi truongphu
Khi gianghoplus gọi Function EnumDisplaySettings (dòng 57)thì thông số dmDisplayFrequency(dòng 44) trong Type DevM sẽ trở lại số 0 hay 1 (vì không được khai báo trong các dòng từ 59 - 62), ví dụ 60 Hz làm gianghoplus đau mắt. Các giá trị nầy là default refresh rate của display hardware và chúng không bị biến đổi bởi Function ChangeDisplaySettings được gọi (ở dòng 64 = Test và 73 = change without restart).
TB: Làm thử nha:
sau dòng 58 'This is what we're going to change, khai thêm:
DevM.dmDisplayFrequency = -1
(vỉ hình như -1 là current display settings)
do đó không bị trả về 0 hay 1, vẫn giữ refresh rate hiện tại
ghi chú: trên đây chỉ là phân tích về mặt code, còn test thì tôi chưa :D


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Giang Hồ
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 50
Ngày tham gia: T.Bảy 12/05/2007 2:36 pm
Đến từ: http://vn-soft.net
Been thanked: 1 time
Liên hệ:

Re: Thay đổi độ phân giải màn hình

Gửi bàigửi bởi Giang Hồ » CN 20/04/2008 3:22 pm

hjx, hôm đó hỏi hoài mà hok có ai làm dc -> bực quá ngồi đọc MSDN. Thực ra mấu chốt ở đây chính là hàm EnumDisplaySettings. Do lúc đó mình hok hiểu các hàm Enum hoạt động như thế nào. Bây giờ thì mình viết lại code này gọn hơn mà chạy cực chính xác. có thể thay đổi số bít, Refresh rate tùy ý

Mã: Chọn hết

  1.  
  2. 'Coder: Tran Dai Nghia
  3. 'Email: gianghoplus@yahoo.com
  4. 'Website: http://giangho.biz
  5.  
  6. Option Explicit
  7.  
  8. Const CCDEVICENAME = 32
  9. Const CCFORMNAME = 32
  10.  
  11. Private Type DEVMODE
  12.     dmDeviceName As String * CCDEVICENAME
  13.     dmSpecVersion As Integer
  14.     dmDriverVersion As Integer
  15.     dmSize As Integer
  16.     dmDriverExtra As Integer
  17.     dmFields As Long
  18.     dmOrientation As Integer
  19.     dmPaperSize As Integer
  20.     dmPaperLength As Integer
  21.     dmPaperWidth As Integer
  22.     dmScale As Integer
  23.     dmCopies As Integer
  24.     dmDefaultSource As Integer
  25.     dmPrintQuality As Integer
  26.     dmColor As Integer
  27.     dmDuplex As Integer
  28.     dmYResolution As Integer
  29.     dmTTOption As Integer
  30.     dmCollate As Integer
  31.     dmFormName As String * CCFORMNAME
  32.     dmUnusedPadding As Integer
  33.     dmBitsPerPel As Integer
  34.     dmPelsWidth As Long
  35.     dmPelsHeight As Long
  36.     dmDisplayFlags As Long
  37.     dmDisplayFrequency As Long
  38. End Type
  39. Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
  40. Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
  41. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  42.  
  43. Dim OldX As Long, OldY As Long
  44.  
  45. Function ChangeRes(X As Long, Y As Long, Optional Bits As Long = 32, Optional Frequency As Long = 75) As Long
  46. Dim DevM As DEVMODE, iResult As Long, iMode As Long
  47.     iMode = 0
  48.     ChangeRes = 0
  49.     Do
  50.     iResult = EnumDisplaySettings(0, iMode, DevM)
  51.     If iResult <> 0 And DevM.dmPelsWidth = X And DevM.dmPelsHeight = Y And _
  52.         DevM.dmBitsPerPel = Bits And DevM.dmDisplayFrequency = Frequency Then
  53.     iResult = ChangeDisplaySettings(DevM, 0)
  54.     ChangeRes = 1 'Success
  55.     Exit Do
  56.     End If
  57.     iMode = iMode + 1
  58.     Loop While iResult <> 0
  59.     If ChangeRes = 0 Then MsgBox "Mode not supported", vbCritical, "Error"
  60. End Function
  61.  
  62.  
  63. Private Sub Form_Load()
  64.     OldX = Screen.Width / Screen.TwipsPerPixelX
  65.     OldY = Screen.Height / Screen.TwipsPerPixelY
  66.     ChangeRes 800, 600
  67. End Sub
  68.  
  69. Private Sub Form_Unload(Cancel As Integer)
  70.     ChangeRes OldX, OldY
  71. End Sub
  72.  
Code chỉ một lần mà fix bug thì mãi mãi
-----------------------------------
VnSecurity 2008 - Bảo vệ máy tính theo phong cách của bạn
Website: http://vn-soft.net


Quay về “[VB] Hệ thống - Tập tin - Thư mục và Mạng”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.0 khách