Здравствуйте!
---------------
И так,
На Главной форме располагается Комбобокс и Главная пдч.
При выборе записи в Комбобоксе,
информация отображается в Главной пдч.
Высота Главной пдч на Главной форме
зависит от содержимого Поля1(мемо в таблице). на Главной пдч.
---------------
Использую такой модуль.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
Option Compare Database
Option Explicit
Private Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As Long
Private Declare Function apiDeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hdc As Long) As Long
Private Declare Function apiDeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal obj As Long) As Long
Private Declare Function apiCreateFont Lib "gdi32" Alias "CreateFontA" _
(ByVal LH As Long, _
ByVal LW1 As Long, _
ByVal LE As Long, _
ByVal LO As Long, _
ByVal LW As Long, _
ByVal LI As Long, _
ByVal LU As Long, _
ByVal LS As Long, _
ByVal LC As Long, _
ByVal LOP As Long, _
ByVal LCP As Long, _
ByVal LQ As Long, _
ByVal LPAF As Long, _
ByVal LFN As String) As Long
Private Declare Function apiCreateIC Lib "gdi32" Alias "CreateICA" _
(ByVal DriverName As String, _
ByVal DeviceName As String, _
ByVal Output As String, _
InitData As Any) As Long
Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _
(ByVal hdc As Long, _
ByVal Index As Long) As Long
Private Declare Function apiSelectObject Lib "gdi32" Alias "SelectObject" _
(ByVal hdc As Long, _
ByVal obj As Long) As Long
Private Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" _
(ByVal hWnd As Long, _
ByVal hdc As Long) As Long
Private Declare Function apiMulDiv Lib "kernel32" Alias "MulDiv" _
(ByVal Number As Long, _
ByVal Numerator As Long, _
ByVal Denumerator As Long) As Long
Private Declare Function apiDrawText Lib "user32" Alias "DrawTextA" _
(ByVal hdc As Long, _
ByVal str As String, _
ByVal Count As Long, _
Rect As Rect, _
ByVal Format As Long) As Long
Private Const PixelsLog = 90
Private Const Twips = 1440
Private Const DT_Top = &H0
Private Const DT_Left = &H0
Private Const DT_WordBreak = &H10
Private Const DT_CalcRect = &H400
Private Type Rect
Top As Long
Left As Long
Right As Long
Bottom As Long
End Type
Public Function CanGrow(ctl As Control) As Integer
Dim Rect As Rect
Dim hWnd As Long
Dim hdc As Long
Dim Ydpi As Long
Dim FontNew As Long
Dim FontOld As Long
Dim FontHeight As Long
Dim Ret As Long
Dim Ic As Long
If IsNull(ctl.FontSize) Then
Exit Function
End If
If TypeOf ctl Is TextBox Then
If Len(ctl & vbNullString) = 0 Then
Exit Function
End If
End If
If TypeOf ctl Is Label Then
If Len(ctl.Caption & vbNullString) = 0 Then
Exit Function
End If
End If
hWnd = ctl.Parent.hWnd
If hWnd = 0 Then
Exit Function
End If
hdc = apiGetDC(hWnd)
Ret = 0
Ic = apiCreateIC("Display", vbNullString, vbNullString, vbNullString)
If Ic <> 0 Then
Ydpi = apiGetDeviceCaps(Ic, PixelsLog)
apiDeleteDC (Ic)
Else
Ydpi = 120
End If
FontHeight = apiMulDiv(ctl.FontSize, Ydpi, 72)
With ctl
FontNew = apiCreateFont(-FontHeight, 0, 0, 0, .FontWeight, .FontItalic, .FontUnderline, 0, 0, 0, 0, 0, 0, .FontName)
End With
FontOld = apiSelectObject(hdc, FontNew)
With Rect
.Top = 0
.Left = 0
.Right = ctl.Width / (Twips / Ydpi)
.Bottom = 0
If TypeOf ctl Is TextBox Then
Ret = apiDrawText(hdc, ctl, -1, Rect, DT_WordBreak + DT_CalcRect + DT_Top + DT_Left)
End If
If TypeOf ctl Is Label Then
Ret = apiDrawText(hdc, ctl.Caption, -1, Rect, DT_WordBreak + DT_CalcRect + DT_Top + DT_Left)
End If
Ret = apiSelectObject(hdc, FontOld)
apiDeleteObject (FontNew)
Ret = apiReleaseDC(hWnd, hdc)
.Bottom = .Bottom * (Twips / Ydpi)
ctl.Height = .Bottom + (.Bottom * 0.005) + 31
End With
CanGrow = ctl.Height
End Function
Но работает он не совсем корректно.
При разном количестве текста, то добавляет пустую строку,
то в данном случае урезает последнюю строку.
И текст отображается не весь.
------------------------------------------
Как сделать,
Чтобы все строки текста правильно отображались
в Главной пдч на Главной форме?
Архив мдб
