VBA中的Twip与Point尺寸单位转换

分类:代码, 博客 标签:

VBA中的尺寸单位很丰富,如Twip、Point、Pixel、Inch、Character、Millimeter、Centimeter等,同时也很复杂,因此单位转换时会觉得有点混乱。这里介绍一下用得比较多的Twip,Point和Pixel及相互间的转换。

Twip/Point是一个与屏幕无关的测量单位,使用这两个单位在打印时不需要考虑屏幕分辨率的问题,是以在水文水利工程成图中使用这样的单位可以打印出精确的距离,方便使用。Pixel则是同屏幕分辨率有关的测量单位,屏幕上显示最小的一个点就是一个像素。

Twip、Point和Inch转换公式如下(1 Point等于20 Twip,1 Inch等于72 Point):

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

获取屏幕分辨率的方法还有使用GetSystemMetrics API函数。例如下面的方法:

Public Declare Function _
GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Sub GetScreenDimension()
    MsgBox "屏幕宽度为: " & GetSystemMetrics(0) & vbCrLf & _
           "屏幕高度为: " & GetSystemMetrics(1)
End Sub

Excel中也提供了一些方法进行尺寸转换,例如Application对象的CentimetersToPoints方法将厘米转换成Point,另一个InchesToPoints方法将Inch转换成Point。

比较奇怪的是Window对象的两个方法PointsToScreenPixelsX和PointsToScreenPixelsY。根据字面意义和帮助文件这两个方法表示将Point转换Pixel,而实际的结果并不正确。下面的代码是一个示例。

Sub Test()
    Dim lSelWidth1 As Long
    Dim lSelHeight1 As Long
    Dim lSelWidth2 As Long
    Dim lSelHeight2 As Long
 
    With ActiveWindow
        lSelWidth1 = .PointsToScreenPixelsX(.Selection.Width)
        lSelHeight1 = .PointsToScreenPixelsY(.Selection.Height)
        lSelWidth2 = Point2PixelX(.Selection.Width)
        lSelHeight2 = Point2PixelY(.Selection.Height)
    End With
    MsgBox "ActiveWindow的PointsToScreenPixels方法计算结果:" & vbCrLf & vbTab & _
        "宽度: " & lSelWidth1 & " | 高度: " & lSelHeight1 & vbCrLf & _
        "自定义函数Point2Pixel方法计算结果:" & vbCrLf & vbTab & _
        "宽度: " & lSelWidth2 & " | 高度: " & lSelHeight2
End Sub

这两个方法实际上接受的参数是以Pixel为单位,返回的值也是以Pixel为单位。传递的值为Excel中的像素坐标值(以A1单元格的左上角为原点),返回的结果表示传递的值在屏幕坐标(以屏幕左上角为原点)中的像素坐标值。PointsToScreenPixelsX(0)和PointsToScreenPixelsY(0)分别返回单元格A1的左上角在屏幕坐标(屏幕最左上角为[0,0],向下和右为+)中的X轴和Y轴像素。所以应该是微软搞错了,但这两个方法应该还是很有用,只是比较让人迷惑而已。

计算Point转换Pixel时没有考虑到Point可能不是整数,导致计算错误。重新更改Point2PixelX,Point2PixelY,Pixel2PointX和Pixel2PointY函数如下:

Function Pixel2PointX(x As Long) As Double
'水平方向Pixel转Point
  Pixel2PointX = Pixel2TwipX(x) / 20
End Function
Function Pixel2PointY(x As Long) As Double
'垂直方向Pixel转Point
  Pixel2PointY = Pixel2TwipY(x) / 20
End Function
Function Point2PixelX(x As Double) As Long
'水平方向Point转Pixel
  Point2PixelX = Twip2PixelX(x * 20)
End Function
Function Point2PixelY(x As Double) As Long
'垂直方向Point转Pixel
  Point2PixelY = Twip2PixelY(x * 20)
End Function


分类:代码, 博客 标签:

发表评论

You must be logged in to post a comment.