J'en avais besoin pour mon jeu 3arks/Arkeos Chronicles, alors, je me suis fabirqué un petit programme pour créer des sortes d'anagrammes :
Code : Tout sélectionner
;{ anagramme
; blendman 2011
; pb 4.60
;}
Enumeration
#G_Btn
#g_btn_copy
#G_listview
#G_spin
EndEnumeration
#window =0
Global nbre.a = 10
OpenWindow(#window,0,0,300,400,"Blendman's Anagramme",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
ButtonGadget(#G_Btn,50,50,80,20,"Nouveau")
ButtonGadget(#g_btn_copy,150,50,80,20,"Copier")
ListViewGadget(#G_listview,50,100,100,200,#PB_ListView_MultiSelect)
SpinGadget(#G_spin,50,75,50,20,1,200)
SetGadgetText(#G_spin,Str(nbre))
Structure StLettre
lettre$
id.w
EndStructure
Procedure.s anagramme(nb.a=10)
mot$ = InputRequester("mot","entrer le mot","")
If mot$<>""
ClearGadgetItems(#G_listview)
Protected Dim Result.StLettre(Len(mot$)+1), NbFound.l
For i = 0 To Len(mot$)-1
result(i)\lettre$ = Mid(mot$,i+1,1)
Next i
For n = 0 To nb-1
For a = 0 To Len(mot$)
result(a)\id = 0
Next a
anagramme$ = ""
For m = 0 To Len(mot$)
While result(m)\id = 0
x = Random(Len(mot$))
If result(x)\id = 0
result(x)\id = 1
anagramme$ + result(x)\lettre$
EndIf
Wend
Next m
AddGadgetItem(#G_listview,n,anagramme$)
Next n
EndIf
EndProcedure
Procedure.s CopyAnagramme()
txt$ = ""
For u =0 To nbre
txt$+GetGadgetItemText(#G_listview,u)+Chr(10)
Next u
SetClipboardText(txt$)
EndProcedure
Repeat
event = WaitWindowEvent(1)
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case #G_Btn
anagramme(nbre)
Case #g_btn_copy
CopyAnagramme()
Case #G_spin
SetGadgetText(#G_spin,Str(GetGadgetState(#G_spin)))
nbre = GetGadgetState(#G_spin)
EndSelect
EndSelect
Until event = #PB_Event_CloseWindow
.N'hésitez pas à le modifier et à poster vos changements si vous l'améliorez
