如何使VB程序窗口自适应不同分辨率的屏幕
解决方案 »
- 1、如何将屏幕的图像放到dc中;2、如何再将dc中的图像根据鼠标单击、拖动坐标加框后放到屏幕上.
- 关于获取LISTVIEW控件中内容的问题
- 打算写一个组件,用于读取数据库的数据来画失量图。可没有头绪,不知有哪位高人做过,请指教!(急)
- 把从字段名以"|"号间隔的test.txt导入到SQLSERVER表中,提示错误,谢谢大家!!
- VB 如何最大化 但是也要屏蔽最小化和最大化和关闭按钮 如何实现
- [求助]请问谁有关于Gif文件格式方面的资料?
- 我的winsock是否已经关掉
- 大家帮忙看看这道题
- VB个人财务管理系统
- 怎么使用collection功能实现查找功能
- 求高手帮忙改段程序,急急急!
- 请问一个vb中shell函数的问题!急!!!
Me.WindowState = 2
Private Sub Form_Load()
Me.Move 0, 0, Screen.Width, Screen.Height
'Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 设置窗体居中
End Sub
Dim SW As Long, SH As Long
Private Sub Form_Load()
SW = Screen.Width
SH = Screen.Height
Me.Move 0, 0, SW, SH
Timer1.Interval = 500
Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
If SW <> Screen.Width And SH <> Screen.Height Then
SW = Screen.Width
SH = Screen.Height
Me.Move 0, 0, SW, SH
End If
End Sub
试试子类化 WM_DISPLAYCHANGE
这个有点太夸张了,呵呵,timer来的话不仅会造成系统资源的浪费,还会造成窗体不停闪动
然后,窗体上的其他所有控件都跟着居中.也可以自己调整!
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long' if True, also fonts are resized
'是否缩放字体
Public ResizeFont As Boolean
' if True, form's height/width ratio is preserved
'是否保持比例
Public KeepRatio As BooleanPrivate Type TcontrolInfo
ctrl As Control
Left As Single
Top As Single
Width As Single
Height As Single
FontSize As Single
End Type' this array holds the original position
' and size of all controls on parent form
'保存父窗体内所有控件的初始位置与大小
Dim Controls() As TcontrolInfo' a reference to the parent form
'父窗体事件
Private WithEvents ParentForm As Form' parent form's size at load time
'载入时父窗体的大小
Private ParentWidth As Single
Private ParentHeight As Single' ratio of original height/width
'初始高宽比例
Private HeightWidthRatio As SinglePrivate Sub ParentForm_Load()
' the ParentWidth variable works as a flag
ParentWidth = 0
' save original ratio
'保存初始比例
HeightWidthRatio = ParentForm.Height / ParentForm.Width
End SubPrivate Sub UserControl_ReadProperties(PropBag As PropertyBag)
ResizeFont = PropBag.ReadProperty("ResizeFont", False)
KeepRatio = PropBag.ReadProperty("KeepRatio", False)
If Ambient.UserMode = False Then Exit Sub
' store a reference to the parent form and
' start receiving events
Set ParentForm = Parent
End SubPrivate Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "ResizeFont", ResizeFont, False
PropBag.WriteProperty "KeepRatio", KeepRatio, False
End SubPrivate Sub UserControl_Resize()
' refuse to resize
'限制大小
Size 420, 420
End Sub
' trap the parent form's Resize event
' this include the very first resize event
' that occurs soon after form's load
Private Sub ParentForm_Resize()
'MsgBox "A"
LockWindowUpdate ParentForm.hwnd
If ParentWidth = 0 Then
Rebuild
Else
Refresh
End If
LockWindowUpdate 0
'MsgBox "B"
End Sub' save size and position of all controls on parent form
' you should manually invoke this method each time you
' add a new control to the form
' (through Load method of a control array)
'
Sub Rebuild()
' rebuild the internal table
Dim I As Integer, ctrl As Control
' this is necessary for controls that don't support
' all properties (e.g. Timer controls)
On Error Resume Next
If Ambient.UserMode = False Then Exit Sub
' save a reference to the parent form
' and its initial size
Set ParentForm = UserControl.Parent
ParentWidth = ParentForm.ScaleWidth
ParentHeight = ParentForm.ScaleHeight
' read the position of all controls on the parent form
ReDim Controls(ParentForm.Controls.count - 1) As TcontrolInfo
For I = 0 To ParentForm.Controls.count
With Controls(I)
Set .ctrl = ParentForm.Controls(I)
.Left = ParentForm.Controls(I).Left
.Top = ParentForm.Controls(I).Top
.Width = ParentForm.Controls(I).Width
.Height = ParentForm.Controls(I).Height
.FontSize = ctrl.Font.Size
End With
Next
End Sub' update size and position of controls on parent form
'更新父窗体内控件的大小与位置
Sub Refresh()
Dim I As Integer, ctrl As Control
Dim widthFactor As Single, heightFactor As Single
Dim minFactor As Single '比例因子
' inhibits recursive calls if KeepRatio = True
Static executing As Boolean
If executing Then Exit Sub
'如果不是运行时,则退出
If Ambient.UserMode = False Then Exit Sub
If KeepRatio Then
executing = True
' we must keep original ratio
If ParentForm.WindowState <> 2 And ParentForm.WindowState <> 1 Then ParentForm.Height = HeightWidthRatio * ParentForm.Width
executing = False
End If
' this is necessary for controls that don't support
' all properties (e.g. Timer controls)
'错误处理,不能调整所有控件的大小,比如 Timer 控件
On Error Resume Next
widthFactor = ParentForm.ScaleWidth / ParentWidth
heightFactor = ParentForm.ScaleHeight / ParentHeight
' take the lesser of the two
If widthFactor < heightFactor Then
minFactor = widthFactor
Else
minFactor = heightFactor
End If
' this is a regular resize
For I = 0 To UBound(Controls)
With Controls(I)
' the change of font must occur *before* the
' resizing to account for companion scrollbar
' of listbox and other similar controls
If ResizeFont Then
.ctrl.Font.Size = .FontSize * minFactor
End If
' move and resize the controls - we can't use a
' Move method because some controls do not
' support the change of all the four properties
' (eg. Height with comboboxes)
'.ctrl.Left = .Left * widthFactor
'.ctrl.Top = .Top * heightFactor
'.ctrl.Width = .Width * widthFactor
'.ctrl.Height = .Height * heightFactor
If InStr(UCase(.ctrl.Name), UCase("combo")) <> 0 Then
.ctrl.Left = .Left * widthFactor
.ctrl.Top = .Top * heightFactor
Else
.ctrl.Move .Left * widthFactor, .Top * heightFactor, .Width * widthFactor, .Height * heightFactor
End If
End With
Next
End Sub
添加用户控件,代码贴进去使用时,工程添加此用户控件,再添加到需要自适应的窗口中即可这样都还不会用,可以撞墙了