Die Community zu .NET und Classic VB.

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

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

 von ActiveVB

Schwierigkeitsgrad:

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 --------------