🚀 go-pugleaf

Użytkownik "Krzysztof Pozorek" <access@vis.pl> napisał w wiadomości
news:g83l98$a9a$1@news.onet.pl...
> (...)
>> Tworzę etykiety za pomocą raportu w Accessie 2003.
>> Jak zrobić aby wielkość czcionki automatycznie dopasowywała się
>> do stałej wielkości pola etykiety ?
>> Ilość wpisywanych znaków max 20.
>> Chodzi o to aby tekst zmieścił się w jednej linii z max możliwą
>> wielkością czcionki.
>
> Access nie ma takich wbudowanych mozliwosci.
>
> Ale nie ma rzeczy niemozliwych, trzeba kombinowac. Przepis na sukces:
> - jeden BraZby
> - jakies API
> i to wszystko ;-)

[...]

No niezupełnie.
Jeden BraZby może (aczkolwiek niekoniecznie),  API niepotrzebne ;-)

Kusiło mnie użycie API, ale dość dawno nie ruszałem API operującego na
tekście więc odpuściłem. Potrzebne funkcje API można znaleźć w przykładach:

2.2. Grawerowanie siekierą, czyli prymitywny "pseudoRTF" w kontrolce Image.
2.3. . Kontynuacja tematu .  czyli jak napisać w pseudoetykiecie tekst
        pionowo w kierunku od dołu do góry ?
na stronie:
http://www.bratki.w.v1.pl/accesspseudofaq/31a_ImgHDCFaq.htm

Ja spróbowałem zrobić to bez API,

'_______________________________
1. Raport pomocniczy rptTest:

Public m_lHeight As Long
Public m_lHeightBis As Long

' utwórz Raport pomocniczy rptTest a na nim dwa formanty TextBox
' identyczne z Twoją etykietą na raporcie głównym ,
' Me.txtTest i ustaw mu CanShrink = True
' Me.txtTestBis i ustaw mu CanShrink = False, ten formant jest potrzebny ,
' w przypadku gdy tekst jest krótki i należy powiększać czcionkę,
' a równocześnie wysokość etykiety jest na tyle wysoko, że pomieści
' dwa lub więcej wierszy

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
    m_lHeight = Me.txtTest.Height '
    m_lHeightBis = Me.txtTestBis.Height
End Sub


Raport roboczy:
'________________________
Private m_lHeight As Long
Private m_lHeightBis As Long
Private m_lFontSize As Long
Private rpt As Report
'_____________________________________
' Twoja etykieta to "txtLabel"
Private Sub Report_Open(Cancel As Integer)

    DoCmd.OpenReport "rptTest", acViewPreview
    Set rpt = Reports("rptTest")

    m_lFontSize = Me.TxtLabel.FontSize

    With rpt
        .Visible = False
        ' ustaw wielkość formantów w "rptTest",  na takie same jak txtLabel
        ' zakładam, że atrybuty czcionki są takie same
        .txtTest.Height = Me.TxtLabel.Height
        .txtTest.Width = Me.TxtLabel.Width
        .txtTestBis.Height = Me.TxtLabel.Height
        .txtTestBis.Width = Me.TxtLabel.Width
        .txtTest.FontSize = m_lFontSize

        .txtTest = "X"
        .txtTestBis = "X"
        ' wymuś odświeżenie raportu
        .txtTest.Visible = False
        .txtTest.Visible = True
        DoEvents
        ' pobierz wymiary pionowe, po wykonaniu
        ' się Detail_Print w "rptTest"
        m_lHeight = .m_lHeight()
        m_lHeightBis = .m_lHeightBis()
    End With

End Sub
'_________________________________________________________
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim lHeightTmp As Long

    With rpt
        ' przywróc wielkość czcionki
        .txtTest.FontSize = m_lFontSize
        ' przypisz aktualny tekst
        .txtTest = Me.TxtLabel.Value
        ' wymuś odświeżenie raportu
        .txtTest.Visible = False
        .txtTest.Visible = True
        DoEvents
        ' pobierz aktualną wysokość formantu w "rptTest"
        lHeightTmp = .m_lHeight()

        If lHeightTmp > m_lHeight Then
            ' za duży formant, zmiejszaj czcionkę
            Do
                .txtTest.FontSize = .txtTest.FontSize - 1
                ' wymuś odświeżenie raportu
                .txtTest.Visible = False
                .txtTest.Visible = True
                DoEvents
                ' pobierz aktualną wysokość formantu
                lHeightTmp = .m_lHeight
            Loop Until lHeightTmp <= m_lHeight

            Me.TxtLabel.FontSize = .txtTest.FontSize

        Else
            ' zwiększ o 1 pkt wielkość czcionki
            .txtTest.FontSize = .txtTest.FontSize + 1
            ' wymuś odświeżenie raportu
            .txtTest.Visible = False
            .txtTest.Visible = True
            DoEvents
            ' pobierz aktualną wysokość formantu
            lHeightTmp = .m_lHeight

            ' sprawdź, jak wymiar pionowy się zmienił
            If lHeightTmp > .m_lHeight Then
                ' nie rób nic, bo wysokość się zwiększyła
            Else
                Do
                    .txtTest.FontSize = .txtTest.FontSize + 1
                    ' wymuś odświeżenie raportu
                    .txtTest.Visible = False
                    .txtTest.Visible = True
                    DoEvents
                    ' pobierz aktualną wysokość formantu
                    lHeightTmp = .m_lHeight
                Loop Until lHeightTmp > m_lHeightBis

                Me.TxtLabel.FontSize = .txtTest.FontSize

            End If
        End If
        'Debug.Print .txtTest.FontSize
    End With

End Sub
Private Sub Report_Close()
    Set rpt = Nothing
End Sub

Powinno zadziałać.
Resztę dopasuj sobie sam.

-- 
Pozdrowienia
BraZby
www.bratki.w.v1.pl/accesspseudofaq