Springen naar inhoud


- - - - -
VB6

Afzonderlijke Waarden Va Letters In Een Programma Numerologie



  • Log in a.u.b. om te beantwoorden
Er zijn 4 reacties in dit onderwerp

#1 houthalen

houthalen

    Senior Developer

  • Leden
  • PipPipPip
  • 157 berichten
    Laatst bezocht 01 apr 2017 08:58

Geplaatst op 13 juni 2016 - 09:05

Ik had een paar  jaren geleden een programma over numerologie geschreven.
Hieronder de (perfect werkende) code.
Code:
Dim vet As Variant
Dim Woord As String, Teken As String
Dim k As Integer, valcar As Integer, asciTeken As Integer, somKlinker As Integer
vet = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8)
Woord = Trim(txtwoord.Text)
valcar = 0
eerste.Text = vet(Asc(UCase(Left(Woord, 1))) - 65)
For k = 1 To Len(Woord)
Teken = Mid(UCase(Woord), k, 1)
asciTeken = Asc(UCase(Teken)) - 65
Select Case asciTeken
Case 0, 4, 8, 14, 20, 24
valcar = valcar + vet(asciTeken)
somKlinker = somKlinker + vet(asciTeken)
Case 0 To 25
valcar = valcar + vet(asciTeken)
End Select
Next
txtsom.Text = valcar 'som waarde van de ingevoerde letters

Het werkt als volgende:
Na input van een  naam, woord, ... worden de waarden van de letters (vet-valcar))
omgezet in getallen
bv. a=1
b=2..
M=4
S=1
enz
daarna wordt het total van de waarden  van de letters een som gemaakt en getoond  in txtsom.text. Tot hier alles ok.
Zoals gezegd wordt het total van (alle) letters waarden gegeven.
Hoe kan ik in een textbox (a part) de afzonderlijke waarden tonen?

Bv als HUIS input  dan is het total 21
MAMA is het total 10

Maar ik wou dan in een textbox de afzonderlijke waarden van HUIS
8391

of van MAMA
4141
dank u

#2 josk79

josk79

    Master Developer

  • Leden
  • PipPipPipPipPip
  • 614 berichten
    Laatst bezocht 30 jan 2017 23:38

Geplaatst op 13 juni 2016 - 22:36

Definieer een string, bijv 'afzonderlijk'

Code:
dim afzonderlijk as string


In de loop iedere waarde toevoegen aan de string:

Code:
afzonderlijk = afzonderlijk & CStr(vet(asciTeken))


en aan het einde van de rit aan een textbox toekennen:

Code:
txtAfzonderlijk.Text = afzonderlijk



#3 houthalen

houthalen

    Senior Developer

  • Leden
  • PipPipPip
  • 157 berichten
    Laatst bezocht 01 apr 2017 08:58

Geplaatst op 14 juni 2016 - 08:04

Best Jos79  ik heb een paar test gedaan en  inderdaad uw oplossing
blijkt te werken !
Dank je. Het is wat ik gevraagd had.
Ik heb dus zo geïntegreerd
Code:
Private Sub Command1_Click()
Dim afzonderlijk As String
Dim vet As Variant
Dim Woord As String, Teken As String
Dim k As Integer, valcar As Integer, asciTeken As Integer, somKlinker As Integer

vet = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8)
Woord = Trim(txtwoord.Text)

valcar = 0
eerste.Text = vet(Asc(UCase(Left(Woord, 1))) - 65)
For k = 1 To Len(Woord)
Teken = Mid(UCase(Woord), k, 1)
asciTeken = Asc(UCase(Teken)) - 65
Select Case asciTeken
Case 0, 4, 8, 14, 20, 24
valcar = valcar + vet(asciTeken)
somKlinker = somKlinker + vet(asciTeken)
afzonderlijk = afzonderlijk & CStr(vet(asciTeken))
Case 0 To 25
afzonderlijk = afzonderlijk & CStr(vet(asciTeken))
valcar = valcar + vet(asciTeken)
End Select
Next
txtsom.Text = valcar 'som waarde van de ingevoerde letters
txtafzonderlijk.Text = afzonderlijk
End Sub
ik moest wel
Code:
afzonderlijk = afzonderlijk & CStr(vet(asciTeken))
op drie plaatsen invoegen want mijn routine berekent ook klinkers  en medeklinkers
a part.
Dus het werkt  . Moest iets zijn zal ik terug komen maar ik denk dat opgelost is.

Nogmaals dank!!
houthalen

#4 houthalen

houthalen

    Senior Developer

  • Leden
  • PipPipPip
  • 157 berichten
    Laatst bezocht 01 apr 2017 08:58

Geplaatst op 14 juni 2016 - 08:04

Best Jos79  ik heb een paar test gedaan en  inderdaad uw oplossing
blijkt te werken !
Dank je. Het is wat ik gevraagd had.
Ik heb dus zo geïntegreerd
Code:
Private Sub Command1_Click()
Dim afzonderlijk As String
Dim vet As Variant
Dim Woord As String, Teken As String
Dim k As Integer, valcar As Integer, asciTeken As Integer, somKlinker As Integer

vet = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8)
Woord = Trim(txtwoord.Text)

valcar = 0
eerste.Text = vet(Asc(UCase(Left(Woord, 1))) - 65)
For k = 1 To Len(Woord)
Teken = Mid(UCase(Woord), k, 1)
asciTeken = Asc(UCase(Teken)) - 65
Select Case asciTeken
Case 0, 4, 8, 14, 20, 24
valcar = valcar + vet(asciTeken)
somKlinker = somKlinker + vet(asciTeken)
afzonderlijk = afzonderlijk & CStr(vet(asciTeken))
Case 0 To 25
afzonderlijk = afzonderlijk & CStr(vet(asciTeken))
valcar = valcar + vet(asciTeken)
End Select
Next
txtsom.Text = valcar 'som waarde van de ingevoerde letters
txtafzonderlijk.Text = afzonderlijk
End Sub
ik moest wel
Code:
afzonderlijk = afzonderlijk & CStr(vet(asciTeken))
op drie plaatsen invoegen want mijn routine berekent ook klinkers  en medeklinkers
a part.
Dus het werkt  . Moest iets zijn zal ik terug komen maar ik denk dat opgelost is.

Nogmaals dank!!
houthalen

#5 josk79

josk79

    Master Developer

  • Leden
  • PipPipPipPipPip
  • 614 berichten
    Laatst bezocht 30 jan 2017 23:38

Geplaatst op 20 juni 2016 - 20:07

Die somKlinker, doet zo niets hoor. Je schrijf er wat in maar verder doe je er niets mee.

Dit doet volgens mij hetzelfde (VB6 ligt onder 18 jaar stof, dus ik kan het niet uitproberen)


Code:
Private Sub Command1_Click() 
Dim afzonderlijk As String 
Dim vet As Variant 
Dim Woord As String, Teken As String 
Dim k As Integer, valcar As Integer, asciTeken As Integer
 
vet = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8) 
Woord = Trim(txtwoord.Text) 
 
valcar = 0 
eerste.Text = vet(Asc(UCase(Left(Woord, 1))) - 65) 
For k = 1 To Len(Woord) 
  Teken = Mid(UCase(Woord), k, 1) 
  asciTeken = Asc(UCase(Teken)) - 65 
  valcar = valcar + vet(asciTeken) 
  afzonderlijk = afzonderlijk & CStr(vet(asciTeken)) 
Next 
txtsom.Text = valcar 'som waarde van de ingevoerde letters 
txtafzonderlijk.Text = afzonderlijk 
End Sub 







Ook met taq VB6 voorzien

0 gebruiker(s) lezen dit onderwerp

0 lid(leden), 0 bezoeker(s), 0 anonieme gebruikers

Inloggen


[VB6] Untitled 1

Met dank aan Jürgen voor de jarenlange inzet van visualbasic.be (anno dec 2000)
Met dank aan Mike en Ronneke voor de jarenlange inzet van vbib.be (anno dec 2010)
Met dank aan PascalBianca voor de jarenlange inzet van vbib.be (anno dec 2016)