VBA里的尺寸单位很多,如Twip,Point,Pixel,Inch,Character,Millimeter,Centimeter等。而不同的地方使用的单位有时不一样,例如Excel和Word里的长宽单位多用Point,Access里多用Twip,而API里用的尺寸单位多为Pixel,这样单位转换时会觉得有点混乱。这主要介绍用得比较多的Twip,Point和Pixel之间的转换方法。
VBA里的尺寸单位很多,如Twip,Point,Pixel,Inch,Character,Millimeter,Centimeter等。而不同的地方使用的单位有时不一样,例如Excel和Word里的长宽单位多用Point,Access里多用Twip,而API里用的尺寸单位多为Pixel,这样单位转换时会觉得有点混乱。这主要介绍用得比较多的Twip,Point和Pixel之间的转换方法。
Twip/Point是一个与屏幕无关的测量单位,这样在打印时不要考虑屏幕分辨率的问题。Pixel则是同像素有关的测量单位。屏幕上显示最小的一个点就是一个像素。
Twip,Point和Inch转换公式如下:
Twip=1/20*Point=1/1440*Inch
Point=20*Twip=1/72*Inch
而Twip/Point同Pixel之间则要依据设备环境参数做转换,下面是一些转换的函数。
Private Const HORZRES = 8
Private Const VERTRES = 10
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const TWIPSPERINCH = 1440
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, _
ByVal nIndex As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hDC As Long) As Long
Function getDPI(bX As Boolean) As Integer '获取屏幕分辨率
Dim hDC As Long, RetVal As Long
hDC = GetDC(0)
If bX = True Then
getDPI = GetDeviceCaps(hDC, LOGPIXELSX)
Else
getDPI = GetDeviceCaps(hDC, LOGPIXELSY)
End If
RetVal = ReleaseDC(0, hDC)
End Function
Function Pixel2TwipX(x As Long) As Long '水平方向Pixel转Twip
Pixel2TwipX = (x / getDPI(True)) * TWIPSPERINCH
End Function
Function Pixel2TwipY(x As Long) As Long '垂直方向Pixel转Twip
Pixel2TwipY = (x / getDPI(False)) * TWIPSPERINCH
End Function
Function Pixel2PointX(x As Long) As Long '水平方向Pixel转Point
Pixel2PointX = Pixel2TwipX(x) / 20
End Function
Function Pixel2PointY(x As Long) As Long '垂直方向Pixel转Point
Pixel2PointY = Pixel2TwipY(x) / 20
End Function
Function Twip2PixelX(x As Long) As Long '水平方向Twip转Pixel
Twip2PixelX = x / TWIPSPERINCH * getDPI(True)
End Function
Function Twip2PixelY(x As Long) As Long '垂直方向Twip转Pixel
Twip2PixelY = x / TWIPSPERINCH * getDPI(False)
End Function
Function Point2PixelX(x As Long) As Long '水平方向Point转Pixel
Point2PixelX = Twip2PixelX(x * 20)
End Function
Function Point2PixelY(x As Long) As Long '垂直方向Point转Pixel
Point2PixelY = Twip2PixelY(x * 20)
End Function
Function getScreenX() As Long '获取屏幕宽
Dim hDC As Long, RetVal As Long
hDC = GetDC(0)
getScreenX = GetDeviceCaps(hDC, HORZRES)
RetVal = ReleaseDC(0, hDC)
End Function
Function getScreenY() As Long '获取屏幕高
Dim hDC As Long, RetVal As Long
hDC = GetDC(0)
getScreenY = GetDeviceCaps(hDC, VERTRES)
RetVal = ReleaseDC(0, hDC)
End Function