Ποσό ολογράφως...

Ποσό ολογράφως...

Από {giocha_}

Παιδιά χαίρετε...

Μήπως έχετε κάνα scriptaki σε VB 5.0 ή VB 6.0 το οποίο να μετατρέπει το ποσό σε κείμενο;

Π.χ. το 1567,87 να γραφεί ΧΙΛΙΑ ΠΕΝΤΑΚΟΣΙΑ ΕΞΗΝΤΑ ΕΠΤΑ ΕΥΡΩ και ΟΓΔΟΝΤΑ ΕΠΤΑ ΛΕΠΤΑ.

Έχω παιδευτεί τόσο πολύ και δεν μπορώ να βγάλω άκρη.

  1. 10/2/2004

    Ένα γρήγορο πρόγραμμα που έφτιαξα (δεν ξέρω αν είναι ο πιο εύκολος τρόπος αλλά σίγουρα δουλεύει) είναι κάπως έτσι:

    Option Explicit
    Option Base 0
    Private Sub Command1_Click()
    Dim strArxikoPoso As Long
    Dim lngPoso As Long
    Dim strPoso As String
    Dim strDecOnomata(2, 10) As String
    Dim strIntOnomata(6, 10) As String
    Dim i As Integer
    strIntOnomata(1, 0) = ""
    strIntOnomata(1, 1) = "ένα"
    strIntOnomata(1, 2) = "δύο"
    strIntOnomata(1, 3) = "τρία"
    strIntOnomata(1, 4) = "τέσσερα"
    strIntOnomata(1, 5) = "πέντε"
    strIntOnomata(1, 6) = "έξι"
    strIntOnomata(1, 7) = "επτά"
    strIntOnomata(1, 8) = "οκτώ"
    strIntOnomata(1, 9) = "εννιά"
    strIntOnomata(2, 0) = ""
    strIntOnomata(2, 1) = "δέκα"
    strIntOnomata(2, 2) = "είκοσι"
    strIntOnomata(2, 3) = "τριάντα"
    strIntOnomata(2, 4) = "σαράντα"
    strIntOnomata(2, 5) = "πενήντα"
    strIntOnomata(2, 6) = "εξήντα"
    strIntOnomata(2, 7) = "εβδομήντα"
    strIntOnomata(2, 8) = "ογδόντα"
    strIntOnomata(2, 9) = "ενενήντα"
    strIntOnomata(3, 0) = ""
    strIntOnomata(3, 1) = "εκατό"
    strIntOnomata(3, 2) = "διακόσια"
    strIntOnomata(3, 3) = "τριακόσια"
    strIntOnomata(3, 4) = "τετρακόσια"
    strIntOnomata(3, 5) = "πεντακόσια"
    strIntOnomata(3, 6) = "εξακόσια"
    strIntOnomata(3, 7) = "επτακόσια"
    strIntOnomata(3, 8) = "οκτακόσια"
    strIntOnomata(3, 9) = "ενιακόσια"
    strIntOnomata(4, 0) = ""
    strIntOnomata(4, 1) = "χίλια"
    strIntOnomata(4, 2) = "δύο χιλιάδες"
    strIntOnomata(4, 3) = "τρεις χιλιάδες"
    strIntOnomata(4, 4) = "τέσσερις χιλιάδες"
    strIntOnomata(4, 5) = "πέντε χιλιάδες"
    strIntOnomata(4, 6) = "έξι χιλιάδες"
    strIntOnomata(4, 7) = "επτά χιλιάδες"
    strIntOnomata(4, 8) = "οκτώ χιλιάδες"
    strIntOnomata(4, 9) = "εννιά χιλιάδες"
    'symplhrwse ta ypoloipa
    'gia dekades xiliadwn, ekatontades xiliadwn, klp
    'ypotypwdhs elegxos gia sfalmata
    'isws 8es na to kaneis kalytero, dhl. if isnumeric(text1.text) klp...
    If Len(Text1.Text) > 0 Then strArxikoPoso = Replace(Text1.Text, ",", ".") Else strArxikoPoso = "0"
    'proteinw na elegkseis an to lngposo einai megalytero apo tis times
    'gia tis opoies exeis dwsei onomata sta arrays. an nai, exit sub me error
    lngPoso = CLng(strArxikoPoso)
    'stroggylopoihsh sta 2 dekadika pshfia
    lngPoso = Round(lngPoso, 2)
    'arxizoume ton elegxo:
    'edw egw arxizw apo tis xiliades epeidh mexri xiliades exw symplhrwsei
    'an eixes symplhrwsei mexri ekatommyria 8a arxizes apo ekatommyria.
    'piase to skeptiko kai ftiakse ton kwdika gia ta ypoloipa
    If lngPoso \ 1000 <> 0 Then strPoso = strIntOnomata(4, lngPoso \ 1000)
    lngPoso = lngPoso - 1000 * Int(lngPoso / 1000)
    'ekatontades
    If lngPoso \ 100 <> 0 Then strPoso = strPoso & " " & strIntOnomata(3, lngPoso \ 100)
    lngPoso = lngPoso - 100 * Int(lngPoso / 100)

    'gia tis dekades kai tis monades kanw patenta:
    If Not Right(CStr(Int(lngPoso)), 2) = 12 And Not Right(CStr(Int(lngPoso)), 2) = 11 And lngPoso \ 10 <> 0 Then
    If lngPoso \ 10 <> 0 Then strPoso = strPoso & " " & strIntOnomata(2, lngPoso \ 10)
    lngPoso = lngPoso - 10 * Int(lngPoso / 10)
    strPoso = strPoso & " " & strIntOnomata(1, lngPoso)
    ElseIf Right(CStr(Int(lngPoso)), 2) = 11 And (lngPoso \ 10) <> 0 Then
    strPoso = strPoso & " ένδεκα"
    ElseIf Right(CStr(Int(lngPoso)), 2) = 12 And (lngPoso \ 10) <> 0 Then
    strPoso = strPoso & " δώδεκα"
    ElseIf lngPoso \ 10 = 0 Then
    strPoso = strPoso & " " & strIntOnomata(1, lngPoso)
    End If
    'kai vgazw to mexri twra apotelesma...
    If strPoso = "" Or strPoso = " " Then strPoso = "μηδέν"
    strPoso = strPoso & " ευρώ"
    'psakse na vreis an sto strArxikoPoso yparxei "." kai tote vgale ta dekadika pshfia
    '8a se voh8nhsei h parapanw patenta, einai sxedon idios kwdikas
    'vgazoume to apotelesma:
    Label1.Caption = strPoso
    End Sub

    Θα πρέπει να συμπληρώσεις τον κώδικα με τα δεκαδικά ψηφία και σύμφωνα με τα σχόλια που σου έχω κάνει. Sorry, δεν έχω το χρόνο να το τελειώσω.

  1. 10/2/2004

    Οπ παράλειψη:

    Η φόρμα έχει ένα command button (button1), ένα label (label1) και ένα text (text1).

    Στη γραμμή

    If Not Right(CStr(Int(lngPoso)), 2) = 12 And Not Right(CStr(Int(lngPoso)), 2) = 11 And lngPoso \ 10 <> 0 Then

    άλλαξέ την καλύτερα με
    If Not Right(CStr(Int(lngPoso)), 2) = "12" And Not Right(CStr(Int(lngPoso)), 2) = "11" And lngPoso \ 10 <> 0 Then

    (όχι ότι είναι λάθος, αλλά μια και είναι strings)




   Πίσω στην προηγούμενη σελίδα