ضبط حجم الشاشة

السلام عليكم

أخى الكريم جرب هذا الكود

'ضع هذا الكود فى موديول
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const CCDEVICENAME = 32
Public Const CCFORMNAME = 32
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CDS_UPDATEREGISTRY = &H1
Public Const CDS_TEST = &H4
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1

Type typDevMODE
   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

Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lptypDevMode As Any) As Boolean
Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lptypDevMode As Any, ByVal dwFlags As Long) As Long
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

'ضع هذا الكود فى زر
Private Sub Command1_Click()
Dim typDevM As typDevMODE
Dim lngResult As Long
Dim intAns	As Integer

lngResult = EnumDisplaySettings(0, 0, typDevM)

With typDevM
   .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
   .dmPelsWidth = 640  (640,800,1024, etc)
   .dmPelsHeight = 480 (480,600,768, etc)
End With

lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)
Select Case lngResult
   Case DISP_CHANGE_RESTART
	   intAns = MsgBox("You must restart your computer to apply these changes." & _
		   vbCrLf & vbCrLf & "Do you want to restart now?", _
		   vbYesNo + vbSystemModal, "Screen Resolution")
	   If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
   Case DISP_CHANGE_SUCCESSFUL
	   Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
	   MsgBox "Screen resolution changed", vbInformation, "Resolution Changed"
   Case Else
	   MsgBox "Mode not supported", vbSystemModal, "Error"
End Select

End Sub

وفى المرفقات ايضا يوجد اداه لتغير دقه عرض الشاشه

ChangeRes.rar

مشكوووووووووووور على الكود وهل الاداة مجانيه

ألف شكر أخي Genius وبالفعل انت مبدع

على الكود وعلى الرد السريع

وبالفعل هذا ما كنت أبحث عنه ليس الكود بل هذا المنتدى بأعضائه الكرام

السلام عليكم

اخى الكريم ارجو ان تكون أستفدت من الكود والأداه أعتقد انها مجانيه فهى لم

تعطينى اى رساله للتسجيا من قبل