j'espère 
J'ai ajouté une catégorie pour les débutants (une idée d'idle).
Compétition PurePunch Numéro 3
Merci chef! 
Je pensais à un truc (pendant que je bidouille sur ce dont je t'ai parler sur MSN), faire le vote en 2 etapes.
Premier étape, on eli les 3 meilleur punch des 3 plus grosse comunauté (EN, FR, DE)
Deuxieme étape, on eli les 3 meilleur punch EN, FR et DE confondu des 3 meilleur punch EN, FR et DE séparer.
Ouf... j'espere que vous avez compris, parceque moi j'ai rien pigé à ce que je viens de dir
Je pensais à un truc (pendant que je bidouille sur ce dont je t'ai parler sur MSN), faire le vote en 2 etapes.
Premier étape, on eli les 3 meilleur punch des 3 plus grosse comunauté (EN, FR, DE)
Deuxieme étape, on eli les 3 meilleur punch EN, FR et DE confondu des 3 meilleur punch EN, FR et DE séparer.
Ouf... j'espere que vous avez compris, parceque moi j'ai rien pigé à ce que je viens de dir
Faut pas me faire une usine à gaz! Déjà que Dobro ne comprend rien au malheureux tableau que j'avais utilisé pour le 1er vote!
Pour l'instant on pourrait tous simplement poster pour ses 3 punchs favoris, en leur donnant 3 points/2 points/1 point comme à l'eurovision
. Plus tard on pourra rajouter des critères
Sinon, pour ceux qui n'ont pas d'idée, j'ai trouvé ça sur /. -> http://www.programmerfish.com/source-co ... -released/
Pour l'instant on pourrait tous simplement poster pour ses 3 punchs favoris, en leur donnant 3 points/2 points/1 point comme à l'eurovision
. Plus tard on pourra rajouter des critères Sinon, pour ceux qui n'ont pas d'idée, j'ai trouvé ça sur /. -> http://www.programmerfish.com/source-co ... -released/
J'ouvre le bal !
Hello,
En attendant de voir les pros en action, j'envoie mes 20 lignes !
J'ai légèrement modifié un code qu'Ollivier m'avait "punché" (certaines lignes dépassaient 80 caractères, ajout du meilleur score courant, utilisation de goto pour refaire une partie).
Objectif: ralentir la fonte des icebergs
Hasta la vista !
En attendant de voir les pros en action, j'envoie mes 20 lignes !
J'ai légèrement modifié un code qu'Ollivier m'avait "punché" (certaines lignes dépassaient 80 caractères, ajout du meilleur score courant, utilisation de goto pour refaire une partie).
Objectif: ralentir la fonte des icebergs
Code : Tout sélectionner
;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name : "Old skull" game
;* Author : Huitbit
;* Category : Game
;* Date : 12 / 07 / 09
;* Notes : "Purepunched" with the help of the french coder Ollivier
;*
;*****************************************************************************
Macro D:Macro:EndMacro:D K:End:End#D:Dim C(4):Dim N(4):Dim O(4):InitSprite()
D Q:EndIf:K#D:D R:Random:K#D:D F:DisplaySprite:K#D:L=640:H=480:Dim B(4):a=1
D P:Next:K#D:D S(A,B,C):For A=B To C:K#D:InitKeyboard():D U:StopDrawing():K#D
S(I,1,4):D T(A,B,C):CreateSprite(A,B,C):StartDrawing(SpriteOutput(A)):K#D:P
OpenWindowedScreen(OpenWindow(0,0,0,L,H,"Old skull !"),0,0,L,H,0,0,0):T(0,L,99)
Box(0,0,L,99,$EFCF10):U:T(1,16,16):S(J,1,8):S(I,1,8)
If Mid(RSet(Bin(Asc(Mid("|þˉþþU",J,1))),8,"0"),I,1)="1"
Box(i*2-2,j*2-2,2,2,$FF):Q:P:P:U:T(2,16,16):Circle(8,8,8,$227CE9):U
T(3,48,H):Ellipse(24,0,24,360,$FCFBEB):U:G::s=0:x=4:y=0:w=0:C(0)=240:N(0)=R(L)
O(0)=-R(L):S(I,1,4):B(i)=B(i-1)+128+R(32):C(i)=160+R(160):N(i)=R(L):O(i)=-R(L)
P:Repeat:FlipBuffers():ClearScreen(0):S(I,0,4):If O(i)>440:N(i)=r(L):O(i)=-r(L)
C(i)+10:Q:If SpriteCollision(1,x,y,2,N(i),O(i)):N(i)=R(624):O(i)=-r(L):S+1:Q
F(2,N(i),O(i)):O(i)=O(i)+1:P:S(I,0,4):F(3,B(i),C(i)):P:F(1,x,y):F(0,0,440)
S(I,0,4):If SpriteCollision(1,x+v,y+w,3,B(i),C(i)):If y<=C(i)-15:Z=C(i)-16:Q
I=4:Else:Z=0:Q:P:If SpriteCollision(1,x,y,0,0,440):If s>m:m=s:Q
MessageRequester("","S:"+Str(s)+Chr(13)+"H:"+Str(m)):Goto G:Q:ExamineKeyboard()
If KeyboardPushed(200):If z:w=-24:a=1:Q:Q:If KeyboardPushed(203) And x>3:v=-3
ElseIf KeyboardPushed(205) And x<621:v=3:Else:v=0:Q:If z=0:If y<=424:x+v:w+a
y+w:Q:Else:x+v:y=z:Q:Delay(1):Until WindowEvent()=16Bonjour à tous
Voici une aide MSDOS pour les nostalgiques du système de base
Je l’ai réalisé en punch avec l’utilisation d’un fichier *.bat ou *.cmd au choix.
OU celui-ci avec CMD et listviewgadget
Voici une aide MSDOS pour les nostalgiques du système de base
Je l’ai réalisé en punch avec l’utilisation d’un fichier *.bat ou *.cmd au choix.
Code : Tout sélectionner
;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name : "Help MSDOS " Aide Msdos avec file *.BAT et listicongadget
;* Author : PAPIPP
;* Category : UTIL
;* Date : 15 / 07 / 09
;*
;*****************************************************************************
#W0=0:#L0=0:#L1=1:Procedure afch(gdgt,f_t$,hlp$="HELP"):asci$ = Space(99):ansi$=Space(99):OF.l=OpenFile(#PB_Any,f_t$):If of<>0
:asci$=ReadString(OF)+Chr(10):OemToChar_(@asci$,@ansi$):AddGadgetItem(gdgt,-1, hlp$+" :"+ansi$):eof1=Eof(OF):While Eof(of)=0
:asci$ =ReadString(OF)+Chr(10):OemToChar_(@asci$,@ansi$):AddGadgetItem(gdgt,-1,ansi$):Wend:EndIf:CloseFile (OF):EndProcedure
Procedure OW0():If OpenWindow(#W0, 0, 0, 800, 600, "HELP MSDOS",13107200|12845056|13238272|12582912):ListIconGadget(#L0, 0, 0, 800, 300, "CMD Dos Double cliquez sur une CMD", 800, 8|65536|1073741824)
:ListIconGadget(#L1, 0, 300, 800, 300, "Help CMD", 800, 8|65536|1073741824): GadgetToolTip(#L0, "Double Cliquez sur une des ligne pour une aide")
:EndIf::EndProcedure::U$="c:\":s$=".BAT":ft$=Space(255):mask$="%YY"+Str(DayOfYear(Date()))+"%ii%ss":fp$="PB"+FormatDate(mask$,Date())
:fb$=u$+fp$+s$:FB.l=CreateFile(#PB_Any,fb$):GetTempFileName_(@U$,@fp$,000,@ft$):WriteStringN(FB, "@ECHO OFF"):WriteStringN(FB, "help %1>"+ft$)
:WriteString(FB,"Exit /B 233"):CloseFile(FB):OW0():F1=LoadFont(#PB_Any,"Courier New",8,256):SetGadgetFont(#L0, FontID(F1)):SetGadgetFont(#L1, FontID(F1))
:prg=RunProgram(fb$,"",".",1):afch(#L0,ft$):Repeat: WWE = WaitWindowEvent(): Select WWE: Case #PB_Event_Gadget: EG = EventGadget():ET = EventType()
:If EG = #L0:If ET=2:ELEM.l = GetGadgetState(#L0):ELEM$= GetGadgetItemText(#L0, Elem):Pos= FindString(elem$, " ", 1):CMD$=Mid(elem$,1,pos-1)
:prg=RunProgram(fb$,cmd$,".",1):ClearGadgetItems(#L1):afch(#L1,ft$,CMD$):DeleteFile(ft$):EndIf:EndIf:Case 16:EventWindow = EventWindow()
:If EventWindow = #W0:CloseWindow(#W0): DeleteFile(FB$):DeleteFile(FT$):Break: EndIf:EndSelect:ForEver
Code : Tout sélectionner
;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name : "Help MSDOS " Aide Msdos avec file *.CMD et listviewgadget
;* Author : PAPIPP
;* Category : UTIL
;* Date : 15 / 07 / 09
;*
;*****************************************************************************
#W0=0:#L0=0: #L1=1:Procedure afch(gdgt,f_t$,hlp$="HELP"):asci$ = Space(99):ansi$=Space(99):OF.l=OpenFile(#PB_Any,f_t$):If of<>0:asci$=ReadString(OF)
:OemToChar_(@asci$,@ansi$): AddGadgetItem(gdgt,-1, hlp$+" :"+ansi$):eof1=Eof(OF):While Eof(of)=0:asci$ =ReadString(OF):OemToChar_(@asci$,@ansi$)
:AddGadgetItem(gdgt,-1,ansi$):Wend:EndIf:CloseFile (OF):EndProcedure:Procedure OW0():If OpenWindow(#W0, 0, 0, 800, 600, "HELP MSDOS Double cliquez une ligne pour aide",13107200|12845056|13238272|12582912)
:ListViewGadget(#L0, 0, 0, 800, 300):ListViewGadget(#L1, 0, 300, 800, 300):GadgetToolTip(#L0, "Double Cliquez sur une des ligne pour une aide")
EndIf:EndProcedure:U$="c:\":s$=".CMD":ft$=Space(255):mask$="%YY"+Str(DayOfYear(Date()))+"%ii%ss":fp$="PB"+FormatDate(mask$,Date()):fb$=u$+fp$+s$
FB.l=CreateFile(#PB_Any,fb$):GetTempFileName_(@U$,@fp$,000,@ft$):WriteStringN(FB, "@ECHO OFF"):WriteStringN(FB, "help %1>"+ft$):WriteString(FB,"Exit /B 233")
:CloseFile(FB):OW0():F1=LoadFont(#PB_Any,"Courier New",8,256):SetGadgetFont(#L0, FontID(F1)):SetGadgetFont(#L1, FontID(F1)):prg=RunProgram(fb$,"",".",1)
:afch(#L0,ft$):Repeat:WWE = WaitWindowEvent():Select WWE:Case #PB_Event_Gadget:EG = EventGadget():ET = EventType():If EG = #L0:If ET=2
ELEM.l = GetGadgetState(#L0):ELEM$= GetGadgetItemText(#L0, Elem):Pos= FindString(elem$, " ", 1):CMD$=Mid(elem$,1,pos-1):prg=RunProgram(fb$,cmd$,".",1)
:ClearGadgetItems(#L1):afch(#L1,ft$,CMD$): DeleteFile(ft$):EndIf:EndIf:Case 16: EW = EventWindow():If EW = #W0:CloseWindow(#W0)
: DeleteFile(FB$):DeleteFile(FT$):Break:EndIf:EndSelect:ForEver
@Djes
OK et comme cela 20 lignes de 80 caractères max
Pour améliorer on peut retirer le caractère : devant chaque ligne.
OK et comme cela 20 lignes de 80 caractères max
Code : Tout sélectionner
;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name : "Help MSDOS " Aide Msdos avec file *.CMD et listviewgadget
;* Author : PAPIPP
;* Category : UTIL
;* Date : 15 / 07 / 09
;*
;*****************************************************************************
;----0---_____1____----2-----_____3____-----4----_____5____-----6----_____7____-
;2345678901234567890123456789012345678901234567890123456789012345678901234567890
Macro M:Macro:EndMacro:M ws:WriteStringN:EndMacro:#W0=0:#L0=0:#L1=1:#L8=800
:M AGI:AddgadgetItem:EndMacro:Procedure af(gd,f_t$,h$):A1.s=Space(99)
:A2.s=Space(99):OF.l=OpenFile(#PB_Any,f_t$):If of<>0:A1=ReadString(OF)
:OemToChar_(@a1,@A2):AGI(gd,-1,h$+":"+A2):While Eof(of)=0:A1 =ReadString(OF)
:OemToChar_(@a1,@A2):AGI(gd,-1,A2):Wend:EndIf:CloseFile (OF):EndProcedure
:Procedure OW0():If OpenWindow(#W0,0,0,#L8,600,"")
:ListViewGadget(#L0,0,0,#L8,300):ListViewGadget(#L1,0,300,#L8,300):EndIf
:EndProcedure:U$="c:\":s$=".CMD":ft$=Space(255)
:mk$="%YY"+Str(DayOfYear(Date()))+"%ii%ss":fp$="PB"+FormatDate(mk$,Date())
:fb$=u$+fp$+s$:FB.l=CreateFile(#PB_Any,fb$):GetTempFileName_(@U$,@fp$,000,@ft$)
:ws(FB, "@ECHO OFF"):ws(FB,"help %1>"+ft$):ws(FB,"Exit"):CloseFile(FB):OW0()
:F1=LoadFont(#PB_Any,"Courier New",8,256):SetGadgetFont(#L0, FontID(F1))
:SetGadgetFont(#L1, FontID(F1)):RunProgram(fb$,"",".",1):af(#L0,ft$,"Dbl clic")
:Repeat:WWE=WaitWindowEvent():Select WWE:Case 13100:EG = EventGadget()
:ET = EventType():If EG = #L0:If ET=2:ELEM.l = GetGadgetState(#L0)
:el$= GetGadgetItemText(#L0, Elem):Pos= FindString(el$," ",1)
:CMD$=Mid(el$,1,pos-1):RunProgram(fb$,cmd$,".",1):ClearGadgetItems(#L1)
:af(#L1,ft$,CMD$):DeleteFile(ft$):EndIf:EndIf:Case 16: EW = EventWindow()
:If EW = #W0:CloseWindow(#W0):DeleteFile(FB$):DeleteFile(FT$)
:Break:EndIf:EndSelect:ForEverEncore plus court 18 lignes de 80 caractères
Code : Tout sélectionner
;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name : "Help MSDOS Normal" Aide Msdos Double cliquez sur une ligne
;* Author : PAPIPP
;* Category : UTIL
;* Date : 15 / 07 / 09
;*
;*****************************************************************************
;----0---_____1____----2-----_____3____-----4----_____5____-----6----_____7____-
;2345678901234567890123456789012345678901234567890123456789012345678901234567890
Macro M: Macro : EndMacro:M AGI:AddGadgetItem:EndMacro :#W0=0:#L0=0: #L1=1
M RPS :ReadProgramString:EndMacro:Procedure OW0():
If OpenWindow(#W0, 0, 0, 800, 600, "Dbl Clic")
ListViewGadget(#L0, 0, 0, 800, 300):ListViewGadget(#L1, 0, 300, 800, 300)
GadgetToolTip(#L0, "Double Cliquez sur une des ligne pour une aide")::EndIf
EndProcedure:Procedure AFCH(Gd,Cm$)
prg=RunProgram("cmd"," /A /C help "+CM$,".",28)
As$ = Space(99):an$=Space(99):ClearGadgetItems(Gd):If prg:As$=RPS(prg)
OemToChar_(@as$,@an$): AGI(gd,-1, "Help "+Cm$+" :"+an$)
While ProgramRunning(prg):As$ =RPS(prg):OemToChar_(@as$,@an$):AGI(Gd,-1, an$)
Wend:EndIf:EndProcedure:OW0():Font1 = LoadFont(#PB_Any, "Courier New",8)
SetGadgetFont(#L0, FontID(Font1)):SetGadgetFont(#L1, FontID(Font1))
AFCH(#L0,""):Repeat: WWE = WaitWindowEvent():Select WWE:Case #PB_Event_Gadget
EG = EventGadget():ET = EventType():If EG = #L0:If ET=2:EL.l=GetGadgetState(#L0)
EL$= GetGadgetItemText(#L0, El):Pos= FindString(el$, " ", 1):
CMD$=Mid(el$,1,pos-1):AFCH(#L1, CMD$):EndIf:EndIf:Case #PB_Event_CloseWindow
EW = EventWindow():If EW = #W0:CloseWindow(#W0):Break:EndIf: EndSelect
ForEver 
@dobro
Je me permets juste une modif à ta version afin de réutiliser
la fonction OemToChar() qui est bien utile ici (accents).
et l'affichage avec la police Courier assez adapté pour le DOS.
Le tout en 6 lignes.
Petite remarque sur a fonction OemToChar() :
http://msdn.microsoft.com/en-us/library ... S.85).aspx
En ASCII (contrairement donc au mode UNICODE) pas besoin d'allouer une variable pour le résultat, il suffit de mettre le même pointeur qu'en entrée : OemToChar_(@text$, @text$), un remplacement octet par octet est effectué dans la chaine passée en premier argument.
Je me permets juste une modif à ta version afin de réutiliser
la fonction OemToChar() qui est bien utile ici (accents).
et l'affichage avec la police Courier assez adapté pour le DOS.
Le tout en 6 lignes.
Code : Tout sélectionner
OpenWindow(0,10,10,800,480,"Aide MSDOS"):StringGadget(1,2,2,796,20,"dir")
EditorGadget(2,2,24,796,454,2048):SetGadgetFont(2,LoadFont(0,"Courier",8))
Repeat:Select WaitWindowEvent():Case 16:Break:Case 257:c$=GetGadgetText(1)
If c$:p=RunProgram("cmd.exe","/c "+c$+"/?","",30):If p:h$=""
While ProgramRunning(p):h$+ReadProgramString(p)+#LF$:Wend:OemToChar_(@h$,@h$)
SetGadgetText(2,h$):CloseProgram(p):EndIf:EndIf:EndSelect:ForEverhttp://msdn.microsoft.com/en-us/library ... S.85).aspx
En ASCII (contrairement donc au mode UNICODE) pas besoin d'allouer une variable pour le résultat, il suffit de mettre le même pointeur qu'en entrée : OemToChar_(@text$, @text$), un remplacement octet par octet est effectué dans la chaine passée en premier argument.