注冊 登錄
Office中國論壇/Access中國論壇 返回首頁

的個人空間 http://m.mzhfr.cn/?0 [收藏] [復制] [分享] [RSS]

日志

緹與像素的互換

已有 514 次閱讀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


 

發(fā)表評論 評論 (1 個評論)

回復 tanhong 2008-2-22 11:33
學習,收藏

facelist doodle 涂鴉板

您需要登錄后才可以評論 登錄 | 注冊

QQ|站長郵箱|小黑屋|手機版|Office中國/Access中國 ( 粵ICP備10043721號-1 )  

GMT+8, 2025-7-13 21:34 , Processed in 0.068841 second(s), 15 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回頂部