Office中国论坛/Access中国论坛

标题: 大哥：还是关于如何让窗体适应不同分辨率！[求助] [打印本页]

作者: linda0418 时间: 2003-6-15 06:46
标题: 大哥：还是关于如何让窗体适应不同分辨率！[求助]
TO：LYLY和李版主
两位大哥发表的“关于让分辨率保持不变的”的程序“
因水平有限，还是不会用，
我上传了一个数据库，
可否帮忙将程序导入我的数据库中，
让我们女好好学习一下。
我的窗体是在1024X768的分辨率下做的。
谢谢！[attach]754[/attach]

作者: 李寻欢 时间: 2003-6-15 17:12
[attach]757[/attach]

作者: linda0418 时间: 2003-6-16 00:28
谢谢李版主！
谢谢！

作者: ccczzz 时间: 2003-6-16 02:36
标题: 请帮忙修改
这是在800x600下开发的窗体，用了自适应模块，控件重叠，在非最大化时控件不完整，请李版主帮忙修改，谢谢。[attach]765[/attach]

作者: 李寻欢 时间: 2003-6-16 17:19
放了这么多控件，在没最大化时都会出现控件不完整的情况，这很正常，你在open事件里最大化它就行了吧？
如果想控件随窗体变化（就是窗体最大化，控件就变大，窗体缩小，控件也缩小），就请看这个例子：http://mdw.vicp.net/show.asp?id=416

作者: 李寻欢 时间: 2003-6-16 17:37
标题: 改了一下
[attach]774[/attach]

作者: ccczzz 时间: 2003-6-16 20:26
标题: 对不起，上传文件错误，请看这个
[attach]776[/attach]对不起，上传文件错误，请看这个

作者: 李寻欢 时间: 2003-6-16 21:24
标题: 太容易得到的东西往往不懂得珍惜
[attach]777[/attach]
原来这个模块竟是万能的！可以大转小，也可以小转大！！
我很早就有了这个模块，因为用不上，也一直懒得看它，顺手就丢在一边，由于说明文字是日文，看得不太明白，就以为只是一个从1024*768变为800*600的分辨率的模块，想不到竟是可以随意转的，只要定义一个常量保存你开发环境的分辨率，就可以在任意分辨率下完整显示所有控件！
实在是帅呆了酷毙了！！！

作者: ccczzz 时间: 2003-6-17 02:01
标题: 模块对选项卡控件不支持，能否改进
模块对选项卡控件不支持，能否改进?谢谢[attach]781[/attach]

作者: 李寻欢 时间: 2003-6-17 03:48
标题: 改好了，不是很完美
[attach]782[/attach]

作者: linda0418 时间: 2003-6-17 09:15
再次感谢李版主！
希望各位网友也看看，
因为这确实是个好东东！

作者: ccczzz 时间: 2003-6-18 02:54
谢谢李版主，这个模块非常有用。

作者: 毛毛熊 时间: 2003-6-18 17:46
我想请教一下，能否让控件随着分辩率的变化而变化。
比如说一个文本框。在800*600下显示为半屏，当分辩率为1024*768时也为半屏显示？
文本框的高度仍然为窗体的高度。宽度仍然为窗体宽度的1/2？

作者: duzili 时间: 2003-6-19 08:06
酷！我正需要这样的程序，谢谢谢谢！

作者: duzili 时间: 2003-6-20 08:20
实在是帅呆了酷毙了！！！

作者: wewyhy 时间: 2003-7-3 15:28
ok

作者: 自由弧 时间: 2003-7-4 13:13
斑竹：很好的东西。你上传的是日文原件吗？我有学日文的朋友，可以翻译一下。

作者: 李寻欢 时间: 2003-7-6 07:33
不是原文，我用了翻译软件译过来的，原文不知放哪里去了。
不过慢慢看程序也明白了原理。

作者: 懒UFO 时间: 2003-7-6 07:45
我的《调整分辨率之后选项卡不见了》帖子就是用的这个模块。为什么会出现那种情况？请李斑竹瞧瞧！

作者: george 时间: 2006-4-6 19:27
收藏，感谢

作者: hi-wzj 时间: 2006-4-6 19:45
另一种简单的方法就是,进入程序时强行修改屏幕分辩率为指定的分辩率(即开发时的分辨率),很多游戏软件都是这样做的.

作者: wmok 时间: 2007-9-5 12:55
这么精彩的帖子，我顶上去！！
好让更多的朋友看到！！
感谢李寻欢！感谢各位版主！

作者: mubaiding 时间: 2007-9-5 23:05
标题: 我的密码忘了，只好重新注册用户，下载不了,呜呜......
我的密码忘了，只好重新注册用户，下载不了,呜呜......

作者: fswxs 时间: 2007-9-5 23:24
其实并不是最佳效果，和开发的原型有差距

作者: 75501241 时间: 2007-9-11 10:16
模块太经典了!收藏了!
谢谢寻欢~

作者: tz-chf 时间: 2007-9-11 10:56

原帖由 hi-wzj 于 2006-4-6 19:45 发表
另一种简单的方法就是,进入程序时强行修改屏幕分辩率为指定的分辩率(即开发时的分辨率),很多游戏软件都是这样做的.

这个方法比较好，开销也小，原汁原味。有没有原代码？

作者: 小戴 时间: 2007-9-11 13:48
经典,版主是我们的神

作者: jyjyqz 时间: 2007-12-12 17:55
标题: 请版主看看用了模块的问题
在800*600建的,用了上面的模块后,在1024*768时,选项组的框显示不正常,烦请李版主解决一下.谢谢![attach]27223[/attach]

作者: divineka 时间: 2008-2-1 19:03
真是太好了.................

作者: divineka 时间: 2008-2-1 19:11
确实是好东西,..............

作者: wty_lx 时间: 2008-7-28 17:25
谢谢斑竹

作者: wty_lx 时间: 2008-7-28 17:30
在感谢一次

作者: wu8313 时间: 2008-7-28 18:04

原帖由 tz-chf 于 2007-9-11 10:56 发表

这个方法比较好，开销也小，原汁原味。有没有原代码？

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias _
"EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, _
ByVal iModeNum As Long, lpDevMode As Any) As Long
Private Declare Function ChangeDisplaySettings Lib "user32" Alias _
"ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long
Const EWX_REBOOT = 2
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DISP_CHANGE_SUCCESSFUL = 0
Const DISP_CHANGE_RESTART = 1
Const CDS_UPDATEREGISTRY = 1
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
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
Private DevM As DEVMODE
Dim XVal As Long, YVal As Long, Z As Long
Private Sub DisplaySetting()
Dim i As Long
Dim b As Long
Dim ans As Long
Dim a As Long
a = EnumDisplaySettings(0, 0, DevM)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = XVal
DevM.dmPelsHeight = YVal
b = ChangeDisplaySettings(DevM, 0)
If b = DISP_CHANGE_RESTART Then
ans = MsgBox("要重开机设定才能完成，重开？", vbOKCancel)
If ans = 1 Then
b = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
Call ExitWindowsEx(EWX_REBOOT, 0)
End If
Else
If b <> DISP_CHANGE_SUCCESSFUL Then
Call MsgBox("设定有误", vbCritical)
End If
End If
End Sub
Private Sub Form_Load()
Dim MBN As Integer, x As Long, y As Long
y = GetSystemMetrics(SM_CYSCREEN)
x = GetSystemMetrics(SM_CXSCREEN)
If Not x = 1024 Then
   MBN = MsgBox("您的屏幕分辨率为" & x & "×" & y & "，而程序的最佳显示分辨率为1024×768。" _
      & Chr(13) + Chr(10) & "*  如果需要程序自动重新设置分辨率，请单击“确定”按钮。" _
      & Chr(13) + Chr(10) & "*  如果退出程序自己重新设置分辨率，请单击“取消”按钮。", vbOKCancel + vbExclamation, "提示...")
   If MBN = 1 Then
      XVal = 1024
      YVal = 768
      Call DisplaySetting
      XVal = x
      YVal = y
      Z = 1

   Else
      Application.Quit

   End If

End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim MBN As Integer
If Z = 1 Then
   MBN = MsgBox("是否恢复原来的屏幕分辨率?" _
      & Chr(13) + Chr(10) & "*  如果需要程序自动恢复分辨率，请单击“确定”按钮。" _
      & Chr(13) + Chr(10) & "*  如果退出程序自己恢复分辨率，请单击“取消”按钮。", vbOKCancel + vbExclamation, "提示...")
   If MBN = 1 Then
      Call DisplaySetting
   Else
      Application.Quit
   End If
End If
End Sub
============================
以上代码可以放在你的启动窗体中就可以了。
我记得游戏 "红色警戒" 以前的单机版本就是强行更改你的分辨率为800*600,退出的时候又改回了用户的分辨率

上述代码中：程序设计时分辨率为1024*768 ，如果你设计时的分辨率不同于1024*768的话，适当修改代码就可以了。

一旦修改分辨率成功后，后面运行就不用管了，不必每次都去调用。

[ 本帖最后由 wu8313 于 2008-7-28 21:53 编辑 ]

作者: chenlugen 时间: 2008-7-28 22:24
下来看看...

作者: qinds1977 时间: 2008-8-31 23:16
[:50] [:50] [:50] [:50]

作者: bpchan 时间: 2008-12-5 16:48
标题: 学习！！！
学习！！！

作者: songwenqin 时间: 2011-4-25 13:38
学习了，谢谢

作者: songwenqin 时间: 2011-7-15 13:05
看看

作者: 轻风 时间: 2011-7-16 13:23
在ACCESS2010下，这个问题就很好办了。

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)