Функции VBA для перевода пикселей в твипы

Функции для перевода пикселей в твипы, и обратно

Function TwipsPerPixel(Optional ByVal Dimension As Long = LOGPIXELSY) As Long
    Const TwipsPerInch As Long = 1440: Dim DesktopDC As Long
    DesktopDC = GetDC(HWND_DESKTOP)
    TwipsPerPixel = TwipsPerInch / GetDeviceCaps(DesktopDC, Dimension)
    Call ReleaseDC(HWND_DESKTOP, DesktopDC)
End Function
Public Function TwipToPixel(ByVal Twips As Long) As Long    'перевод твипов в пиксели
    TwipToPixel = Twips / TwipsPerPixel()
End Function
Public Function PixelToTwip(ByVal Pixels As Long) As Long    'перевод пикселей в твипы
    PixelToTwip = Pixels * TwipsPerPixel()
End Function
 
Public Function PixelToTwipX(ByVal Pixels As Long) As Long: PixelToTwipX = Pixels * TwipsPerPixel(LOGPIXELSX): End Function
Public Function PixelToTwipY(ByVal Pixels As Long) As Long: PixelToTwipY = Pixels * TwipsPerPixel(LOGPIXELSY): End Function

Комментарии

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  ____    _        ____            _      ____  
| _ \ | |__ / ___| ___ / \ | _ \
| | | | | '_ \ | | / __| / _ \ | | | |
| |_| | | |_) | | |___ \__ \ / ___ \ | |_| |
|____/ |_.__/ \____| |___/ /_/ \_\ |____/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.