vb界面自适应不同分辨率终极解决方案
现在宽屏,大屏幕显示器越来越普遍,原来在800*600下设计的软件界面,在大屏幕显示器(1680*1050)上界面总是缩到一角,非常难看,要将老程序的界面按照不同的分辨率在重新进行设计编程,整个过程比较复杂而且实用性不大,如果原来程序比较大且界面比较多的话那么工作量也将是巨大的,而且还可能出现其他错误,有没有一种重要增加少许代码就能将所有的界面自动适应不同的分辨率呢,在网上搜索了一下有很多现成的方法,但或多或少都有些问题,总之没有完美的解决方案,我经过研究找到了一种方法基本可以解决所有问题,与大家共享,当然该代码中所考虑的控件不完全,有些控件还需要特别处理,这个我在后面的常见问题说明里会提到,具体的代码需要你自己去添加。
代码如下:
1、新建一个模块(general.bas),在上面添加两个函数;
Public Type CONTROLRECT
Left As Single
Top As Single
Width As Single
Height As Single
End Type
Public Const HORZRES = 8
Public Const VERTRES = 10
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
'取得界面原始控件的位置及大小,并保存到数组里
Public Sub GetSourcePos(this As Object, rc() As CONTROLRECT, Optional bigFont As Boolean = True)
Dim tempX As Integer, tempY As Integer
tempX = this.ScaleWidth '1024
tempY = this.ScaleHeight '768
'此处原来如果在1024*768分辨率下显示正常的话,就可以直接赋值1024和768
Dim temp As Control
Dim nSum As Integer
nSum = 0
For Each temp In this
'此处要注意,有些控件没有width,height等属性,在此要做出判断
If TypeOf temp Is ComboBox Then
With rc(nSum)
.Left = temp.Left / tempX
.Width = temp.Width / tempX
.Top = temp.Top / tempY
End With
'
相关文档:
VB编写托盘图标有两个要点,一是使用 Shell_NotifyIcon 函数显示图标;二是向系统注册 TaskbarCreated 消息,以便explorer崩溃时恢复托盘的图标。
首先需要增加一个模块文件,内容如下:
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOT ......
'代码:
Option Explicit
'======================用于查找进程和终止进程的API函数常数定义================ =====
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessF ......
Option Explicit
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const scuseragent = "vb wininet"
Private Const INTERNET_FLAG_PASSIVE = &H8000000
'调用设置环境
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long ......
在工程中添加一个类模块,名为 Selection
然后加入以下代码:
Dim colRows As Collection
Dim ControlKey As Boolean
Public WithEvents flx As M ......
Option Explicit
Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32
Private Type NCB
ncb_command As Byte
ncb_retcode As Byte
ncb_lsn As Byte
ncb_num As Byte ......