Memposisikan Teks (Metode Warpping)

Topik sebelumnya Topik selanjutnya Go down

Memposisikan Teks (Metode Warpping)

Post by PujanggaBageur on Thu Aug 07, 2008 10:38 pm

Bisakah Anda mengkode PictureBox agar dapat menampilkan cetakan teks? Jika tidak bisa, mudah saja, kok! Cukup ketik kode berikut ini:

Code:
NamaPictureBox.Print "Teks yang akan dicetak"

Maka, pada sebuah PictureBox akan tercetak teks tersebut. Tetapi, bagaimana jika teks terlalu panjang, sementara lebar PictureBox tersebut terbatas (dimana kode di atas hanya dapat mencetak teks dalam satu baris, sehingga jika panjang teks melampaui lebar PictureBox maka teks tidak akan tercetak seluruhnya)?

Jawabnya adalah memposisikan teks menjadi beberapa baris.

Buatlah project baru, tambahkan kontrol PictureBox, dan kontrol Command Button. Lalu ketik kode di bawah ini:

Code:

Sub PosisisikanTeks(ctl As Object, Teks As String)

    Dim Posisi As Long
    Dim PosisiKosong As Long
    Dim Lebar As Single
   
    Lebar = ctl.ScaleWidth '<--- ubah nilai lebar sesuai kebutuhan
   
    'ctl.AutoRedraw = True
   
    'Set Posisi awal pencetakan
    ctl.ScaleLeft = -100
    ctl.ScaleTop = -100
   
    'Kosongkan
    ctl.Cls
   
    'Pengulangan sepanjang teks
    Do While Posisi < Len(Teks)
        Posisi = Posisi + 1
        If Mid$(Teks, Posisi, 2) = vbCrLf Then
            'Jika menemukan karakter CR-LF
            'cetak teks sebelum karakter CR-LF
            ctl.Print Left$(Teks, Posisi - 1)
           
            'Set ulang variable-variabel.
            Teks = LTrim$(Mid$(Teks, Posisi + 2))
            Posisi = 0
            PosisiKosong = 0
        ElseIf Mid$(Teks, Posisi, 1) = " " Then
            'Jika menemukan spasi, simpan posisi
            'untuk digunakan selanjutnya
            PosisiKosong = Posisi
        End If

        'Jika teks terlalu panjang (melebihi lebar kontrol)
        If ctl.TextWidth(Left$(Teks, Posisi)) > _
        Lebar + (2 * ctl.ScaleLeft) Then
            'Jika teks terlalu panjang, teks akan dipenggal
            'menurut posisi spasi yang ditemukan
           
            If PosisiKosong Then Posisi = PosisiKosong
           
            'Cetak penggalan teks
            ctl.Print Left$(Teks, Posisi - 1)
           
            'Set ulang variable-variabel.
            Teks = LTrim$(Mid$(Teks, Posisi))
            Posisi = 0
            PosisiKosong = 0
        End If
    Loop
    'Cetak semua teks
    If Len(Teks) Then ctl.Print Teks

    'Note: silakan ubah nilai variabel Lebar dengan suatu nilai Single
    'contoh: Lebar = 2000
End Sub

Private Sub Form_Load()
    Text1.Text =  "Orang yang bergolongan darah AB " & _
        "mempunyai perasaan yang sensitif, lembut. " & _
        "Mereka penuh perhatian dengan perasaan " & _
        "orang lain dan selalu menghadapi orang lain " & _
        "dengan kepedulian serta kehati-hatian. " & _
        " Disamping itu mereka keras dengan " & _
        " diri mereka sendiri juga dengan orang-orang " & _
        "yang dekat dengannya."
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Me.Picture1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub

PrivateSub Command1_Click()
    PosisisikanTeks Me.Picture1, Me.Text1.Text
    End doc
End Sub

PujanggaBageur
Admin
Admin

Jumlah posting : 148
Join date : 07.08.08
Age : 34
Lokasi : Cirebon

Lihat profil user http://inochi.forumotion.net

Kembali Ke Atas Go down

Topik sebelumnya Topik selanjutnya Kembali Ke Atas

- Similar topics

 
Permissions in this forum:
Anda tidak dapat menjawab topik