GOOGLE TRADUCTION
cs_PaTaTe
Messages postés
2126
Date d'inscription
mercredi 21 août 2002
Statut
Contributeur
Dernière intervention
19 février 2021
-
10 mars 2009 à 12:18
KESHAROI - 23 déc. 2013 à 22:49
KESHAROI - 23 déc. 2013 à 22:49
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/49461-google-traduction
https://codes-sources.commentcamarche.net/source/49461-google-traduction
23 déc. 2013 à 22:49
20 avril 2009 à 14:52
17 avril 2009 à 12:59
Private Sub w_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
If Progress = -1 Then
w.Silent = True
.....
17 avril 2009 à 09:13
16 avril 2009 à 20:04
En VB6 je n'ai jamais rencontré ça.
J'ai toujours utilisé WebBrowser1.Silent True et donc, dans le programme de vbnino en mettant>
' Envoi au traducteur Google
w.Silent = True
w.navigate "http://translate.google.com/translate_.....
on n'est plus ennuyé par les messages d'erreur de script.
Je précise aussi qu'il ne faut pas essayer de mettre silent à TRUE dans la fenêtre des Propriétés car il n'y a pas de mémorisation. Il faut écrire w.Silent = True , dans le Code.
J'ai fait le même commentaire, dans le dernier programme
de vbnino. Il permet de lire les flux RSS
16 avril 2009 à 16:34
12 avril 2009 à 12:00
contacte-moi par MP avec les mots désirés et j'activerai manuellement
12 avril 2009 à 11:49
12 avril 2009 à 11:12
louche, cette désactivation... ? As-tu demandé aux admis le pourquoi du comment de cette erreur ?...
Je regarderais un peu plus tard ta version en VB.NET, mais cela va être pas facile de poursuivre dans ces conditions...
Amicalement,
Us.
12 avril 2009 à 10:21
www.vbfrance.com/code.aspx?ID=49799
Du coup je l'ai mis aussi ici :
http://patrice.dargenton.free.fr/tmp/GTradDist.zip
J'arrête pour le moment, je passe à autre chose...
5 avril 2009 à 11:55
3 avril 2009 à 13:52
3 avril 2009 à 12:44
Patrice, comme j'avais dit : "j'ai testé directement la limite sur le site GOOGLE", et pas encore par URL... peut-être dimanche...
Indique aussi l'adresse de la version VB.NET...
A+
Amicalement,
Us.
3 avril 2009 à 10:38
3 avril 2009 à 10:22
net à part, puisque VB France fait le distingo. Bien sûr,il serait mieux que vbnino soit d'accord, car c'est lui qui a eu l'idée de ce programme mais si tu le cites, il ne devrait pas y avoir de problème. Sur le site on trouve des reprises de codes signalées.
3 avril 2009 à 08:17
Est-ce que personne ne voit d'inconvénient à ce que je publie ma version dotnet à part ? je citerai tout ceux qui ont contribué ici.
30 mars 2009 à 12:10
Conclusion : le bouton traduire du site web arrive à passer 30700 caractères du poste client vers le site de traduction, c'est donc bien possible d'une manière ou d'une autre, reste à voir comment en VB.
Moi j'aimais bien VB6 jusqu'à l'année dernière, où j'ai observé que certains exécutables VB6 ne fonctionnaient plus sur certains postes, avec un message d'erreur n°7 : "Mémoire insuffisante" au lancement de l'appli (ex.: Snap2Pdf), la seule solution étant de réinstaller VB6 sur le poste client !!! du coup, j'ai vraiment perdu confiance dans le produit maintenant.
Du reste, j'utilise la version gratuite de VB.Net depuis 2005 pour développer des applications professionnelles, ce qui à l'avantage de pouvoir installer le compilo sur un portable pour déboguer chez un client par exemple (pour les cas extrêmes !). Même Microsoft affirme que c'est une bonne idée d'utiliser la version gratuite pour des applis professionnelles !
30 mars 2009 à 11:41
Euh... Patrice, j'ai testé directement la limite sur le site GOOGLE, et non en passant par DotNet... Par vb6, cela à l'air de passer aussi... je dis à l'air, car j'ai eu qlq petits bugs qui ont disparus ensuite... Je pense qu'il faudrait améliorer l'envoi et la récupération vers Google. Déjà, un petit plus c'est de repérer si la connexion à internet est effective ou pas. Pour cela j'ai fini par utiliser la DLL de Brunews qui fonctionne parfaitement dans tous les cas. (les autres alternatives ne sont pas aussi bonne dans tous les cas...)
La DLL et le code, est présent dans la version que j'ai laissé sur mon adresse...
En ce qui concerne le language de programmation, disons que Vb6 va fatalement finir par disparaître... De plus, on peut obtenir VB2008 Express gratuitement... sans compter que beaucoup d'eau a coulé sous les ponts depuis, et avec une série d'améliorations... même si il reste toujours des choses un brin casse tête, qui fait que vb6 sur certains détails est plus pratique... mais bon. Vbnino, changer de language, maintenant après autant avoir travaillé sur vb6, est un brin un peu tard, mais bon, pourquoi pas. Peut-être faire qlq chose de commun avec Patrice... ?
Mais, personnemellement, j'aime bien ta façon de faire, qui consiste bien souvent à trouver le moyen le plus simple d'arriver au résultat, en évitant tout cumul inutile... enfin, c'est un peu floue de dire les choses ainsi... Exemple, pour l'historique tu reprends les fonctions du Webbrowser, bah, c'est pas bête !... Finalement, il y a qu'une chose que je trouve surperflue, c'est le calcul du temps de la traduction... mais bon.
Si l'idée de faire une source commune vous tente, je suis partant, dans la mesure du temps disponible, bien sur... mais comme on en prends déjà le chemin ici...
Amicalement,
Us.
30 mars 2009 à 08:30
Google Error : Request-URI Too Large
The requested URL /translate_t... is too large to process.
Ce qui est vrai c'est que sur le site, Google accepte plus de caractères. Pour ce qui est des abus, une prochaine version devrait effectivement permettre de traduire des textes de longueur illimitée, reste à voir si Google détecte et bloque les multiples requêtes successives depuis la même IP.
29 mars 2009 à 20:10
Autant pour moi, INKED n'est pas si limité que cela, mais cela semble être plutôt w.navigate le point faible... j'y réfléchi encore...
Patrice : "Mais ce qui est sûr c'est que la limite de Google via l'URL est moins de 2000 caractères"
> Non. Je n'observe pas cette limite... La limite se situe vers 30700 caractères, mais n'est pas constante. En effet, GOOGLE arrête la traduction à une phrase (repérée par un point)... Je ne sais pas si c'est la seule règle d'arrêt (à priori, non. Sinon, les abus seraient trop important.)
Amicalement,
Us.
29 mars 2009 à 16:19
Sauf peut être du point de vue de l' "employabilité" : là c'est pratiquement un devoir oui !
Mais pourquoi choisir si l'on peut conserver les 2 versions en même temps ? laissons les utilisateurs voir ce qui les intéressent le plus.
29 mars 2009 à 15:41
29 mars 2009 à 15:31
J'ai testé ta dernière version. Elle va bien et je te remercie vivement pour le code de chargement et de sauvetage qui permet de garder les accents. Tu es un as du VBnet.
J'ai parcouru un nombre incalculable d'articles sur le Net et je n'ai rien trouvé de fiable. J'avais même trouvé un petit éditeur, bien fait mais sans la gestion des accents.
Ce que j'avais proposé le 28 marchait, en test avec seulement un TextBox et un Bouton mais implanté dans ton code plus d'accents. Au passage je remercie Renfield qui, sur le Forum m'avait dit qu'il fallait utiliser TextReader
Entre parenthèses j'avais fait une étouderie:
lgs.Text = ObjetFichier.ReadToEnd
au lieu de
tbHaut = ObjetFichier.ReadToEnd
vbnino on est content de te lire.
29 mars 2009 à 14:22
vbnino : tu as pu tester la version dotnet ? elle est ici :
http://patrice.dargenton.free.fr/tmp/GTradDist.zip
29 mars 2009 à 13:42
29 mars 2009 à 13:19
us_30 : Exact, il restera quand même le problème de la limite du textBox (ou autre contrôle ?). Mais ce qui est sûr c'est que la limite de Google via l'URL est moins de 2000 caractères. J'ai mis 1000, ce qui est bizarre c'est que la limite via le site, elle, est plus grande !? le PostBack du bouton doit fonctionner d'une autre façon, à exploiter ?
Sechaud : Non IO.File.OpenText ne permet pas de choisir l'encodage : OpenText ne fonctionne qu'en UTF-8. Tu confonds avec IO.File.ReadAllText.
28 mars 2009 à 20:52
Est-ce qu'un RichtBox ne serait pas mieux ? pourquoi ce choix de INKED ?...
Amicalement,
Us.
28 mars 2009 à 19:58
J'ai repris la source en incluant encore qlq améliorations. Vous trouverez tout sur l'adresse précédente. Vbnino, tu peux peut-être reprendre à partir de là...
IL reste encore qlq points importants à traiter, notamment lorsque la source vient d'un copier d'un PDF avec des formules et autres spécificités, l'envoi à GOOGLE déclenche un message d'erreur, qu'alors en directe sur GOOGLE cela passe bien...
Amicalement,
Us.
28 mars 2009 à 17:33
Dans son commentaire du 21 US_30 proposait une modification du Timing et proposait de télécharger sa source : http://fordom.free.fr/us_GOOGLE-TRADUCTION.zip (qui restera qlq jours en ligne)...
J'ai testé son code. J'ai pu constater que les échecs au démarrage sont un peu moins fréquents par contre l'affichage
du temps de connexion n'est pas toujours évident. A vous de tester.
Entre parenthèses, pour ceux qui testent la version de Fabrice, et qui comme moi ont constaté les accents curieux si on charge un fichier, j'ai péniblement trouvé une méthode qui les affiche correctement:
Dim ObjetFichier As System.IO.TextReader
With OpenFileDialog1
.Filter = "Text files (*.txt)|*.txt|All files (*.*)|*.*"
.FilterIndex = 1
' .InitialDirectory = "C:"
.Title = " Ouvrir un fichier "
.CheckFileExists = False
End With
'Charger le fichier
ObjetFichier = System.IO.File.OpenText(OpenFileDialog1.FileName, System.Text.Encoding.Default)
'Lire jusqu'à la fin du fichier.
lgs.Text = ObjetFichier.ReadToEnd
ObjetFichier.Close()
28 mars 2009 à 16:00
Pour info., pour détecter la langue (code auto), on peut aussi laisser le code langue vide. Maintenant cela à l'air de fonctionner, pourtant je n'ai rien changé !?
J'ai mis à jour ma version DotNet, pour charger un fichier c'était ReadAllText et non ReadAllLines qu'il fallait utiliser, pardon pour la mauvaise info ! Effectivement, si on reste en UTF-8 on perd les accents (même si Google arrive à traduire quand même, car le code caractère est quand même transmis) : sous Windows en français, on peut difficilement se passer de l'encodage 1252, tout fonctionne avec ça. Le seul cas que j'ai trouvé où il fallait laisser l'encodage par défaut (encodage non précisé) c'est pour faire un fichier xml international.
Je prépare une nouvelle version...
28 mars 2009 à 14:14
28 mars 2009 à 12:24
Voici qlqs propositions de code pour l'amélioration générale...
=
Pour l'envoi en Mail :
----------------------
- Actuellement, l'envoi en Mail ouvre IE puis le logiciel de messagerie. On peut améliorer les choses en ouvrant uniquement le logiciel de messagerie installé.
Code proposé :
Private Sub Send_By_Mail_Click()
' ENVOYER PAR MAIL
On Error Resume Next
Call ShellExecute(0&, "Open", "mailto:" & "" & "?&Subject=" & "" & "&body=" & result.Text, vbNullString, vbNullString, vbNormalFocus)
End Sub
et... en tête de module mettre :
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Ici, j'ai repris le snippet de PCPT à http://www.codyx.org/snippet_pre-remplir-champs-mail-client-defaut_623.aspx
IL reste que je ne suis pas arrivé à faire passer un texte en caractère unicode UTF8... donc au-delà des 256 caractères...
=
Pour l'affichage en verticale des boites :
------------------------------------------
J'avais fait cette proposition précédemment. Cela améliore l'organisation visuel (selon le besoin de l'utilisateur).
Pour cela rajouter dans le popup les menus :
- Affichage
---- Horizontal (name : Aff_Horizontal checked : TRUE)
---- Vertical (name : Aff_Vertical)
Puis les codes :
' =======================================
' // OPTIONS DES MENUS POPUP AFFICHAGE //
' =======================================
Private Sub Aff_Horizontal_click()
' COCHE/DECOCHE
Aff_Horizontal.Checked = True
Aff_Vertical.Checked = False
Form_Resize
End Sub
Private Sub Aff_vertical_click()
' COCHE/DECOCHE
Aff_Vertical.Checked = True
Aff_Horizontal.Checked = False
Form_Resize
End Sub
... ICI , j'ai le code total de Resize (pour juste faire un copier/coller) ...
Private Sub Form_Resize()
' REDIMENSIONNEMENT DES OBJETS
' Taille mini (évite erreur de calcul taille <0 sans avoir à faire de test)
On Error Resume Next
If Me.Width < 6630 Then Me.Width = 6630 'boutons tj visivibles
If Me.Height < 2300 Then Me.Height = 2300 'boite réduite à 1 ligne
' AFFICHAGE HORIZONTAL
If Aff_Horizontal.Checked Then
' Redéfinition des objets (position, taille)
With Label1
.Left = 10
.Top = 0
.Height = 17
End With
With source
.Left = 10
.Top = Label1.Height
.Width = Me.ScaleWidth - 20
.Height = (Me.ScaleHeight - 2 * Label1.Height - 1.2 * controls_.Height) / 2
End With
With controls_
.Top = source.Height + source.Top + 3
.Left = source.Width + source.Left - .Width
End With
With result
.Left = 10
.Top = Label1.Height + source.Height + 1.2 * controls_.Height
.Width = source.Width
.Height = source.Height
End With
With w
.Left = result.Left
.Top = result.Top
.Width = result.Width
.Height = result.Height
End With
With Check1
.Left = 10
.Top = result.Top + result.Height
End With
With temps_passe
.Top = result.Top + result.Height
.Left = result.Left + result.Width - .Width
End With
With Label2
.Height = 17
.Left = 10
.Top = result.Top - .Height
End With
With w_forward
.Left = source.Width + source.Left - .Width
w_back.Left = .Left - .Width
End With
Else
' AFFICHAGE VERTICAL
' Redéfinition des objets (position, taille)
With Label1
.Left = 10
.Top = 0
.Height = 17
End With
With source
.Left = 10
.Top = Label1.Height
.Width = (Me.ScaleWidth - 30) / 2
.Height = Me.ScaleHeight - 2 * Label1.Height - 1.2 * controls_.Height
End With
With result
.Left = 10 + source.Width + 10
.Top = Label1.Height
.Width = source.Width
.Height = source.Height
End With
With Check1
.Left = 10
.Top = source.Top + source.Height
End With
With controls_
.Top = source.Top + source.Height + Check1.Height
.Left = result.Left + result.Width - .Width
End With
With w
.Left = result.Left
.Top = result.Top
.Width = result.Width
.Height = result.Height
End With
With temps_passe
.Top = result.Top + result.Height
.Left = result.Left + result.Width - .Width
End With
With Label2
.Height = 17
.Left = result.Left
.Top = Label1.Top
End With
With w_forward
.Left = result.Left + result.Width - .Width
w_back.Left = .Left - .Width
End With
End If
End Sub
Note : ME.refresh n'est pas nécessaire, car tout deplacement rafraichie la Form...
=
Autres petites rq : Le Check1 devrait être étirer un peu plus sur la form pour être affiché en totalité... Le Label "temps passé" devrait avoir une taille de police identique aux autres label (8)...
=
Dans la liste des langues :
--------------------------
Comme dit précédemment, il faudrait rajouter dans les listes "Auto sélection" en début (Donc utiliser VBE sur le control mettre Sorted=False pour éviter le tri automatique).
Mais si on utilise l'inversion, on met automatiquement "auto sélection" dans result, qui n'est pas compris dans GOOGLE... donc erreur...
Pour contrer cela, la solution simple est de considérer que la langue de traduction en "auto sélection" est le français. Ce qui donne dans "traduirebtn" le code suivant à rajouter dès le début :
' Choix par défaut langue
If lgr.Text "Auto Sélection" Then lgr.Text "Français"
=
Amicalement,
Us.
26 mars 2009 à 08:52
25 mars 2009 à 18:54
Fais-nous un bouton Lire et un bouton sauver pour que tout le monde en profite.
A+
25 mars 2009 à 16:23
mais j'aurai pas bcp de tps avant ce week-end.
25 mars 2009 à 15:42
Quand je veux relire une traduction sauvée, il ne reconnaît pas systématiquement le sauvetage en UTF 8 .Par contre si je relis avec Open Office, à tous les coups il me propose de décoder l'UTF8. En sauvant en passant par un RichTextBox, comme je l'ai dit, je peux relire la traduction sans filtres et avec les accents corrects.
Je n'ai pas su écrire le bon code avec IO.File.ReadAllLines(sCheminFichier, _
Encoding.GetEncoding(iCodePageWindowsLatin1252))
25 mars 2009 à 10:09
En DotNet, il ne faut pas oublier l'encodage 1252 (code page européen) pour lire un fichier avec les accents :
IO.File.ReadAllLines(sCheminFichier, _
Encoding.GetEncoding(iCodePageWindowsLatin1252))
Au fait pourquoi utiliser du RTF ? Pourquoi vouloir reproduire une mise en forme alors qu'on va traduire du contenu, et non un texte mis en forme ? C'est pour pourvoir utiliser des caractères exotiques ? L'UTF 8 ne sert que pour l'envoi à Google.
25 mars 2009 à 08:51
> Choix_Langue "auto"
"Détecter la langue" peut devenir par exemple "AutoDétect". Ainsi, on rend les combos plus lisibles. J'ai aussi mis des majuscules à "Tagalog" , "Ukrainien , "Vietnamien" mais là je pinaille.
J'ai choisi de mettre en tête les langues que l'on utilise le plus souvent, pour éviter de trop chercher dans les combos:
Select Case Txt
Case "AutoDétect": Choix_Langue "auto" Case "Anglais": Choix_Langue "en"
Case "Français": Choix_Langue = "fr"
Case "Italien": Choix_Langue = "it"
Case "Espagnol": Choix_Langue = "es"
Case "Allemand": Choix_Langue = "de"
...puis ordre alphabétique....
Case "Arabe": Choix_Langue = "ar"
Case "Albanais": Choix_Langue = "sq"
Case "Bulgare": Choix_Langue = "bg"
Case "Catalan": Choix_Langue = "ca"
Case "Chinois (simpl)": Choix_Langue = "zh-CN"
Case "Chinois (trad)": Choix_Langue = "zh-TW"
etc...
Pour la version de Patrice, et pour ceux qui comme moi sont réfractaires au VB.net, mais qui veulent quand même essayer d'apprendre, voici un code simple pour implanter un Bouton Charger et un Bouton Sauver:
'Charger un fichier
Private Sub Chargement_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Chargement.Click
Dim objstreamreader As System.IO.StreamReader
OpenFileDialog1.ShowDialog() 'Affiche la boite de dialogue Open
objstreamreader = System.IO.File.OpenText(OpenFileDialog1.FileName)
tbHaut.Text = objstreamreader.ReadToEnd()
objstreamreader.Close()
End Sub
'Sauver un fichier
Private Sub Sauver_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim objstreamwriter As System.IO.StreamWriter
Dim fichier As String
fichier = tbBas.Text
SaveFileDialog1.ShowDialog() 'Affiche la boite de dialogue Save
objstreamwriter = System.IO.File.AppendText(SaveFileDialog1.FileName)
objstreamwriter.WriteLine(fichier)
objstreamwriter.Close()
End Sub
Ce qui me surprend, moi le novice en VB.net, c'est qu'un fichier texte, en français par exemple, se charge avec les lettres accentuées remplacées par d'autres caractères et plus surprenant encore, Google sait traduire le texte.
Un coller du même texte possède les lettres accentuées normales. Curieux! Qui peut expliquer pourquoi?
Autre chose, j'ai voulu tester un RichTextBox et j'ai découvert que celui de VB 2008 est moins bien que celui de VB6, il ne possède pas de case à cocher pour avoir un menu Clic droit!
J'ai testé avec un RichTextBox car si on en met un (Caché sous source.Text par exemple), et si on écrit RichTextBox.TextRTF = result.TextRTF, après on peut sauver la traduction en RTF et on évite d'avoir recours au filtrage du UTF 8 quand on veut relire.
25 mars 2009 à 00:48
Rajouter aussi "Détecter la langue"... en début de liste semble aussi plus intuitif...
Amicalement,
Us.
25 mars 2009 à 00:35
Que ce soit pour cette source, ou celle de Patrice, la liste des langues ne reprend pas l'intégralité des propositions de google...
Voici la liste des langues à mettre dans les bandeaux :
Albanais
Allemand
Anglais
Arabe
Bulgare
Catalan
Chinois (simplifie)
Chinois (traditionnel)
Coréen
Croate
Danois
Espagnol
Estonien
Finnois
Français
Galicien
Grec
Hébreu
Hindi
Hongrois
Indonésien
Italien
Japonais
Letton
Lituanien
Maltais
Néerlandais
Norvégien
Polonais
Portugais
Roumain
Russe
Serbe
Slovaque
Slovène
Suédois
tagalog
Tchéque
Thaï
Turc
ukrainien
vietnamien
et dans le module choix_langue devient :
Function Choix_Langue(Txt As String) As String
'LA BASE DES LANGUES COMPRIS PAR GOOGLE TRADUCTION
Select Case Txt
Case "Albanais": Choix_Langue = "sq" 'Albanais
Case "Allemand": Choix_Langue = "de" 'Allemand
Case "Anglais": Choix_Langue = "en" 'Anglais
Case "Arabe": Choix_Langue = "ar" 'Arabe
Case "Bulgare": Choix_Langue = "bg" 'Bulgare
Case "Catalan": Choix_Langue = "ca" 'Catalan
Case "Chinois (simplifie)": Choix_Langue = "zh-CN" 'Chinois (simplifie)
Case "Chinois (traditionnel)": Choix_Langue = "zh-TW" 'Chinois (traditionnel)
Case "Coréen": Choix_Langue = "ko" 'Coréen
Case "Croate": Choix_Langue = "hr" 'Croate
Case "Danois": Choix_Langue = "da" 'Danois
Case "Espagnol": Choix_Langue = "es" 'Espagnol
Case "Estonien": Choix_Langue = "et" 'Estonien
Case "Finnois": Choix_Langue = "fi" 'Finnois
Case "Français": Choix_Langue = "fr" 'Français
Case "Galicien": Choix_Langue = "gl" 'Galicien
Case "Grec": Choix_Langue = "el" 'Grec
Case "Hébreu": Choix_Langue = "iw" 'Hébreu
Case "Hindi": Choix_Langue = "hi" 'Hindi
Case "Hongrois": Choix_Langue = "hu" 'Hongrois
Case "Indonésien": Choix_Langue = "id" 'Indonésien
Case "Italien": Choix_Langue = "it" 'Italien
Case "Japonais": Choix_Langue = "ja" 'Japonais
Case "Letton": Choix_Langue = "lv" 'Letton
Case "Lituanien": Choix_Langue = "lt" 'Lituanien
Case "Maltais": Choix_Langue = "mt" 'Maltais
Case "Néerlandais": Choix_Langue = "nl" 'Néerlandais
Case "Norvégien": Choix_Langue = "no" 'Norvégien
Case "Polonais": Choix_Langue = "pl" 'Polonais
Case "Portugais": Choix_Langue = "pt" 'Portugais
Case "Roumain": Choix_Langue = "ro" 'Roumain
Case "Russe": Choix_Langue = "ru" 'Russe
Case "Serbe": Choix_Langue = "sr" 'Serbe
Case "Slovaque": Choix_Langue = "sk" 'Slovaque
Case "Slovène": Choix_Langue = "sl" 'Slovène
Case "Suédois": Choix_Langue = "sv" 'Suédois
Case "tagalog": Choix_Langue = "tl" 'tagalog
Case "Tchéque": Choix_Langue = "cs" 'Tchéque
Case "Thaï": Choix_Langue = "th" 'Thaï
Case "Turc": Choix_Langue = "tr" 'Turc
Case "ukrainien": Choix_Langue = "uk" 'ukrainien
Case "vietnamien": Choix_Langue = "vi" 'vietnamien
End Select
End Function
Amicalement,
Us.
24 mars 2009 à 16:24
24 mars 2009 à 12:12
Patrice99 > En effet, il existe une limite de taille dans la traduction sur GOOGLE. L'idée serait justement d'envoyer par morceau (arrêter à une phrase) le texte et le "recompiler" dans result. Cela donnerait d'ailleurs un plus par rapport au site... idée à creuser...
Par l'ICO, c'est à vbnino qui faut le demander... Perso, je ne fais que des propositions d'améliorations...
Comme vu avec Sechaud par MP, toutes les langues ne sont pas bien codées dans le Module... Par exemple, le Coréen a l'extension "co" au lieu de "ko"... à revoir donc... Nous avons abordés d'autres petites améliorations, ou corrections...
J'essayerais de mettre cela prochainement ici.
Mais juste en passant, le code pour cocher ou décocher la webbrowser, peut simplement s'écrire ainsi :
=
Private Sub Check1_Click()
' AFFICHAGE RESULT
result.Visible (Check1.Value 0)
End Sub
=
Amicalement,
Us.
23 mars 2009 à 12:19
Sinon j'ai testé mon appli sous Vista : pas de pb, aucun msg (pas besoin d'être admin).
Je vais bientôt ajouter un historique (RAM seulement) des traductions avec des boutons pour naviguer en arrière et en avant : pratique pour tester plusieurs solutions quand on écrit un mail en anglais par exemple.
Sinon je crois qu'il faudra vérifier la taille limite qu'on peut passer en URL : un gros texte ne passera pas à mon avis.
22 mars 2009 à 15:54
http://patrice.dargenton.free.fr/tmp/GTradDist.zip
Pour la langue auto, cela à l'air de fonctionner sur le site en ligne, mais il faut que j'y regarde encore dans l'interface, pour le moment cela ne fonctionne pas.
22 mars 2009 à 15:38
La page de Google Traduction possède une option de reconnaissance de la langue.
vbnino n'a pas installé toutes les langues et options.
Si dans le Module1 tu ajoutes:
Case "Détecter la langue": Choix_Langue = "auto"
et dans dans la Combo lgs "Détecter la langue",
tu verras que l'on peut mettre dans source n'importe quelle langue et la traduction se fait dans la langue de notre choix. Ton idée de stocker les langues dans un fichier ini est à exploiter il me semble. Ainsi, chacun pourrait se faire le fichier ini de son choix, sans avoir à reprogrammer
22 mars 2009 à 13:49
22 mars 2009 à 09:59
us_30 : est-ce que tu pourrais m'envoyer le fichier .ico qui correspond à ton appli ? je n'ai pas réussi à le récupérer (il fait 178 Ko si je l'importe en VB2008 et il ne fonctionne pas).
Si quelqu'un a une idée pour détecter la langue, ça serait super (mais là c'est vrai qu'à ce niveau, c'est vraiment du pinaillage :-)
22 mars 2009 à 09:35
21 mars 2009 à 11:35
http://patrice.dargenton.free.fr/tmp/GTradDist.zip (31 Ko, exe inclut)
Remarques :
- Pas de composants externes, que des composants standards
- Sauvegarde dans les paramètres utilisateurs au lieu de la BR (+ pratique pour Vista et pour partager un ordi)
- Code + simple pour redimensionnement par ex., ainsi que pour sauver les paramètres
- Compilateur VB 2008 gratuit contrairement à VB6
- Je ne voie pas trop l'utilité de charger un fichier externe, puisque le copié/collé suffit
- Amélioration possible : sauver la liste des langues dans les paramètres ou dans un fichier externe dans le dossier de l'application
21 mars 2009 à 00:17
J'ai trouvé un moyen simple (proche du code d'origine) pour le pb de temps de connexion... J'ai fait de nbrx tests concluants. Par ailleurs, j'ai apporté également qlq autres modifications. Comme c'est trop long à expliquer, je vous invite à télécharger la source : http://fordom.free.fr/us_GOOGLE-TRADUCTION.zip (qui restera qlq jours en ligne)...
Maintenant, en terme d'améliorations possibles :
- passage en mail de result, en unicode... (dur ! dur!)
- Faire une organisation des boites en verticale (avec choix horizontale) (Code similaire à celui actuellement présent)
Sechaud, tu peux m'écrire en MP, y'a pas de pb.
Amicalement,
Us.
20 mars 2009 à 10:35
J'ai revu mon code et ça marche bien.
J'ai enlevé la ProgressBar et j'ai mis un label qui affiche en s le temps mis pour la traduction.
J'ai utiliseé une autre fonction du WebBrowser:
Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
If Progress = -1 Then
'On initialise le document du contenu HTML
Set Document0 = WebBrowser1.document
'On initialise l'élement qu'on veut, à savoir le resultat
Set Element = Document0.getElementById("result_box")
On Error Resume Next
result.Text = Element.outerText
result.Enabled = True
traduire_inverse.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
Text1.Text = WebBrowser1.LocationURL
Static t As Long
t = t + 100
'Afficher le temps de traduction en secondes
Label5.Caption = Format(t / 10000, "0#.000")
'Le serveur renvoie http:/// et ne renvoie pas l'URL donc on est en échec
If Left(Text1.Text, 8) "http:///" Or result.Text "" Then
MsgBox "La traduction a échoué. Retentez!"
Timer1.Interval = 0
t = 0
'On stoppe le webbrowser
WebBrowser1.stop
result.Text = ""
Exit Sub
End If
'Le serveur renvoie l'URL et le Browser n'est plus occupé: c'est traduit
If Left(Text1.Text, 8) "http://t" And WebBrowser1.Busy False Then
' MsgBox "Traduction réussie"
Timer1.Interval = 0
t = 0
'On stoppe le webbrowser
WebBrowser1.stop
Exit Sub
End If
If t > 100000 Then
MsgBox "Temps imparti dépassé"
Timer1.Interval = 0
t = 0
'On stoppe le webbrowser
WebBrowser1.stop
Exit Sub
End If
End Sub
US, acceptes-tu d'échanger d'autres idées en mail privé pour ne pas ajouter des commentaires sans fins?
Amicalement
Sechaud
20 mars 2009 à 09:30
J'aime bien l'idée du progressbar.
J'ai testé ton code, mais il me semble pas concluant. En effet, lorsqu'on coupe la connexion internet (et donc on est pas en attente de la réponse du serveur en qlq sorte), ben on reste en attente... C'est ce que je voulais aussi contrer...
IL existe peut-être un code pour détecter si la connexion internet est établie ou pas, et dans ce cas on renvoit un message d'erreur du type : "Aucune connexion internet détectée"...
Amicalement,
Us.
19 mars 2009 à 21:29
Oui j'ai constaté, moi aussi, qu'il y avait des ennuis avec le Timer.
Alors j'ai fait autrement:
_J'ai abandonné le Timer d'origine pour en créer un autre
avec Enabled à True et Interval à 0
_Je détecte si le serveur renvoie l'URL. En principe cela signifie qu'il est en mesure de la traiter et je détecte
l'occupation du WebBrowser, pour savoir quand il a fini le travail, ce qui correspond à Busy = False
Voici mon code:
Private Sub traduirebtn_Click()
'Choix des langues
lang_r = Choix_Langue(lgr.Text)
lang_s = Choix_Langue(lgs.Text)
ProgressBar1.Value = 0
Text1.Text = "" 'Réponse de WebBrowser1.LocationURL
result.Text = ""
' Traitement pour la traduction
If Left$(source.Text, 7) <> "http://" Then ' Test si la source débute avec "http://"
If source.Text <> "" Then
' Message d'attente
result = "Traduction en cours ... , cela dépend de la vitesse de votre connexion à Internet."
result.Enabled = False
' Envoi au traducteur Google
WebBrowser1.navigate "http://translate.google.com/translate_t?text=" & UTF8_Encode(source.Text) & "&langpair=" & lang_s & "|" & lang_r
' On active la minuterie
Timer1.Interval = 10
Else
' Message d'instruction
result.Text = "Insérer un texte à traduire."
End If
Else
' Ouverture du lien par Explorer (traitement indépendant)
result.Text = "http://translate.google.fr/translate?u=" & source.Text & "&sl=" & lang_s & "&tl=" & lang_r & "&hl=fr&ie=UTF-8"
Shell "explorer " & """" & result.Text & """", vbMaximizedFocus
End If
End Sub
Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
'On initialise le document du contenu HTML
Set Document0 = WebBrowser1.document
'On initialise l'élement qu'on veut, à savoir le resultat
Set Element = Document0.getElementById("result_box")
On Error Resume Next
result.Text = Element.outerText
result.Enabled = True
traduire_inverse.Enabled = True
Text1.Text = WebBrowser1.LocationURL
End Sub
Private Sub Timer1_Timer()
Static t As Integer
t = t + 100
ProgressBar1.Value = t
'Le serveur renvoie http:/// et ne renvoie pas l'URL donc on est en échec
If Left(Text1.Text, 8) = "http:///" Then
MsgBox "La traduction a échoué. Retentez!"
Timer1.Interval = 0
t = 0
'On stoppe le webbrowser
WebBrowser1.stop
Exit Sub
End If
'Le serveur renvoie l'URL et le Browser n'est plus occupé: c'est traduit
If Left(Text1.Text, 8) "http://t" And WebBrowser1.Busy False Then
MsgBox "Traduction réussie"
Timer1.Interval = 0
t = 0
'On stoppe le webbrowser
WebBrowser1.stop
Exit Sub
End If
If t > 9500 Then
MsgBox "Temps imparti dépassé"
Timer1.Interval = 0
t = 0
'On stoppe le webbrowser
WebBrowser1.stop
Exit Sub
End If
End Sub
On voit que j'ai mis aussi une progress-bar.
Vous enleverez le message qui dit que c'est réussi quand vous aurez testé.
Bonne réussite.
Au passage j'ai aussi mis le WebBrowser sous result et avec un Check.Box mis en graphique je le fais apparaître ou pas ce qui permet de contrôler tout en gagnant de la place.
Voici comment:
Private Sub Check1_Click() 'Montrer ou cacher le WebBrowser
If Check1.Value = 0 Then
result.Visible = True
End If
If Check1.Value = 1 Then
WebBrowser1.Visible = True
result.Visible = False
End If
End Sub
19 mars 2009 à 19:24
Avec un "on error..." dans le redimensionnement :
' Taille mini (évite erreur de calcul taille <0 sans avoir à faire de test)
On Error Resume Next
If Me.Width < 6630 Then Me.Width = 6630 'boutons tj visivibles
If Me.Height < 2300 Then Me.Height = 2300 'boite réduite à 1 ligne
Amicalement,
Us.
19 mars 2009 à 19:16
J'ai un bug dans le timer... je vais réfléchir pour l'améliorer cela.
Sinon pour la redimensionnement des objets, je propose ceci :
=
Private Sub Form_Resize()
' REDIMENSIONNEMENT DES OBJETS
' Taille mini (évite erreur de calcul taille <0 sans avoir à faire de test)
If Me.Width < 6630 Then Me.Width = 6630 'boutons tj visivibles
If Me.Height < 2300 Then Me.Height = 2300 'boite réduite à 1 ligne
w.Left = -100 ' cache le browser
With Label1
.Left = 10
.Top = 0
.Height = 17
End With
With source
.Left = 10
.Top = Label1.Height
.Width = Me.ScaleWidth - 20
.Height = (Me.ScaleHeight - 2 * Label1.Height - 2 * lgs.Height) / 2
End With
With result
.Left = 10
.Top = Label1.Height + source.Height + 2 * lgs.Height
.Width = source.Width
.Height = source.Height
End With
With Label2
.Height = 17
.Left = 10
.Top = result.Top - .Height
End With
With lgs
.Top = result.Top - 1.5 * .Height
permuter.Top = .Top
lgr.Top = .Top
traduirebtn.Top = .Top
traduire_inverse.Top = .Top
save_traduction.Top = .Top
End With
End Sub
=
et la sub LOAD doit être simplifiée, ainsi :
=
Private Sub Form_Load()
' COLORIER L'INTERFACE COMME APPLE
Call Desgin
' Initialisation des langues par défaut ici : Anglais et Français
Call Load_And_Save("load")
End Sub
=
... visuellement, je préfère vraiment plus... (il n'y a plus l'effet élastique).
=
En guise de remarque complémentaire concernant la base de registre, le chemin d'enregistrement devrait être dans "Software", comme tout programme pour éviter de ce perdre... De plus, la sous-rubrique "réglages" ne sert ici à rien. Autant laisser directement Langues_par_défaut. Soit la proposition du code modifié :
=
Sub Load_And_Save(Choix As String)
' BASE DE REGISTRE : REGLAGES DES LANGUES DE TRADUCTION
' Initialisation de l'objet regedit
Set Regedit = CreateObject("Wscript.shell")
If Choix = "load" Then
On Error GoTo Create_Default_Options
lgs.Text = Regedit.regread("HKCU\Software\Google_Traduction\Langues_par_defaut\Langue_source")
lgr.Text = Regedit.regread("HKCU\Software\Google_Traduction\Langues_par_defaut\Langue_result")
' Définition des indices des langues
Lang_r = Choix_Langue(lgr.Text)
Lang_s = Choix_Langue(lgs.Text)
Exit Sub
Else
Regedit.regwrite "HKCU\Software\Google_Traduction\Langues_par_defaut\Langue_source", lgs.Text
Regedit.regwrite "HKCU\Software\Google_Traduction\Langues_par_defaut\Langue_result", lgr.Text
Exit Sub
End If
Create_Default_Options:
Regedit.regwrite "HKCU\Software\Google_Traduction\Langues_par_defaut\Langue_source", "Anglais"
Regedit.regwrite "HKCU\Software\Google_Traduction\Langues_par_defaut\Langue_result", "Français"
lgs.Text = "Anglais"
lgr.Text = "Français"
End Sub
=
Il reste vraiment que le pb du timer... dont une des causes est qu'à initialisation, le status du webbrowser vaut "Terminé"...
Je pense que w_DocumentComplete est peut-être plus adapté.
Amicalement,
Us.
18 mars 2009 à 11:51
Je viens de voir aussi un pb dans la gestion du Timer. IL ne faut pas utiliser la propriété Enable, mais interval.
Si Interval = 0 alors la minuterie n'est pas active, sinon elle est en fonctionnement...
Ainsi, dans la feuille Temps_Perdu, doit être au départ, Enable = True et Interval=0... puis dans : Traduirebtn_Click , on a :
' On active la minuterie
Temps_Perdu.Interval = 10000 '10 secondes
dans : Temps_Perdu_Timer
Temps_Perdu.Interval = 0
à corriger...
Amicalement,
Us.
18 mars 2009 à 10:49
J'ai trouvé qlq simplifications supplémentaires...
La variables Last_focus n'est pas nécessaire, on peut facilement s'en passer. Il suffit donc de la supprimer des déclarations (Dim ...)
puis les parties de code modifiés donnent ceci :
=
Private Sub Source_MouseDown(ByVal Button As Integer, ByVal ShiftKey As Integer, ByVal xMouse As Long, ByVal yMouse As Long)
' AFFICHAGE MENU POPUP SOURCE
Source.SetFocus
Saut.Visible = True
Open_From.Visible = True
If Button = 2 Then PopupMenu edit
End Sub
Private Sub Result_MouseDown(ByVal Button As Integer, ByVal ShiftKey As Integer, ByVal xMouse As Long, ByVal yMouse As Long)
' AFFICHAGE MENU POPUP RESULT
Result.SetFocus
Saut.Visible = False
Open_From.Visible = False
If Button = 2 Then PopupMenu edit
End Sub
Private Sub Select_All_Click()
' SELECTIONNER TOUT
SendKeys "^{A}"
End Sub
Private Sub Highest_text_Click()
' TAILLE POLICE : Plus Grande
main.ActiveControl.Font.Size = 20
End Sub
Private Sub large_text_Click()
' TAILLE POLICE : Grande
main.ActiveControl.Font.Size = 18
End Sub
Private Sub normal_texte_Click()
' TAILLE POLICE : Moyenne
main.ActiveControl.Font.Size = 12
End Sub
Private Sub Small_Text_Click()
' TAILLE POLICE : Petite
main.ActiveControl.Font.Size = 10
End Sub
Private Sub Smaller_Text_Click()
' TAILLE POLICE : Plus Petite
main.ActiveControl.Font.Size = 8
End Sub
=
En clair, comme on donne le Focus à la boite InkEdit (grace à setfocus), on est sur que les popup s'affichent pour l'objet en-dessous. Puis, grace à main.activecontrol, on peut appliquer font.size sans avoir à retenir au préalable le nom de l'objet...
=
Amicalement,
Us.
17 mars 2009 à 22:53
J'ai oublié de passer en revue systématique, les instructions "source" et "result" pour les remplacer par "source.text" et "result.text".
En effet, même si cela peut paraître sans importance capitale au premier abord, doit être une pratique indispensable pour éviter une confusion.
Amicalement,
Us.
17 mars 2009 à 22:43
Je vois moins d'inconviénient à conserver l'exportation des données tel que vbnino l'a programmé. En effet, si on veut une traduction en Hébreu, il faut absolument que cela soit en UTF8 pour être lu sur un logiciel assez puissant (WORD)... (On utilise alors un filtre en UTF8). Sinon, on ne peut rien retrouver... quant au bloc note, ben, pour du texte sans caractère spécial, cela pourra aller sinon tant pis.
Sinon, j'ai repris le code de MAIN, en le restructurant un peu et en y mettant qlq commentaires (bien sur tj un peu perso). J'ai également supprimé qlq petites choses inutiles. "DoEvents" n'a strictement aucune justification ici. L'utilisateur à en permanence la main... La traduction se fait en "parrallèle" et donc permet de faire ce que l'on veut pendant le temps d'attente, même fermer l'application... donc DoEvents ?... Ensuite, dans la base de registre, il est inutile également d'enregistrer les valeurs Lang_r et Lang_s, car elles sont retrouvés avec la fonction Choix_Langue, vu précédemment. Et pour finir, j'ai mis un certain ordre dans les SUB... Ah ! si, aussi, une modification de Selection Tout à ma manière pour rester cohérent avec les raccourcis, mais bon...
Enfin, voici le résultat du code :
=
Option Explicit
' Déclarations
Dim Lang_s As String 'lang_r --> Langue destinataire
Dim Lang_r As String 'lang_s --> Langue source
Dim Tempo As String 'Var. temporaire (permutation des textes)
Dim Document0 As HTMLDocument 'Document0 comme document
Dim Element As HTMLDDElement 'Element comme element d'un document
Dim Regedit As Object 'Objet pour manipulation de la base de registre
Dim Volume As Object 'Objet présent sur la feuille (pour redimensionnement)
Dim Last_Focus As String 'Flag la boite Source ou Result pour popup
' =========================================================
' // INITIALISATIONS ET ACTIONS SUR LA FENETRE GRAPHIQUE //
' =========================================================
Private Sub Form_Load()
' REDIMENSIONNEMENT DES OBJETS : Initialisation
' code celiphane : http://www.vbfrance.com/codes/CODE-REDIMENSIONNER-TOUS-VOS-CONTROLES-PROPORTIONNELLEMENT-REDIMENSIONNEMENT-FENETRE_2621.aspx
On Error Resume Next
Me.Tag = CStr(Me.Width) & ":" & CStr(Me.Height)
For Each Volume In Me
Volume.Tag = CStr(Volume.X1) & ":" & CStr(Volume.Y1) & ";" & CStr(Volume.X2) & "!" & CStr(Volume.Y2)
Volume.Tag = CStr(Volume.Width) & ":" & CStr(Volume.Height) & ";" & CStr(Volume.Left) & "!" & CStr(Volume.Top)
Next Volume
' Initialisation des langues par défaut ici : Anglais et Français
Call Load_And_Save("load")
End Sub
Private Sub Form_Resize()
' REDIMENSIONNEMENT DES OBJETS
' code de celiphane : http://www.vbfrance.com/codes/CODE-REDIMENSIONNER-TOUS-VOS-CONTROLES-PROPORTIONNELLEMENT-REDIMENSIONNEMENT-FENETRE_2621.aspx
' Pour redimensionner les controles
On Error Resume Next
For Each Volume In Me
'pour les graphiques
Volume.X1 = Val(Mid(Volume.Tag, 1, InStr(Volume.Tag, ":") - 1)) * Me.Width / Val(Mid(Me.Tag, 1, InStr(Me.Tag, ":") - 1))
Volume.Y1 = Val(Mid(Volume.Tag, InStr(Volume.Tag, ":") + 1, Len(Volume.Tag) - InStr(Volume.Tag, ":") + 1)) * Me.Height / Val(Mid(Me.Tag, InStr(Me.Tag, ":") + 1, Len(Me.Tag) - InStr(Me.Tag, ":") + 1))
Volume.X2 = Val(Mid(Volume.Tag, InStr(Volume.Tag, ";") + 1, Len(Volume.Tag) - InStr(Volume.Tag, ";") + 1)) * Me.Width / Val(Mid(Me.Tag, 1, InStr(Me.Tag, ":") - 1))
Volume.Y2 = Val(Mid(Volume.Tag, InStr(Volume.Tag, "!") + 1, Len(Volume.Tag) - InStr(Volume.Tag, "!") + 1)) * Me.Height / Val(Mid(Me.Tag, InStr(Me.Tag, ":") + 1, Len(Me.Tag) - InStr(Me.Tag, ":") + 1))
'pour le reste
Volume.Width = Val(Mid(Volume.Tag, 1, InStr(Volume.Tag, ":") - 1)) * Me.Width / Val(Mid(Me.Tag, 1, InStr(Me.Tag, ":") - 1))
Volume.Height = Val(Mid(Volume.Tag, InStr(Volume.Tag, ":") + 1, Len(Volume.Tag) - InStr(Volume.Tag, ":") + 1)) * Me.Height / Val(Mid(Me.Tag, InStr(Me.Tag, ":") + 1, Len(Me.Tag) - InStr(Me.Tag, ":") + 1))
Volume.Left = Val(Mid(Volume.Tag, InStr(Volume.Tag, ";") + 1, Len(Volume.Tag) - InStr(Volume.Tag, ";") + 1)) * Me.Width / Val(Mid(Me.Tag, 1, InStr(Me.Tag, ":") - 1))
Volume.Top = Val(Mid(Volume.Tag, InStr(Volume.Tag, "!") + 1, Len(Volume.Tag) - InStr(Volume.Tag, "!") + 1)) * Me.Height / Val(Mid(Me.Tag, InStr(Me.Tag, ":") + 1, Len(Me.Tag) - InStr(Me.Tag, ":") + 1))
Next Volume
End Sub
Private Sub Form_Unload(Cancel As Integer)
' SAUVEGARDE PARAMETRES LANGUES
Call Load_And_Save("save")
End Sub
Sub Load_And_Save(Choix As String)
' BASE DE REGISTRE : REGLAGES DES LANGUES DE TRADUCTION
' Initialisation de l'objet regedit
Set Regedit = CreateObject("Wscript.shell")
If Choix = "load" Then
On Error GoTo Create_Default_Options
lgs.Text = Regedit.regread("HKCU\Google_Traduction\réglages\Langues_par_defaut\Langue_source")
lgr.Text = Regedit.regread("HKCU\Google_Traduction\réglages\Langues_par_defaut\Langue_result")
' Définition des indices des langues
Lang_r = Choix_Langue(lgr.Text)
Lang_s = Choix_Langue(lgs.Text)
Exit Sub
Else
Regedit.regwrite "HKCU\Google_Traduction\réglages\Langues_par_defaut\Langue_source", lgs.Text
Regedit.regwrite "HKCU\Google_Traduction\réglages\Langues_par_defaut\Langue_result", lgr.Text
Exit Sub
End If
Create_Default_Options:
Regedit.regwrite "HKCU\Google_Traduction\réglages\Langues_par_defaut\Langue_source", "Anglais"
Regedit.regwrite "HKCU\Google_Traduction\réglages\Langues_par_defaut\Langue_result", "Français"
End Sub
' ================================================
' // ACHIFFAGE DES MENUS POPUP SOURCE ET RESULT //
' ================================================
Private Sub Source_MouseDown(ByVal Button As Integer, ByVal ShiftKey As Integer, ByVal xMouse As Long, ByVal yMouse As Long)
' AFFICHAGE MENU POPUP SOURCE
Source.SetFocus
Last_Focus = "source"
Saut.Visible = True
Open_From.Visible = True
If Button = 2 Then PopupMenu edit
End Sub
Private Sub Result_MouseDown(ByVal Button As Integer, ByVal ShiftKey As Integer, ByVal xMouse As Long, ByVal yMouse As Long)
' AFFICHAGE MENU POPUP RESULT
Result.SetFocus
Last_Focus = "result"
Saut.Visible = False
Open_From.Visible = False
If Button = 2 Then PopupMenu edit
End Sub
' ==============================================
' // OPTIONS DES MENUS POPUP SOURCE ET RESULT //
' ==============================================
Private Sub Paste_Click()
' COLLER
SendKeys "^{V}"
End Sub
Private Sub Copy_Click()
' COPIER
SendKeys "^{C}"
End Sub
Private Sub Select_All_Click()
' SELECTIONNER TOUT
If Last_Focus = "source" Then
Source.SetFocus
Else
Result.SetFocus
End If
SendKeys "^{a}"
End Sub
Private Sub Open_From_Click()
' OUVRIR UN FICHIER TEXTE
Dim file As New FileSystemObject
Dim contenu As TextStream 'Pour récupérer le contenu du fichier texte
Cmd.ShowOpen
If Cmd.FileName <> "" Then
Set contenu = file.OpenTextFile(Cmd.FileName, ForReading, False, TristateUseDefault)
Source.Text = contenu.ReadAll
End If
End Sub
Private Sub Highest_text_Click()
' TAILLE POLICE : Plus Grande
If Last_Focus = "source" Then
Source.Font.Size = 20
Else
Result.Font.Size = 20
End If
End Sub
Private Sub large_text_Click()
' TAILLE POLICE : Grande
If Last_Focus = "source" Then
Source.Font.Size = 18
Else
Result.Font.Size = 18
End If
End Sub
Private Sub normal_texte_Click()
' TAILLE POLICE : Moyenne
If Last_Focus = "source" Then
Source.Font.Size = 12
Else
Result.Font.Size = 12
End If
End Sub
Private Sub Small_Text_Click()
' TAILLE POLICE : Petite
If Last_Focus = "source" Then
Source.Font.Size = 10
Else
Result.Font.Size = 10
End If
End Sub
Private Sub Smaller_Text_Click()
' TAILLE POLICE : Plus Petite
If Last_Focus = "source" Then
Source.Font.Size = 8
Else
Result.Font.Size = 8
End If
End Sub
' =======================================
' // ACHIFFAGE DES MENUS POPUP ENVOYER //
' =======================================
Private Sub Save_Traduction_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' AFFICHAGE MENU POPUP ENVOYER
PopupMenu Envoi
End Sub
' =====================================
' // OPTIONS DES MENUS POPUP ENVOYER //
' =====================================
Private Sub Exporter_Text_Click()
' EXPORTATION DE RESULT
'Exporter la source et le contenu dans un fichier texte(.txt) ou word 1997-2003(.doc)
Dim file As New FileSystemObject
Dim contenu As TextStream
Cmd.Filter = "(*.txt) Fichier Texte|*.txt|(*.doc) Fichier Word 1997-2003|*.doc|"
Cmd.ShowSave
If Cmd.FileName <> "" Then
Set contenu = file.CreateTextFile(Cmd.FileName, True, False)
contenu.Write "Texte originale en " & lgs.Text & " :" & vbCrLf _
& String$(54, "-") & vbCrLf _
& UTF8_Encode(Source) & vbCrLf _
& String$(54, "-") & vbCrLf _
& "Ce qui suit et traduit avec Google Traduction en " & lgr.Text & " :" & vbCrLf _
& String$(54, "-") & vbCrLf _
& UTF8_Encode(Result.Text)
End If
End Sub
Private Sub Send_By_Mail_Click()
' ENVOYER PAR MAIL
On Error Resume Next
Clipboard.SetText Result
Shell "explorer.exe mailto:", vbNormalFocus
End Sub
' =========================
' // TRAITEMENTS BOUTONS //
' =========================
Private Sub Permuter_Click()
' PERMUTATION DES LANGUES
Tempo lgr.Text: lgr.Text lgs.Text: lgs.Text = Tempo
End Sub
Private Sub Traduire_Inverse_Click()
' TRADUCTION INVERSEE
'on change la source avec le resultat
Source = Result
'On permute
Call Permuter_Click
'Puis en traduit le tout
Call Traduirebtn_Click
End Sub
Private Sub Traduirebtn_Click()
' TRADUCTION GOOGLE
' Définition des indices des langues
Lang_s = Choix_Langue(lgs.Text)
Lang_r = Choix_Langue(lgr.Text)
' Traitement pour la traduction
If Left$(Source, 7) <> "http://" Then ' Test si la source débute avec une forme de lien "http://"
If Source <> "" Then
' Message d'attente
Result = "Traduction en cours ... , cela dépend de la vitesse de votre connexion à Internet."
Result.Enabled = False
' Envoi au traducteur Google
W.navigate "http://translate.google.com/translate_t?text=" & UTF8_Encode(Source.Text) & "&langpair=" & Lang_s & "|" & Lang_r
' On active la minuterie
Temps_Perdu.Enabled = True
Else
' Message d'instruction
Result = "Insérer un texte à traduire."
End If
Else
' Ouvrerture du lien par Explorer (traitement indépendant)
Result = "http://translate.google.fr/translate?u=" & Source.Text & "&sl=" & Lang_s & "&tl=" & Lang_r & "&hl=fr&ie=UTF-8"
Shell "explorer " & """" & Result & """", vbMaximizedFocus
End If
End Sub
Private Sub w_StatusTextChange(ByVal Text As String)
' FIN DE LA TRADUCTION DE GOOGLE ?
'On test si le chargement de la page est terminé
If Text = "Terminé" Then
'On inisialise le document du contenu HTML
Set Document0 = W.document
'On initialise l'element qu'on veut à savoir le resultat
Set Element = Document0.getElementById("result_box")
On Error Resume Next
Temps_Perdu.Enabled = False
Result.Text = Element.outerText
Result.Enabled = True
Traduire_Inverse.Enabled = True
End If
End Sub
Private Sub Temps_Perdu_Timer()
' TRAITEMENT ERREUR TRADUCTION
' ARRET en cas de dépassement du delai d'attente
W.stop 'On stop le webbrowser
Result.Text = "Délai dépassé , vérifié vos paramétres de connecion à Internet."
Result.Enabled = True
Temps_Perdu.Enabled = False
End Sub
=
Bon, j'ose penser que cette version est un peu mieux visuellement, mais ne change rien en réalité. Il fonctionne normalement sans pb, les modifs étant mineurs.
Le redimensionnement reste peut-être à améliorer, même si pas trop mal. Je pense qu'il faudrait garder des points fixes (par exemple , "texte à traduire") et aussi garder des bordures contantes, etc...
Comme Sechaud, je me joins à ses encouragements pour les améliorations que tu as apporté à cette source...
Amicalement,
Us.
17 mars 2009 à 20:02
Attention par contre avec ta Sub de sauvetage.
Tu as mis cmd.ShowOpen au lieu de cmd.ShowSave...
Ça marche quand même mais ce n'est pas logique.
Autre chose, avec FileSystemObject, le result.txt est sauvé en UTF 8 ce qui donne des caractères bizarres quand on veut relire avec le Bloc note ou un autre traitement de texte.
J'ai fait plus simple et on peut relire:
Private Sub exporter_text_Click()
Dim FileName As String
On Error GoTo Annuler
Cmd.ShowSave
FileName = Cmd.FileName
Open FileName For Output As #1
Print #1, source.Text
Print #1, ""
Print #1, result.Text
Close #1
MsgBox "Votre fichier est sauvé!"
Exit Sub
Annuler:
End Sub
*******************************************
Petite info:
J'ai testé le programme sous XP et sous VISTA et ça va.
Par contre sous le nouveau Windows Seven, on est surpris.
Le programme démarre bien puis dit temps dépassé et pas de traduction dans result.
Si on rend visible le Webbrowser, on s'aperçoit que tout s'est bien passé et que la traduction est réalisée dans Google traduction.
Donc c'est la recopie dans result qui ne se fait pas mais pour le moment je n'ai pas compris pourquoi.
Il est vrai que Seven n'est pas encore au point et de plus, pour faire fonctionner nos programmes en VB6, il faut mettre la sécurité au minimum...
17 mars 2009 à 11:31
En effet, retenir dans une variable l'endroit où le menu est appeler, pour l'utiliser ensuite afin de condenser le codage et éviter ainsi de créer deux menus est une bonne autre solution.
On peut également, penser à "mixer" ces deux proposition pour continuer à l'utiliser l'astuce des raccourcis clavier... c'est comme on le sent ensuite...
Amicalement,
Us.
17 mars 2009 à 08:47
Il me semble que les sub source_Click et result_Click
n'attribuent pas correctement le focus, lors du clic droit, pour avoir le Popup et les problèmes viennent ensuite.(Un clic gauche fait au préalable arrangeait les choses).D'ailleurs, vbnino a ôté ces sub dans sa dernière mise à jour.
Pour éviter ce double cliquage j'ai testé avec succès ceci:
-Remettre Dim last_focus As String
-Modifier les sub MouseDown comme ceci =>
Private Sub source_MouseDown(ByVal Button As Integer, ByVal ShiftKey As Integer, ByVal xMouse As Long, ByVal yMouse As Long)
' On affiche le menu si le clic droit est selectionné dans source.text
source.SetFocus
last_focus = "source"
If Button = 2 Then
PopupMenu edit
End If
End Sub
Private Sub result_MouseDown(ByVal Button As Integer, ByVal ShiftKey As Integer, ByVal xMouse As Long, ByVal yMouse As Long)
result.SetFocus
last_focus = "result"
' On affiche le menu si le clic droit est selectionné dans result.text
If Button = 2 Then
PopupMenu edit
End If
End Sub
_Pour charger où on veut:
Private Sub ChargerFichier_Click()
Dim file As New FileSystemObject
Dim contenu As TextStream
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
Set contenu = file.OpenTextFile(CommonDialog1.FileName, ForReading, False, TristateUseDefault)
If last_focus = "source" Then
source.Text = contenu.ReadAll
End If
If last_focus = "result" Then
result.Text = contenu.ReadAll
End If
End If
End Sub
Pour tout sélectionner
'SELECTIONNER TOUT
Private Sub Selectout_Click()
If last_focus = "source" Then
source.SetFocus
source.SelStart = 0
source.SelLength = Len(source.Text)
End If
If last_focus = "result" Then
result.SetFocus
result.SelStart = 0
result.SelLength = Len(result.Text)
End If
End Sub
16 mars 2009 à 23:20
En ce qui concerne les menus popup, il me semble que la solution proposée par Sechaud était plus assurée, dans le sens où il n'y a pas de confusion entre la source et le résultat... En effet, actuellement tu appliques le même popup quelque soit le menu, or si la selection par l'utilisateur n'est pas effective, on peut arriver à faire (par exemple) un coller dans la boite resultat, en ayant un menu popup affiché sur la boite source... curieux pour l'utilisateur lambda... c'est encore plus évident avec le fichier à ouvrir qu'on peut activer dans la boite "result" mais s'appliquant à la source...
Le mieux, serait de faire 2 menus distincts pour chaque boite. Et si tu veux utiliser l'astuce des raccourcis clavier, il suffit alors de cibler la boite correspondante en la selectionnant (ici lui envoyer le Focus) avant SendKeys...
=
En clair, dans Main faire deux menus ainsi :
1er menu
--------
caption : &Edition_Source / name : edit_source
caption : ...&Copier / name : copy_source
caption : ...Co&ller / name : paste_source
caption : ...&Selectionner Tout / name : AllSelect_source
caption : ...- / name : jump
caption : ...&Traduire à partir d'un fichier texte / name : open_from_source
2 ime Menu
----------
identique en structure avec les noms "result" au lieu de "source", et sans la dernière option.
=
Puis les codes :
Private Sub copy_source_Click()
source.SetFocus
SendKeys "^{C}"
End Sub
Private Sub Allselect_source_Click()
source.SetFocus
SendKeys "^{a}"
End Sub
Private Sub paste_source_Click()
source.SetFocus
SendKeys "^{V}"
End Sub
Private Sub open_from_source_Click()
Dim file As New FileSystemObject
Dim contenu As TextStream
cmd.ShowOpen
If cmd.FileName <> "" Then
Set contenu = file.OpenTextFile(cmd.FileName, ForReading, False, TristateUseDefault)
source.Text = contenu.ReadAll
End If
End Sub
Private Sub copy_result_Click()
result.SetFocus
SendKeys "^{C}"
End Sub
Private Sub Allselect_result_Click()
result.SetFocus
SendKeys "^{a}"
End Sub
Private Sub paste_result_Click()
result.SetFocus
SendKeys "^{V}"
End Sub
Private Sub result_MouseDown(ByVal Button As Integer, ByVal ShiftKey As Integer, ByVal xMouse As Long, ByVal yMouse As Long)
' Affichage popup
If Button = 2 Then PopupMenu edit_result
End Sub
Private Sub source_MouseDown(ByVal Button As Integer, ByVal ShiftKey As Integer, ByVal xMouse As Long, ByVal yMouse As Long)
' Affichage popup
If Button = 2 Then PopupMenu edit_source
End Sub
=
On pourrait également rajouter l'option "Effacer tout", avec la combinaison "Selection Tout" + DEL, soit par exemple :
Private Sub Clear_source_click()
source.SetFocus
SendKeys "^{a}{DEL}"
End Sub
=
Amicalement,
Us.
16 mars 2009 à 22:03
P'tite remarque de presque rien, concernant l'info bulle du texte à traduire... Il y a une faute d'accord : "des mots"... avec un s.
Perso, je préfère écrire : "Taper,Glisser ou Ouvrir un fichier texte à traduire..."
Enfin, noter les différents moyens de rentrer le texte à traduire...
Sinon, une autre piste de réflexion concernant la mise en forme, c'est de pouvoir dimensionner les boites de texte en fonction de la taille de Main (en la mettant en BorderStyle sur 5 (réglable) )... La taille étant parfois un peu petite, pour une lecture rapide, à mon sens...
Amicalement,
Us.
16 mars 2009 à 11:22
Félicitations à US-30 pour la gestion des textes nécessitant l'UTF 8 . Ca marche bien.
15 mars 2009 à 20:24
Lire : "comme on trouve plein de chose sur VBF"
à la place de : "comme on trouve pas de chose sur VBF"
Us.
15 mars 2009 à 20:23
Eurêka !
Pour faire la traduction des langues Arabe, Grec et autres, utilisant
des alphabets codés en unicode par GOOGLE, il faut les convertir en
unicode UTF8...
Pour un peu d'explication sur le sujet voici une page à lire :
http://sebsauvage.net/python/charsets_et_encoding.html
Pour le codage en VB6 de UTF8, comme on trouve pas de chose sur VBF, je suis
tombé sur le code (parfait) de "fredlynx"... à la page :
http://www.vbfrance.com/forum/sujet-TRANSFORMER-TEXTE-UTF-AVEC-VB6_220964.aspx
=
Pour intégrer donc cette conversion, il suffit de mettre un Module2 et de coller
le code suivant : (donc de fredlynx)
=
Option Explicit
' http://www.vbfrance.com/forum/sujet-TRANSFORMER-TEXTE-UTF-AVEC-VB6_220964.aspx
' de fredlynx
Private Declare Function MultiByteToWideChar Lib "Kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_ACP = 0
Private Const CP_UTF8 = 65001
Public Function UTF8_Encode(ByVal Text As String) As String
Dim sBuffer As String
Dim lLength As Long
lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), -1, 0, 0, 0, 0)
sBuffer = Space$(lLength)
lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(Text), -1, StrPtr(sBuffer), Len(sBuffer), 0, 0)
sBuffer = StrConv(sBuffer, vbUnicode)
UTF8_Encode = Left$(sBuffer, lLength - 1)
End Function
Public Function UTF8_Decode(ByVal Text As String) As String
Dim lLength As Long
Dim sBuffer As String
Text = StrConv(Text, vbFromUnicode)
lLength = MultiByteToWideChar(CP_UTF8, 0, StrPtr(Text), -1, 0, 0)
sBuffer = Space$(lLength)
lLength = MultiByteToWideChar(CP_UTF8, 0, StrPtr(Text), -1, StrPtr(sBuffer), Len(sBuffer))
UTF8_Decode = Left$(sBuffer, lLength - 1)
End Function
=
Puis de modifier la ligne d'envoi dans "traduirebtn_Click", par :
' Envoi au traducteur Google
w.navigate "http://translate.google.com/translate_t?text=" & UTF8_Encode(source.Text) & "&langpair=" & lang_s & "|" & lang_r
et le tour est joué !
=
Maintenant, on peut également de manière équivalente, le code de conversion de "EBArtSoft"
proposé en snippets :
http://www.codyx.org/snippet_ainsi-vers-utf8-vice-versa_54.aspx
ce qui donnera la modification de la ligne d'appel, comme ceci :
w.navigate "http://translate.google.com/translate_t?text=" & AToUTF8(source.Text) & "&langpair=" & lang_s & "|" & lang_r
=
Amicalement,
Us.
Amicalement,
Us.
15 mars 2009 à 09:58
Pour ceux qui veulent essayer voici un peu d'aide:
' Pour gérer l'annuler du menu
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const EM_GETSEL = &HB0
Const EM_SETSEL = &HB1
Const EM_UNDO = &HC7
Const EM_CANUNDO = &HC6
'##################################################
'GESTION DES MENUS DE EDITION
'#################################################
Private Sub mnuEdition_Click()
If source.SelText = "" Then 'aucun texte sélectionné
mnuEditionCouper.Enabled = False
mnuEditionCopier.Enabled = False
mnuEditionEffacer.Enabled = False
Else 'si texte sélectionné
mnuEditionCouper.Enabled = True
mnuEditionCopier.Enabled = True
mnuEditionEffacer.Enabled = True
End If
If Clipboard.GetText() = "" Then 'aucun texte dans le Presse-papiers
mnuEditionColler.Enabled = False
mnuEditionAnnuler.Enabled = False
Else 'si texte dans le Presse-papiers
mnuEditionColler.Enabled = True
mnuEditionAnnuler.Enabled = True
End If
End Sub
'ANNULER
Private Sub mnuEditionAnnuler_Click()
On Local Error Resume Next
Dim undoResult
If (SendMessage(source.hwnd, EM_CANUNDO, 0, 0)) Then
undoResult = SendMessage(source.hwnd, EM_UNDO, 0, 0)
End If
End Sub
'COUPER
Private Sub mnuEditionCouper_Click()
Clipboard.Clear
Clipboard.SetText source.SelText
source.SelText = ""
End Sub
'COLLER
Private Sub mnuEditionColler_Click()
On Local Error Resume Next
source.SelText = ""
source.SelText = Clipboard.GetText()
End Sub
'COPIER
Private Sub mnuEditionCopier_Click()
On Local Error Resume Next
Clipboard.Clear
Clipboard.SetText source.SelText
End Sub
'EFFACER
Private Sub mnuEditionEffacer_Click()
On Local Error Resume Next
Call mnuEditionCopier_Click
source.SetFocus
source.SelText = ""
End Sub
'SELECTIONNER TOUT
Private Sub mnuEditionSelectout_Click()
source.SetFocus
source.SelStart = 0
source.SelLength = Len(source.Text)
End Sub
Private Sub source_MouseUp(ByVal Button As Integer, ByVal ShiftKey As Integer, ByVal xMouse As Long, ByVal yMouse As Long)
' On affiche le menu si le clik droit est selectionné
If Button = 2 Then
PopupMenu mnuEdition
End If
End Sub
*****************
Bonne programmation
13 mars 2009 à 11:51
Par contre, pourquoi aller écrire dans la Base de registre alors qu'un petit fichier ini suffirait à mémoriser nos choix. Personnellement j'ai supprimé ça
et mis dans le load:
'Initialisation des langues par défaut ici : Anglais et Français
lang_s = "en"
lang_r = "fr"
lgs.Text = "Anglais"
lgr.Text = "Français"
Je ne connaissais pas Inked.dll et je constate, chez moi, qu'un clic droit ne donne pas de popup permettant de coller le texte à traduire. On doit utiliser le Control + v pour coller le texte que l'on veut traduire.
Ce qui serait bien c'est de pouvoir charger un fichier, mais reste à savoir comment. Pour le moment je n'ai pas trouvé d'infos correctes sur l'utilistion de cette dll.
Dans Google traduction, on a accès au popup et comme le dit US_30 on gère aussi une adresse Web. Donc, à mon avis il eut été plus simple de seulement utiliser le WebBrowser et d'appeler la page de Google Traduction.
mais reste que ton travail est valable car il permet de dimensionner les pages sources et résultat.
12 mars 2009 à 16:11
Exit Sub
End If
create_default_options:
Ok pour INKED.DLL, cela fonctionne aussi en VB6 maintenant.
RICHTX32.OCX n'est pas utilisé dans Google_Traduction.vbp : tu peux l'enlever en éditant le fichier avec le bloc-notes, cela facilite la distribution et la migration.
Pour l'ergonomie, c'est déjà mieux que ce que fait Google lui-même, car Google lui ne propose pas de permuter le texte (on est obligé de faire un copié/collé sur leur site). Mais personnellement moi j'aurais plutôt mis 2 flèches, une vers le bas et une vers le haut, et j'aurai mis les combos en haut et en bas, mais bon, chacun fait comme il le sent. Bonne idée de source en tout cas, bravo.
11 mars 2009 à 22:12
J'ai pas la solution, mais une piste.
Visiblement pour les langues faisant appellent au jeu de caractère étendu (unicode), Google attend un codage du texte... exemple, ton message en arabe doit etre envoyé avec ceci :
http://translate.google.fr/translate_t#ar|en|%D9%85%D8%B1%D8%AD%D8%A8%D8%A7%20%D8%8C%20%D8%A3%D9%86%D8%A7%20%D8%A7%D8%B3%D8%AA%D8%AE%D8%AF%D8%A7%D9%85%20%D8%AC%D9%88%D8%AC%D9%84%20%D9%84%D9%84%D8%AA%D8%B1%D8%AC%D9%85%D8%A9
IL faut voir du côté des caractères unicode, mais je n'ai pas trouvé comment retrouver les valeurs que google a besoin...
SI cela peut d'aider a y voir clair, voici un bout code donnant le message en unicode (en nb decimal) à mettre dans traduirebtn_Click...
Dim t, message
For t = 1 To Len(source)
message = message & AscW(Mid(source, t, 1)) & " "
Next t
MsgBox message
Hélas, la conversion en Hex ne semble pas donner les bonnes valeurs à passer à Google. De plus, Google tient compte du sens de l'écriture, qui ici est de la droite vers la gauche.
Amicalement,
Us.
11 mars 2009 à 17:14
-Patrice99 j'ai ajouté les 2 améliorations demandé.
-Par contre si vous pouvez m'aider , quand je tape un texte en arabe et après la traduction , je reçois dans le résultat que des ??????
-Quelle-q'un peux m'aider ?
Merci
11 mars 2009 à 16:13
Petite amélioration pas mal à faire : mémoriser les 2 langues en quittant et les rappeler au prochain démarrage, et faire 2 boutons traduire : l'un dans un sens, et l'autre dans l'autre sens, ce qui permet d'éditer un texte aussi bien dans la langue source que dans la langue de destination, ce qui permet de vérifier et d'essayer plusieurs traductions.
11 mars 2009 à 00:53
Amicalement,
Us.
11 mars 2009 à 00:50
11 mars 2009 à 00:42
Private Sub permuter_Click()
' Permutation des langues
Tempo lgr.Text: lgr.Text lgs.Text: lgs.Text = Tempo
End Sub
Amicalement,
Us.
11 mars 2009 à 00:36
Select Case Txt
Case "Anglais": Choix_Langue = "en"
Case "Français": Choix_Langue = "fr"
Case "Arabe": Choix_Langue = "ar"
Case "Italien": Choix_Langue = "it"
Case "Espagnol": Choix_Langue = "es"
Case "Bulgare": Choix_Langue = "bg"
Case "Albanais": Choix_Langue = "sq"
Case "Allemand": Choix_Langue = "de"
Case "Chinois": Choix_Langue = "zh-CN"
Case "Grec": Choix_Langue = "el"
Case "Hébreu": Choix_Langue = "iw"
Case "Japonais": Choix_Langue = "ja"
Case "Roumain": Choix_Langue = "ro"
Case "Catalan": Choix_Langue = "ca"
Case "Danois": Choix_Langue = "da"
Case "Estonien": Choix_Langue = "et"
Case "Hindi": Choix_Langue = "hi"
Case "Indonésien": Choix_Langue = "id"
Case "Norvégien": Choix_Langue = "no"
Case "Lituanien": Choix_Langue = "lt"
Case "Maltais": Choix_Langue = "mt"
Case "Néerlandais": Choix_Langue = "nl"
Case "Polonais": Choix_Langue = "pl"
Case "Turc": Choix_Langue = "tr"
Case "ukrainien": Choix_Langue = "uk"
End Select
Amicalement,
Us.
11 mars 2009 à 00:34
D'autre pb du même genre peuvent se produire... Un exemple simple : tape "http://www.vbfrance.com/codes/GOOGLE-TRADUCTION_49461.aspx" à traduire du français en anglais...
Une solution, c'est regarder avant d'envoyer le texte, si c'est une page Web... et dans ce cas ne pas l'envoyer afin d'éviter l'erreur... ou trouver une autre solution meilleure... -:);
Amicalement,
Us.
10 mars 2009 à 23:50
En guise d'amélioration, il faudrait mettre la boite de texte "source" en multilignes.
Ensuite, il faudrait également changer la police en fonction de la langue traduite, car pour le chinois ou autre, la police de caractère renvoi des "?" ...
=
Pour le code, on peut également simplifier le choix de la langue par une fonction dans un module, comme ceci :
Function Choix_Langue(Txt As String) As String
Select Case Txt
Case "Anglais": Choix_Langue = "en"
Case "Français": Choix_Langue = "fr"
Case "Arabe": Choix_Langue = "ar"
Case "Italien": Choix_Langue = "it"
Case "Espagnol": Choix_Langue = "es"
Case "Bulgare": Choix_Langue = "bg"
Case "Albanais": Choix_Langue = "sq"
Case "Allemand": Choix_Langue = "de"
Case "Chinois": Choix_Langue = "zh-CN"
Case "Grec": Choix_Langue = "el"
Case "Hébreu": Choix_Langue = "iw"
Case "Japonais": Choix_Langue = "ja"
Case "Roumain": Choix_Langue = "ro"
Case "Russe": Choix_Langue = "ru"
End Select
End Function
=
puis, les clicks sur les bandeaux sont inutiles... le reste du code, pourrait plus simplement être ainsi :
' Déclarations des paramètres
Dim lang_s As String 'lang_r --> Langue destinataire
Dim lang_r As String 'lang_s --> Langue source
Dim Tempo As String
Dim Document0 As HTMLDocument 'Document0 comme document
Dim Element As HTMLDDElement 'Element comme element d'un document
Private Sub Form_Load()
' Initialisation des langues par défaut ici : Anglais et Français
lang_s = "en"
lang_r = "fr"
End Sub
Private Sub permuter_Click()
' Permutation des langues
Tempo lgs.Text: lgr.Text lgs.Text: lgs.Text = Tempo
End Sub
Private Sub traduire_Click()
' Envoi au traducteur Google
'Message
Result.Text = "Traduction en cours ..."
Result.Enabled = False
'Choix des langues
lang_r = Choix_Langue(lgr.Text)
lang_s = Choix_Langue(lgs.Text)
'le w c'est notre WebBrowser
w.navigate "http://translate.google.com/translate_t?text=" & Source & "&langpair=" & lang_s & "|" & lang_r
End Sub
Private Sub w_StatusTextChange(ByVal Text As String)
'On test si le chargement de la page est terminé
If Text = "Terminé" Then
'On inisialise le document du contenu HTML
Set Document0 = w.document
'On initialise l'element qu'on veut à savoir le resultat
Set Element = Document0.getElementById("result_box")
On Error Resume Next
Result = Element.outerText
Result.Enabled = True
End If
End Sub
=
Voilà... On pourrait penser à plus d'options ensuite, comme la reconnaissance de la langue du PC utilisateur, pour la mettre par défaut, ou encore identifier la langue du texte à traduire (par statistique) pour la proposer également par défaut... Bref, imaginer des petits plus, par rapport à l'interface de Google...
=
Amicalement,
Us.
10 mars 2009 à 13:25
J'aime beaucoup. Il est simple...
Néanmoins, comme le sugère Patate, un meilleur typage des variables serait une bonne chose... bien qu'elles sont toutes déclarées, elles ne le sont pas toutes avec la défintion de leur type... mais bon...
Ensuite sous VBE, lors de l'initialisation, il faut rajouter la gestion d'erreur...
En clair, il faut rajouter ON ERROR RESUME NEXT :
Set Element = Document0.getElementById("result_box")
On Error Resume Next
result.Text = Element.outerText
Cettte gestion est nécessaire au lancement, car l'initialisation complète ne peut être fait qu'à l'issu du chargement complet de l'application.
En attendant cette petite correction : 10/10...
Amicalement,
Us.
10 mars 2009 à 12:18