title image


Smiley TIPP: Laufweite eines Fonts ermitteln...
es gibt dazu ein (zugebenermaßen etwas umständliches) Beispiel im DBWiki.



Für Arial hab ich es aber mal ausprogrammiert (müsste mit einem Skalierungsfaktor zumindest grob auch für andere Sansserif-Schriften passen - oder du müsstest die Laufweitentabelle anpassen):



Public Function LaufweiteArial(S As String, FontSize As Long) As Double

Dim A As Variant, I As Long, L As Double

A = Array( _

0.5838, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 1.1676, 18.6809, 18.6809, 18.6809, 18.6809, 18.6809, 0.3221, _

0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.3221, 0.1394, 0.0929, _

0.1044, 0.1394, 0.1698, 0.2076, 0.2076, 0.3459, 0.3221, 0.0929, 0.1394, 0.1394, 0.2076, 0.2365, 0.1044, 0.1394, 0.1044, 0.116, _

0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.116, 0.116, 0.2365, 0.2365, 0.2365, 0.185, _

0.3812, 0.3013, 0.2788, 0.2788, 0.3013, 0.2559, 0.2306, 0.3013, 0.3013, 0.1394, 0.1624, 0.3013, 0.2559, 0.3663, 0.3013, 0.3013, _

0.2306, 0.3013, 0.2788, 0.2306, 0.2559, 0.3013, 0.3013, 0.3892, 0.3013, 0.3013, 0.2559, 0.1394, 0.116, 0.1394, 0.1966, 0.2076, _

0.1394, 0.185, 0.2076, 0.185, 0.2076, 0.185, 0.1394, 0.2076, 0.2076, 0.116, 0.116, 0.2076, 0.116, 0.3221, 0.2076, 0.2076, _

0.2076, 0.2076, 0.1394, 0.1624, 0.116, 0.2076, 0.2076, 0.3013, 0.2076, 0.2076, 0.185, 0.2009, 0.0929, 0.2009, 0.2251, 0.3221, _

0.2076, 0.3221, 0.1394, 0.2076, 0.185, 0.4151, 0.2076, 0.2076, 0.1394, 0.4151, 0.2306, 0.1394, 0.3663, 0.3221, 0.2559, 0.3221, _

0.3221, 0.1394, 0.1394, 0.185, 0.185, 0.1459, 0.2076, 0.4151, 0.1394, 0.4061, 0.1624, 0.1394, 0.3013, 0.3221, 0.185, 0.3013, _

0.1044, 0.1394, 0.2076, 0.2076, 0.2076, 0.2076, 0.0929, 0.2076, 0.1394, 0.3166, 0.1153, 0.2076, 0.2365, 0.1394, 0.3166, 0.2076, _

0.1668, 0.2278, 0.1254, 0.1254, 0.1394, 0.2395, 0.1887, 0.1044, 0.1394, 0.1254, 0.1297, 0.2076, 0.3113, 0.3113, 0.3113, 0.185, _

0.3013, 0.3013, 0.3013, 0.3013, 0.3013, 0.3013, 0.3663, 0.2788, 0.2559, 0.2559, 0.2559, 0.2559, 0.1394, 0.1394, 0.1394, 0.1394, _

0.3013, 0.3013, 0.3013, 0.3013, 0.3013, 0.3013, 0.3013, 0.2365, 0.3013, 0.3013, 0.3013, 0.3013, 0.3013, 0.3013, 0.2306, 0.2076, _

0.185, 0.185, 0.185, 0.185, 0.185, 0.185, 0.2788, 0.185, 0.185, 0.185, 0.185, 0.185, 0.116, 0.116, 0.116, 0.116, _

0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2278, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076, 0.2076)



For I = 1 To Len(S)

L = L + A(Asc(Mid(S, I, 1)))

Next I

LaufweiteArial = (L * FontSize) / 10

End Function





Und dann so etwas wie:



With Me!MeinFeld

Do Until LaufweiteArial(.Value & "", .FontSize) < .Width

.FontSize = .FontSize -1

Loop

Loop


Gruß aus dem Norden

Reinhard


Bitte immer die Access-Version angeben


 



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: