سؤال:كيف يمكنني تغيير دقة الالوان (PPB)

أخي الكريم إذهب إلى هذا الرابط قد يساعد أو يعطيك فكرة

Planet-Source-Code

شكرا يا اخي اعتقد اني توصلت الى حل المشكلة وعندما اصنع الكود كامل سوف اضعه هنا

والسلام

السلام عليكم و رحمة الله و بركاته

ادناه ستجد كود لفئة صممتها سريعا لتأدية الغرض .. و يمكنك استخدامها كالتالي لتغيير الالوان الى 24 بت :

rtaScreen.ChangeColorDepth(24)

ويمكنك التغيير الى 16 او 32 بشرط كون كرت الشاشة يدعم هذه القيم .. كما يمكنك استخدامها لتغيير دقة الشاشة الى اي قيم مثلا 800 في 600 بالشكل التالي :

rtaScreen.ChangeResolution(800,600)

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

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

Class rtaScreen

#Region "	APIs Section"

	Private Class apis

		Public Const CCDEVICENAME As Short = 32
		Public Const CCFORMNAME As Short = 32
		Public Const DM_BITSPERPEL As Integer = &H40000
		Public Const DM_PELSWIDTH As Integer = &H80000
		Public Const DM_PELSHEIGHT As Integer = &H100000
		Public Const CDS_UPDATEREGISTRY As Short = &H1S
		Public Const CDS_TEST As Short = &H4S
		Public Const DISP_CHANGE_SUCCESSFUL As Short = 0
		Public Const DISP_CHANGE_RESTART As Short = 1
		Public Const BITSPIXEL As Short = 12

		Structure DEVMODE
			<VBFixedString(CCDEVICENAME), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=CCDEVICENAME)> Public dmDeviceName As String
			Dim dmSpecVersion As Short
			Dim dmDriverVersion As Short
			Dim dmSize As Short
			Dim dmDriverExtra As Short
			Dim dmFields As Integer
			Dim dmOrientation As Short
			Dim dmPaperSize As Short
			Dim dmPaperLength As Short
			Dim dmPaperWidth As Short
			Dim dmScale As Short
			Dim dmCopies As Short
			Dim dmDefaultSource As Short
			Dim dmPrintQuality As Short
			Dim dmColor As Short
			Dim dmDuplex As Short
			Dim dmYResolution As Short
			Dim dmTTOption As Short
			Dim dmCollate As Short
			<VBFixedString(CCFORMNAME), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=CCFORMNAME)> Public dmFormName As String
			Dim dmUnusedPadding As Short
			Dim dmBitsPerPel As Short
			Dim dmPelsWidth As Integer
			Dim dmPelsHeight As Integer
			Dim dmDisplayFlags As Integer
			Dim dmDisplayFrequency As Integer
		End Structure

		Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Integer, ByVal iModeNum As Integer, ByRef lpDevMode As DEVMODE) As Boolean
		Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByRef lpDevMode As DEVMODE, ByVal dwFlags As Integer) As Integer

	End Class

#End Region

	Shared Sub ChangeResolution(ByVal Width As Integer, ByVal Height As Integer)
		Dim dev As apis.DEVMODE = Nothing
		Dim res As Integer

		res = apis.EnumDisplaySettings(0, 0, dev)

		dev.dmFields = apis.DM_PELSWIDTH Or apis.DM_PELSHEIGHT
		dev.dmPelsWidth = Width 'Screen Width
		dev.dmPelsHeight = Height 'Screen Height

		res = apis.ChangeDisplaySettings(dev, apis.CDS_TEST)
	End Sub

	Shared Sub ChangeColorDepth(ByVal Bits As Integer)
		Dim dev As apis.DEVMODE = Nothing
		Dim res As Integer

		res = apis.EnumDisplaySettings(0, 0, dev)

		dev.dmFields = apis.DM_BITSPERPEL
		dev.dmBitsPerPel = Bits 'Color Depth

		res = apis.ChangeDisplaySettings(dev, apis.CDS_TEST)
	End Sub
End Class

السلام عليكم و رحمة الله و بركاته

رغيد الطيب

اثابك الله

شكرا لك