Wrap Text

Mengatur teks agar terpisah di baris selanjutnya.
Modul :

Source Code :

Sub WrapPText(obj As Object, xLeft As Single, xTop As Single, xWidth As Single, strText As String)
    Dim Posisi As Long
    Dim PosisiSpasi As Long
    
    obj.CurrentX = xLeft
    obj.CurrentY = xTop
    
    Do While Posisi < Len(strText)
        Posisi = Posisi + 1
        If Mid$(strText, Posisi, 2) = vbCrLf Then
            obj.CurrentX = xLeft
            obj.CurrentY = xTop
            
            obj.Print Left(strText, Posisi - 1)
            strText = LTrim(Mid(strText, Posisi + 2))
            Posisi = 0:
            PosisiSpasi = 0
        ElseIf Mid$(strText, Posisi, 1) = " " Then
            PosisiSpasi = Posisi
        End If
        'Jika lebar strText melampaui lebar form
        If obj.TextWidth(Left(strText, Posisi)) > (xWidth - 400) Then
            If PosisiSpasi Then
                Posisi = PosisiSpasi
            End If
            
            obj.CurrentX = xLeft
            'obj.CurrentY = xTop + (Posisi * obj.TextHeight(strText))
            
            obj.Print Left(strText, Posisi - 1)
            strText = LTrim(Mid(strText, Posisi))
            Posisi = 0:
            PosisiSpasi = 0
        End If
        DoEvents
    Loop
    If Len(strText) Then
        obj.CurrentX = xLeft
        obj.Print strText
    End If
End Sub

Contoh Penggunaan :

Source Code :

Dim strText As String

Private Sub Form_Resize()
    strText = "Ini adalah teks untuk " & _
    "percobaan wrapping. Posisi teks akan " & _
    "menyesuaikan dengan ukuran " & _
    "lebar form. Bila lebar form terlalu sempit, " & _
    "maka teks akan otomatis " & _
    "berpindah baris."
    
    If Me.WindowState <> vbMinimized Then
        Me.Picture1.Width = Me.ScaleWidth - (2 * Me.Picture1.Left)
        Me.Picture1.Height = Me.ScaleHeight - (2 * Me.Picture1.Top)
        
        Me.Picture1.Cls
        Me.Picture1.CurrentX = 0
        Me.Picture1.CurrentY = 0
        
        WrapPText Me.Picture1, 100, 100, Me.Picture1.Width, strText
    End If
End Sub

Sumber

Related Post :