Guidance
指路人
g.yi.org
software / rapidq / Examples / String & Text / convtoalpha.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
'**************************************
' Convert Number To Alpha
' By Samsul Zakaria
' You can use this code as you will
' no comment .....sorry..:)
' please send me anychange to this code
' *************************************
     DECLARE SUB Edit1Change(key AS BYTE)

     DECLARE SUB convalpha
     CREATE Form AS QFORM:CAPTION ="Convert Number To Alpha":Width = 450:Height = 240:Center
      CREATE label1 AS QLABEL:CAPTION = "Enter number": left = 10: top = 25: END CREATE
      CREATE label2 AS QLABEL:CAPTION = "Result convert to alpha": left = 10: top = 75: END CREATE
      CREATE Edit1 AS QEDIT:Left = 10:Top = 41:Onkeypress = Edit1Change:END CREATE
      CREATE Edit2 AS QEDIT:Left = 10:Top = 90:Width = 400:Height = 105:END CREATE
     END CREATE

     Form.SHOWMODAL

'--------- Subroutines ---------

     SUB Edit1Change (key AS BYTE)
      IF key = 13 THEN CALL convalpha
     END SUB

     SUB convalpha

      DIM panjang AS INTEGER
      DIM panjangd AS INTEGER

      DIM nbrutama AS STRING
      DIM nbrdecimal AS STRING

      DIM hurufsa AS STRING
      DIM hurufpuluh AS STRING
      DIM hurufratus AS STRING
      DIM hurufribu AS STRING
      DIM hurufpuluhribu AS STRING
      DIM hurufratusribu AS STRING
' **********************************************************************
      DEFSTR sa(9)        = {"","satu","dua","tiga","empat","lima","enam","tujuh","lapan","sembilan"}
      DEFSTR puluh(9)     = {"","sepuluh","dua puluh","tiga puluh","empat puluh","lima puluh","enam puluh","tujuh puluh","lapan puluh","sembilan puluh"}
      DEFSTR ratus(9)     = {"","satu ratus","dua ratus","tiga ratus","empat ratus","lima ratus","enam ratus","tujuh ratus","lapan ratus","sembilan ratus"}
      DEFSTR ribu(9)      = {"","satu ribu","dua ribu","tiga ribu","empat ribu","lima ribu","enam ribu","tujuh ribu","lapan ribu","sembilan ribu"}
      DEFSTR puluhribu(9) = {"","sepuluh ribu","dua puluh ribu","tiga puluh ribu","empat puluh ribu","lima puluh ribu","enam puluh ribu","tujuh puluh ribu","lapan puluh ribu","sembilan puluh ribu"}
' **********************************************************************
      panjang = LEN(VAL(FIELD$((edit1.text),".",1)))
      panjangd = LEN(VAL(FIELD$((edit1.text),".",2)))

      SELECT CASE panjang
      CASE 1 'sa
       hurufsa = sa(VAL(edit1.text))
       nbrutama = hurufsa
      CASE 2 'puloh
       IF VAL(edit1.text) <20 AND VAL(edit1.text) > 10 THEN
        IF sa(VAL(MID$(edit1.text,2,1))) = "satu" THEN
         nbrutama = "sebelas"
        ELSE
         hurufsa = sa(VAL(MID$(edit1.text,2,1)))
         nbrutama = hurufsa &"belas"
        END IF
       ELSE
        hurufpuluh = puluh(VAL(LEFT$(edit1.text,1)))
        hurufsa = sa(VAL(MID$(edit1.text,2,1)))
        nbrutama = hurufpuluh & " " & hurufsa
       END IF
      CASE 3 'ratus
       hurufpuluh = puluh(VAL(MID$(edit1.text,2,1)))
       IF VAL(MID$(edit1.text,2,2)) <20 AND VAL(MID$(edit1.text,2,2))  > 10 THEN
        IF sa(VAL(MID$(edit1.text,3,1))) = "satu" THEN
         hurufsa = "sebelas"
        ELSE
         hurufsa = sa(VAL(MID$(edit1.text,3,1)))
         hurufsa = hurufsa &"belas"
        END IF
        hurufpuluh = hurufsa
       ELSE
        hurufsa = sa(VAL(MID$(edit1.text,3,1)))
        hurufpuluh = hurufpuluh & " " & hurufsa
       END IF
       hurufratus = ratus(VAL(LEFT$(edit1.text,1)))'
       nbrutama = hurufratus & " "& hurufpuluh
      CASE 4 'ribu
       hurufribu = ribu(VAL(LEFT$(edit1.text,1)))
       hurufratus = ratus(VAL(MID$(edit1.text,2,1)))
       hurufpuluh = puluh(VAL(MID$(edit1.text,3,1)))
       IF VAL(MID$(edit1.text,3,2)) < 20 AND VAL(MID$(edit1.text,3,2)) > 10 THEN
        IF sa(VAL(MID$(edit1.text,4,1))) = "satu" THEN
         hurufsa = "sebelas"
        ELSE
         hurufsa = sa(VAL(MID$(edit1.text,4,1)))
         hurufsa = hurufsa &"belas"
        END IF
        hurufpuluh = hurufsa
       ELSE
        hurufsa = sa(VAL(MID$(edit1.text,4,1)))
        hurufpuluh = hurufpuluh & " " & hurufsa
       END IF
       hurufsa = sa(VAL(MID$(edit1.text,4,1)))
       nbrutama = hurufribu & " "& hurufratus & " "& hurufpuluh
      CASE 5 'puluhribu
       IF VAL(MID$(edit1.text,1,2)) <20 THEN
        IF sa(VAL(MID$(edit1.text,2,1))) = "satu" THEN
         hurufpuluhribu = "sebelas ribu"
        ELSE
         hurufsa  = sa(VAL(MID$(edit1.text,2,1)))
         hurufsa = hurufsa  & "belas ribu"
         IF hurufsa  = 0 THEN hurufsa  = ""
        END IF
        hurufpuluhribu = hurufsa
       ELSE
        hurufpuluhribu = puluh(VAL(MID$(edit1.text,1,1)))
        hurufsa  = sa(VAL(MID$(edit1.text,2,1)))
        hurufpuluhribu = hurufpuluhribu & " " & hurufsa & " ribu"
       END IF
       hurufratus = ratus(VAL(MID$(edit1.text,3,1)))
       hurufpuluh = puluh(VAL(MID$(edit1.text,4,1)))
       IF VAL(MID$(edit1.text,4,2)) <20 AND VAL(MID$(edit1.text,4,2)) >10 THEN
        IF sa(VAL(MID$(edit1.text,5,1))) = "satu" THEN
         hurufsa = "sebelas"
        ELSE
         hurufsa = sa(VAL(MID$(edit1.text,5,1)))
         hurufsa = hurufsa &"belas"
         IF hurufsa = 0 THEN hurufsa = ""
        END IF
        hurufpuluh = hurufsa
       ELSE
        hurufsa = sa(VAL(MID$(edit1.text,5,1)))
        hurufpuluh = hurufpuluh & " " & hurufsa
       END IF
       hurufsa = sa(VAL(MID$(edit1.text,5,1)))
       nbrutama = hurufpuluhribu & " " & hurufribu & " "& hurufratus & " "& hurufpuluh' & " " & hurufsa
      CASE 6 'ratus ribu'
       IF VAL(MID$(edit1.text,2,2)) <20 THEN
        IF sa(VAL(MID$(edit1.text,3,1))) = "satu" THEN
         hurufpuluhribu = "sebelas ribu"
        ELSE
         hurufsa  = sa(VAL(MID$(edit1.text,3,1)))
         hurufsa = hurufsa  & "belas ribu"
         IF hurufsa  = 0 THEN hurufsa  = ""
        END IF
        hurufpuluhribu = hurufsa
       ELSE
        hurufpuluhribu = puluh(VAL(MID$(edit1.text,2,1)))
        hurufsa  = sa(VAL(MID$(edit1.text,3,1)))
        hurufpuluhribu = hurufpuluhribu & " " & hurufsa & " ribu"
       END IF
       hurufratus = ratus(VAL(MID$(edit1.text,4,1)))
       hurufpuluh = puluh(VAL(MID$(edit1.text,5,1)))
       IF VAL(MID$(edit1.text,5,2)) <20 AND VAL(MID$(edit1.text,5,2)) >10 THEN
        IF sa(VAL(MID$(edit1.text,5,1))) = "satu" THEN
         hurufsa = "sebelas"
        ELSE
         hurufsa = sa(VAL(MID$(edit1.text,5,1)))
         hurufsa = hurufsa &"belas"
         IF hurufsa = 0 THEN hurufsa = ""
        END IF
        hurufpuluh = hurufsa
       ELSE
        hurufsa = sa(VAL(MID$(edit1.text,5,1)))
        hurufpuluh = hurufpuluh & " " & hurufsa
       END IF
       hurufsa = sa(VAL(MID$(edit1.text,5,1)))
       hurufratusribu = ratus(VAL(LEFT$(edit1.text,1)))
       nbrutama = hurufratusribu & " " & hurufpuluhribu & " " & hurufribu & " "& hurufratus & " "& hurufpuluh
      CASE 7 'juta
       nbrutama = "biar betui"
      END SELECT

      SELECT CASE panjangd
       DIM j AS INTEGER
       j = panjang + 2
      CASE 1
       hurufsa = sa(VAL(MID$(edit1.text,j,1)))
       nbrdecimal = hurufsa
      CASE 2
       IF VAL(RIGHT$(edit1.text,2)) <20 AND VAL(RIGHT$(edit1.text,2)) > 10 THEN
        IF sa(VAL(RIGHT$(edit1.text,1))) = "satu" THEN
         nbrdecimal = "sebelas"
        ELSE
         hurufsa = sa(VAL(RIGHT$(edit1.text,1)))
         nbrdecimal = hurufsa &"belas"
        END IF
       ELSE
        hurufpuluh = puluh(VAL(MID$(edit1.text,j,1)))
        hurufsa = sa(VAL(RIGHT$(edit1.text,1)))
        nbrdecimal = hurufpuluh & " " & hurufsa
       END IF
      END SELECT
      IF panjangd > 0 THEN
       nbrdecimal = " dan " & nbrdecimal
      ELSE
       nbrdecimal = ""
      END IF
      edit2.text = nbrutama & nbrdecimal
     END SUB
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Tue 2024-4-23  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2003-06-11 18:31:24