Font autosize access
leku
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.
pozdrawiam
leku
Krzysztof Pozorek
Access nie ma takich wbudowanych mozliwosci.
Ale nie ma rzeczy niemozliwych, trzeba kombinowac. Przepis na sukces:
- jeden BraZby
- jakies API
i to wszystko ;-)
K.P.
BraZby
Użytkownik "Krzysztof Pozorek" <acc...@vis.pl> napisał w wiadomości
news:g83l98$a9a$1...@news.onet.pl...
[...]
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
BraZby
Użytkownik "BraZby" <bra...@BEZTEGOpoczta.onet.pl> napisał w wiadomości
news:g84aa9$np9$1...@news.onet.pl...
>
POPRAWKA:
[...]
> Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
> Dim lHeightTmp As Long
>
> With rpt
[...]
> ' 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
Me.TxtLabel.FontSize = .txtTest.FontSize -1
^^^^^^^^^^^^^^^^^^^^^^^^^
ponieważ wyjście z pętli Do ... Loop następuje po przekroczeniu
rozmiaru pionowego więc musimy wielkość czcionki zmniejszyć o 1 pt.
--
Pozdrowienia
BraZby
PS.
Jest to mój ostatni post przez najbliższe 2 tygodnie.
Wyjeżdżam na urlop.
BraZby
leku
> 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,
...
> Powinno zadziałać.
> Resztę dopasuj sobie sam.
>
Dzięki za pomoc. Biorę się za testy.
pozdrawiam
leku