Programme convertissant les codes iso en codes lng

Télécharger le projet
Commenter

Description

Cette source convertit un code langue et un code pays ISO en un code LNG et vice-versa. Les codes LNG sont des entiers longs permettant d'identifier une langue facilement (voir la source 10104, FACILITER LA TRADUCTION D'UN PROGRAMME VB).

Source / Exemple : 


'Le code de l'unique feuille :
Option Explicit

Const HWND_TOPMOST = -1

Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40

Private Declare Sub SetWindowPos Lib "USER32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)

Dim TextBuffer As String

Private Sub cmdISOToLNG_Click()
 Dim i As Byte
 Dim LNGCode As Currency
 For i = 1 To 6
  txtISOCode(6 - i).Text = LCase(Left(txtISOCode(6 - i).Text, 1))
  LNGCode = LNGCode + (LetterToNumber(txtISOCode(6 - i).Text) * (26 ^ (i - 1)))
 Next i
 If LNGCode = 0 Then
  txtLNGCode.Text = ""
 Else
  txtLNGCode.Text = LNGCode
 End If
End Sub

Private Sub cmdLNGToISO_Click()
 Dim i As Byte
 Dim R As Currency
 If IsNumeric(txtLNGCode.Text) Then
  R = CCur(txtLNGCode.Text)
  For i = 1 To 6
   txtISOCode(i - 1).Text = NumberToLetter(Fix(R / (26 ^ (6 - i))))
   R = R - (Fix(R / (26 ^ (6 - i))) * (26 ^ (6 - i)))
  Next i
 Else
  GoTo ErrorHandler
 End If
 
 Exit Sub
 
ErrorHandler:
 MsgBox "Format du code LNG non valide", vbCritical + vbOKOnly, "Erreur"
End Sub

Private Function LetterToNumber(Letter As String) As Byte
 If Letter = "" Then
  LetterToNumber = 0
 Else
  LetterToNumber = Asc(Letter) - 96
  If (LetterToNumber < 1) Or (LetterToNumber > 26) Then
   LetterToNumber = 0
  End If
 End If
End Function

Private Function NumberToLetter(Number As Byte) As String
 If (Number < 1) Or (Number > 26) Then
  NumberToLetter = ""
 Else
  NumberToLetter = Chr(Number + 96)
 End If
End Function

Private Sub cmdResetISOCode_Click()
 Dim i As Integer
 For i = 0 To 5
  txtISOCode(i).Text = ""
 Next i
End Sub

Private Sub cmdResetLNGCode_Click()
 txtLNGCode.Text = ""
End Sub

Private Sub Form_Load()
  SetWindowPos Me.hWnd, _
      HWND_TOPMOST, _
      0, _
      0, _
      0, _
      0, _
      SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOSIZE
  Me.Top = (Screen.Height - Me.Height) / 2
  Me.Left = (Screen.Width - Me.Width) / 2
  TextBuffer = ""
End Sub

Private Sub txtISOCode_GotFocus(Index As Integer)
 Dim i As Integer
 For i = 0 To 5
  txtISOCode(i).Text = LCase(Left(txtISOCode(i), 1))
 Next i
 txtISOCode(Index).SelStart = 0
 txtISOCode(Index).SelLength = 1
End Sub

Private Sub txtISOCode_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
 If (txtISOCode(Index).Text <> "") And (KeyCode <> 37) Then
  If Index < 5 Then txtISOCode(Index + 1).SetFocus
 Else
  If Index > 0 Then txtISOCode(Index - 1).SetFocus
 End If
End Sub

'Private Sub txtISOCode_GotFocus(Index As Integer)
' Dim i As Integer
' If txtISOCode(Index).Text <> "" Then
'  txtISOCode(Index).Text = TextBuffer
'  TextBuffer = ""
' End If
' For i = 0 To 5
'  txtISOCode(i).Text = Left(txtISOCode(i), 1)
' Next i
'End Sub
'
'Private Sub txtISOCode_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
' If txtISOCode(Index).Text <> "" Then
'  If Index < 5 Then txtISOCode(Index + 1).Text = LCase(Chr(KeyCode))
'  If Index < 4 Then
'   txtISOCode(Index + 2).SetFocus
'  ElseIf Index < 5 Then
'   TextBuffer = txtISOCode(Index + 1).Text
'   txtISOCode(Index + 1).SetFocus
'  End If
' End If
'End Sub

Conclusion :


La documentation arrivera plus tard !
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_cnb)