VB and VBA Users Source Code: Converting between different types of graphical units
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Converting between different types of graphical units
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Sunday, September 15, 2002
Hits:
1009
Category:
Visual Basic General
Article:
Below are a list of useful conversion routines for converting between the various graphical measurement types: -----API CALLS AND CONSTANTS--------- Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Const HWND_DESKTOP = 0 Private Const LOGPIXELSX = 88 'Logical pixels/inch in X Private Const LOGPIXELSY = 90 'Logical pixels/inch in Y -----TWIP CONVERSION ROUTINES--------- 'Returns the number of twips in a inch Function TwipsToInches(fTwips As Double) As Double TwipsToInches = fTwips / 1440 End Function 'Returns the number of twips in a centimeter Function TwipsToCM(fTwips As Double) As Double TwipsToCM = fTwips / (1440 / 2.54) End Function -----POINT CONVERSION ROUTINES--------- 'Returns the number of points in a inch Function PointsToInches(fPoints As Double) As Double PointsToInches = fPoints / 72 End Function 'Returns the number of points in a centimeter Function PointsToCM(fPoints As Double) As Double PointsToCM = fPoints / (72 / 2.54) End Function -----PIXEL CONVERSION ROUTINES--------- 'Returns the width of a pixel, in twips. Function TwipsPerPixelX() As Single Dim lngDC As Long lngDC = GetDC(HWND_DESKTOP) TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX) ReleaseDC HWND_DESKTOP, lngDC End Function 'Returns the height of a pixel, in twips. Function TwipsPerPixelY() As Single Dim lngDC As Long lngDC = GetDC(HWND_DESKTOP) TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY) ReleaseDC HWND_DESKTOP, lngDC End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
