تغییر Resolution به 1024*768

[m_bargostavan_66]

چطوری میشه که اگر میخواهیم وارد یک فایل اکسس بشیم اگر Resolution آن 1024*768 نبود اخطار بده و تا Resolution را تنظیم نکنیم باز نشود خیلی فوری

[7skies]

http://barnamenevis.org/forum/showthread.php?t=53377&page=2

[RESMAILY]

به نام خدا
با سلام مي توانيد از كد هاي زير استفاده كنيد. مثال براي 600*800 است ولي شما مي توانيد انازه خودتان را بگذاريد. جدول كمكي tblPass براي نگاهداري اطلاعات لازم است.

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 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 Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
'----------------
' open form

Public Function frm_Load()
Dim Dm As DEVMODE
Dim retval As Long
Dm.dmSize = Len(Dm)
retval = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, Dm)
OldX = Dm.dmPelsWidth
OldY = Dm.dmPelsHeight
Set db = CurrentDb
Set rs = db.OpenRecordset("tblPass")
rs.Edit
rs!lngXscrn = OldX
rs!lngYscrn = OldY
rs.Update
If OldX = 800 And OldY = 600 Then Exit Function
Dm.dmPelsWidth = 800
Dm.dmPelsHeight = 600
Call ChangeDisplaySettings(Dm, CDS_UPDATEREGISTRY)
DoEvents
MoveWindow Access.hWndAccessApp, 0, 0, 800, 600, 1
DoEvents
End Function
'---------------------
' close Form
Public Function 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
If OldX = 800 And OldY = 600 Then Exit Function
retval = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, Dm)
Dm.dmPelsWidth = OldX
Dm.dmPelsHeight = OldY
Call ChangeDisplaySettings(Dm, CDS_UPDATEREGISTRY)
DoEvents
MoveWindow Access.hWndAccessApp, 0, 0, OldX, OldY, 1
DoEvents
End Function

[azadich]

به نام خدا
با سلام مي توانيد از كد هاي زير استفاده كنيد. مثال براي 600*800 است ولي شما مي توانيد انازه خودتان را بگذاريد. جدول كمكي tblPass براي نگاهداري اطلاعات لازم است.

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 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 Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
'----------------
' open form

Public Function frm_Load()
Dim Dm As DEVMODE
Dim retval As Long
Dm.dmSize = Len(Dm)
retval = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, Dm)
OldX = Dm.dmPelsWidth
OldY = Dm.dmPelsHeight
Set db = CurrentDb
Set rs = db.OpenRecordset("tblPass")
rs.Edit
rs!lngXscrn = OldX
rs!lngYscrn = OldY
rs.Update
If OldX = 800 And OldY = 600 Then Exit Function
Dm.dmPelsWidth = 800
Dm.dmPelsHeight = 600
Call ChangeDisplaySettings(Dm, CDS_UPDATEREGISTRY)
DoEvents
MoveWindow Access.hWndAccessApp, 0, 0, 800, 600, 1
DoEvents
End Function
'---------------------
' close Form
Public Function 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
If OldX = 800 And OldY = 600 Then Exit Function
retval = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, Dm)
Dm.dmPelsWidth = OldX
Dm.dmPelsHeight = OldY
Call ChangeDisplaySettings(Dm, CDS_UPDATEREGISTRY)
DoEvents
MoveWindow Access.hWndAccessApp, 0, 0, OldX, OldY, 1
DoEvents
End Function

ميشه نمونه بزاريد ممنون ميشم

[RESMAILY]

به نام خدا
با سلام. دوست محترم اين نمونه است ديگر! كدها را درون يك ماجول كپي بفرماييد. سپس فانكشن ها را در رويداد openform براي تغيير رزوليشن close form براي برگشتن به حالت اوليه صدا بزنيد. ابنطوري legh
call frmload ويا call frmunload

[RESMAILY]

به نام خدا
با سلام. به فايل پيوست هم نگاهي بيندازيد