سؤال كيفية ضبط اعدادات الشاشة بالفيجول بيسك؟!

الأمثلة كثيرة في المنتدى لذلك

أخي المدمر في المرفقات مثال لتغيير دقة الشاشة

حيث غير الدقة التي تريدها من داخل الكود

ولكن هذا الكود لا يكفي

يجب عليك إستعاده هرتز الشاشة التي كانت عليه قبل التغيير

لأنك لو غيرت دقة الشاشة للأصغر فإن الهرتز ينحفض ويجب إرجاعه (قد يسبب إرتجاج للشاشة حسب نوع الشاشة)

أرجو من الأخوة الأفاضل من لديه كود لإرجاع أو تغيير هرتز الشاشة فليتفضل

____________________.rar

	 'حافظ على اعدادات الشاشة الأصلية
			OldX = Screen.Width / Screen.TwipsPerPixelX
			OldY = Screen.Height / Screen.TwipsPerPixelY
			'تغيير حجم  الشاشة
			ChangeRes 800, 600
			'End Sub
			DisableCloseWindowButton Me
			DisableWindowState = 2
			'Skin1.ApplySkin Me.hWnd
			WindowState = vbMaximized
				Me.Top = 0
				Me.Left = 0

أخي أنت هنا أختذت الريزوليشن الحالي ووضعتها في متغيير OidX

فقط في حدث Unload اكتب التالي

ChangeRes OldX,OldY

أخي { عبدالعزيز }

اشكرك على الكود والمثال الذي أرفقته بردك :)

إلا أنني كنت أريد كود ، يقوم بإعادة اعدادات الشاشة السابقة ، فور الخروج من البرنامج ;)

حتى لا يضطر صاحب الجهاز ، لإعادتها يدوياً ... وبالتالي يذمر من البرنامج تبعي :^)

أخي { omani }

بالضبط فعلت ذلك .. واسمحوا لي لو انه سقط سهواً ...حيث الكود تبعي هو كالتالي

Private Sub Form_Unload(Cancel As Integer)
ChangeRes OldX, OldY
End Sub

لا أعرف أين الخطأ ... الرجاء التدقيق في الكودين ، واعطائي مكان الخطأ والكود الصحيح

كما إذا عندكم كود بديل والـFunction اللازم ...

أرجو إفادتي به :unsure:

اشكركم مرة أخرى ... وبإنتظار ردودكم

أخ المدمر007

ضع الكود في حدث Unload للفورم وتحل المشكلة

ولكن يبقى معك مشكلة تردد الشاشة

شكرا لكم جميعاُ .. بارك الله فيكم .. تحياتي

لقد فعلت ذلك أخي { عبدالعزيز }

بس حد يشوف هالأكواد بالـModule فيها شيء غلط ؟!!!!

Option Explicit

'لتغيير إعدادات الشاشة
'=========================
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Public Const MF_BYPOSITION = &H400&



Const CCFORMNAME = 32
Const CCDEVICENAME = 32
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
Const WM_DISPLAYCHANGE = &H7E
Const HWND_BROADCAST = &HFFFF&
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CDS_UPDATEREGISTRY = &H1
Const CDS_TEST = &H4
Const DISP_CHANGE_SUCCESSFUL = 0
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
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
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
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
Public OldX As Long, OldY As Long

Sub ChangeRes(X As Long, Y As Long)
Dim DevM As DEVMODE, ScInfo As Long, Ret As Long

'الحصول على معامل الشاشة الحالي

Ret = EnumDisplaySettings(0&, 0&, DevM)

'اضافة القيم الجديدة
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = X
DevM.dmPelsHeight = Y

'تغيير حجم الشاشة لتجربة الحجم الجديد

Ret = ChangeDisplaySettings(DevM, CDS_TEST)

'إذا نجح التغيير
If Ret = DISP_CHANGE_SUCCESSFUL Then
	'حفظ التغيير
	Ret = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)

	'ارسال رسالة للنوافذ قيد العمل بتغير حجم الشاشة
	ScInfo = MAKELONG(X, Y)
	SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal 0&, ByVal ScInfo
Else
	'في حالة حدوث خطأ

	MsgBox "حدث خطأ في اعدادات دقة الشاشة"
End If
End Sub

وهذا ملف مرفق للـModule

Module1.rar

وينكم شباب ؟!!!

الخطأ هو أن كودك ناقص تصريح عن عمل المتحول MAKELONG

MAKELONG(X, Y)

أرفق لك تعديل البرنامج الأول لما يناسبك ، يحفظ دقة الشاشة ويعيدها كما كانت عند إنهاء البرنامج ، تستطيع تعديل الدقة بحسب طلبك

ولكن أن جعلته في المثال 1152* 864 لتحويل الشاشة للأكبر لعدم إزعاج أيقونات سطح المكتب إذا نزله مستخدم غيرك

007.rar

اشكرك أخي { عبدالعزيز } :)

جاري التجربة ...

وسأوافيك بالنتيجة ;)

جزاءك الله كل خير أخوي { يوسف }

عدلت في الكود بما يتناسب مع برنامجي ... ونجحت 100% :D

كل الشكر لك وللإخوة الذين وقفوا معي ، وتابعوا هالموضوع -waf

عسى أن اخدمكم في أقرب وقت B)

أهلاً وسهلاً بك دائماً

الحمد لله إنحلت مشكلتك

أخي المدمر

يا ريت لو ترفق الكود النهائي لتعم الفائدة على الجميع

وشكرا لك