Generator broja

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Treba mi code za generator cetvorocifrenog broja. To mi treba jer koristim neke sigurnosne sifre koje stalno moram da menjam pa ne mogu stalno da smisljam novu. Dakle broj mora biti cetvorocifren s tim sto u genirisanom broju ne smeju biti dve iste cifre jedna do druge recimo broj 5517 nije validan mora biti 5157.... nadam se da sam bio jasan

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Hmm... Mozda da se prvo napise code za generisanje nekog slucajnog cetvorocifrenogf broja.

x = Int(((10000 - 1000 + 1) * Rnd) + 1000)

Pa posle proverimo da li u tom broju postoje dve iste cifre jedna do druge.

If Left(x, 1) = Right(Left(x, 2), 1) Then 'nesto If Right(Left(x, 2), 1) = Right(Left(x, 3), 1) Then 'nesto If Right(Left(x, 3), 1) = Right(x, 1) Then 'nesto

a ako uklopimo sve zajedno:

Dim x, a As String a = 0 Do While a = 0 a = 1 x = Int(((10000 - 1000 + 1) * Rnd) + 1000) If Left(x, 1) = Right(Left(x, 2), 1) Then a = 0 If Right(Left(x, 2), 1) = Right(Left(x, 3), 1) Then a = 0 If Right(Left(x, 3), 1) = Right(x, 1) Then a = 0 Loop

i na kraju dobijas x koji je cetvorocifreni broj u kome ne bi trebalo da se pojavi recomo 1153, 5466, 7998 itd. Koliko mogu da razmisljam u ove kasne sate, ovo treba da radi ispravno.... javi dal radi

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Zaboravio sam da napisem meni ovo treba da se pojavi u txtbox-u kad kliknem na cmd... mozes li ga jos malo doraditi

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Citat:i na kraju dobijas x koji je cetvorocifreni broj


Ali evo:

Private Sub Command1_Click() Dim x, a As String a = 0 Do While a = 0 a = 1 x = Int(((10000 - 1000 + 1) * Rnd) + 1000) If Left(x, 1) = Right(Left(x, 2), 1) Then a = 0 If Right(Left(x, 2), 1) = Right(Left(x, 3), 1) Then a = 0 If Right(Left(x, 3), 1) = Right(x, 1) Then a = 0 Loop Text1.Text = x End Sub

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

Da, skontao sam ali kasno... vec si odgovorio....

Dopuna: 03 Jun 2007 14:15

Sve radi k'o sat, hvala puno biseru

• 0Niko još nije pohvalio poruku.
  Registruj se da bi pohvalio/la poruku!

ali prije Rnd pozovi Randomize()