PureGolf mit TicTacToe
667 !!!  
 
			
			
									
									Code: Alles auswählen
Procedure S(k,s.s) 
  SetGadgetText(k,s) 
EndProcedure 
Dim T(9) 
s.s="'s turn" 
t=79 
c=190 
m=50
CreateGadgetList(OpenWindow(0,0,0,c,280,1,"Game")) 
For a=0 To9
  ButtonGadget(a,70*a%3,70*(a/3),m,m,z.s) 
  TextGadget(9,0,c,c,m,"O"+s,1)
  SetGadgetFont(a,LoadFont(a,z,24)) 
Next 
c/2 
ButtonGadget(c,0,250,c,30,"New") 
ButtonGadget(t,c,250,c,30,"End") 
l: 
  If WindowEvent()=13100 
    O=EventwParam() 
    If O=t 
      End 
    ElseIf O=c 
      For a=0 To9 
        T(a)=S(a,z) 
        DisableGadget(a,0) 
      Next 
      p=0 
    Else 
      If T(O)=0 
        T(O)=p+1 
        h.s=Chr(t+p*9) 
        p!1 
        S(9,Chr(t+p*9)+s) 
        For i=DisableGadget(O,1) To2 
          x=i*3 
          If (T(x)&T(x+1)&T(x+2))|(T(i)&T(i+3)&T(i+6))|(T(S(O,h))&T(4)&T(8))|(T(2)&T(4)&T(6)) 
            For a=S(9,h+" wins") To8 
              DisableGadget(a,1) 
            Next 
          EndIf 
        Next 
      EndIf 
    EndIf 
  EndIf 
Goto l PB 6.10LTs / Windows 11 64Bit 25H2
... ich mache dazu keine Aussage, weil ich mich damit selbst belasten könnte !
						... ich mache dazu keine Aussage, weil ich mich damit selbst belasten könnte !
die wurde ja schon etwas geändert (siehe openwindow Werte am Anfang von 260 auf 250 )
666 :
			
			
													666 :
Code: Alles auswählen
Procedure S(k,s.s) 
  SetGadgetText(k,s) 
EndProcedure 
Dim T(9) 
s.s="'s turn" 
t=79 
c=190 
m=50
CreateGadgetList(OpenWindow(0,0,0,c,280,1,"Game")) 
For a=0 To9
  ButtonGadget(a,70*a%3,70*(a/3),m,m,z.s) 
  TextGadget(9,0,c,c,m,"O"+s,1)
  SetGadgetFont(a,LoadFont(a,z,24)) 
Next 
c/2 
m*5
ButtonGadget(c,0,m,c,30,"New") 
ButtonGadget(t,c,m,c,30,"End") 
l: 
  If WindowEvent()=13100 
    O=EventwParam() 
    If O=t 
      End 
    ElseIf O=c 
      For a=0 To9 
        T(a)=S(a,z) 
        DisableGadget(a,0) 
      Next 
      p=0 
    Else 
      If T(O)=0 
        T(O)=p+1 
        h.s=Chr(t+p*9) 
        p!1 
        S(9,Chr(t+p*9)+s) 
        For i=DisableGadget(O,1) To2 
          x=i*3 
          If (T(x)&T(x+1)&T(x+2))|(T(i)&T(i+3)&T(i+6))|(T(S(O,h))&T(4)&T(8))|(T(2)&T(4)&T(6)) 
            For a=S(9,h+" wins") To8 
              DisableGadget(a,1) 
            Next 
          EndIf 
        Next 
      EndIf 
    EndIf 
  EndIf 
Goto l 
					Zuletzt geändert von Then am 31.01.2006 18:51, insgesamt 1-mal geändert.
									
			
									PB 6.10LTs / Windows 11 64Bit 25H2
... ich mache dazu keine Aussage, weil ich mich damit selbst belasten könnte !
						... ich mache dazu keine Aussage, weil ich mich damit selbst belasten könnte !
- ts-soft
 - Beiträge: 22292
 - Registriert: 08.09.2004 00:57
 - Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel - Wohnort: Berlin
 
Veränderung der GUI ist schon ne ganze Weile mit beiFranky hat geschrieben:hm, also eeeeeeeeeeeeeeeiiiiiiigentlich stellt das ja ne änderung der GUI da
Aber wenn ihr wollt
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.

						Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.

@Then: Teufelszahl 
 
663
 +4 für das Wait. Denkt es euch weg, ich find, so läuft´s besser
			
			
									
									663
Code: Alles auswählen
Procedure S(k,s.s)
  SetGadgetText(k,s)
EndProcedure
Dim T(9)
s.s="'s turn"
c=190
m=50
CreateGadgetList(OpenWindow(0,0,0,c,280,1,"Game"))
For a=0 To9
  ButtonGadget(a,70*a%3,70*(a/3),m,m,z.s)
  TextGadget(9,0,c,c,m,"O"+s,1)
  SetGadgetFont(a,LoadFont(a,z,24))
Next
c/2
ButtonGadget(c,0,250,c,30,"New")
ButtonGadget(m,c,250,c,30,"End")
l:
  If waitWindowEvent()=13100
    O=EventwParam()
    If O=m
      End
    ElseIf O=c
      For a=0 To9
        T(a)=S(a,z)
        DisableGadget(a,0)
      Next
      p=0
    Else
      If T(O)=0
        T(O)=p+1
        h.s=Chr(t+p*9)
        p!1
        S(9,Chr(t+p*9)+s)
        For i=DisableGadget(O,1) To2
          x=i*3
          If (T(x)&T(x+1)&T(x+2))|(T(i)&T(i+3)&T(i+6))|(T(S(O,h))&T(4)&T(8))|(T(2)&T(4)&T(6))
            For a=S(9,h+" wins") To8
              DisableGadget(a,1)
            Next
          EndIf
        Next
      EndIf
    EndIf
  EndIf
Goto lFalsch zugeordnetes Zitat des Tages: "O'zapft is" - Edward Snowden 
						599
ihr habt den code so verändert, dann ist das jetzt auch egal.
p.s.: wenn unentschieden, müsst ihr das programm neustarten. its not a bug, its a feature.
 
c ya,
nco2k
			
			
									
									Code: Alles auswählen
Procedure S(k,s.s)
  SetGadgetText(k,s)
EndProcedure
Dim T(9)
s.s=" turn"
t=79
c=190
CreateGadgetList(OpenWindow(0,0,0,c,210,13107201,"XXO"))
For a=0 To8
  ButtonGadget(a,70*a%3,70*(a/3),50,50,z.s)
  SetGadgetFont(a,LoadFont(a,z,24))
Next
TextGadget(9,0,c,c,20,"O"+s,1)
c/2
SetGadgetFont(9,LoadFont(9,z,12))
l:
  w=WindowEvent()
  If w>999
    O=EventwParam()
    If T(O)=0
      T(O)=P+1
      h.s=Chr(t+P*9)
      S(O,h)
      S(9,Chr(t+P!1*9)+s)
      For i=DisableGadget(O,1) To2
        x=i*3
        If (T(x)&T(x+1)&T(x+2))| (T(i)&T(i+3)&T(i+6))|(T(0)&T(4)&T(8))|(T(2)&T(4)&T(6))
          For a=0 To9
            T(a)=0
            S(a,z)
            DisableGadget(a,0)
          Next
          S(9,h+" wins")
          P=0
        EndIf
      Next
      P!1
    EndIf
  ElseIf w=16
    End
  EndIf
Goto lp.s.: wenn unentschieden, müsst ihr das programm neustarten. its not a bug, its a feature.
c ya,
nco2k
~|__/
..o.o.. <--- This is Einkaufswagen. Copy Einkaufswagen into your signature to help him on his way to world domination.
						..o.o.. <--- This is Einkaufswagen. Copy Einkaufswagen into your signature to help him on his way to world domination.
hey, funzt doch super, bis auf das "feature". 
 
bei deinem letzten code, wird die schrift nicht richtig angezeigt, zumindest bei mir.
edit: obwohl, da gibts mehr features, merk ich grad. naja ihr macht das schon.
 
c ya,
nco2k
			
			
													bei deinem letzten code, wird die schrift nicht richtig angezeigt, zumindest bei mir.
edit: obwohl, da gibts mehr features, merk ich grad. naja ihr macht das schon.
c ya,
nco2k
					Zuletzt geändert von nco2k am 31.01.2006 19:05, insgesamt 1-mal geändert.
									
			
									~|__/
..o.o.. <--- This is Einkaufswagen. Copy Einkaufswagen into your signature to help him on his way to world domination.
						..o.o.. <--- This is Einkaufswagen. Copy Einkaufswagen into your signature to help him on his way to world domination.
