Je cherche a faire un dictionnaire allemand de tous les mots de 2 lettres.
J'ai besoin d'une âme charitable pour me le faire (je ne parle pas allemand).
Voici le programme. Enregistrez le quelque part et executez le. Remplissez les cases correspondant a des mots allemands et enregistrez les.
Quand vous aurez fini, veuillez zipper le dossier "dico-german" et me l'envoyer sur mon email.
Grand merci
---------
PS : évidement, il faut que vous parliez l'allemand.
PS2 : j'ai aussi posté sur le fofo deutch.
Code : Tout sélectionner
#src=0
#dst=1
#tmp=2
OpenWindow(0, 0, 0, 300, 500, "Wörterbuch", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
PanelGadget (0, 0, 0, 300, 500)
id=1
ii=85
uu=100
bt=1
For x=0 To 25
AddGadgetItem (0, x,Chr(65+x))
TextGadget(1100+bt, 30, 30, 230, 32, "Wählen Sie die Wörter aus 2 Buchstaben aus, die in Ihrer Sprache vorhanden sind :")
nb=65
For i=0 To 1
For u=0 To 12
CheckBoxGadget(id, ii+i*80, uu+u*20, 40, 20, Chr(65+x)+Chr(nb))
nb+1
id+1
Next
Next
ButtonGadget(1000+bt, 80, 400, 130, 40,"Rekord")
bt+1
Next
;;;;;;;;;;;;;;;
; AddGadgetItem (0, 26,"Wörter mit 3 Buchstaben und mehr")
;
; EditorGadget(2000, 10, 10, 276, 140, #PB_Editor_WordWrap)
; EditorGadget(2001, 10, 160, 276, 140, #PB_Editor_ReadOnly | #PB_Editor_WordWrap)
;
; ButtonGadget(2002, 80, 320, 130, 40,"überprüfen")
; ButtonGadget(2003, 80, 370, 130, 40,"hinzufügen")
; ButtonGadget(2004, 80, 420, 130, 40,"zurückziehen")
;
;
; AddGadgetItem(2001, -1, "Fügen Sie Ihre Wörter in das obere Fenster ein")
;
; SetGadgetState(0,26)
; SetActiveGadget(2000)
;
;;;;;;;;;;;;;;;
chemin$="dico-german\"
CreateDirectory(chemin$)
;;;;;;;;;;;;;;;;;;;;
For i=97 To 122
; Debug "==="+Chr(i)+"==="
If ReadFile(#dst, chemin$+"dico-"+Chr(i)+"2") ; : ;beep_(1500,50)
While Eof(#dst) = 0
a$=ReadString(#dst)
a$=LCase(a$)
; Debug Asc(a$)
SetGadgetState((i-97)*26+Asc(a$)-96, #PB_Checkbox_Checked)
Wend
CloseFile(#dst)
; EndIf
EndIf
Next
;;;;;;;;;;;;;;;;;;;;
Repeat
EventID = WaitWindowEvent()
If EventID = #PB_Event_Gadget
evg = EventGadget()
If evg >= 1001 And evg <= 1026
Gosub dico
EndIf
If evg=2002
ecrire=0
Gosub lire
EndIf
If evg=2003
ecrire=1
Gosub lire
EndIf
If evg=2004
ecrire=2
Gosub lire
EndIf
EndIf
Until EventID = #PB_Event_CloseWindow
End
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
dico:
evg-1000+96
CreateFile(#dst, chemin$+"dico-"+Chr(evg)+"2") ; crée un nouveau fichier texte ou recrée une fichier texte vide s'il existe déjà ...
For i=1 To 26
If GetGadgetState((evg-97)*26+i)
WriteStringN(#dst, Chr(i+96)) ; écriture de 10 lignes (suivies du code 'Fin de Ligne')
EndIf
Next
CloseFile(#dst) ; ferme le fichier précédemment ouvert et enregistre les données
Return
;;;;;;;;;;;;;;
;;;;
;;;;
;;;;
;;;;
lire:
mot$ = GetGadgetText(2000)
mot$=LCase(mot$)
mot$=ReplaceString(mot$,"ß","ss")
mot$=ReplaceString(mot$,"à","a")
mot$=ReplaceString(mot$,"á","a")
mot$=ReplaceString(mot$,"â","a")
mot$=ReplaceString(mot$,"ã","a")
mot$=ReplaceString(mot$,"ä","a")
mot$=ReplaceString(mot$,"å","a")
mot$=ReplaceString(mot$,"ç","c")
mot$=ReplaceString(mot$,"è","e")
mot$=ReplaceString(mot$,"é","e")
mot$=ReplaceString(mot$,"ê","e")
mot$=ReplaceString(mot$,"ë","e")
mot$=ReplaceString(mot$,"ì","i")
mot$=ReplaceString(mot$,"í","i")
mot$=ReplaceString(mot$,"î","i")
mot$=ReplaceString(mot$,"ï","i")
mot$=ReplaceString(mot$,"ð","o")
mot$=ReplaceString(mot$,"ñ","n")
mot$=ReplaceString(mot$,"ò","o")
mot$=ReplaceString(mot$,"ó","o")
mot$=ReplaceString(mot$,"ô","o")
mot$=ReplaceString(mot$,"õ","o")
mot$=ReplaceString(mot$,"ö","o")
mot$=ReplaceString(mot$,"ù","u")
mot$=ReplaceString(mot$,"ú","u")
mot$=ReplaceString(mot$,"û","u")
mot$=ReplaceString(mot$,"ü","u")
mot$=ReplaceString(mot$,"ý","y")
mot$=ReplaceString(mot$,"ÿ","y")
mot$=ReplaceString(mot$,"æ","ae")
mot$=ReplaceString(mot$,"œ","oe")
; ; debug mot$
; ; debug Len(mot$)
; ; debug("===")
len=Len(mot$)
len2=1
b$=""
cmb=0
Dim mot$(100000)
While len2<=len
a$=Mid(mot$,len2,1)
; ; debug a$
If Asc(a$)>=97 And Asc(a$)<=122
b$+a$
; ; debug b$
Else
If b$<>""; And Len(b$)>=3
;; debug b$
cmb+1
mot$(cmb)=b$
b$=""
EndIf
EndIf
len2+1
Wend
If b$<>""; And Len(b$)>=3
; ; debug b$
cmb+1
mot$(cmb)=b$
EndIf
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; debug cmb
cmb2=0
cmb3=0
cmb_no=0
liste$=""
retire$=""
ecrire1$=""
For i=1 To cmb
If Len(mot$(i))>=3
AddGadgetItem(2001, -1, mot$(i))
cmb2+1
;;;;;;;;;;;;;;;;;;;;;;;;;;
a$=Left(mot$(i),1)
x=Len(mot$(i))
mot_ref$=Mid(mot$(i),2,x-1)
; debug mot_ref$
If OpenFile(#dst, chemin$+"dico-"+a$+Str(x)); : ;beep_(1500,50)
While Eof(#dst) = 0 ; loop as long the 'end of file' isn't reached
; ; debug a$+ReadString(#dst)
; ; debug mot$(i)
e$=ReadString(#dst)
d$=a$+e$
; ; debug d$
If d$=mot$(i)
; End
cmb3+1
If ecrire<2
liste$+mot$(i)+", "
EndIf
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
If ecrire=2
CloseFile(#dst)
If OpenFile(#dst, chemin$+"dico-"+a$+Str(x)); : ;beep_(1500,50)
If CreateFile(#tmp, chemin$+"_dico-"+a$+Str(x)); : ;beep_(1500,50)
; debug ("===")
While Eof(#dst) = 0 ; loop as long the 'end of file' isn't reached
f$=ReadString(#dst)
; debug f$
If f$<>mot_ref$
WriteStringN(#tmp, f$)
Else
retire$+d$+", "
; Debug ("----- "+f$)
EndIf
Wend
;End
CloseFile(#dst)
CloseFile(#tmp)
DeleteFile(chemin$+"dico-"+a$+Str(x))
RenameFile(chemin$+"_dico-"+a$+Str(x), chemin$+"dico-"+a$+Str(x))
EndIf
EndIf
Goto ok61
EndIf
;;;;;;
;;;;;;
Goto ok60
EndIf
Wend
cmb_no+1
;;;;;;;;;;;;;;;;;;;;;;;;;;
If ecrire=1
; Beep_(1500,200)
; ; debug mot$(i)
; ; debug mot_ref$
; ; debug "dico-"+a$+Str(x)
CloseFile(#dst)
If OpenFile(#tmp, chemin$+"dico-"+a$+Str(x))
length = Lof(#tmp) ; Lit la taille en octets du fichier
FileSeek(#tmp, length)
WriteStringN(#tmp, mot_ref$)
CloseFile(#tmp)
EndIf
ecrire1$+a$+mot_ref$+", "
Goto ok61
EndIf
;;;;;;;;;;;;;;;;;;;;;;;;;;
ok60:
CloseFile(#dst)
ok61:
EndIf
;;;;;;;;;;;;;;;;;;;;;;;
EndIf
Next
;;;;;;;;;;
If retire$<>""
AddGadgetItem(2001, -1, Left(retire$,Len(retire$)-2)+" : entfernte Wörter")
EndIf
If ecrire1$<>""
AddGadgetItem(2001, -1, Left(ecrire1$,Len(ecrire1$)-2)+" : hinzugefügte Wörter")
EndIf
If liste$<>""
AddGadgetItem(2001, -1, Left(liste$,Len(liste$)-2)+" : verwiesene Wörter")
Else
If ecrire1$=""
AddGadgetItem(2001, -1, "Kein Wort (keine Wörter) angegeben")
EndIf
EndIf
AddGadgetItem(2001, -1, "-")
SendMessage_(GadgetID(2001), #EM_SETSEL, -1, 0)
Return
