تغییر رزولیشن ویندوز

[elham123]

با سلام

من یک فرمی ساختم که سایزش بزرگه روی کامپیوتر خودم مشکلی نیست چون رزولیشن کامپیوترم رو تنظیم کردم
ولی وقتی روی کامپیوتر دیگه نصب می کنم اگه رزولیشن آن پایین باشد نصف فرمم دیده نمی شه
آیا ماژولی هست که وقتی برنامه ام باز می شه رزولیشن ویندوز تغییر کنه و بالا بره ؟


من جستجو کردم برای تغییر رزولیشن برنامه پیدا کردم ولی من تغییر رزولیشن ویندوز مد نظرم هست

[mohsen_csharp]

کاربر گرامی همواره سعی کنید برنامه خود را با نواع سیستم های دیگر مطابقت دهید نه این که کامپیوتر های کاربر را با برنامه خود. شاید رزولوشن یه کامپیوتر نکشه اونوقت چی.

[smderfan]

با سلام
ماژول زیر مشکل شما را برای فهمیدن رزولیشن سیستم مرتفع می کنه.


Option Compare Database
Option Explicit

'Module Declarations
Global Const WM_HORZRES = 8
Global Const WM_VERTRES = 10

Declare Function WM_apiGetDeviceCaps _
Lib "gdi32" Alias "GetDeviceCaps" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function WM_apiGetDesktopWindow _
Lib "user32" Alias "GetDesktopWindow" () As Long
Declare Function WM_apiGetDC _
Lib "user32" Alias "GetDC" _
(ByVal hwnd As Long) As Long
Declare Function WM_apiReleaseDC _
Lib "user32" Alias "ReleaseDC" _
(ByVal hwnd As Long, ByVal hdc As Long) As Long
Declare Function WM_apiGetSystemMetrics _
Lib "user32" Alias "GetSystemMetrics" _
(ByVal nIndex As Long) As Long

Function xg_GetScreenResolution() As String
'return the display height and width
Dim DisplayHeight As Integer
Dim DisplayWidth As Integer
Dim hDesktopWnd As Long
Dim hDCcaps As Long
Dim iRtn As Integer

'* make API calls to get desktop settings
hDesktopWnd = WM_apiGetDesktopWindow() 'get handle to desktop
hDCcaps = WM_apiGetDC(hDesktopWnd) 'Get Display Context
DisplayHeight = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES)
DisplayWidth = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES)
iRtn = WM_apiReleaseDC(hDesktopWnd, hDCcaps)

xg_GetScreenResolution = DisplayWidth & "x" & DisplayHeight

End Function



نحوه استفاده در فرم :

If xg_GetScreenResolution <> "1024x768" Then
MsgBox "Please Change The Screen Resolusion = 1024 by 768 pixels", vbCritical, "Error"
Exit Sub
End If

[RESMAILY]

با سلام خدمت دوستان
با قطعه كد زير مي شود رزوليشن را ازداخل برنامه دستكاري كرد. ولي معمولا از رزوليشن بالا به پايين در محل فرم ها مشكلي به وجود مي آيد كه نياز مند restart برنامه است. (برنامه و نه كامپيوتر)
به هرحال شايد به درد دوستان خورد و اشكالش را توانستند برطرف كنند.



Option Compare Database

Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CDS_UPDATEREGISTRY = &H1
Public Const CDS_TEST = &H2
Public Const CDS_FULLSCREEN = &H4
Public Const CDS_GLOBAL = &H8
Public Const CDS_SET_PRIMARY = &H10
Public Const CDS_RESET = &H40000000
Public Const CDS_SETRECT = &H20000000
Public Const CDS_NORESET = &H10000000
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1
Public Const DISP_CHANGE_FAILED = -1
Public Const DISP_CHANGE_BADMODE = -2
Public Const DISP_CHANGE_NOTUPDATED = -3
Public Const DISP_CHANGE_BADFLAGS = -4
Public Const DISP_CHANGE_BADPARAM = -5
Public Const ENUM_CURRENT_SETTINGS = -1

Public Type DEVMODE
dmDeviceName As String * 32
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 * 32
dmUnusedPadding As Integer
dmBitsPerPixel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long 'Windows 95, 98, 2000
dmICMMethod As Long
dmICMIntent As Long
dmMediaType As Long
dmDitherType As Long
dmReserved1 As Long
dmReserved2 As Long 'Windows 2000
dmPanningWidth As Long
dmPanningHeight As Long
End Type
Public OldX As Long, OldY As Long

Public Declare Function EnumDisplaySettings Lib "user32.dll" Alias _
"EnumDisplaySettingsA" (ByVal lpszDeviceName As String, _
ByVal iModeNum As Long, lpDevMode As DEVMODE) As Long

Public Declare Function ChangeDisplaySettings Lib _
"user32.dll" Alias "ChangeDisplaySettingsA" _
(lpDevMode As Any, ByVal dwFlags _
As Long) As Long
'ÊäÙíã ÕÝÍå äãÇíÔ ÌÏíÏ
Public Sub frm_Load(NewX As Long, NewY As Long)
Dim dm As DEVMODE
Dim Retval As Long
dm.dmSize = Len(dm)
Call EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, dm)
OldX = dm.dmPelsWidth
OldY = dm.dmPelsHeight
If OldX = NewX And OldY = NewY Then Exit Sub
'ËÈÊ ãÔÎÕÇÊ ÏÑ íß ÌÏæá ãËáÇ tblPass
Set db = CurrentDb
Set rs = db.OpenRecordset("tblPass")
rs.Edit
rs!lngXscrn = OldX
rs!lngYscrn = OldY
rs.Update
dm.dmPelsWidth = NewX
dm.dmPelsHeight = NewY
Call ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
End Sub
'ÈÇҐÔÊ ÕÝÍå ÈÕæÑÊ Çæá
Public Sub frm_Unload()
Dim dm As DEVMODE
Dim Retval As Long
dm.dmSize = Len(dm)
Set db = CurrentDb
Set rs = db.OpenRecordset("tblPass")
OldX = rs!lngXscrn
OldY = rs!lngYscrn
Call EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, dm)
NewX = dm.dmPelsWidth
NewY = dm.dmPelsHeight
If OldX = NewX And OldY = NewY Then Exit Sub
dm.dmPelsWidth = OldX
dm.dmPelsHeight = OldY
Call ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
End Sub