【发布时间】：2014-03-27 03:02:57
【问题描述】：
我正在维护一些旧的 VB6 软件，需要根据要显示的字段字符的平均数量以编程方式设置 MS Access 列的宽度，就像在 Access 中的数据表视图中所做的那样。
然而，在 VB 中，该值必须以 Twips 指定，而且我在“字符数”和 Twips 之间进行转换时遇到了一些困难。
例如，如果字体是 Arial 10pt (96 DPI)，并且我在 Access 中指定“50 个字符”，则该值通过 VB 中的Properties("ColumnWidth") 方法返回为“4530 Twips”。如果我在VB中通过CreateProperty("ColumnWidth")方法指定“4530”，Access中会显示“50”。
基于 Office 2010 的 Column Class 规范和 GetTextExtentPoint32 规范，我使用以下代码以 Twips 计算列宽，但对于上面的示例，返回值“5490”而是：
表格
'Identify normal style's font for Access
Dim Font As New StdFont
Font.Name = "Arial"
Font.Size = 10
'Calculate longest width of digits 0-9
Dim Digit As Integer
Dim MaxDigitWidth As Single
For Digit = 0 To 9
Dim mdw As Single
mdw = CalcTextWidth(Digit, Font)
If mdw > MaxDigitWidth Then MaxDigitWidth = mdw
Next Digit
Dim MaxChars As Integer
Dim Width As Single, Pixels As Long, Twips As Long
'Identify number of characters to display horizontally
MaxChars = 50
'Adjust character value based on actual font metrics
Width = Int((MaxChars * MaxDigitWidth + 5) / MaxDigitWidth * 256) / 256
'Convert into screen resolution (TwipsPerPixelX = 1440 / 96 or 120 DPI)
Pixels = Int(((256 * Width + Int(128 / MaxDigitWidth)) / 256) * MaxDigitWidth)
Twips = Pixels * Screen.TwipsPerPixelX
模块
Private Declare Function CreateCompatibleDC Lib "Gdi32" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "Gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "Gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "Gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "Gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Private Type SIZE
cx As Long
cy As Long
End Type
'Calculate width in pixels of screen text
Public Function CalcTextWidth(ByVal Source As String, ByVal Font As StdFont) As Single
Dim myFont As IFont
Dim hFont As Long
Dim mySize As Size
Dim hDC As Long
'Clone font
Set myFont = New StdFont
myFont.Name = Font.Name
'Increase precision since GetTextExtentPoint32 returns a Long
myFont.Size = Font.Size * 1000
'Set device context as screen display for font metrics
hDC = CreateCompatibleDC(0)
'Calculate string width in pixels
hFont = SelectObject(hDC, myFont.hFont)
GetTextExtentPoint32 hDC, Source, Len(Source), mySize
SelectObject hDC, hFont
DeleteObject hFont
DeleteDC hDC
'Restore precision
CalcTextWidth = mySize.cx / 1000
End Function
我还看到了一篇MS Knowledge Base 文章，介绍了如何在 Excel 中计算列宽，但提供的示例似乎与为 Office 公开的算法相冲突。
关于我做错了什么有什么想法吗？
谢谢。
** 3/20 更新 **
下面是代码块的简化版本，它使用之前定义的 Font 和 Twips 设置 ColumnWidth 属性：
Dim db As Database
Dim td As TableDef
Dim prop As Property
Set db = CreateDatabase("db1.mdb", dbLangGeneral)
Set td = db.CreateTableDef("Table1")
td.Fields.Append td.CreateField("Field1", dbMemo)
db.TableDefs.Append td
Set prop = td.CreateProperty("DatasheetFontName", dbText, Font.Name): td.Properties.Append prop
Set prop = td.CreateProperty("DatasheetFontHeight", dbInteger, Font.Size): td.Properties.Append prop
Set prop = td.Fields("Field1").CreateProperty("ColumnWidth", dbInteger, Twips): td.Fields("Field1").Properties.Append prop
db.Close
另外，不确定是否重要，但我正在使用 VB6 Service Pack 6 和以下参考：
- Visual Basic 应用程序
- Visual Basic 运行时对象和过程
- OLE 自动化
- Microsoft DAO 3.6 对象库
- Microsoft ActiveX 数据对象 2.5 库
- Microsoft VBScript 正则表达式 5.5
【问题讨论】：
-
这些是文本框吗？可以设置columnwidth to -2吗？
-
我有兴趣在 Access 中将字段视为 Table 对象时设置它们的宽度。我考虑将它们指定为自动适应，但我更喜欢硬编码值以获得一致的显示。
-
如果你想要一个硬编码的值，你可以使用设计器，不是吗？硬编码似乎有点矫枉过正
-
数据库由VB创建。
-
这是标记为 VB6。实际上是访问 VBA 吗？由于 UI 框架不同，因此有所不同。