vb@rchiv · Tipps & Tricks · Das senkrecht beschriftete Label

Rubrik: Controls · Sonstiges | VB-Versionen: VB6

07.09.10

Das senkrecht beschriftete Label Problem: Senkrechte Beschriftungen (z.B. für Achsen). Textbeschriftungen in verschiedenen Richtungen erfordern meist einigen Aufwand und einige APIs...
Autor: Horst Laubmann	Bewertung:	Views: 26.158
ohne Homepage	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Problem: Senkrechte Beschriftungen (z.B. für Achsen).
Textbeschriftungen in verschiedenen Richtungen erfordern meist einigen Aufwand und einige APIs. Dabei reicht ein senkrecht beschriftetes Label oft aus!
Lösung: Das senkrecht beschriftete Label.

Erstellen Sie ein neues Projekt und platzieren auf die Form:

Label (Lbl_senkrecht)
Linie (Line1)
2 Schaltflächen (Command1, Command2)

Option Explicit
 
' -------------------------------------------------------------------
' LABELS zur senkrechten Beschriftung benutzen.
' müsste mit alle Version von VB funktionieren.
' Horst Laubmann
' -------------------------------------------------------------------
' Ein beliebiges Label zur senkrechten Beschriftung benutzen!
' Die Schriftausrichtung wird dabei nicht geändert!
' Die Größenanpassung erfolgt automatisch.
' Nachträgliche Änderungen (Inhalt / Font / Größe) kein Problem.
'
' Die Einfärbung des Labels dient zum Zeigen der Veränderung!
' Die Linie und der Kreis dienen nur der Positionsorientierung!
'
' Netter Nebeneffekt: Schalten Sie mal mit den Tasten hin und her!
' In Abwandlung auch für die Formatierung von Zahlenkolonnen denkbar.
' -------------------------------------------------------------------

Private Sub Form_Load()
  ' Controls positionieren
  With Me.Lbl_senkrecht
    .Alignment = 2
    .AutoSize = True
    .Caption = "SENKRECHT"
    .BackColor = &HFFFF&
    .Move 420, 360, 1428, 600
  End With
 
  With Me.Line1
    .X1 = 960
    .X2 = 960
    .Y1 = 120
    .Y2 = 4200
  End With
 
  With Command1
    .Caption = "andere Schrift"
    .Move 2160, 360, 1485, 330
  End With
 
  With Command2
    .Caption = "etwas breiter"
    .Move 2160, 840, 1485, 330
  End With
 
  ' Label senkrecht beschriften
  ' dazu AutoSize auf 'true' und Alignment auf 'zentriert'
  Call funLabelVertikal(Lbl_senkrecht)
 
  ' nur zur Info für Positionierung: Ursprung des Labels kennzeichnen
  Circle (Lbl_senkrecht.Left, Lbl_senkrecht.Top), Lbl_senkrecht.Width
End Sub

Public Function funLabelVertikal(objLabel As Object)
  'jedes Label wird bearbeitet, da als Objekt übergeben
  Dim iA As Integer
  Dim strA As String
  Dim strB As String
 
  strA = objLabel.Caption
  strB = ""
  For iA = 1 To Len(strA) - 1
    ' zeichenweise plus Zeilenumbruch
    strB = strB & Mid$(strA, iA, 1) & Chr$(10)
  Next iA
  ' plus letztes Zeichen ohne Zeilenumbruch = sonst 'Leerzeichen' am Ende!
  strB = strB & Right$(strA, 1)
  objLabel.Caption = strB
  ' objLabel.Refresh
End Function

Private Sub Command1_Click()
  ' auch ein Schriftwechsel ist kein Problem
  ' Anordnung bleibt mittig!
  Lbl_senkrecht.Font = "Arial Rounded MT Bold"
  Lbl_senkrecht.FontSize = 16
  Form1.Cls
  Circle (Lbl_senkrecht.Left, Lbl_senkrecht.Top), Lbl_senkrecht.Width
End Sub

Private Sub Command2_Click()
  ' doppelte Breite bitte
  ' Anordnung verschiebt sich!
  Lbl_senkrecht.Width = Lbl_senkrecht.Width * 2
End Sub