Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0226: Text in beliebigem Winkel drehen

 von 

Beschreibung 

Text kann in Form von Grafik in beliebigen Winkeln gedreht werden. Zu beachten ist hierbei, daß dies nur mit TrueType Schriftarten funktioniert.

Schwierigkeitsgrad:

Schwierigkeitsgrad 1

Verwendete API-Aufrufe:

CreateFontA (CreateFont), DeleteObject, SelectObject, TextOutA (TextOut)

Download:

Download des Beispielprojektes [2,4 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"

Option Explicit
 
Private Declare Function CreateFont Lib "gdi32" Alias _
        "CreateFontA" (ByVal H As Long, ByVal W As Long, _
        ByVal E As Long, ByVal O As Long, ByVal W As _
        Long, ByVal I As Long, ByVal u As Long, ByVal S _
        As Long, ByVal C As Long, ByVal OP As Long, ByVal _
        CP As Long, ByVal Q As Long, ByVal PAF As Long, _
        ByVal F As String) 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 Declare Function TextOut Lib "gdi32" Alias "TextOutA" _
        (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
        ByVal lpString As String, ByVal nCount As Long) As Long
 
Dim x&, y&

Private Sub Form_Activate()
  Form1.WindowState = 2
  x = Screen.Width / Screen.TwipsPerPixelX / 2
  y = Screen.Height / Screen.TwipsPerPixelY / 2
End Sub

Private Sub Command1_Click()
  Call Rotate
End Sub

Private Sub Command2_Click()
  Me.AutoRedraw = True
  Me.Cls
  Me.Refresh
  Me.AutoRedraw = False
End Sub

Sub Rotate()
  Dim z&, n%
  
    n = 60
    Me.AutoRedraw = True
    For z = 0 To 360 Step 15
      If n > 10 Then
        n = n - 2
      Else
        If n > 2 Then n = n - 1
      End If
      Call TOut(x, y, z, n, "    Textausgabe")
    Next z
    Me.Refresh
    Me.AutoRedraw = False
End Sub

Private Sub TOut(x&, y&, Winkel&, Size%, Text$)
  Dim hFont&, FontMem&, Bold&, Result&
 
    If Me.FontBold Then
      Bold = 700
    Else
      Bold = 400
    End If
 
    hFont = CreateFont(-Size, 0, Winkel * 10, 0, Bold, _
            Me.FontItalic, Me.FontUnderline, 0, 1, 4, &H10, _
            2, 4, Me.FontName)
 
    FontMem = SelectObject(Me.hdc, hFont)
    Result = TextOut(Me.hdc, x, y, Text, Len(Text))
    Result = SelectObject(Me.hdc, FontMem)
    Result = DeleteObject(hFont)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 16 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von am 14.07.2010 um 17:35

Nehme alles zurück. Das Ineinanderschreiben kam nur beim von dieser Seite kopierten Code vor. Bei Verwendung des Beispielprojekts vom Download funktionierte die gedrehte Ausgabe.

Kommentar von am 14.07.2010 um 17:30

Die Form wird beim Start maximiert und bei Click auf Button1 der String "Textausgabe" in der Bildschirmmitte x-fach in wachsender Größe übereinandergeschrieben.
Der Winkel verändert sich nicht, nur der x-Wert wandert um einige Millimeter.

Kommentar von Volker am 19.03.2009 um 23:08

Hallo,

vielen Dank an Tom für die schönen Hinweise zum Drucken mit TOut! Funktioniert super!

Auf verschiedenen Druckern ergibt sich jedoch das Problem, dass die Fontsizes der Drucker extrem unterschiedlich zu den Fontsizes im VB-Formular sein können.

Um dieses Problem zu beheben und auch auf dem Drucker immer die richtige Fontgröße zu haben, ist eine Umrechnung der logischen Fontgröße in die physikalische Größe auf dem Drucker nötig. Dies kann man mit GetDeviceCaps() bewerkstelligen.

Hierzu sind zuerst folgende, zusätzliche Deklarationen nötig:

Private Const LOGPIXELSY = 90

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDC As Long, _
ByVal nIndex As Long) As Long

Private Declare Function MulDiv Lib "kernel32.dll" ( _
ByVal nNumber As Long, _
ByVal nNumerator As Long, _
ByVal nDenominator As Long) As Long


In der Prozedur TOut() muss zudem der Aufruf von CreateFont() modifiziert werden. Die Fontsize darf nicht direkt übergeben werden, sondern muss vorher noch umgerechnet werden. Der Aufruf sieht dann folgendermaßen aus:

hFont = CreateFont(MulDiv(CLng(-Size), GetDeviceCaps(hPrinterDC, LOGPIXELSY), 72&), _
0, Winkel * 10, 0, Bold, Me.FontItalic, Me.FontUnderline, _
0, 1, 4, &H10, 2, 4, Me.FontName)


Schöne Grüße, Volker

Kommentar von Chris am 13.03.2008 um 01:28

Hi,

mal eine ganz andere Frage...wie kann man einen Zeilenumbruch darstellen? Es kommen nur diese Bekannten..unschönen Zeichen.

Danke ;)

Chris

Kommentar von cadcam am 12.03.2004 um 16:55

Kommentar für Win XP:

Für Winkel mit 0, 90, 180 und 270 Altgrad ergeben sich Lageabweichungen des Text-Referenzpunktes gegenüber anderen Winkeln. Unter Win 98 ist das z.B. nicht der Fall (zum Ausprobieren einfach einen gleich großen Text drehen lassen). Die Ursache erforsche ich noch.

Kommentar von krage am 10.03.2004 um 08:38

Die Textausgabe erfolgt mit der Farbe schwarz und auf weißem Hintergrund. Wie kann ich die Farben ändern?

Freundliche Grüße
Gerold

Kommentar von cadcam am 08.03.2004 um 19:46

Das drehen funktioniert unter WIN98 einwandfrei. Unter WIN XP erhält man für Winkel von 0 und leicht verschiedene Winkel z.B. 1 , 2 usw. starke vertikale Abweichungen gegenüber 0 und damit keine "saubere" Drehung. Wer weiß Rat (XP-Update, Patch)?

Kommentar von Tom am 22.08.2003 um 21:37

Habe auch lange damit gekämpft, aber so gehts:
1)
Der Drucker benötigt ein "StartDoc" und ein "StartPage" aus der "gdi32.dll", bevor man mit API-Befehlen herumzeichnen kann. Noch einfacher geht's mit:

Line (-1,-1)-(-1,-1)

Hier wird automatisch ein "StartDoc" und "StartPage" ausgeführt.
2)
In der Prozedur "TOut" darf man nicht mit "Printer.hDC" statt "Me.hDC" werken. Stattdessen muss vorher eine Long-Variable definiert werden:
Dim hPrinterDC As Long
hPrinterDC = Printer.hDC

Warum das so is, weiß ich nicht.

Tom.

Kommentar von Sham Peterson am 30.07.2002 um 18:01

Hi,
auch ich habe an diesem Druckerproblem gekämpft, später aber festgestellt, dass der Drucker selbst nicht das Problem zu sein scheint. Wenn ich das Programm in eine Form ohne Titelleiste und so kopiere, funktioniert es schon nicht. Alles sehr seltsam, für Tipps wäre also auch ich sehr dankbar!
Grüße, Sham.

Kommentar von Alex am 03.04.2002 um 15:45

Na, da schließ ich mich doch gleich mal an: Ich kämpfe auch gerade mit dem Problem, diesen Tipp auf die Druckausgabe zu übertragen.
Erstaunlich eigentlich, dass das Problem offenbar bisher noch niemand gelöst hat, obwohl es doch schon über ein Jahr bekannt ist...

Kommentar von Bernd am 26.03.2002 um 16:33

Auch ich bin nach stundenlangem Probieren nicht draufgekommen, wie man gedrehten Text auf den Drucker ausgeben kann. Wer kann mir helfen ??

Kommentar von mirko am 11.02.2002 um 21:44

Text in beliebigem Winkel drehen
Wie kann man gedrehten Text auf dem Drucker darstellen?

Kommentar von sven brodowski am 28.01.2002 um 22:38

wie kann man den Inhalt einer Picture1 auf den drucker genau positionieren

Kommentar von Lothar Post am 26.06.2001 um 08:51

Text in beliebigem Winkel drehen
Wie kann man gedrehten Text auf dem Drucker darstellen?

Kommentar von SAP* am 18.05.2001 um 09:50

Das Beispiel funktioniert auch tadellos auf einer Picturebox. Einfach im Code Me. durch Picture1. ersetzen

Kommentar von René am 07.03.2001 um 02:08

Hallo. Habe "Text in beliebigem Winkel drehen" auf Formularen ausprobiert und es funktioniert. Was aber nicht funktioniert ist, wenn ich statt dem Formular-Objekt das Printer-Objekt benutze. Der Text wird nicht gedreht auf dem Drucker ausgedruckt. Wie kann man gedrehten Text auf dem Drucker darstellen?