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 :

VB6

• Project - SMS Gateway Sederhana Dengan ActiveXpert
• Runtime Error 430 - Class Does Not Support Automation or Does Not Support Expected Interface
• Functions for calculating the Min, Max and StdDev
• Recordset Sementara Dengan Desimal
• Mengambil Log Data di Fingerprint CZKEM
• Multi Column Combo Box ActiveX
• Show Data With Store Procedure And RecordSet In VB6
• Hapus User Info di Fingerprint CZKEM
• Koneksi Fingerprint CZKEM
• Wrap Text Function (VB 6)
• Copy Paste Clipboard
• Cegah Aplikasi Visual Basic Bisa Dijalankan Dua Kali
• 10 Tips and Trick Visual Basic From Vb Bego Forum
• Mencari Tanggal Terakhir di Suatu Bulan
• Menonaktifkan tombol Maximize yang terdapat di MDIForm
• Getting the Windows and System Directory
• Disable Tombol Maximize di MDIForm
• Make a form with a gradient background

Tips Trik

• Tricks for Paging and Row Offset in Various Versions of SQL Server
• Runtime Error 430 - Class Does Not Support Automation or Does Not Support Expected Interface
• Functions for calculating the Min, Max and StdDev
• Recordset Sementara Dengan Desimal
• Penomoran Pada DatagridView VB.Net
• Copy Paste Clipboard
• Cegah Aplikasi Visual Basic Bisa Dijalankan Dua Kali
• Optimasi SQL

String

• Wrap Text Function (VB 6)
• Optimasi SQL
• 10 Tips and Trick Visual Basic From Vb Bego Forum
• Mencari Tanggal Terakhir di Suatu Bulan