Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Codificatore 1.05 - codificatore.frm

codificatore.frm

Caricato da: Piero Tofy
Scarica il programma completo

  1. 'Codificatore 1.05 by Piero Tofy © 2003 Revisione da Codificatore creato nel 2002   |
  2. 'Creato in Visual Basic 6.0                                                         |
  3. 'Sito: Http://www.pierotofy.too.it                                                  |
  4. '-----------------------------------------------------------------------------------|
  5.  
  6. Dim lunghezzatesto As Single
  7. Dim livellox As Single
  8.  
  9. Private Sub cmdabout_Click()
  10. MsgBox "Codificatore 1.05 Copyright © by Piero Tofy 2003", , "About"
  11. End Sub
  12. Private Sub cmdalto_Click()
  13. livellox = 2
  14. cmdnormale.Checked = False
  15. cmdalto.Checked = True
  16. cmdestremo.Checked = False
  17. End Sub
  18. Private Sub cmdestremo_Click()
  19. livellox = 3
  20. cmdnormale.Checked = False
  21. cmdalto.Checked = False
  22. cmdestremo.Checked = True
  23. End Sub
  24. Private Sub cmdnormale_Click()
  25. livellox = 1
  26. cmdnormale.Checked = True
  27. cmdalto.Checked = False
  28. cmdestremo.Checked = False
  29. End Sub
  30.  
  31. Private Sub cmdok_Click()
  32. On Error GoTo 1
  33.  
  34. 'Assegna ad una variabile il contenuto del testo
  35. Dim original As String
  36. original = LCase(normal.Text)
  37.  
  38. 'Ripete il ciclo a seconda del livello di codificazione
  39. Dim count As Single
  40.  
  41. For count = 1 To livellox
  42.  
  43. lunghezzatesto = Len(normal.Text)
  44. Dim numeroper As Single
  45. numeroper = lunghezzatesto / 100
  46.  
  47. code.Text = ""
  48. normal.Text = LCase(normal.Text)
  49. Dim lunghezza As Single
  50. lunghezza = Len(normal.Text)
  51. Dim x
  52.  
  53. For x = 1 To lunghezza
  54. DoEvents
  55. 'Mostra la percentuale rimanente sulla barra del titolo
  56. Dim difflen As Single
  57. difflen = lunghezzatesto - x
  58. Dim percentuale As Single
  59. percentuale = 100 - (difflen / numeroper)
  60. cod.Caption = "Codificatore | " & "Livello: " & count & " | " & percentuale & "%"
  61.  
  62. 'Codifica il testo...
  63. Dim testo As String
  64. testo = Mid(normal.Text, x, 1)
  65. Dim find As String
  66. Select Case testo
  67.     Case "a"
  68.     find = "17-"
  69.     Case "b"
  70.     find = "9-"
  71.     Case "c"
  72.     find = "21-"
  73.     Case "d"
  74.     find = "26-"
  75.     Case "e"
  76.     find = "14-"
  77.     Case "f"
  78.     find = "1-"
  79.     Case "g"
  80.     find = "16-"
  81.     Case "h"
  82.     find = "22-"
  83.     Case "i"
  84.     find = "24-"
  85.     Case "l"
  86.     find = "11-"
  87.     Case "m"
  88.     find = "8-"
  89.     Case "n"
  90.     find = "25-"
  91.     Case "o"
  92.     find = "4-"
  93.     Case "p"
  94.     find = "2-"
  95.     Case "q"
  96.     find = "20-"
  97.     Case "r"
  98.     find = "6-"
  99.     Case "s"
  100.     find = "13-"
  101.     Case "t"
  102.     find = "19-"
  103.     Case "u"
  104.     find = "3-"
  105.     Case "v"
  106.     find = "23-"
  107.     Case "z"
  108.     find = "7-"
  109.     Case "j"
  110.     find = "18-"
  111.     Case "w"
  112.     find = "12-"
  113.     Case "y"
  114.     find = "5-"
  115.     Case "k"
  116.     find = "10-"
  117.     Case "x"
  118.     find = "15-"
  119.     'Spazio
  120.     Case " "
  121.     find = "27-"
  122.     'Punto esclamativo
  123.     Case "!"
  124.     find = "28-"
  125.     'Punto interrogativo
  126.     Case "?"
  127.     find = "29-"
  128.     'Accentate
  129.     Case "è"
  130.     find = "30-"
  131.     Case "ò"
  132.     find = "31-"
  133.     Case "à"
  134.     find = "32-"
  135.     Case "ù"
  136.     find = "33-"
  137.     Case "ì"
  138.     find = "34-"
  139.     'Se è un numero
  140.     Case "0"
  141.     find = "44-"
  142.     Case "1"
  143.     find = "45-"
  144.     Case "2"
  145.     find = "36-"
  146.     Case "3"
  147.     find = "41-"
  148.     Case "4"
  149.     find = "46-"
  150.     Case "5"
  151.     find = "37-"
  152.     Case "6"
  153.     find = "43-"
  154.     Case "7"
  155.     find = "39-"
  156.     Case "8"
  157.     find = "47-"
  158.     Case "9"
  159.     find = "40-"
  160.     'Se è un punto una virgola doppio punto o linetta
  161.     Case ","
  162.     find = "38-"
  163.     Case "."
  164.     find = "42-"
  165.     Case ":"
  166.     find = "35-"
  167.     Case "-"
  168.     find = "48-"
  169.     'Se è un'altra lettera...
  170.     Case Else
  171.     find = ""
  172. End Select
  173. code.Text = code.Text & find
  174. Next x
  175. normal.Text = code.Text
  176. Next count
  177. normal.Text = original
  178. 'Scrive all'inizio del codice generato il livello di codificazione
  179. code.Text = CStr(livellox) & "-" & code.Text
  180. 'Scrive complete 100%!
  181. cod.Caption = "Codificatore | 100% Complete!"
  182.  
  183. Exit Sub
  184. 1
  185. MsgBox "Errore nel processo di codificazione. Molto probabilmente è colpa del testo che hai inserito! Controlla il testo che hai inserito e riprova. Se il problema non si risolve contatta il produttore!", , "Errore"
  186. cod.Caption = "Codificatore |"
  187. Exit Sub
  188. End Sub
  189.  
  190. Private Sub cmdok2_Click()
  191. On Error GoTo 1
  192.  
  193. 'Assegna ad una variabile il contenuto del testo
  194. Dim original As String
  195. original = LCase(code.Text)
  196.  
  197. 'Guarda il livello di codificazione e tronca la stringa inutile...
  198. livellox = CSng(Mid(code.Text, 1, 1))
  199. code.Text = Right(code.Text, Len(code.Text) - 2)
  200.  
  201. 'Ripete il ciclo a seconda del livello di codificazione
  202. Dim count As Single
  203.  
  204. For count = 1 To livellox
  205.  
  206. lunghezzatesto = Len(code.Text)
  207. Dim numeroper As Single
  208. numeroper = lunghezzatesto / 100
  209.  
  210. normal.Text = ""
  211. 'Operazione Inversa
  212. Dim testotot As String
  213. testotot = code.Text
  214. Dim ciclocount As Double
  215. Dim lunghezzatemp As Double
  216. lunghezzatemp = 0
  217.  
  218. Do
  219. DoEvents
  220. ciclocount = lunghezzatemp
  221.  
  222. 'Mostra la percentuale rimanente sulla barra del titolo
  223. Dim difflen As Single
  224. difflen = lunghezzatesto - ciclocount
  225. Dim percentuale As Single
  226. percentuale = 100 - (difflen / numeroper)
  227. cod.Caption = "Codificatore | " & "Livello: " & count & " | " & percentuale & "%"
  228.  
  229.  
  230. Dim posizione As Single
  231. posizione = InStr(testotot, "-")
  232. Dim testook As String
  233. testook = Left(testotot, posizione - 1)
  234. 'Riconosce i caratteri estratti
  235. Dim find As String
  236. Select Case testook
  237.     Case "17"
  238.     find = "a"
  239.     Case "9"
  240.     find = "b"
  241.     Case "21"
  242.     find = "c"
  243.     Case "26"
  244.     find = "d"
  245.     Case "14"
  246.     find = "e"
  247.     Case "1"
  248.     find = "f"
  249.     Case "16"
  250.     find = "g"
  251.     Case "22"
  252.     find = "h"
  253.     Case "24"
  254.     find = "i"
  255.     Case "11"
  256.     find = "l"
  257.     Case "8"
  258.     find = "m"
  259.     Case "25"
  260.     find = "n"
  261.     Case "4"
  262.     find = "o"
  263.     Case "2"
  264.     find = "p"
  265.     Case "20"
  266.     find = "q"
  267.     Case "6"
  268.     find = "r"
  269.     Case "13"
  270.     find = "s"
  271.     Case "19"
  272.     find = "t"
  273.     Case "3"
  274.     find = "u"
  275.     Case "23"
  276.     find = "v"
  277.     Case "7"
  278.     find = "z"
  279.     Case "18"
  280.     find = "j"
  281.     Case "12"
  282.     find = "w"
  283.     Case "5"
  284.     find = "y"
  285.     Case "10"
  286.     find = "k"
  287.     Case "15"
  288.     find = "x"
  289.     'Spazio
  290.     Case "27"
  291.     find = " "
  292.     'Punto esclamativo
  293.     Case "28"
  294.     find = "!"
  295.     'Punto interrogativo
  296.     Case "29"
  297.     find = "?"
  298.     'Accentate
  299.     Case "30"
  300.     find = "è"
  301.     Case "31"
  302.     find = "ò"
  303.     Case "32"
  304.     find = "à"
  305.     Case "33"
  306.     find = "ù"
  307.     Case "34"
  308.     find = "ì"
  309.     'Se è un numero
  310.     Case "44"
  311.     find = "0"
  312.     Case "45"
  313.     find = "1"
  314.     Case "36"
  315.     find = "2"
  316.     Case "41"
  317.     find = "3"
  318.     Case "46"
  319.     find = "4"
  320.     Case "37"
  321.     find = "5"
  322.     Case "43"
  323.     find = "6"
  324.     Case "39"
  325.     find = "7"
  326.     Case "47"
  327.     find = "8"
  328.     Case "40"
  329.     find = "9"
  330.     'Se è un punto una virgola doppio punto o linetta
  331.     Case "38"
  332.     find = ","
  333.     Case "42"
  334.     find = "."
  335.     Case "35"
  336.     find = ":"
  337.     Case "48"
  338.     find = "-"
  339.     'Se è un'altra lettera...
  340.     Case Else
  341.     find = ""
  342. End Select
  343. 'Determina la lunghezza di testotot è Tronca testotot
  344. Dim lunghezza As Single
  345. lunghezza = Len(testotot)
  346. testotot = Right(testotot, (lunghezza - posizione))
  347. 'Variabile per la percentuale...
  348. lunghezzatemp = lunghezzatesto - lunghezza
  349.  
  350. normal.Text = normal.Text & find
  351. Loop Until testotot = ""
  352. code.Text = normal.Text
  353. Next count
  354. count = count - 1
  355. code.Text = original
  356. 'Scrive complete 100%!
  357. cod.Caption = "Codificatore | 100% Complete!"
  358.  
  359. Exit Sub
  360. 1
  361. MsgBox "Errore nel processo di codificazione. Molto probabilmente è colpa del testo che hai inserito! Controlla il testo che hai inserito e riprova. Se il problema non si risolve contatta il produttore!", , "Errore"
  362. cod.Caption = "Codificatore |"
  363. Exit Sub
  364. End Sub
  365.  
  366. Private Sub esci_Click()
  367. MsgBox "Http://www.pierotofy.too.it", , "Exit"
  368. End
  369. End Sub
  370. Private Sub Form_Load()
  371. livellox = 1
  372. End Sub