-Ïîèñê ïî äíåâíèêó

Ïîèñê ñîîáùåíèé â rss_sql_ru_access_programming

 -Ïîäïèñêà ïî e-mail

 

 -Ïîñòîÿííûå ÷èòàòåëè

 -Ñòàòèñòèêà

Ñòàòèñòèêà LiveInternet.ru: ïîêàçàíî êîëè÷åñòâî õèòîâ è ïîñåòèòåëåé
Ñîçäàí: 16.03.2006
Çàïèñåé:
Êîììåíòàðèåâ:
Íàïèñàíî: 4


Çàïèñü 4 - Õî÷ó óâèäåòü ÷óäåñà

Ñðåäà, 13 Ìàðòà 2019 ã. 13:02 + â öèòàòíèê
Çäðàâñòâóéòå!
---------------

È òàê,
Íà Ãëàâíîé ôîðìå ðàñïîëàãàåòñÿ Êîìáîáîêñ è Ãëàâíàÿ ïä÷.
Ïðè âûáîðå çàïèñè â Êîìáîáîêñå,
èíôîðìàöèÿ îòîáðàæàåòñÿ â Ãëàâíîé ïä÷.

Âûñîòà Ãëàâíîé ïä÷ íà Ãëàâíîé ôîðìå
çàâèñèò îò ñîäåðæèìîãî Ïîëÿ1(ìåìî â òàáëèöå). íà Ãëàâíîé ïä÷.
---------------
Èñïîëüçóþ òàêîé ìîäóëü.
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


Íî ðàáîòàåò îí íå ñîâñåì êîððåêòíî.
Ïðè ðàçíîì êîëè÷åñòâå òåêñòà, òî äîáàâëÿåò ïóñòóþ ñòðîêó,
òî â äàííîì ñëó÷àå óðåçàåò ïîñëåäíþþ ñòðîêó.
È òåêñò îòîáðàæàåòñÿ íå âåñü.
------------------------------------------
Êàê ñäåëàòü,
×òîáû âñå ñòðîêè òåêñòà ïðàâèëüíî îòîáðàæàëèñü
â Ãëàâíîé ïä÷ íà Ãëàâíîé ôîðìå?

Àðõèâ ìäá

https://www.sql.ru/forum/1310128/zapis-4-hochu-uvidet-chudesa


 

Äîáàâèòü êîììåíòàðèé:
Òåêñò êîììåíòàðèÿ: ñìàéëèêè

Ïðîâåðêà îðôîãðàôèè: (íàéòè îøèáêè)

Ïðèêðåïèòü êàðòèíêó:

 Ïåðåâîäèòü URL â ññûëêó
 Ïîäïèñàòüñÿ íà êîììåíòàðèè
 Ïîäïèñàòü êàðòèíêó