Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0429: Blocksatz in einer PictureBox ermöglichen

 von 

Beschreibung 

Mit etwas Rechenaufwand und der vorgestellten API läßt sich ein Blocksatz in einem grafischen Element erzielen. Funktioniert also nicht in bei TextBox und Konsorten.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

SetTextJustification

Download:

Download des Beispielprojektes [2,7 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 "Command1"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Textfeld "Text1"

Option Explicit

Private Declare Function SetTextJustification Lib "gdi32" _
        (ByVal hdc As Long, ByVal nBreakExtra As Long, _
        ByVal nBreakCount As Long) As Long

Private Sub Form_Load()
    Dim Text As String, x As Integer
    
    Text = "Dies ist ein Text, der im Blocksatz ausgegeben" & _
           "werden soll! Viel Vergnügen."
    
    For x = 1 To 3
        Text = Text & Text
    Next x
    
    Text1.Text = Text
End Sub

Private Sub Command1_Click()
    Dim i As Integer, Weite As Integer
    
    Weite = 180
    
    Picture1.Cls
    BlockSatz Picture1, Text1.Text, 0, 0, Weite

    Picture1.Height = Picture1.CurrentY * Screen.TwipsPerPixelY
End Sub

Sub BlockSatz(Pic As Object, ByVal Text$, X1%, Y1%, Breite%)
    Dim Sp As Integer, Sp1 As Integer, SPcount As Integer
    Dim T As String
    Dim Tl As Integer, Tl1 As Integer
    Dim Res As Long
   
    With Pic
        .CurrentY = Y1
        Sp = 0
        SPcount = 0
        
        Do
            Sp1 = InStr(Sp + 1, Text, " ")
            If Sp1 = 0 Then
                Sp1 = Len(Text) + 1
            Else
                SPcount = SPcount + 1
            End If
            
            Tl1 = .TextWidth(Left$(Text, Sp1 - 1))
            
            If Tl1 > Breite Or Sp > Len(Text$) Then
                If Sp1 <= Len(Text) And SPcount > 2 Then
                    Res = SetTextJustification(.hdc, Breite - Tl, SPcount - 2)
                End If
                
                T = Left$(Text, Sp - 1)
                .CurrentX = X1
                Pic.Print T
                
                Res = SetTextJustification(.hdc, 0, 10)
                Text = Mid$(Text, Sp + 1)
                
                SPcount = 0
                Sp = 0
            Else
                Sp = Sp1
            End If
            
            Tl = Tl1
        Loop While Len(Text)
    End With
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.