Unser nachfolgender Tipp zeigt, wie sich ein beliebiger Text in einer beliebigen Schriftart um 90° gegen den Uhrzeigersinn ausgeben lässt. Die Ausgabe kann auf einer Form, einer PictureBox oder auch auf den Drucker erfolgen. Um die Rotation zu realisieren wird über die LOGFONT-Struktur und der CreateFontIndirect-Funktion eine "neue" Schriftart erzeugt. Nach dem Ausgeben des Textes in der neuen Schriftart wird diese dann über DeleteObject wieder gelöscht. Und hier der Code: ' zunächst die benötigten API-Deklarationen Private Declare Function CreateFontIndirect Lib "gdi32" _ Alias "CreateFontIndirectA" ( _ lpLogFont As LOGFONT) As Long Private Declare Function SelectObject Lib "gdi32" ( _ ByVal hDC As Long, _ ByVal hObject As Long) As Long Private Declare Function DeleteObject Lib "gdi32" ( _ ByVal hObject As Long) As Long Private Const LF_FACESIZE = 32 Private Const ANTIALIASED_QUALITY = 4 Private Const FW_NORMAL = 400 Private Const FW_BOLD = 700 Private Const DEFAULT_CHARSET = 1 Private Const OUT_TT_PRECIS = 4 Private Const VARIABLE_PITCH = 2 Private Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName As String * LF_FACESIZE End Type ' Text um 90° gedreht ausgeben Private Function PrintRotatedText(prnObj As Object, _ ByVal Text As String) As Boolean Dim RotFont As LOGFONT Dim OrgFont As Long Dim hFont As Long Dim X As Single Dim Y As Single Dim xSize As Long Dim ySize As Long Const Winkel = 90 On Local Error GoTo Error_PrintRotatedText With prnObj ' LOGFONT definieren With RotFont .lfEscapement = CLng(Winkel * 10) .lfFaceName = prnObj.Font.Name .lfHeight = prnObj.Font.Size * -20 / _ Screen.TwipsPerPixelY .lfWeight = IIf(prnObj.Font.Bold, FW_BOLD, FW_NORMAL) .lfItalic = IIf(prnObj.Font.Italic, 1, 0) .lfOutPrecision = OUT_TT_PRECIS .lfQuality = ANTIALIASED_QUALITY .lfCharSet = DEFAULT_CHARSET .lfPitchAndFamily = VARIABLE_PITCH End With ' Font-Objekt erzeugen und zuweisen hFont = CreateFontIndirect(RotFont) OrgFont = SelectObject(.hDC, hFont) ' Größe (Maße) des Textes xSize = .TextWidth(Text) ySize = .TextHeight(Text) ' Position Y = .CurrentY + xSize X = .CurrentX .CurrentX = X .CurrentY = Y ' Text ausgeben prnObj.Print Text ' Originalfont wiederherstellen SelectObject .hDC, OrgFont ' neuen Font löschen DeleteObject hFont End With PrintRotatedText = True Exit Function Error_PrintRotatedText: PrintRotatedText = False End Function Beispiele: ' Ausgabe auf aktuelle Form With Me.Font .Name = "Arial" .Size = 14 .Bold = True End With PrintRotatedText Me, "HALLO" ' Ausgabe auf Drucker With Printer.Font .Name = "Arial" .Size = 14 .Bold = True End With PrintRotatedText Printer, "www.vbarchiv.de" Dieser Tipp wurde bereits 17.720 mal aufgerufen.
Anzeige
![]() ![]() ![]() (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevISDN 1.0 ![]() Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats ![]() Dieter Otter PopUp-Menü wird nicht angezeigt :-( In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. Neu! sevPopUp 2.0 ![]() Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |