Manipulasi string dengan menjadikannya segitiga bolak-balik

Oleh Unknown

Thursday, 9 May 2013

Bagikan :

Tweet

1. siapin komponen2 dlu kya gini : 2 Textbox, 2 Button
2. jangan ubah namanya, ubah captionnya aja di menu Properties. susun komponen terserah agan, klo ane kya gini

kotak yg paling gede itu Text2, yg kecil Text1, button yg kiri Command1, yg kanan Command2
tambahin ScrollBars pada Text2 nya. caranya tinggal arahin pointer ke Text2, trus cari ScrollBars di menu Properties, pilih Both, otomatis akan menambahkan scrollbars vertikal dan horizontal pada Text2
3. klo udah, klik 2 kali Command1 nya, trus masukin kode ini

If Text1.Text = "" Then
    MsgBox ("kotak masih kosong"), vbInformation, "!!"
End If
If Len(Text1.Text) = 1 Then
    MsgBox ("string harus lebih dari satu"), vbInformation, "!!"
End If
If Text1.Text <> "" And Len(Text1.Text) <> 1 Then
    Text2.Text = Clear
    Dim a, a2, panjang, spasi1, b, c, c2 As Integer
    Dim str As String
    str = Trim(Text1.Text)
    panjang = Len(str)
    spasi1 = 2
    For b = panjang To 1 Step -1
    c = b
    c2 = 2
    For a = 1 To b
        Text2.Text = Text2.Text & Space(c) & Right(str, a) & StrReverse(Right(str, a)) & vbCrLf
        c = c - 1
    Next a
    For a2 = b - 1 To 1 Step -1
        Text2.Text = Text2.Text & Space(c2) & Right(str, a2) & StrReverse(Right(str, a2)) & vbCrLf
        c2 = c2 + 1
    Next a2
    Text2.Text = Text2.Text & vbCrLf
    Next b
End If

4. klik 2 kali Command2, masukin :

'ini cuma untuk ngehapus text nya aja gan 
Text1.Text = Clear
Text2.Text = Clear

5. klik 2 kali Form1 nya, sampai agan diarahin ke baris kode kya gini

Private Sub Form_Load()

End Sub

dan masukin ini antara 2 baris kode tsb :

'untuk mengeset font menjadi courier new 
Dim f As New StdFont
f = "Courier New"
Text2.Font = f

alasan ane pilih courier new adalah karena keunikan font tsb, sebab menghasilkan jarak antar spasi yg sama antar string nya, coba agan ganti ama font yg lain, ntar gak beraturan hasilnya 6. klo mw agar Form1 nya gak bisa di ubah sizenya, pilih BorderStyle pada Properties nya, trus pilih Fixed Singleini kode lengkapnya

Private Sub Command1_Click()
If Text1.Text = "" Then
    MsgBox ("kotak masih kosong"), vbInformation, "!!"
End If
If Len(Text1.Text) = 1 Then
    MsgBox ("string harus lebih dari satu"), vbInformation, "!!"
End If
If Text1.Text <> "" And Len(Text1.Text) <> 1 Then
    Text2.Text = Clear
    Dim a, a2, panjang, spasi1, b, c, c2 As Integer
    Dim str As String
    str = Trim(Text1.Text)
    panjang = Len(str)
    spasi1 = 2
    For b = panjang To 1 Step -1
    c = b
    c2 = 2
    For a = 1 To b
        Text2.Text = Text2.Text & Space(c) & Right(str, a) & StrReverse(Right(str, a)) & vbCrLf
        c = c - 1
    Next a
    For a2 = b - 1 To 1 Step -1
        Text2.Text = Text2.Text & Space(c2) & Right(str, a2) & StrReverse(Right(str, a2)) & vbCrLf
        c2 = c2 + 1
    Next a2
    Text2.Text = Text2.Text & vbCrLf
    Next b
End If
End Sub

Private Sub Command2_Click()
Text1.Text = Clear
Text2.Text = Clear
End Sub

Private Sub Form_Load()
Dim f As New StdFont
f = "Courier New"
Text2.Font = "Courier New"
End Sub

klo mw versi c++ nya buka yg ini gan

Tag : Programming, VB6