注册 登录
Office中国论坛/Access中国论坛 返回首页

的个人空间 http://www.office-cn.net/?0 [收藏] [复制] [分享] [RSS]

日志

缇与像素的互换

已有 508 次阅读2008-2-14 13:30 |个人分类:API

      API都是以像素为单位,VBA中的默认度量单位为缇;1440 缇等于 1 英寸,2者的单位不同必须进行转换。

'获取指定窗口的设备场景
Private Declare Function apiGetDC Lib "user32" _
  Alias "GetDC" _
  (ByVal hwnd As Long) _
  As Long
'释放由调用GetDC或GetWindowDC函数获取的指定设备场景。它对类或私有设备场景无效(但这样的调用不会造成损害)
Private Declare Function apiReleaseDC Lib "user32" _
  Alias "ReleaseDC" _
  (ByVal hwnd As Long, _
  ByVal hdc As Long) _
  As Long
'根据指定设备场景代表的设备的功能返回信息
Private Declare Function apiGetDeviceCaps Lib "gdi32" _
  Alias "GetDeviceCaps" (ByVal hdc As Long, _
  ByVal nIndex As Long) As Long

Private Const nTwipsPerInch = 1440
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Function ConvertTwipsToPixels(lngTwips As Long, _
                                lngDirection As Long) _
                                As Long
 '缇转换成像素
    Dim lngDC As Long
    Dim lngPixelsPerInch As Long
    lngDC = apiGetDC(SM_CXSCREEN)
    If (lngDirection = SM_CXSCREEN) Then
        lngPixelsPerInch = apiGetDeviceCaps(lngDC, LOGPIXELSX)
    Else
        lngPixelsPerInch = apiGetDeviceCaps(lngDC, LOGPIXELSY)
    End If
    lngDC = apiReleaseDC(SM_CXSCREEN, lngDC)
    ConvertTwipsToPixels = lngTwips / nTwipsPerInch * lngPixelsPerInch
End Function

Function ConvertPixelsToTwips(lngPixels As Long, _
                                lngDirection As Long) _
                                As Long
  
 '像素转换成缇
 
    Dim lngDC As Long
    Dim lngPixelsPerInch As Long
    lngDC = apiGetDC(SM_CXSCREEN)
    If (lngDirection = SM_CXSCREEN) Then
        lngPixelsPerInch = apiGetDeviceCaps(lngDC, LOGPIXELSX)
    Else
        lngPixelsPerInch = apiGetDeviceCaps(lngDC, LOGPIXELSY)
    End If
    lngDC = apiReleaseDC(SM_CXSCREEN, lngDC)
    ConvertPixelsToTwips = lngPixels * nTwipsPerInch / lngPixelsPerInch
End Function


 

发表评论 评论 (1 个评论)

回复 tanhong 2008-2-22 11:33
学习,收藏

facelist doodle 涂鸦板

您需要登录后才可以评论 登录 | 注册

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-25 05:29 , Processed in 0.056795 second(s), 15 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部