怎么样使Form自动适应不同的分辨率?

cansum396 2003-03-05 03:32:17
怎么样使Form自动适应不同的分辨率?
包括form里的控件的大小
位置
...全文
68 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
Sean918 2003-03-05
  • 打赏
  • 举报
回复
自己写配置文件

检测分辨率变化

然后load不同的数据
coward_c 2003-03-05
  • 打赏
  • 举报
回复
做不同的分辨率的然后根据当前分辨率调用吧

整体缩放不会好效果的
VB窗体控件大小随窗体大小变化自動調整 有时窗体变化后,如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦,下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。 在Form的Resize事件中调用函数Resize_All就能实现控件自动调整大小,如: Private Sub Form_Resize() Dim H, i As Integer On Error Resume Next Resize_ALL Me 'Me是窗体名,Form1,Form2等等都可以 End Sub 在模块中添加以下代码: Public Type ctrObj Name As String Index As Long Parrent As String Top As Long Left As Long Height As Long Width As Long ScaleHeight As Long ScaleWidth As Long End Type Private FormRecord() As ctrObj Private ControlRecord() As ctrObj Private bRunning As Boolean Private MaxForm As Long Private MaxControl As Long Private Const WM_NCLBUTTONDOWN = &HA1 Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function ReleaseCapture Lib "USER32" () As Long Function ActualPos(plLeft As Long) As Long If plLeft < 0 Then ActualPos = plLeft + 75000 Else ActualPos = plLeft End If End Function Function FindForm(pfrmIn As Form) As Long Dim i As Long FindForm = -1 If MaxForm > 0 Then For i = 0 To (MaxForm - 1) If FormRecord(i).Name = pfrmIn.Name Then FindForm = i Exit Function End If Next i End If End Function Function AddForm(pfrmIn As Form) As Long Dim FormControl As Control Dim i As Long ReDim Preserve FormRecord(MaxForm + 1) FormRecord(MaxForm).Name = pfrmIn.Name FormRecord(MaxForm).Top = pfrmIn.Top FormRecord(MaxForm).Left = pfrmIn.Left FormRecord(MaxForm).Height = pfrmIn.Height FormRecord(MaxForm).Width = pfrmIn.Width FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth AddForm = MaxForm MaxForm = MaxForm + 1 For Each FormControl In pfrmIn i = FindControl(FormControl, pfrmIn.Name) If i < 0 Then i = AddControl(FormControl, pfrmIn.Name) End If Next FormControl End Function Function FindControl(inControl As Control, inName As String) As Long Dim i As Long FindControl = -1 For i = 0 To (MaxControl - 1) If ControlRecord(i).Parrent = inName Then If ControlRecord(i).Name = inControl.Name Then On Error Resume Next If ControlRecord(i).Index = inControl.Index Then FindControl = i Exit Function End If On Error GoTo 0 End If End If Next i End Function Function AddControl(inControl As Control, inName As String) As Long ReDim Preserve ControlRecord(MaxControl + 1) On Error Resume Next ControlRecord(MaxControl).Name = inControl.Name ControlRecord(MaxControl).Index = inControl.Index ControlRecord(MaxControl).Parrent = inName If TypeOf inControl Is Line Then ControlRecord(MaxControl).Top = inControl.Y1 ControlRecord(MaxControl).Left = ActualPos(inControl.X1) ControlRecord(MaxControl).Height = inControl.Y2 ControlRecord(MaxControl).Width = ActualPos(inControl.X2) Else ControlRecord(MaxControl).Top = inControl.Top ControlRecord(MaxControl).Left = ActualPos(inControl.Left) ControlRecord(MaxControl).Height = inControl.Height ControlRecord(MaxControl).Width = inControl.Width End If inControl.IntegralHeight = False On Error GoTo 0 AddControl = MaxControl MaxControl = MaxControl + 1 End Function Function PerWidth(pfrmIn As Form) As Long Dim i As Long i = FindForm(pfrmIn) If i < 0 Then i = AddForm(pfrmIn) End If PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth End Function Function PerHeight(pfrmIn As Form) As Double Dim i As Long i = FindForm(pfrmIn) If i < 0 Then i = AddForm(pfrmIn) End If PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight End Function Public Sub ResizeControl(inControl As Control, pfrmIn As Form) On Error Resume Next Dim i As Long Dim widthfactor As Single, heightfactor As Single Dim minFactor As Single Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long yRatio = PerHeight(pfrmIn) xRatio = PerWidth(pfrmIn) i = FindControl(inControl, pfrmIn.Name) If inControl.Left < 0 Then lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000) Else lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100) End If lTop = CLng((ControlRecord(i).Top * yRatio) \ 100) lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100) lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100) If TypeOf inControl Is Line Then If inControl.X1 < 0 Then inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000) Else inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100) End If inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100) If inControl.X2 < 0 Then inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000) Else inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100) End If inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100) Else inControl.Move lLeft, lTop, lWidth, lHeight inControl.Move lLeft, lTop, lWidth inControl.Move lLeft, lTop End If End Sub Public Sub ResizeForm(pfrmIn As Form) Dim FormControl As Control Dim isVisible As Boolean Dim StartX, StartY, MaxX, MaxY As Long Dim bNew As Boolean If Not bRunning Then bRunning = True If FindForm(pfrmIn) < 0 Then bNew = True Else bNew = False End If If pfrmIn.Top < 30000 Then isVisible = pfrmIn.Visible On Error Resume Next If Not pfrmIn.MDIChild Then On Error GoTo 0 ' ' pfrmIn.Visible = False Else If bNew Then StartY = pfrmIn.Height StartX = pfrmIn.Width On Error Resume Next For Each FormControl In pfrmIn If FormControl.Left + FormControl.Width + 200 > MaxX Then MaxX = FormControl.Left + FormControl.Width + 200 End If If FormControl.Top + FormControl.Height + 500 > MaxY Then MaxY = FormControl.Top + FormControl.Height + 500 End If If FormControl.X1 + 200 > MaxX Then MaxX = FormControl.X1 + 200 End If If FormControl.Y1 + 500 > MaxY Then MaxY = FormControl.Y1 + 500 End If If FormControl.X2 + 200 > MaxX Then MaxX = FormControl.X2 + 200 End If If FormControl.Y2 + 500 > MaxY Then MaxY = FormControl.Y2 + 500 End If Next FormControl On Error GoTo 0 pfrmIn.Height = MaxY pfrmIn.Width = MaxX End If On Error GoTo 0 End If For Each FormControl In pfrmIn ResizeControl FormControl, pfrmIn Next FormControl On Error Resume Next If Not pfrmIn.MDIChild Then On Error GoTo 0 pfrmIn.Visible = isVisible Else If bNew Then pfrmIn.Height = StartY pfrmIn.Width = StartX For Each FormControl In pfrmIn ResizeControl FormControl, pfrmIn Next FormControl End If End If On Error GoTo 0 End If bRunning = False End If End Sub Public Sub SaveFormPosition(pfrmIn As Form) Dim i As Long If MaxForm > 0 Then For i = 0 To (MaxForm - 1) If FormRecord(i).Name = pfrmIn.Name Then FormRecord(i).Top = pfrmIn.Top FormRecord(i).Left = pfrmIn.Left FormRecord(i).Height = pfrmIn.Height FormRecord(i).Width = pfrmIn.Width Exit Sub End If Next i AddForm (pfrmIn) End If End Sub Public Sub RestoreFormPosition(pfrmIn As Form) Dim i As Long If MaxForm > 0 Then For i = 0 To (MaxForm - 1) If FormRecord(i).Name = pfrmIn.Name Then If FormRecord(i).Top < 0 Then pfrmIn.WindowState = 2 ElseIf FormRecord(i).Top < 30000 Then pfrmIn.WindowState = 0 pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height Else pfrmIn.WindowState = 1 End If Exit Sub End If Next i End If End Sub Public Sub Resize_ALL(Form_Name As Form) Dim OBJ As Object For Each OBJ In Form_Name ResizeControl OBJ, Form_Name Next OBJ End Sub Public Sub DragForm(frm As Form) On Local Error Resume Next Call ReleaseCapture Call SendMessage(frm.hwnd, WM_NCLBUTTONDOWN, 2, 0) End Sub
说 明: 〖accResize1.0〗

这是针对access97所做的自动调整窗体和控件大小的控件,使你的窗口在缩放的时候各控件位置和大小会自动调整。这样你的程序即可在640*480分辨率下运行,也可在800*600下运行,而且在任何大小情况下,窗体里的控件都会随着窗体的大小而变化,保证你可以看到整个窗体的所有内容。只要改变窗体的大小,包括标签、文本框、下拉框、列表框、选项框、检查框、图片、普通子窗体、数据子窗体等控件都会自动按相应的比例实时改变大小。
写这个控件的初衷主要是以前在开发VB程序时用到resize的控件,觉得比较好用,而当时找遍所有的资料,都找不到类似针对ACCESS的控件(VB的RESIZE控件在ACCESS中会出现一些奇怪的现象,主要是因为ACCESS窗体的特别结构),而当时我开发的一个项目需要同时适应800*600 和640*480 两种分辨率,所以触发我自己写这方面的程序。经过几次比较大的改动,现在大致可以满足我的需要。一年后,我在网络上找到Ken Getz, Paul Litwin, and Mike Gilbert写的Scale and Resize Your Access Forms演示程序,知道原来在这个世界,还有人与我有同样的想法,他们的功能做得挺棒,只可惜看不到他们的源码。不过知道他们是用API来做的。我比较了两者之间的速度,应该是差不多的。为了让大家了解,我迟点会把他们的演示程序上传。




〖accResize1.0〗说明文件


一、【主要功能】
实现窗口在缩放的时候各控件位置和大小自动调整功能
二、文件列表

resize.mde 控件缩放的核心代码
testresize.mdb 测试缩放效果的例子程序

三、〖accResize1.0〗使用方法

1. 确保你已经安装了access97
2. 将下载的文件用WINRAR解压后放在同一个目录
3. 用ACCESS打开(或双击)testresize.mdb,运行其中的窗体文件即可
4. 如果你想在你的程序中使用这个功能,只要把resize.mde抄到你的程序目录下,然后打开你的程序,在工具菜单中选择[引用],引用resize.mde即可(你需进入代码状态才能看到工具菜单中的引用子菜单),最后在你自己程序的窗体中的resize事件中加入 resize.Form_myResize Me 这句程序即可。

5. 请注意,为了加快窗体缩放的速度,所以程序有个特别注意的地方: 当你在窗体中添加新的控件或改变了位置,需在重新关闭你的程序(即关闭MDB后)再打开才能生效。
实际我试过,即使增加新的控件就自动更新,速度亦差不多


四、错误反馈

1. 如果你发现软件中的错误,欢迎你反馈给作者。


五、【使用许可/LICENSE】

请仔细阅读以下使用许可,如果您不同意以下任何一点,请
立即停止使用此软件。

1.〖accResize1.0〗的作者王宇虹授予您对此版本的最终用户使用
许可权;
2.您不能对软件作任何的软件反向工程,如反汇编,跟踪等;
3.您可以分发此软件,但不能收取任何费用或用于商业目的,
同时,必须保证所分发的软件包含全部文件,并且不作任何
修改;分发的软件应该至少包括我软件所附带的README.txt
4.本软件不包含任何使用保证,不能保证适用或不出故障,由
于此软件是免费提供,因此作者不对您或别的用户使用此
软件所带来的理论上或实际的损失负责;
5.如果您用了此软件就等于您同意以上几点许可;
6.如果你觉的该软件好用,请发一封Email给作者表示感谢,这些支持将会使作者
写出更好软件,谢谢!

六、【软件注册费用】
完全免费!!
本软件所有功能都可以免费使用,完全没有限制。

七、【源码费用】

如果你对此软件的源码感兴趣,你可以向作者免费索取。
你只要发封EMAIL给作者,说明你需要索取这个程序的源码,作者即会把源码EMAIL给你。
电子信箱:wang_yu_hong@163.net
tmtony@21cn.com


你可以到我的主页
http://www.zstmcomputer.com
或 http://tmcomputer.6to23.com

免费获得其它完整的应用软件或一些已公开的源码。



八、【主要技术】
具体请参照程序


系统编写开始时间: 12/03/2001
完成及验收时间: 18/04/2001

九、【感谢】
此软件的诞生得到了同事以及客户的支持和测试,在此表示感谢。
 
一些老的控件的集合: ------------------------------------------------------------------ xtoolbar.zip 41K 作者: Jean-Philippe Bernardy. 很不错的工具条控件 armenutb.zip 33K 作者: Albert Research。 提供用TListView选择全部的 Menu Item的工具条控件 dfssatausbar.zip 36K 作者: Brad Stowers。 TDFSStatusBar 是加强版 TStatusBar 构件,能够在其内放置其他构件(可在IDE环境瞎直接拖放),提供显示键盘上( CAPS Lock、NUM Lock、SCROLL Lock) 的状态,并提供进度显示进度及当前时间日期等多项功能 dfstoolbar.zip 10K 作者: Brad Stowers。 TDFSToolBar 是增强型的 TToolBar 构件,提供类似 Netscape Communicator 般的工具条,能够放到最大化及还原 sfoutbar.zip 23K 作者: Sylvain Frere. 类似Microsoft Outlook控制条控件,功能有支持大小图标显示,平滑滚动,快捷键,多重选择等 tbargood.zip 44K 作者: Seth Taylor。 配置 TForm TiTle的控件,功能很多 colorbtn.zip 9K Windows95风格的选择颜色的按钮元件 bcolorbtn.zip 26K 作者: Brad Stowers. Windows95风格的选择颜色的按钮元件 explbtn.zip 37K 作者: Fabrice Deville 。 TExploreButton 是类似 Microsoft Internet Explorer 3.0 式样的 Speed Button gradbutt.zip 13K 作者: Harm TGradBtn 是能够显示渐变颜色的 TButton 构件,并能控制按钮上文字以多种立体样式显示 avhebchk.zip 13K 作者: Alex Zanis. 在右边显示选择勾的CHeckBox控件,适合从右到作的语言如阿拉伯语. amcbrb.zip 10K 作者: Alexander Meeder。 以BMP图片自定义显示外观的增强型 TRadioButton 及 TCheckBox 构件 noshape.zip 86K 作者: Michael Tran 能够照指定的BMP 图像外观直接变成按钮外观的增强型按钮构件,带Exe演示程序 hnoshape.zip 4K 能够照指定两个BMP 图像变成按钮外观的增强型按钮构件 btchkbox.zip 5K 增强型TCheckBox 构件,可以按不同的选取状态选择各自BMP图片 jcheck10.zip 12K 很漂亮的增强型TCheckBox 构件 lightchk.zip 2K 作者: Frederic Vanmol。 圆形 LED 类型的 TCheckBox 构件,可以加亮变暗. speedrol.zip 1K 可以根据Button不同状态(Up,Down,Over)显示不同图片,支持一个大Glyph分成三个按钮图. transrad.zip 2K 作者: Jason Looney. 透明Ridio Button torrybtn.zip 81K 作者: Maxim Peresada, Rob Schoenaker. TTorryButton 是增强型的 TSpeedButton 构件,外观如同一个普通的 TLabel 般,当鼠标移动至按钮上方,立即显示出按钮边框及加亮的LED 类型.带Exe演示程序 jcheck10.zip 12K 作者: Jan Hulala。 Windows98 外观的增强型 TCheckBox 构件. coolbtn.zip 2K 作者: Geert Vos。 TCoolButton2 是增强型的 TSpeedButton 构件,当鼠标移至其上方时按钮上的文字将会出现阴影 corelbtn.zip 2K 作者: Peter Theill。 提供类似 Corel 公司产品( Corel Photo Paint )中的特殊样式按钮 mscheckb.zip 5K 作者: Vasily Kholopov. 增强型的 TBitBtn 构件,当被鼠标按下时能够改变 Glyphs 格式 .BMP 的显示内容 shakebtn.zip 36K 作者: Harm. Sh
这是针对access2000所做的自动调整窗体和控件大小的控件,使你的窗口在缩放的时候各控件位置和大小会自动调整。这样你的程序即可在640*480分辨率下运行,也可在800*600下运行,而且在任何大小情况下,窗体里的控件都会随着窗体的大小而变化,保证你可以看到整个窗体的所有内容。只要改变窗体的大小,包括标签、文本框、下拉框、列表框、选项框、检查框、图片、普通子窗体、数据子窗体等控件都会自动按相应的比例实时改变大小。写这个控件的初衷主要是以前在开发VB程序时用到resize的控件,觉得比较好用,而当时找遍所有的资料,都找不到类似针对ACCESS的控件(VB的RESIZE控件在ACCESS中会出现一些奇怪的现象,主要是因为ACCESS窗体的特别结构),而当时我开发的一个项目需要同时适应800*600 和640*480 两种分辨率,所以触发我自己写这方面的程序。经过几次比较大的改动,现在大致可以满足我的需要。一年后,我在网络上找到Ken Getz, Paul Litwin, and Mike Gilbert写的Scale and Resize Your Access Forms演示程序,知道原来在这个世界,还有人与我有同样的想法,他们的功能做得挺棒,只可惜看不到他们的源码。不过知道他们是用API来做的。我比较了两者之间的速度,应该是差不多的。为了让大家了解,我迟点会把他们的演示程序上传。〖accResize1.0〗说明文件一、【主要功能】实现窗口在缩放的时候各控件位置和大小自动调整功能二、文件列表resize.mde 控件缩放的核心代码testresize.mdb 测试缩放效果的例子程序三、〖accResize1.0〗使用方法1. 确保你已经安装了access20002. 将下载的文件用WINRAR解压后放在同一个目录3. 用ACCESS打开(或双击)testresize.mdb,运行其中的窗体文件即可4. 如果你想在你的程序中使用这个功能,只要把resize.mde抄到你的程序目录下,然后打开你的程序,在工具菜单中选择[引用],引用resize.mde即可(你需进入代码状态才能看到工具菜单中的引用子菜单),最后在你自己程序的窗体中的resize事件中加入 resize.Form_myResize Me 这句程序即可。5. 请注意,为了加快窗体缩放的速度,所以程序有个特别注意的地方: 当你在窗体中添加新的控件或改变了位置,需在重新关闭你的程序(即关闭MDB后)再打开才能生效。实际我试过,即使增加新的控件就自动更新,速度亦差不多四、错误反馈1. 如果你发现软件中的错误,欢迎你反馈给作者。五、【使用许可/LICENSE】请仔细阅读以下使用许可,如果您不同意以下任何一点,请立即停止使用此软件。1.〖accResize1.0〗的作者王宇虹授予您对此版本的最终用户使用许可权;2.您不能对软件作任何的软件反向工程,如反汇编,跟踪等;3.您可以分发此软件,但不能收取任何费用或用于商业目的,同时,必须保证所分发的软件包含全部文件,并且不作任何修改;分发的软件应该至少包括我软件所附带的README.txt4.本软件不包含任何使用保证,不能保证适用或不出故障,由于此软件是免费提供,因此作者不对您或别的用户使用此软件所带来的理论上或实际的损失负责;5.如果您用了此软件就等于您同意以上几点许可;6.如果你觉的该软件好用,请发一封Email给作者表示感谢,这些支持将会使作者写出更好软件,谢谢!六、【软件注册费用】完全免费!!本软件所有功能都可以免费使用,完全没有限制。七、【源码费用】如果你对此软件的源码感兴趣,你可以向作者免费索取。你只要发封EMAIL给作者,说明你需要索取这个程序的源码,作者即会把源码EMAIL给你。电子信箱:wang_yu_hong@163.net tmtony@21cn.com你可以到我的主页http://www.zstmcomputer.com 或 http://tmcomputer.6to23.com 免费获得其它完整的应用软件或一些已公开的源码。八、【主要技术】具体请参照

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧