Get actual width of text in a particular font configuration? - vba

Question

I am printing barcodes and as part of the process I have a Chart object which has a textbox on it.
I render the barcode on it using the clsBarcode class I got from here
Generating Code 128 Barcodes using Excel VBA
Now the issue I have is that I can't tell the width of the barcode.
I generate the barcode on that chart object and then .export the chart as a jpeg file. I had been using a fixed size for the chart object but now I'm trying to print barcodes of different sizes and have to adjust the chart object to match the barcode size or else it gets clipped.
I found an strWidth function here
http://www.ozgrid.com/forum/showthread.php?t=94339
Unfortunately it uses a lookup table for commonly available fonts. There is no entry in the table for code128.fft.
So I am kind of stuck here. If I just resize my chart to be the long possible size of any barcode then I get a lot of wasted whitespace in my barcode image. And since I am printing these barcodes on 2"x4" stickers, you can guess space is at a premium.
I think the best course would be to populate the lookup table with values for code128 characters. The barcode class indicates that chr 32 to 126 and 200 to 211 are in use.
How can I figure out the mafChrWid(i) values for these chars ?
thanks !

Answer 1

For this function you need to name a cell BARCODE and set it's font code128.fft.
Function getBarCodeWidth(strBarcode As String) As Double
With Range("BARCODE")
.Formula = "=Code128_Str(" & strBarcode & ")"
.Worksheet.Columns(.Column).AutoFit
getBarCodeWidth = .Width
End With
End Function

Answer 2

I can't remember where I got the original code to determine font size. I modified it into an easy to use function that can be used to automatically resize a textbox to fit its contents. Drop the below code into its own module and you can then getLabelPixel(theControlYouWantToSizeToItsContents) as the textbox width.
Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Private Declare Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Const LOGPIXELSY As Long = 90
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Private Type SIZE
cx As Long
cy As Long
End Type
Public Function getLabelPixel(textBox As Control) As Integer
Dim font As New StdFont
Dim sz As SIZE
font.Name = textBox.FontName
font.SIZE = textBox.FontSize
font.Weight = textBox.FontWeight
sz = GetLabelSize(textBox.Value, font)
getLabelPixel = sz.cx * 15 + 50 'Multiply this by 15 to get size in twips and +50 to account for padding for access form. .cx is width for font height us .cy
End Function
Private Function GetLabelSize(text As String, font As StdFont) As SIZE
Dim tempDC As Long
Dim tempBMP As Long
Dim f As Long
Dim lf As LOGFONT
Dim textSize As SIZE
' Create a device context and a bitmap that can be used to store a
' temporary font object
tempDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0)
tempBMP = CreateCompatibleBitmap(tempDC, 1, 1)
' Assign the bitmap to the device context
DeleteObject SelectObject(tempDC, tempBMP)
' Set up the LOGFONT structure and create the font
lf.lfFaceName = font.Name & Chr$(0)
lf.lfHeight = -MulDiv(font.SIZE, GetDeviceCaps(GetDC(0), 90), 72)
'LOGPIXELSY
lf.lfItalic = font.Italic
lf.lfStrikeOut = font.Strikethrough
lf.lfUnderline = font.Underline
lf.lfWeight = font.Weight
'If font.Bold Then lf.lfWeight = 800 Else lf.lfWeight = 400
f = CreateFontIndirect(lf)
' Assign the font to the device context
DeleteObject SelectObject(tempDC, f)
' Measure the text, and return it into the textSize SIZE structure
GetTextExtentPoint32 tempDC, text, Len(text), textSize
' Clean up (very important to avoid memory leaks!)
DeleteObject f
DeleteObject tempBMP
DeleteDC tempDC
' Return the measurements
GetLabelSize = textSize
End Function