PureBasic - форум

ВиниПур

Niset написал(а):

Что тут не так?

Ты бы посмотрел, как вообще игры такого плана делаются...
Есть код архив, там есть несколько игрушек.

Вот к примеру образчик, посмотри как там организовано управление, ( первый раз вижу, что бы управляли героем при помощи AddKeyboardShortcut !)

Код:

InitSprite():InitKeyboard()
#screenX=640
#screenY=480
Dim raster.f(#screenX,#screenY)
Global futterX.w
Global futterY.w
Global score.w
Global speed.b
Global laenge.f
Procedure drawing(text$,X,Y,color)
  StartDrawing(ScreenOutput())
  DrawingMode(1)
  FrontColor(color)
  DrawText(x,y,text$)
  StopDrawing()
EndProcedure
laenge=3
speed=10
futterX=((Random(((#screenX-20)/speed)))*speed)+10
futterY=((Random(((#screenY-20)/speed)))*speed)+10
For x=0 To laenge*10 Step 10
  raster(10+x,10)=x/10
Next
headX=10+x
headY=10
speedX=speed
speedY=0

OpenWindow(0, 0, 0, #ScreenX,#ScreenY, "Snake", #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,#screenX,#screenY,1,0,0)
SetFrameRate(20)

Repeat
  ClearScreen(RGB(10,10,10))
  WindowEvent()
  StartDrawing(ScreenOutput())
  Box(futterX,futterY,10,10,RGB(255,0,0))
  For y=1 To #screenY
    For x=1 To #screenX
      If raster(x,y)>0
        Box(x,y,10,10,RGB(255*(raster(x,y)/laenge),255*(raster(x,y)/laenge),255*(raster(x,y)/laenge)))
        If raster(x,y)=laenge
          Box(x,y,10,10,RGB(0,0,255))
        EndIf
        raster(x,y)-1
      EndIf
    Next
  Next
  headX+speedX
  headY+speedY
  If headX>#screenX-10
    headX=10
  EndIf
  If headX<10
    headX=#screenX-10
  EndIf
  If headY>#screenY-10
    headY=10
  EndIf
  If headY<10
    headY=#screenY-10
  EndIf
  If raster(headX,headY)<>0
    Goto die
  EndIf
  raster(headX,headY)=laenge
  StopDrawing()
  drawing(Str(score),1,1,RGB(255,255,255))
  FlipBuffers()
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Up) And speedY<>speed
    speedY=-speed
    speedX=0
  ElseIf KeyboardPushed(#PB_Key_Down) And speedY<>-speed
    speedY=speed
    speedX=0
  ElseIf KeyboardPushed(#PB_Key_Left) And speedX<>speed
    speedY=0
    speedX=-speed
  ElseIf KeyboardPushed(#PB_Key_Right) And speedX<>-speed
    speedY=0
    speedX=speed
  EndIf
  If headX=futterX And headY=futterY
    score+1
    laenge+1
    futterX=((Random(((#screenX-20)/speed)))*speed)+10
    futterY=((Random(((#screenY-20)/speed)))*speed)+10
  EndIf
Until KeyboardPushed(#PB_Key_Escape)
End

die:
StopDrawing()
drawing("GameOver!",100,100,RGB(100,100,100))
OpenFile(1,"highscore.dat")
highscore.w=ReadWord(1)
CloseFile(1)
drawing("Highscore:"+Str(highscore),50,150,RGB(255,255,0))
FlipBuffers()
Delay(1000)
If score>highscore
  drawing("New Highscore!",200,200,RGB(0,255,0))
  OpenFile(1,"highscore.dat")
  WriteWord(1,score)
  CloseFile(1)
  FlipBuffers()
  Delay(1000)
EndIf
End

0

max · [1985-03-29]

Всем привет!
Можно ли как-то сделать группу переключателей с помощью

Код:

ButtonGadget(45, 61, 254, 57, 20, "   ",#PB_Button_Toggle)

Т. е. у меня несколько таких кнопок. Нажал на первую, она изменила свое состояние, нажал на вторую- первая вернулась в исходное положение, вторая изменила свое состояние и т.д.
Заранее спасибо!

0

Пётр

Можно вот так это сделать.

Код:

Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Button_0
  #Button_1
  #Button_2
  #Button_3
  #Button_4
  #Button_5
  #Button_6
  #Button_7
EndEnumeration


Procedure Open_Window_0()
  If OpenWindow(#Window_0, 231, 93, 299, 69, "New window ( 0 )",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar )
    If CreateGadgetList(WindowID(#Window_0))
      ButtonGadget(#Button_0, 10, 20, 30, 30, "1", #PB_Button_Toggle)
      ButtonGadget(#Button_1, 45, 20, 30, 30, "2", #PB_Button_Toggle)
      ButtonGadget(#Button_2, 80, 20, 30, 30, "3", #PB_Button_Toggle)
      ButtonGadget(#Button_3, 115, 20, 30, 30, "4", #PB_Button_Toggle)
      ButtonGadget(#Button_4, 150, 20, 30, 30, "5", #PB_Button_Toggle)
      ButtonGadget(#Button_5, 185, 20, 30, 30, "6", #PB_Button_Toggle)
      ButtonGadget(#Button_6, 220, 20, 30, 30, "7", #PB_Button_Toggle)
      ButtonGadget(#Button_7, 255, 20, 30, 30, "8", #PB_Button_Toggle)
      
    EndIf
  EndIf
EndProcedure

Open_Window_0()

Repeat
  Event=WaitWindowEvent()
  
  If Event=#PB_Event_Gadget
    Gadget=EventGadget()
    If Gadget>=#Button_0 And Gadget<=#Button_7
      For i=#Button_0 To #Button_7
        If i=Gadget
          SetGadgetState(i,1)
        Else
          SetGadgetState(i,0)
        EndIf
      Next i
    EndIf
  EndIf
  
Until Event=#PB_Event_CloseWindow

0

max · [1985-03-29]

Спасибо!

0

Niset

Код:

OpenWindow(0, 0, 0, 800, 800, "Игра", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
 CreateImage(0, 800, 800)
  ImageGadget(0, 0, 0, 800, 800, ImageID(0))
    If InitSprite() And InitKeyboard() And OpenWindowedScreen(WindowID(0), 0, 0, 800, 800, 0, 0, 0)

      x=500
      y=500
      c=10
      d=10
  
  
  Repeat
    
    
  FlipBuffers()
  
  StartDrawing(ScreenOutput())
  Box(0,0,800,800,RGB(0,255,30))
  Circle(x,y,5,RGB(255,255,0))
  Circle(c,d,5,RGB(0,0,0))
    StopDrawing()
    
    ExamineKeyboard()
    If KeyboardPushed(#PB_Key_W)
      y=y-5
    ElseIf KeyboardPushed(#PB_Key_A)
      x=x-5
    ElseIf KeyboardPushed(#PB_Key_S)
      y=y+5
    ElseIf  KeyboardPushed(#PB_Key_D)
      x=x+5
    EndIf
    If c=x And d<y
      d+5
      ElseIf c=x And d>y
        d-5
      ElseIf d=y And c>x
        c-5 
      ElseIf d=y And c<x
        c+5
      ElseIf c>x And d>y
        c-5
        d-5
      ElseIf c>x And d<y
        c-5
        d+5
      ElseIf c<x And d>y
        c+5
        d-5
      ElseIf c<x And d<y
        c+5
        d+5
        EndIf
     
    
A= WaitWindowEvent()
If A=#PB_Event_CloseWindow
Q=1
EndIf
Until Q=1

EndIf
End

Почему чёрный круг ходит за гг только когда нажата какая либо кнопка или двигается мышь, а во всё остальное время он стоит на месте? Как сделать так, чтобы чёрный круг ходил всегда медленно за мной ,а не ходил тогда когда я хожу!!

Отредактировано Niset (07.01.2011 15:40:30)

0

ВиниПур

Niset написал(а):

очему чёрный круг ходит за гг только когда нажата какая либо кнопка или двигается мышь, а во всё остальное время он стоит на месте? Как сделать так, чтобы чёрный круг ходил всегда медленно за мной ,а не ходил тогда когда я хожу!!

Исправил, сам смотри где:

Код:

OpenWindow(0, 0, 0, 800, 800, "Игра", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
 CreateImage(0, 800, 800)
  ImageGadget(0, 0, 0, 800, 800, ImageID(0))
    If InitSprite() And InitKeyboard() And OpenWindowedScreen(WindowID(0), 0, 0, 800, 800, 0, 0, 0)

      x=500
      y=500
      c=10
      d=10
    ; учись пользоваться переменными - надо исправить скорости меняй тут:
      vg = 5 ; скорость геймера
      vk = 3 ; скорость компьютера
  Repeat
    
    
  FlipBuffers()
  
  StartDrawing(ScreenOutput())
  Box(0,0,800,800,RGB(0,255,30))
  Circle(x,y,5,RGB(255,255,0))
  Circle(c,d,5,RGB(0,0,0))
    StopDrawing()
    
    ExamineKeyboard()
    If KeyboardPushed(#PB_Key_W)
      y=y-vg
    ElseIf KeyboardPushed(#PB_Key_A)
      x=x-vg
    ElseIf KeyboardPushed(#PB_Key_S)
      y=y+vg
    ElseIf  KeyboardPushed(#PB_Key_D)
      x=x+vg
    EndIf
    If c=x And d<y
      d+vk
      ElseIf c=x And d>y
        d-vk
      ElseIf d=y And c>x
        c-vk
      ElseIf d=y And c<x
        c+vk
      ElseIf c>x And d>y
        c-vk
        d-vk
      ElseIf c>x And d<y
        c-vk
        d+vk
      ElseIf c<x And d>y
        c+vk
        d-vk
      ElseIf c<x And d<y
        c+vk
        d+vk
        EndIf
     
    
A= WaitWindowEvent(10) ; тут исправил
If A=#PB_Event_CloseWindow
Q=1
EndIf
Until Q=1

EndIf
End

0

goodwen

Здравствуйте, на VB6 можно было сделать примерно так:
Dim stttri()
stttri = Array("Q800", "Q801", "Q802")
Объявил массив безразмерный и присвоил ему значения компактно, как на PureBasic сделать тоже самое?

0

Niset

Спасибо за прошлые ответы,но вот скопились новые вопросы:
1) Как сделать так чтобы нельзя было проходить сквозь стены?
я смог сделать чтоб нельзя было выйти за границы поля:

Код:

 ExamineKeyboard()
    If KeyboardPushed(#PB_Key_W) And y>5
      y=y-vg
    ElseIf KeyboardPushed(#PB_Key_A) And x>5
      x=x-vg
    ElseIf KeyboardPushed(#PB_Key_S) And y<795
      y=y+vg
    ElseIf  KeyboardPushed(#PB_Key_D) And x<795
      x=x+vg 
    EndIf

но этим способом слишком сложно и долго будет это делать.Есть другие способы?

Код:

OpenWindow(0, 0, 0, 800, 800, "Игра", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
 CreateImage(0, 800, 800)
  ImageGadget(0, 0, 0, 800, 800, ImageID(0))
    If InitSprite() And InitKeyboard() And OpenWindowedScreen(WindowID(0), 0, 0, 800, 800, 0, 0, 0)

      x=10               
      y=790              
      c=10        
      d=10            
      m=790         
      n=790                
      
      vg = 2 ; скорость геймера
      vk = 1 ; скорость компьютера
      vm = 1 ; скорость 2-го компьютера
  Repeat
    
    
  FlipBuffers()
  
  StartDrawing(ScreenOutput())
  Box(0,0,800,800,RGB(0,255,30))                 
  Circle(x,y,5,RGB(255,255,0))                    ;1-й компьютер
  Circle(m,n,5,RGB(0,0,0))                        ;2-й компьютер
  Circle(c,d,5,RGB(0,0,0))                        ;ГГ
    StopDrawing()
    
    ExamineKeyboard()
    If KeyboardPushed(#PB_Key_W) And y>5
      y=y-vg
    ElseIf KeyboardPushed(#PB_Key_A) And x>5
      x=x-vg
    ElseIf KeyboardPushed(#PB_Key_S) And y<795
      y=y+vg
    ElseIf  KeyboardPushed(#PB_Key_D) And x<795
      x=x+vg 
    EndIf
    
    
    If c=x And d<y                                     ;Первый компьютер
      d+vk
      ElseIf c=x And d>y
        d-vk
      ElseIf d=y And c>x
        c-vk
      ElseIf d=y And c<x
        c+vk
      ElseIf c>x And d>y
        c-vk
        d-vk
      ElseIf c>x And d<y
        c-vk
        d+vk
      ElseIf c<x And d>y
        c+vk
        d-vk
      ElseIf c<x And d<y
        c+vk
        d+vk
      EndIf
      
      
      If m=x And d<y                                    ;Второй компьютер
      n+vk
      ElseIf m=x And n>y
        n-vm
      ElseIf n=y And m>x
        m-vm
      ElseIf n=y And m<x
        m+vm
      ElseIf m>x And n>y
        m-vm
        n-vm
      ElseIf m>x And n<y
        m-vm
        n+vm
      ElseIf m<x And n>y
        m+vm
        n-vm
      ElseIf m<x And n<y
        m+vm
        n+vm
        EndIf
     
    
A= WaitWindowEvent(10)
If A=#PB_Event_CloseWindow
Q=1
EndIf
Until Q=1

EndIf
End

2)Как можно сделать так, чтобы компьютер смог обходить препятствия?(хотя бы идейку подкиньте)
3)И ещё:2 чёрных круга когда идут за ГГ ,рано или поздно их координаты становятся одинаковыми, и они как бы сливаются и уже не разделятся.Как этого избежать?Как изменить поведение одного из них, чтобы он выбирал другую дорогу к ГГ,а желательно пытался его обойти,окружить?
4)И как изменить скорость?тут можно только целые числа,а мне надо 1.8 и 1.5!Пробовал использовать Delay, но он останавливает всю программу,как остановить на определённое время только кусок программы, чтобы можно было замедлить только круги управляемые компьютером?
(наверное я вас замучил с вопросами, но ответьте плиз,больше постараюсь вас не мучить ,заранее спасибо!)
Да!И как вы училили это язык?При помощи справки и видео уроков учиться проблематично!

Отредактировано Niset (07.01.2011 20:27:28)

0

Пётр

Niset написал(а):

)Как можно сделать так, чтобы компьютер смог обходить препятствия?(хотя бы идейку подкиньте)

Для этого надо искуственный интелект!

Niset написал(а):

желательно пытался его обойти,окружить?

Опять же, искуственный интелект.

Niset написал(а):

1) Как сделать так чтобы нельзя было проходить сквозь стены?

Вот посмотри как в этой игре сделано:

Код:

;      **************************** 
;    ******************************** 
;  ***                              *** 
; ***                                *** 
; ***          MAZE MISSION          *** 
; ***                                *** 
; ***  © 2005 by Christian Gleinser  *** 
; ***                                *** 
;  ***                              *** 
;    ******************************** 
;      **************************** 



InitSprite() 
InitKeyboard() 

Global breite.b 
Global hoehe.b 
Global cnt.l 
Global rndness.b, maxrnd.b 

Global cx.b, cy.b 
Global Dim zelle(500,500,5) 
Global Dim maze.b(1001,1001) 
Global Dim bereits(4) 
Global modus.b 
Global mrichtung.b 
Global anzeigen.b 
Global deadends.l 
Global mazefertig.b 

Global PlayerX.w, PlayerY.w 
Global richtung.b, walk.b, Blickrichtung.b 
Global anicnt.l 

Global Dim GegnerX.w(500) 
Global Dim GegnerY.w(500) 
Global Dim GegnerRichtung.b(500) 
Global GegnerAnzahl.l 
Global ganicnt.l 

Global Dim MuniX.w(100) 
Global Dim MuniY.w(100) 
Global MuniAnzahl.l 
Global Munition.l 

Global ShotX.w, ShotY.w 
Global Shoot.b 
Global ShootRichtung.b 

Global mission.b 
Global Zeit.w 

Global BlueX.w 
Global BlueY.w 

Global TheButtonX.w 
Global TheButtonY.w 

Global ExitX.w 
Global ExitY.w 

Global newgame.b 

Declare removesomedeadends() 
Declare makesomerooms() 
Declare scheiss() 
Declare init() 
Declare Map() 
Declare MakeSomeSprites() 
Declare game() 
Declare gameover() 
Declare explode() 
Declare Display() 
Declare DisplayMaze() 
Declare DisplayItems() 
Declare DisplayPlayer() 
Declare DisplayEnemies() 
Declare Controls() 
Declare Player() 
Declare Enemies() 
Declare Richtungswechsel(i.l) 

#links=0 
#rechts=1 
#hoch=2 
#runter=3 




Procedure umrechnenfinal() 
  For i = 2 To breite*2 Step 2 
    For j = 2 To hoehe*2 Step 2 
      If zelle(i/2,j/2,5)=1 
        maze(i-1,j-1)=1 
      EndIf 
      
      If zelle(i/2,j/2,2)=1 
        maze(i-1,j-1)=1 
        maze(i+1-1,j-1)=1 
      EndIf 
      If zelle(i/2,j/2,3)=1 
        maze(i-1,j-1)=1 
        maze(i-1,j+1-1)=1 
      EndIf 
    Next j 
  Next i 
  
  makesomerooms() 
EndProcedure 



Procedure umrechnen() 
  For i = 1 To breite 
    For j = 1 To hoehe 
      If zelle(i,j,1)=1 
        zelle(i,j-1,3)=1 
      EndIf 
      If zelle(i,j,2)=1 
        zelle(i+1,j,4)=1 
      EndIf 
      If zelle(i,j,3)=1 
        zelle(i,j+1,1)=1 
      EndIf 
      If zelle(i,j,4)=1 
        zelle(i-1,j,2)=1 
      EndIf 
    Next j 
  Next i 
EndProcedure 


Procedure calcmaze() 
  If modus=0 
    If cnt>=breite*hoehe 
      modus=1 
      umrechnen() 
      removesomedeadends() 
    EndIf 
  EndIf 
  
  
  If zelle(cx, cy, 5)=0 
    zelle(cx, cy, 5)=1 
    cnt=cnt+1 
  EndIf 
  
  
  While erfolg=0 
    rndness=rndness+1 
    If rndness=1 
      maxrnd=Int(Random(Int(breite/10)+1)+2) 
      mrichtung=Int(Random(3)+1) 
    EndIf 
    
    bereits(mrichtung)=1 
    If bereits(1) And bereits(2) And bereits(3) And bereits(4) 
      Break 
    EndIf 
    
    Select mrichtung 
      Case 1: 
        If cy>1 
          If zelle(cx,cy-1,5)=0 
            zelle(cx,cy,1)=1 
            cy=cy-1 
            erfolg=1 
          EndIf 
        EndIf 
      Case 2: 
        If cx<breite 
          If zelle(cx+1,cy,5)=0 
            zelle(cx,cy,2)=1 
            cx=cx+1 
            erfolg=1 
          EndIf 
        EndIf 
      Case 3: 
        If cy<hoehe 
          If zelle(cx,cy+1,5)=0 
            zelle(cx,cy,3)=1 
            cy=cy+1 
            erfolg=1 
          EndIf 
        EndIf 
      Case 4: 
        If cx>1 
          If zelle(cx-1,cy,5)=0 
            zelle(cx,cy,4)=1 
            cx=cx-1 
            erfolg=1 
          EndIf 
        EndIf 
    EndSelect 
  Wend 
  
  If rndness>=maxrnd 
    rndness=0 
  EndIf 
  
  
  For i = 1 To 4: bereits(i)=0: Next i 
  If erfolg=0 
    Repeat 
      cx=Int(Random(breite-1)+1) 
      cy=Int(Random(hoehe-1)+1) 
    Until zelle(cx, cy,5)=1 
    rndness=0 
    deadends=deadends+1 
  EndIf 
  
EndProcedure 



Procedure makesomeloops() 
  
  For krass = 1 To Int(breite/2) 
    ; dead ends suchen 
    Repeat 
      cx=Int(Random(breite-1)+1) 
      cy=Int(Random(hoehe-1)+1) 
      If zelle(cx,cy,1)+zelle(cx,cy,2)+zelle(cx,cy,3)+zelle(cx,cy,4)=1 
        Break 
      EndIf 
      cnt2=cnt2+1 
      If cnt2>=300 
        umrechnenfinal() 
      EndIf 
    ForEver 
    
    
    ; dead end zum loop machen 
      
      Repeat 
        i=Int(Random(3))+1 
      Until zelle(cx,cy,i)=0 
      
      zelle(cx,cy,i)=1 
      Select i 
        Case 1: cy=cy-1: zelle(cx,cy,3)=1 
        Case 2: cx=cx+1: zelle(cx,cy,4)=1 
        Case 3: cy=cy+1: zelle(cx,cy,1)=1 
        Case 4: cx=cx-1: zelle(cx,cy,2)=1 
      EndSelect 
    
  Next krass 
  umrechnenfinal() 
EndProcedure 




Procedure removesomedeadends() 
  
  For krass = 1 To Int(breite/2) 
    ; dead ends suchen 
    Repeat 
      cx=Int(Random(breite-1)+1) 
      cy=Int(Random(hoehe-1)+1) 
      If zelle(cx,cy,1)+zelle(cx,cy,2)+zelle(cx,cy,3)+zelle(cx,cy,4)=1 
        Break 
      EndIf 
    ForEver 
    
    ; dead end removen 
    Repeat 
      
      For i = 1 To 4 
        If zelle(cx,cy,i) 
          Break 
        EndIf 
      Next i 
      
      zelle(cx,cy,i)=0 
      zelle(cx,cy,5)=0 
      Select i 
        Case 1: cy=cy-1: zelle(cx,cy,3)=0 
        Case 2: cx=cx+1: zelle(cx,cy,4)=0 
        Case 3: cy=cy+1: zelle(cx,cy,1)=0 
        Case 4: cx=cx-1: zelle(cx,cy,2)=0 
      EndSelect 
      
    Until zelle(cx,cy,1)+zelle(cx,cy,2)+zelle(cx,cy,3)+zelle(cx,cy,4)>1 
  
  Next krass 
  
  makesomeloops() 
  
EndProcedure 


Procedure makesomerooms() 
  roomanzahl=Int(Random(breite*hoehe*0.08))+2 
  For i = 1 To roomanzahl 
    roomwidth=Int(Random(breite/2-4))+3 
    roomheight=Int(Random(hoehe/2-4))+3 
    roomx=Int(Random(breite*2-roomwidth-2))+1 
    roomy=Int(Random(hoehe*2-roomheight-2))+1 
    
    For j = 1 To roomwidth 
      For k = 1 To roomheight 
        maze(roomx+j,roomy+k)=1 
      Next k 
    Next j 
    
  Next i 
  
  FlipBuffers() 
  mazefertig=1 
EndProcedure 


Procedure WaitForKey() 
  Repeat 
    ExamineKeyboard() 
  Until KeyboardReleased(#PB_Any) 
EndProcedure 


Procedure ClearAll() 
  breite = 20 
  hoehe = 15 
  cx = 1 
  cy = 1 
  cnt = 0 
  mazefertig=0 
  mrichtung=0 
  deadends=0 
  modus=0 
  rndness=0 
  maxrnd=0 
  LoadFont(1,"arial",7) 
  LoadFont(2,"arial",5) 
  
  For i = 0 To 1001 
    For j = 0 To 1001 
      maze(i,j)=0 
    Next j 
  Next i 
  
  For i = 0 To 500 
    For j = 0 To 500 
      For k = 0 To 5 
        zelle(i,j,k)=0 
      Next k 
    Next j 
  Next i 
  
  For i = 0 To 4 
    bereits(i)=0 
  Next i 
  
  For i = 0 To 100 
    MuniX(i)=0 
    MuniY(i)=0 
  Next i 
  
  PlayerX=0 
  PlayerY=0 
  
  BlueX=0 
  BlueY=0 

  TheButtonX=0 
  TheButtonY=0 
  
  ShotX=0 
  ShotY=0 
  
  ExitX=0 
  ExitY=0 
  
  For i = 0 To 500 
    GegnerX(i)=0 
    GegnerY(i)=0 
  Next i 
EndProcedure 



Procedure main() 
  ClearAll() 
  
  ClearScreen(RGB(40,60,80))
  StartDrawing(ScreenOutput()) 
  FrontColor(RGB(255,255,255))
  DrawingMode(1) 
  DrawingFont(FontID(1)) 
  DrawText(113, 80, "M A Z E   M I S S I O N") 
  DrawText(100, 120, "© 2005 by Christian Gleinser") 
  DrawText(245, 225, "Press any key...") 
  StopDrawing() 
  FlipBuffers() 
  WaitForKey() 
  
  ClearScreen(RGB(40,60,80))
  StartDrawing(ScreenOutput()) 
  FrontColor(RGB(255,255,255))
  DrawingMode(1) 
  DrawingFont(FontID(1)) 
  DrawText(113, 80, "M A Z E   M I S S I O N") 
  DrawText(130, 120, "F1 - tiny maze") 
  DrawText(130, 140, "F2 - medium maze") 
  DrawText(130, 160, "F3 - giant maze") 
  StopDrawing() 
  FlipBuffers() 
  Repeat 
    ExamineKeyboard() 
    If KeyboardReleased(#PB_Key_F1) 
      breite=15 
      hoehe=15 
      Break 
    EndIf 
    If KeyboardReleased(#PB_Key_F2) 
      breite=25 
      hoehe=15 
      Break 
    EndIf 
    If KeyboardReleased(#PB_Key_F3) 
      breite=35 
      hoehe=25 
      Break 
    EndIf 
    If KeyboardReleased(#PB_Key_Escape) 
      ClearScreen(RGB(40,60,80))
      FlipBuffers() 
      Delay(500) 
      End 
    EndIf 
    If WaitWindowEvent(2) = #PB_Event_CloseWindow
      End
    EndIf
  ForEver 
  
  ClearScreen(RGB(40,60,80))
  StartDrawing(ScreenOutput()) 
  FrontColor(RGB(255,255,255))
  DrawingMode(1) 
  DrawingFont(FontID(1)) 
  DrawText(113, 80, "M A Z E   M I S S I O N") 
  DrawText(130, 120, "patience please...") 
  StopDrawing() 
  FlipBuffers() 
  
  MakeSomeSprites() 
  
  Repeat 
    calcmaze() 
    ExamineKeyboard() 
    If KeyboardPushed(#PB_Key_Escape) 
      End 
    EndIf 
    
    If WaitWindowEvent(2) = #PB_Event_CloseWindow
      End
    EndIf
  Until mazefertig 
  
  init() 
  game() 
  
  End 
EndProcedure 



Procedure game() 
  newgame=1 
  
  Repeat 
    Display() 
    Controls() 
    
    If mission<9 
      Player() 
      Enemies() 
    Else 
      mission=mission+1 
      If mission=100 
        gameover() 
      EndIf 
    EndIf 
    
    Delay(8) 
    
    If mission=2 
      ZeitCnt=ZeitCnt+1 
      If ZeitCnt=100 
        Zeit=Zeit-1 
        ZeitCnt=0 
      EndIf 
      If Zeit=0 
        explode() 
      EndIf 
    EndIf 
    
    If IsWindow(0) 
      If WindowEvent() = #PB_Event_CloseWindow
        End
      EndIf
    EndIf 
    
    
    
  ForEver 
  
EndProcedure 


Procedure gameover() 
  For i = 321 To 200 Step -1 
    ClearScreen(RGB(40,60,80))
    StartDrawing(ScreenOutput()) 
    FrontColor(RGB(255,255,255))
    DrawingMode(1) 
    DrawingFont(FontID(1)) 
    DrawText(i, 200, "game over") 
    StopDrawing() 
    FlipBuffers() 
    Delay(10) 
  Next i 
  WaitForKey() 
  
  main() 
EndProcedure 


Procedure missioncomplete() 
  Delay(700) 
  
  ClearScreen(RGB(40,60,80))
  StartDrawing(ScreenOutput()) 
  FrontColor(RGB(255,255,255))
  DrawingMode(1) 
  DrawingFont(FontID(1)) 
  DrawText(95, 80, "C O N G R A T U L A T I O N S !") 
  DrawText(136, 100, "you made it!") 
  StopDrawing() 
  FlipBuffers() 
  Delay(2000) 
  ExamineKeyboard() 
  WaitForKey() 
  ClearScreen(RGB(0,0,0))
  FlipBuffers() 
  Delay(700) 
  
  main() 
EndProcedure 


Procedure explode() 
  GrabSprite(666,60,40,200,160) 
  For i = 50 To 4 Step -1 
    ClearScreen(RGB(40,60,80))
    DisplaySprite(666,60+Int(Random(i/2)),40+Int(Random(i/2))) 
    FlipBuffers() 
    Delay(16) 
    ClearScreen(RGB(40,60,80))
    DisplaySprite(666,60+Int(Random(i/2)),40+Int(Random(i/2))) 
    FlipBuffers() 
    Delay(16) 
  Next i 
  
  ExamineKeyboard() 
  
  gameover() 
EndProcedure 


Procedure Display() 
  ClearScreen(RGB(0,0,0))
  
  DisplayMaze() 
  DisplayItems() 
  DisplayPlayer() 
  DisplayEnemies() 
  
  StartDrawing(ScreenOutput()) 
  Box(0,0,320,40,RGB(40,60,80)) 
  Box(0,200,320,40,RGB(40,60,80)) 
  Box(0,0,60,240,RGB(40,60,80)) 
  Box(260,0,60,240,RGB(40,60,80)) 
  FrontColor(RGB(255,255,255))
  DrawingMode(1) 
  DrawingFont(FontID(1)) 
  DrawText(17, 17, "Bullets: "+Str(Munition)) 
  
  Select mission 
    Case 0: DrawText(190, 17, "Find the blueprints!") 
    Case 1: DrawText(190, 17, "Find self-destruction switch!") 
    Case 2: DrawText(190, 17, "Get out of here!") 
      If Zeit<11 
        FrontColor(RGB(255,0,0))
      EndIf 
      DrawText(190, 27, Str(Zeit)+" seconds left") 
  EndSelect 
  
  If mission>9 
    FrontColor(RGB(255,0,0)):DrawText(190, 17, "They got you!") 
  EndIf 
  
  If newgame 
    FrontColor(RGB(0,255,0))
    DrawText(140, 70, "get ready") 
  EndIf 
  
  StopDrawing() 
  FlipBuffers() 
  
  If newgame 
    newgame=0 
    Delay(1000) 
  EndIf 
  
EndProcedure 

Procedure DisplayMaze() 
  For x = 0 To 11 
    For y = 0 To 9 
      bx=x*20+60-PlayerX%20-10 
      by=y*20+40-PlayerY%20-10 
      
      ox=(PlayerX/20)+x-5 
      oy=(PlayerY/20)+y-4 
      If ox>=0 And oy>=0 And ox<=breite*2 And oy<=hoehe*2 
        If maze(ox,oy) 
          DisplaySprite(1,bx,by) 
        Else 
          DisplaySprite(2,bx,by) 
        EndIf 
      Else 
        DisplaySprite(2,bx,by) 
      EndIf 
    Next y 
  Next x 
EndProcedure 

Procedure DisplayItems() 
  For i = 0 To MuniAnzahl 
    ox=MuniX(i)-PlayerX-10+160 
    oy=MuniY(i)-PlayerY-10+120 
    DisplayTransparentSprite(301,ox,oy) 
  Next i 
  
  ox=BlueX-PlayerX-10+160 
  oy=BlueY-PlayerY-10+120 
  DisplayTransparentSprite(303,ox,oy) 
  
  ox=TheButtonX-PlayerX-10+160 
  oy=TheButtonY-PlayerY-10+120 
  DisplayTransparentSprite(304,ox,oy) 
  
  ox=ExitX-PlayerX-10+160 
  oy=ExitY-PlayerY-10+120 
  DisplayTransparentSprite(305,ox,oy) 
EndProcedure 

Procedure DisplayPlayer() 
  If walk=0 
    anicnt=0 
  EndIf 
  
  anicnt=anicnt+6 
  If anicnt>200 
    anicnt=0 
  EndIf 
  
  ClipSprite(100,Int(anicnt/100)*20,richtung%2*20,20,20) 
  DisplayTransparentSprite(100,150,110) 
  
  If Shoot 
    ox=ShotX-PlayerX-10+160 
    oy=ShotY-PlayerY-10+120 
    DisplayTransparentSprite(302,ox,oy) 
  EndIf 
  
EndProcedure 

Procedure DisplayEnemies() 
  ganicnt=ganicnt+6 
  If ganicnt>200 
    ganicnt=0 
  EndIf 
  
  For i = 0 To GegnerAnzahl 
    ox=GegnerX(i)-PlayerX-10+160 
    oy=GegnerY(i)-PlayerY-10+120 
    
    If GegnerRichtung(i)>=5 And GegnerRichtung(i)<40 
      GegnerRichtung(i)=GegnerRichtung(i)+1 
      DisplayTransparentSprite(201,ox,oy) 
    EndIf 
    If GegnerRichtung(i)<5 
      ClipSprite(200,Int(ganicnt/100)*20,GegnerRichtung(i)%2*20,20,20) 
      DisplayTransparentSprite(200,ox,oy) 
    EndIf 
    
  Next i 
EndProcedure 

Procedure Controls() 
  Static dauerfeuergibtshiernicht.b 
  
  ExamineKeyboard() 
  If KeyboardPushed(#PB_Key_Escape) 
    End 
  EndIf 
  If KeyboardReleased(#PB_Key_F1) 
    MakeSomeSprites() 
  EndIf 
  If KeyboardReleased(#PB_Key_F2) 
    Map() 
  EndIf 
  
  If KeyboardPushed(#PB_Key_Left) 
    richtung=#links 
    Blickrichtung=#links 
    walk=1 
  EndIf 
  If KeyboardPushed(#PB_Key_Right) 
    richtung=#rechts 
    Blickrichtung=#rechts 
    walk=1 
  EndIf 
  If KeyboardPushed(#PB_Key_Up) 
    richtung=#hoch 
    Blickrichtung=#hoch 
    walk=1 
  EndIf 
  If KeyboardPushed(#PB_Key_Down) 
    richtung=#runter 
    Blickrichtung=#runter 
    walk=1 
  EndIf 
  If KeyboardPushed(#PB_Key_Space) 
    If Shoot=0 And Munition>0 And dauerfeuergibtshiernicht=0 
      Shoot=1 
      ShootRichtung=Blickrichtung 
      Munition=Munition-1 
      ShotX=PlayerX 
      ShotY=PlayerY 
      dauerfeuergibtshiernicht=1 
    EndIf 
  EndIf 
  If KeyboardReleased(#PB_Key_Space) 
    dauerfeuergibtshiernicht=0 
  EndIf 
  
  If KeyboardReleased(#PB_Any) 
    walk=0 
  EndIf 
  
EndProcedure 


Procedure Player() 
  If walk 
    nx1 = Int(PlayerX / 20) 
    nx2 = Int((PlayerX + 19) / 20) 
    ny1 = Int(PlayerY / 20) 
    ny2 = Int((PlayerY + 19) / 20) 
    
    Select richtung 
      Case #links: 
        If maze(nx2-1,ny1)<>1: hoscheisse=1: EndIf 
        If maze(nx2-1,ny2)<>1: ruscheisse=1: EndIf 
        If hoscheisse=0 And ruscheisse=1: richtung=#hoch: EndIf 
        If hoscheisse=1 And ruscheisse=0: richtung=#runter: EndIf 
        If hoscheisse=1 And ruscheisse=1: walk=0: EndIf 
      Case #rechts: 
        If maze(nx1+1,ny1)<>1: hoscheisse=1: EndIf 
        If maze(nx1+1,ny2)<>1: ruscheisse=1: EndIf 
        If hoscheisse=0 And ruscheisse=1: richtung=#hoch: EndIf 
        If hoscheisse=1 And ruscheisse=0: richtung=#runter: EndIf 
        If hoscheisse=1 And ruscheisse=1: walk=0: EndIf 
      Case #hoch: 
        If maze(nx1,ny2-1)<>1: lischeisse=1: EndIf 
        If maze(nx2,ny2-1)<>1: rescheisse=1: EndIf 
        If lischeisse=0 And rescheisse=1: richtung=#links: EndIf 
        If lischeisse=1 And rescheisse=0: richtung=#rechts: EndIf 
        If lischeisse=1 And rescheisse=1: walk=0: EndIf 
      Case #runter: 
        If maze(nx1,ny1+1)<>1: lischeisse=1: EndIf 
        If maze(nx2,ny1+1)<>1: rescheisse=1: EndIf 
        If lischeisse=0 And rescheisse=1: richtung=#links: EndIf 
        If lischeisse=1 And rescheisse=0: richtung=#rechts: EndIf 
        If lischeisse=1 And rescheisse=1: walk=0: EndIf 
    EndSelect 
  EndIf 
  
  If walk 
    Select richtung 
      Case #links: PlayerX=PlayerX-1 
      Case #rechts: PlayerX=PlayerX+1 
      Case #hoch: PlayerY=PlayerY-1 
      Case #runter: PlayerY=PlayerY+1 
    EndSelect 
  EndIf 
      
  ;einsammeln 
  For i = 0 To MuniAnzahl 
    If PlayerX>=MuniX(i)-6 And PlayerX<=MuniX(i)+6 
      If PlayerY>=MuniY(i)-6 And PlayerY<=MuniY(i)+6 
        Munition=Munition+4 
        MuniX(i)=-500 
      EndIf 
    EndIf 
  Next i 
  
  If PlayerX>=BlueX-8 And PlayerX<=BlueX+8 
    If PlayerY>=BlueY-8 And PlayerY<=BlueY+8 
      BlueX=-500 
      mission=1 
    EndIf 
  EndIf 
  
  If PlayerX>=TheButtonX-8 And PlayerX<=TheButtonX+8 
    If PlayerY>=TheButtonY-8 And PlayerY<=TheButtonY+8 
      If mission=1 
        mission=2 
        Zeit=breite*2 
        ClearScreen(RGB(255,255,255))
        FlipBuffers() 
        Delay(20) 
      EndIf 
    EndIf 
  EndIf 
      
  If PlayerX>=ExitX-8 And PlayerX<=ExitX+8 
    If PlayerY>=ExitY-8 And PlayerY<=ExitY+8 
      If mission=2 
        missioncomplete() 
      EndIf 
    EndIf 
  EndIf 
  
  
  
  ;schieЯen 
  If Shoot 
    ox=ShotX-PlayerX-10+160 
    oy=ShotY-PlayerY-10+120 

    Select ShootRichtung 
      Case #links: ShotX=ShotX-5 
      Case #rechts: ShotX=ShotX+5 
      Case #hoch: ShotY=ShotY-5 
      Case #runter: ShotY=ShotY+5 
    EndSelect 
    If ox<20 Or ox>300 Or oy<20 Or oy>220 
      Shoot=0 
    EndIf 
    
    For i = 0 To GegnerAnzahl 
      If GegnerRichtung(i)<5 
        If ShotX>=GegnerX(i)-10 And ShotX<=GegnerX(i)+10 
          If ShotY>=GegnerY(i)-10 And ShotY<=GegnerY(i)+10 
            GegnerRichtung(i)=5 
            Shoot=0 
          EndIf 
        EndIf 
      EndIf 
    Next i 
    
    If maze(Int(ShotX/20),Int(ShotY/20))<>1 
      If Shoot<>2 
        Shoot=Shoot+1 
      Else 
        Shoot=0 
      EndIf 
    EndIf 
    
  EndIf 
EndProcedure 


Procedure Enemies() 
  For i = 0 To GegnerAnzahl 
    nx = Int(GegnerX(i) / 20) 
    nxx = Int((GegnerX(i) + 19) / 20) 
    ny = Int(GegnerY(i) / 20) 
    nyy = Int((GegnerY(i) + 19) / 20) 
    
    Repeat 
      r=0 
      Select GegnerRichtung(i) 
        Case #links 
          If GegnerX(i)%20=0 
            If maze(nxx-1,ny)<>1 
              GegnerRichtung(i)=Int(Random(3)) 
              r=1 
            EndIf 
          EndIf 
          If r=0 
            GegnerX(i)=GegnerX(i)-1 
          EndIf 
          
        Case #rechts 
          If GegnerX(i)%20=0 
            If maze(nx+1,ny)<>1 
              GegnerRichtung(i)=Int(Random(3)) 
              r=1 
            EndIf 
          EndIf 
          If r=0 
            GegnerX(i)=GegnerX(i)+1 
          EndIf 
          
        Case #hoch 
          If GegnerY(i)%20=0 
            If maze(nx,nyy-1)<>1 
              GegnerRichtung(i)=Int(Random(3)) 
              r=1 
            EndIf 
          EndIf 
          If r=0 
            GegnerY(i)=GegnerY(i)-1 
          EndIf 
          
        Case #runter 
          If GegnerY(i)%20=0 
            If maze(nx,ny+1)<>1 
              GegnerRichtung(i)=Int(Random(3)) 
              r=1 
            EndIf 
          EndIf 
          If r=0 
            GegnerY(i)=GegnerY(i)+1 
          EndIf 
      EndSelect 
    Until r=0 
    
    If GegnerRichtung(i)<5 
      ;Kollision 
      If GegnerX(i)>=PlayerX-6 And GegnerX(i)<=PlayerX+6 
        If GegnerY(i)>=PlayerY-9 And GegnerY(i)<=PlayerY+9 
          mission=9 
        EndIf 
      EndIf 
    EndIf 
    
  Next i 
  
EndProcedure 


Procedure Richtungswechsel(i.l) 
  GegnerRichtung(i)=Int(Random(3)) 
EndProcedure 


Procedure Map() 
  ClearScreen(RGB(0,0,0))
  ox=160-breite*3 
  oy=120-hoehe*3 
  
  StartDrawing(ScreenOutput()) 
  For x = 0 To breite*2 
    For y = 0 To hoehe*2 
      If maze(x,y)=0 
        Box(x*3+ox,y*3+oy,3,3,RGB(0,128,255)) 
      EndIf 
    Next y 
  Next x 
  
  For i = 0 To GegnerAnzahl 
    Plot(GegnerX(i)/20*3+1+ox,GegnerY(i)/20*3+1+oy,RGB(255,0,0)) 
  Next i 
  
  Box(PlayerX/20*3+ox,PlayerY/20*3+oy,3,3,RGB(255,255,0)) 
  StopDrawing() 
  FlipBuffers() 
  WaitForKey() 
EndProcedure 



Procedure init() 
  While maze(PlayerX,PlayerY)=0 
    PlayerX=Int(Random(breite*2)) 
    PlayerY=Int(Random(hoehe*2)) 
  Wend 
  PlayerX=PlayerX*20 
  PlayerY=PlayerY*20 
  Blickrichtung=#links 
  
  GegnerAnzahl=breite*hoehe/15 
  ;GegnerAnzahl=49 
  
  For i = 0 To GegnerAnzahl 
    While maze(GegnerX(i),GegnerY(i))=0 
      GegnerX(i)=Int(Random(breite*2)) 
      GegnerY(i)=Int(Random(hoehe*2)) 
    Wend 
    GegnerX(i)=GegnerX(i)*20 
    GegnerY(i)=GegnerY(i)*20 
    GegnerRichtung(i)=Int(Random(3)) 
    
    If GegnerX(i)>=PlayerX-50 And GegnerX(i)<=PlayerX+50 
      If GegnerY(i)>=PlayerY-50 And GegnerY(i)<=PlayerY+50 
        GegnerX(i)=0 
        GegnerY(i)=0 
        i=i-1 
      EndIf 
    EndIf 
  Next i 
  
  Munition=2 
  MuniAnzahl=breite*hoehe/100 
  
  For i = 0 To MuniAnzahl 
    While maze(MuniX(i),MuniY(i))=0 
      MuniX(i)=Int(Random(breite*2)) 
      MuniY(i)=Int(Random(hoehe*2)) 
    Wend 
    MuniX(i)=MuniX(i)*20 
    MuniY(i)=MuniY(i)*20 
  Next i 
  
  While maze(BlueX,BlueY)=0 Or BlueX=PlayerX/20 And BlueY=PlayerY/20 
    BlueX=Int(Random(breite*2)) 
    BlueY=Int(Random(hoehe*2)) 
  Wend 
  BlueX=BlueX*20 
  BlueY=BlueY*20 
  
  While maze(TheButtonX,TheButtonY)=0 Or TheButtonX=PlayerX/20 And TheButtonY=PlayerY/20 
    TheButtonX=Int(Random(breite*2)) 
    TheButtonY=Int(Random(hoehe*2)) 
  Wend 
  TheButtonX=TheButtonX*20 
  TheButtonY=TheButtonY*20 
  
  While maze(ExitX,ExitY)=0 Or ExitX=PlayerX/20 And ExitY=PlayerY/20 
    ExitX=Int(Random(breite*2)) 
    ExitY=Int(Random(hoehe*2)) 
  Wend 
  ExitX=ExitX*20 
  ExitY=ExitY*20 
  
  mission=0 
EndProcedure 


Procedure MakeSomeSprites() 
  StartDrawing(ScreenOutput()) 
  Box(0,0,20,20,RGB(0,128,255)) 
  Line(0,0,20,0,RGB(220,230,255)) 
  Line(0,0,0,20,RGB(220,230,255)) 
  Line(1,19,20,0,RGB(0,96,192)) 
  Line(19,0,0,20,RGB(0,96,192)) 
  If Int(Random(1)) 
    Line(3,3,14,0,RGB(0,96,192)) 
    Line(3,3,0,14,RGB(0,96,192)) 
    Line(4,16,13,0,RGB(220,230,255)) 
    Line(16,3,0,14,RGB(220,230,255)) 
    If Int(Random(1)) 
      Box(4,4,12,12,RGB(100,200,255)) 
    EndIf 
    If Int(Random(1)) 
      Box(4,4,12,12,RGB(0,0,0)) 
    EndIf 
  EndIf 
  If Int(Random(1)) 
    Line(8,8,4,0,RGB(220,230,255)) 
    Line(8,8,0,5,RGB(220,230,255)) 
    Line(9,12,4,0,RGB(0,96,192)) 
    Line(12,8,0,4,RGB(0,96,192)) 
    If Int(Random(1)) 
      Box(9,9,3,3,RGB(100,200,255)) 
    EndIf 
    If Int(Random(1)) 
      Box(9,9,3,3,RGB(0,0,0)) 
    EndIf 
    If Int(Random(1)) 
      Box(9,9,3,3,RGB(0,128,255)) 
    EndIf 
  EndIf 
  StopDrawing() 
  GrabSprite(2,0,0,20,20) 
  
  StartDrawing(ScreenOutput()) 
  Box(0,0,20,20,RGB(0,20,40)) 
  StopDrawing() 
  GrabSprite(1,0,0,20,20) 
  
  ; SPIELFIGUR 
  StartDrawing(ScreenOutput()) 
  Box(0,0,40,40,RGB(0,0,0)) 
  Circle(10,5,2,RGB(255,255,0)) 
  Line(10,7,0,4,RGB(255,255,0)) 
  Line(10,11,-1,4,RGB(255,255,0)) 
  Line(10,11,1,6,RGB(255,255,0)) 
  Line(10,7,-2,4,RGB(255,255,0)) 
  Line(10,7,2,5,RGB(255,255,0)) 
  
  Circle(20+10,5,2,RGB(255,255,0)) 
  Line(20+10,7,0,4,RGB(255,255,0)) 
  Line(20+10,11,-3,6,RGB(255,255,0)) 
  Line(20+10,11,3,4,RGB(255,255,0)) 
  Line(20+10,7,-2,5,RGB(255,255,0)) 
  Line(20+10,7,2,4,RGB(255,255,0)) 
  
  Circle(11,20+5,2,RGB(255,255,0)) 
  Line(10,20+7,0,4,RGB(255,255,0)) 
  Line(10,20+11,-1,4,RGB(255,255,0)) 
  Line(10,20+11,1,6,RGB(255,255,0)) 
  Line(10,20+7,-2,4,RGB(255,255,0)) 
  Line(10,20+7,2,5,RGB(255,255,0)) 
  
  Circle(20+11,20+5,2,RGB(255,255,0)) 
  Line(20+10,20+7,0,4,RGB(255,255,0)) 
  Line(20+10,20+11,-3,6,RGB(255,255,0)) 
  Line(20+10,20+11,3,4,RGB(255,255,0)) 
  Line(20+10,20+7,-2,5,RGB(255,255,0)) 
  Line(20+10,20+7,2,4,RGB(255,255,0)) 
  
  StopDrawing() 
  GrabSprite(100,0,0,40,40) 
  TransparentSpriteColor(-1,RGB(0,0,0))
  
  ; GEGNER 
  StartDrawing(ScreenOutput()) 
  Box(0,0,40,40,RGB(0,0,0)) 
  Circle(10,5,2,RGB(255,0,0)) 
  Line(10,7,0,4,RGB(255,0,0)) 
  Line(10,11,-1,4,RGB(255,0,0)) 
  Line(10,11,1,6,RGB(255,0,0)) 
  Line(10,7,-2,4,RGB(255,0,0)) 
  Line(10,7,2,5,RGB(255,0,0)) 
  
  Circle(20+10,5,2,RGB(255,0,0)) 
  Line(20+10,7,0,4,RGB(255,0,0)) 
  Line(20+10,11,-3,6,RGB(255,0,0)) 
  Line(20+10,11,3,4,RGB(255,0,0)) 
  Line(20+10,7,-2,5,RGB(255,0,0)) 
  Line(20+10,7,2,4,RGB(255,0,0)) 
  
  Circle(11,20+5,2,RGB(255,0,0)) 
  Line(10,20+7,0,4,RGB(255,0,0)) 
  Line(10,20+11,-1,4,RGB(255,0,0)) 
  Line(10,20+11,1,6,RGB(255,0,0)) 
  Line(10,20+7,-2,4,RGB(255,0,0)) 
  Line(10,20+7,2,5,RGB(255,0,0)) 
  
  Circle(20+11,20+5,2,RGB(255,0,0)) 
  Line(20+10,20+7,0,4,RGB(255,0,0)) 
  Line(20+10,20+11,-3,6,RGB(255,0,0)) 
  Line(20+10,20+11,3,4,RGB(255,0,0)) 
  Line(20+10,20+7,-2,5,RGB(255,0,0)) 
  Line(20+10,20+7,2,4,RGB(255,0,0)) 
  StopDrawing() 
  GrabSprite(200,0,0,40,40) 
  
  ;GEGNER TOT 
  StartDrawing(ScreenOutput()) 
  Box(0,0,40,40,RGB(0,0,0)) 
  Line(5,5,10,10,RGB(255,0,0)) 
  Line(14,5,-10,10,RGB(255,0,0)) 
  Line(5,10,10,0,RGB(255,0,0)) 
  Line(10,5,0,10,RGB(255,0,0)) 
  Circle(10,10,3,RGB(0,0,0)) 
  StopDrawing() 
  GrabSprite(201,0,0,20,20) 
  
  ; ITEMS 
  StartDrawing(ScreenOutput()) 
  Box(0,0,20,20,RGB(0,0,0)) 
  Line(5,5,0,3,RGB(255,0,0)) 
  Line(7,5,0,3,RGB(255,0,0)) 
  Line(9,5,0,3,RGB(255,0,0)) 
  Line(11,5,0,3,RGB(255,0,0)) 
  Plot(5,8,RGB(255,255,0)) 
  Plot(7,8,RGB(255,255,0)) 
  Plot(9,8,RGB(255,255,0)) 
  Plot(11,8,RGB(255,255,0)) 
  StopDrawing() 
  GrabSprite(301,0,0,20,20) 
  
  StartDrawing(ScreenOutput()) 
  Box(0,0,20,20,RGB(0,0,0)) 
  Circle(10,10,4,RGB(255,0,0)) 
  Circle(10,10,2,RGB(255,255,0)) 
  StopDrawing() 
  GrabSprite(302,0,0,20,20) 
  
  StartDrawing(ScreenOutput()) 
  Box(0,0,20,20,RGB(0,0,0)) 
  Box(3,3,14,14,RGB(255,255,255)) 
  Box(4,4,12,12,RGB(0,30,170)) 
  Circle(7,7,3,RGB(255,255,255)) 
  Circle(7,7,2,RGB(0,30,170)) 
  Line(5,12,5,0,RGB(255,255,255)) 
  Line(5,14,4,0,RGB(255,255,255)) 
  Line(12,5,0,10,RGB(255,255,255)) 
  Line(12,12,3,0,RGB(255,255,255)) 
  Line(12,14,4,0,RGB(255,255,255)) 
  StopDrawing() 
  GrabSprite(303,0,0,20,20) 
  
  StartDrawing(ScreenOutput()) 
  Box(0,0,20,20,RGB(0,0,0)) 
  Box(4,4,11,11,RGB(80,80,80)) 
  Line(4,4,11,0,RGB(120,120,120)) 
  Line(4,4,0,11,RGB(120,120,120)) 
  Line(15,4,0,11,RGB(50,50,50)) 
  Line(15,15,-11,0,RGB(50,50,50)) 
  Circle(10,10,4,RGB(0,0,0)) 
  Circle(10,10,3,RGB(255,0,0)) 
  Circle(10,10,2,RGB(200,0,0)) 
  StopDrawing() 
  GrabSprite(304,0,0,20,20) 
  
  StartDrawing(ScreenOutput()) 
  Box(0,0,20,20,RGB(0,0,0)) 
  Box(2,2,16,16,RGB(0,180,0)) 
  Box(4,4,12,12,RGB(0,50,0)) 
  DrawingFont(FontID(2)) 
  DrawingMode(1) 
  FrontColor(RGB(255,255,255))
  DrawText(2, 7, "EXIT") 
  StopDrawing() 
  GrabSprite(305,0,0,20,20) 
  
  ClearScreen(RGB(40,60,80))
EndProcedure 


Procedure StartWindowed() 
  If OpenWindow(0,0,0,640,480,"Maze Mission",#PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
    If OpenWindowedScreen(WindowID(0),0,0,320,240,1,0,0) 
      main() 
    EndIf 
  EndIf 
EndProcedure 

Procedure StartFullscreen() 
  If OpenScreen(320,240,32,"Maze Mission") 
    main() 
  Else 
    MessageRequester("Fehler", "Fullscreen-Mode scheint nicht zu gehen. Nun muЯ eben der Fenstermodus genьgen :)") 
    StartWindowed() 
  EndIf 
EndProcedure 


;StartFullscreen()           ;hier kцnnt ihr wдhlen, welchen Modus ihr wollt 
StartWindowed()

0

ВиниПур · Поделиться**100**07.01.2011 21:08:27

Niset написал(а):

Как сделать так чтобы нельзя было проходить сквозь стены?

Условия измени на такое
If y<5: y=5: EndIf
If y>795: y=795: EndIf

Ну и так далее.

Niset написал(а):

И как изменить скорость?тут можно только целые числа,а мне надо 1.8 и 1.5

Для того, что бы использовать дробные числа нудно объявить соотв. переменные как

x.d=500
y.d=500
c.d=10
d.d=10
; учись пользоваться переменными - надо исправить скорости меняй тут:
vg.d = 5.5 ; скорость геймера
vk.d = 3.1 ; скорость компьютера

Смотри в справке, что это значит.

Niset написал(а):

Как можно сделать так, чтобы компьютер смог обходить препятствия?(хотя бы идейку подкиньте)

Niset написал(а):

Да!И как вы училили это язык?

На остальные вопросы - 90 % изучаем по примерам, чего нет в примерах - в интернете по аналогии с других языков. Примеров с играми много тут:
http://pbasic.spb.ru/phpBB2/viewforum.php?f=12
На этом же форуме есть ссылки на кодовый архив, там тоже много примеров с играми и т.п.

0

Lucagin · Поделиться**101**08.01.2011 03:02:46

Ребят, помогите оптимизировать код.
При движении бегунков мышкой, справа отображаются значение, но при быстром движении бегунка идет запаздывание обновления цифр цвета. Здесь это не так заметно, а когда код более сложный, то запаздывание проявляется сильнее. Как сделать максимально быстрое обновление цифр при перемещении бегунка???

Например, программа, кот. рекомендовал mirashic http://purebasic.mybb.ru/viewtopic.php?id=17&p=34 (пост 999). Подобный элемент в той программе работает более динамично, запаздывания не заметно…

Код:

;{ ;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Image_0
  #Image_1
  #Image_2
  #String_0
  #String_1
  #String_2
  #Text_0
  #Text_1
  #Text_2
EndEnumeration

;- Fonts
Global FontID1
FontID1 = LoadFont(1, "Arial", 18)
;}

Procedure Gradient_Line(Red_,Green_,Blue_) ; зиливает градиентом 3-ри полосы цвета...
  For a=#Image_0 To #Image_2     
          
    If  StartDrawing(ImageOutput(a))
            
      DrawingMode(#PB_2DDrawing_Gradient)      
      If a=#Image_0
        BackColor(RGB(0,Green_,Blue_))
        FrontColor(RGB(255,Green_,Blue_))
      ElseIf a=#Image_1
        BackColor(RGB(Red_,0,Blue_))
        FrontColor(RGB(Red_,255,Blue_))               
      Else
        BackColor(RGB(Red_,Green_,0))
        FrontColor(RGB(Red_,Green_,255)) 
      EndIf  
      LinearGradient(0, 20, 255,20)    
      Box(0, 0, 255, 30)
    
      StopDrawing()    

      SetGadgetState(a,ImageID(a))
    EndIf   
  Next  
  
EndProcedure

Procedure Begunok(znach,X,Y) ; рисует бегунки значения цвета...
  If znach<0 : znach=0
  ElseIf znach>255 : znach=255
  EndIf 
  
  If     y=40+30+1 : SetGadgetText(#String_0, Str(znach))
    Gradient_Line(znach,Val(GetGadgetText(#String_1)),Val(GetGadgetText(#String_2)))
  ElseIf y=110+30+1 : SetGadgetText(#String_1, Str(znach))
    Gradient_Line(Val(GetGadgetText(#String_0)),znach,Val(GetGadgetText(#String_2)))
  ElseIf y=180+30+1 : SetGadgetText(#String_2, Str(znach))    
    Gradient_Line(Val(GetGadgetText(#String_0)),Val(GetGadgetText(#String_1)),znach)
  EndIf  
  
  If  StartDrawing(WindowOutput(#Window_0))
    Box(X-5, Y, 267, 12,Point(X-50, Y))
    LineXY(X+znach, Y, X+znach+5, Y+10, $000000) 
    LineXY(X+znach+5, Y+10, X+znach-5, Y+10, $000000) 
    LineXY(X+znach-5, Y+10, X+znach, Y, $000000)
    FillArea(X+znach-2.5, Y+10-2.5, 0, $000000)

      StopDrawing()
  EndIf 
  
EndProcedure

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 216, 0, 467, 245, "New window ( 0 )",  #PB_Window_SystemMenu  | #PB_Window_TitleBar )
    ;If CreateGadgetList(WindowID(#Window_0))
      
      CreateImage(#Image_0,255,30)
      ImageGadget(#Image_0, 70, 40, 255, 30, Image0, #PB_Image_Border)
      CreateImage(#Image_1,255,30)
      ImageGadget(#Image_1, 70, 110, 255, 30, Image1, #PB_Image_Border)
      CreateImage(#Image_2,255,30)
      ImageGadget(#Image_2, 70, 180, 255, 30, Image2, #PB_Image_Border)
      StringGadget(#String_0, 350, 40, 60, 30, "",#PB_String_ReadOnly)
      SetGadgetFont(#String_0, FontID1)
      StringGadget(#String_1, 350, 110, 60, 30, "",#PB_String_ReadOnly)
      SetGadgetFont(#String_1, FontID1)
      StringGadget(#String_2, 350, 180, 60, 30, "",#PB_String_ReadOnly)
      SetGadgetFont(#String_2, FontID1)
      TextGadget(#Text_0, 20, 40, 30, 30, "R")
      SetGadgetFont(#Text_0, FontID1)
      TextGadget(#Text_1, 20, 110, 30, 30, "G")
      SetGadgetFont(#Text_1, FontID1)
      TextGadget(#Text_2, 20, 180, 30, 30, "B")
      SetGadgetFont(#Text_2, FontID1)
      
    ;EndIf
  EndIf
EndProcedure

Open_Window_0()
Gradient_Line(213,140,15)
Begunok(213,70+1,40+30+1)
Begunok(140,70+1,110+30+1)
Begunok(15,70+1,180+30+1)

;{ основной цикл
Repeat
  event=WaitWindowEvent()
    
  If Event=#WM_LBUTTONDOWN      
    If WindowMouseX(#Window_0) >=70 And WindowMouseX(#Window_0)<=325 And  WindowMouseY(#Window_0)>=40+30 And WindowMouseY(#Window_0)<=40+30+30
      While WindowEvent()<>#WM_LBUTTONUP
        Begunok(WindowMouseX(#Window_0)-70,70+1,40+30+1)
      Wend  
    ElseIf WindowMouseX(#Window_0) >=70 And WindowMouseX(#Window_0)<=325 And  WindowMouseY(#Window_0)>=110+30 And WindowMouseY(#Window_0)<=110+30+30    
      While WindowEvent()<>#WM_LBUTTONUP
        Begunok(WindowMouseX(#Window_0)-70,70+1,110+30+1)
      Wend  
    ElseIf  WindowMouseX(#Window_0) >=70 And WindowMouseX(#Window_0)<=325 And  WindowMouseY(#Window_0)>=180+30 And WindowMouseY(#Window_0)<=180+30+30      
      While WindowEvent()<>#WM_LBUTTONUP
        Begunok(WindowMouseX(#Window_0)-70,70+1,180+30+1)
      Wend   
      
    EndIf  

  EndIf  
  
Until event=#PB_Event_CloseWindow
;}

End

Отредактировано Lucagin (08.01.2011 14:25:08)

0

Lucagin · Поделиться**102**08.01.2011 16:34:05

Сделал, заменив отображение цифры цвета по средствам StringGadget() на отображение по средствам ImageGadget() и 2D-рисования. Скорость заметно выросла. Сравните верхний бегунок с остальными… Самая наверно высокая скорость будет если рисовать сразу на окне... :disappointed: Однако, в программе mirashicа, задача реализована именно с помощью StringGadget()… :dontknow:
Было бы интересно, если у кого-то есть предложения, как это реализовать по другому… :rolleyes:

Код:

;{ ;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Image_0
  #Image_1
  #Image_2
  #Image_3
  ;#String_0
  #String_1
  #String_2
  #Text_0
  #Text_1
  #Text_2
EndEnumeration

;- Fonts
Global FontID1
FontID1 = LoadFont(1, "Arial", 18)
;}

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 216, 0, 467, 245, "New window ( 0 )",  #PB_Window_SystemMenu  | #PB_Window_TitleBar )
    ;If CreateGadgetList(WindowID(#Window_0))
      
      CreateImage(#Image_0,255,30)
      ImageGadget(#Image_0, 70, 40, 255, 30, Image0, #PB_Image_Border)
      CreateImage(#Image_1,255,30)
      ImageGadget(#Image_1, 70, 110, 255, 30, Image1, #PB_Image_Border)
      CreateImage(#Image_2,255,30)
      ImageGadget(#Image_2, 70, 180, 255, 30, Image2, #PB_Image_Border)      
      CreateImage(#Image_3,60,30)
      ImageGadget(#Image_3, 350, 40, 60, 30, Image2, #PB_Image_Border)      
      ;StringGadget(#String_0, 350, 40, 60, 30, "",#PB_String_ReadOnly)
      ;SetGadgetFont(#String_0, FontID1)
      ;HideGadget(#String_0, 1)
      StringGadget(#String_1, 350, 110, 60, 30, "",#PB_String_ReadOnly)
      SetGadgetFont(#String_1, FontID1)
      StringGadget(#String_2, 350, 180, 60, 30, "",#PB_String_ReadOnly)
      SetGadgetFont(#String_2, FontID1)
      TextGadget(#Text_0, 20, 40, 30, 30, "R")
      SetGadgetFont(#Text_0, FontID1)
      TextGadget(#Text_1, 20, 110, 30, 30, "G")
      SetGadgetFont(#Text_1, FontID1)
      TextGadget(#Text_2, 20, 180, 30, 30, "B")
      SetGadgetFont(#Text_2, FontID1)
      
    ;EndIf
  EndIf
EndProcedure

Procedure Gradient_Line(Red_,Green_,Blue_) ; зиливает градиентом 3-ри полосы цвета...
  For a=#Image_0 To #Image_2             
    If  StartDrawing(ImageOutput(a))            
      DrawingMode(#PB_2DDrawing_Gradient)      
        If a=#Image_0
          BackColor(RGB(0,Green_,Blue_))
          FrontColor(RGB(255,Green_,Blue_))
        ElseIf a=#Image_1
          BackColor(RGB(Red_,0,Blue_))
          FrontColor(RGB(Red_,255,Blue_))               
        Else
          BackColor(RGB(Red_,Green_,0))
          FrontColor(RGB(Red_,Green_,255)) 
        EndIf  
      LinearGradient(0, 20, 255,20)    
      Box(0, 0, 255, 30)    
        StopDrawing()  :  SetGadgetState(a,ImageID(a))
    EndIf   
  Next    
EndProcedure

Procedure Begunok(znach,X,Y) ; рисует бегунки значения цвета...
  If znach<0 : znach=0  :  ElseIf znach>255 : znach=255  :  EndIf  
  If  StartDrawing(WindowOutput(#Window_0)) : R_G_B=Point(X-10, Y) : StopDrawing() : EndIf 
  
  If     y=40+30+1 : text1=znach  ;SetGadgetText(#String_0, Str(znach))    
    If  StartDrawing(ImageOutput(#Image_3))
      Box(0,0, 60, 30,R_G_B)
      DrawingFont(FontID1) 
      DrawRotatedText(10, 2, Str(text1), 0, RGB(0, 0, 0))    
        StopDrawing() : SetGadgetState(#Image_3,ImageID(#Image_3))
    EndIf    
    Gradient_Line(znach,Val(GetGadgetText(#String_1)),Val(GetGadgetText(#String_2)))
  ElseIf y=110+30+1 : SetGadgetText(#String_1, Str(znach))
    Gradient_Line(text1,znach,Val(GetGadgetText(#String_2)))
  ElseIf y=180+30+1 : SetGadgetText(#String_2, Str(znach))    
    Gradient_Line(text1,Val(GetGadgetText(#String_1)),znach)
  EndIf  
  
  If  StartDrawing(WindowOutput(#Window_0))
    Box(X-5, Y, 267, 12,R_G_B)   
    LineXY(X+znach, Y, X+znach+5, Y+10, $000000) 
    LineXY(X+znach+5, Y+10, X+znach-5, Y+10, $000000) 
    LineXY(X+znach-5, Y+10, X+znach, Y, $000000)
    FillArea(X+znach-2.5, Y+10-2.5, 0, $000000)
      StopDrawing()
  EndIf  
EndProcedure

Open_Window_0()
Gradient_Line(213,140,15)
Begunok(213,70+1,40+30+1)
Begunok(140,70+1,110+30+1)
Begunok(15,70+1,180+30+1)

;{ основной цикл
Repeat : event=WaitWindowEvent()
    
  If Event=#WM_LBUTTONDOWN      
    If WindowMouseX(#Window_0) >=70 And WindowMouseX(#Window_0)<=325 And  WindowMouseY(#Window_0)>=40+30 And WindowMouseY(#Window_0)<=40+30+30
      While WindowEvent()<>#WM_LBUTTONUP
        Begunok(WindowMouseX(#Window_0)-70,70+1,40+30+1)
      Wend  
    ElseIf WindowMouseX(#Window_0) >=70 And WindowMouseX(#Window_0)<=325 And  WindowMouseY(#Window_0)>=110+30 And WindowMouseY(#Window_0)<=110+30+30    
      While WindowEvent()<>#WM_LBUTTONUP
        Begunok(WindowMouseX(#Window_0)-70,70+1,110+30+1)
      Wend  
    ElseIf  WindowMouseX(#Window_0) >=70 And WindowMouseX(#Window_0)<=325 And  WindowMouseY(#Window_0)>=180+30 And WindowMouseY(#Window_0)<=180+30+30      
      While WindowEvent()<>#WM_LBUTTONUP
        Begunok(WindowMouseX(#Window_0)-70,70+1,180+30+1)
      Wend        
    EndIf  
  EndIf  
  
Until event=#PB_Event_CloseWindow
;}

End

Отредактировано Lucagin (08.01.2011 17:20:11)

0

Пётр · Поделиться**103**08.01.2011 17:16:07

У меня быстро цифры обновляются в обоих случаях.

Но попробуй такой вариант.

Код:

;{ ;- Window Constants
;
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #Image_0
  #Image_1
  #Image_2
  #Image_3
  #String_0
  #String_1
  #String_2
  #Text_0
  #Text_1
  #Text_2
EndEnumeration

;- Fonts
Global FontID1
FontID1 = LoadFont(1, "Arial", 18)
;}

Procedure Gradient_Line(Red_,Green_,Blue_) ; зиливает градиентом 3-ри полосы цвета...
  For a=#Image_0 To #Image_2     
    
    If  StartDrawing(ImageOutput(a))
      
      DrawingMode(#PB_2DDrawing_Gradient)      
      If a=#Image_0
        BackColor(RGB(0,Green_,Blue_))
        FrontColor(RGB(255,Green_,Blue_))
      ElseIf a=#Image_1
        BackColor(RGB(Red_,0,Blue_))
        FrontColor(RGB(Red_,255,Blue_))               
      Else
        BackColor(RGB(Red_,Green_,0))
        FrontColor(RGB(Red_,Green_,255)) 
      EndIf  
      LinearGradient(0, 20, 255,20)    
      Box(0, 0, 255, 30)
      
      StopDrawing()    
      
      SetGadgetState(a,ImageID(a))
    EndIf   
  Next  
  
EndProcedure

Procedure Begunok(znach,X,Y) ; рисует бегунки значения цвета...
  If znach<0 : znach=0
  ElseIf znach>255 : znach=255
  EndIf 
  
  If  StartDrawing(WindowOutput(#Window_0)) : R_G_B=Point(X-10, Y) : StopDrawing() : EndIf 
  
  If y=40+30+2 : SetGadgetText(#String_0, Str(znach))    
    If  StartDrawing(ImageOutput(#Image_3))
      Box(0,0, 60, 30,R_G_B)
      DrawingFont(FontID1) 
      DrawRotatedText(10, 2, Str(znach), 0, RGB(0, 0, 0))    
      StopDrawing()
      SetGadgetState(#Image_3,ImageID(#Image_3))
    EndIf    
    Gradient_Line(znach,Val(GetGadgetText(#String_1)),Val(GetGadgetText(#String_2)))
  ElseIf y=110+30+2 : SetGadgetText(#String_1, Str(znach))
    Gradient_Line(Val(GetGadgetText(#String_0)),znach,Val(GetGadgetText(#String_2)))
  ElseIf y=180+30+2 : SetGadgetText(#String_2, Str(znach))    
    Gradient_Line(Val(GetGadgetText(#String_0)),Val(GetGadgetText(#String_1)),znach)
  EndIf  
  
  If  StartDrawing(WindowOutput(#Window_0))
    Box(X-5, Y, 267, 12,R_G_B)   
    LineXY(X+znach, Y, X+znach+5, Y+10, $000000) 
    LineXY(X+znach+5, Y+10, X+znach-5, Y+10, $000000) 
    LineXY(X+znach-5, Y+10, X+znach, Y, $000000)
    FillArea(X+znach-2.5, Y+10-2.5, 0, $000000)
    StopDrawing()
  EndIf 
  
EndProcedure

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 216, 0, 467, 245, "New window ( 0 )",  #PB_Window_SystemMenu  | #PB_Window_TitleBar )
    ;If CreateGadgetList(WindowID(#Window_0))
    
    CreateImage(#Image_0,255,30)
    ImageGadget(#Image_0, 70, 40, 255, 30, Image0, #PB_Image_Border)
    CreateImage(#Image_1,255,30)
    ImageGadget(#Image_1, 70, 110, 255, 30, Image1, #PB_Image_Border)
    CreateImage(#Image_2,255,30)
    ImageGadget(#Image_2, 70, 180, 255, 30, Image2, #PB_Image_Border)
    
    CreateImage(#Image_3,60,30)
    ImageGadget(#Image_3, 350, 40, 60, 30, Image2, #PB_Image_Border)
    
    StringGadget(#String_0, 350, 40, 60, 30, "",#PB_String_ReadOnly)
    SetGadgetFont(#String_0, FontID1)
    HideGadget(#String_0, 1)
    
    StringGadget(#String_1, 350, 110, 60, 30, "",#PB_String_ReadOnly)
    SetGadgetFont(#String_1, FontID1)
    StringGadget(#String_2, 350, 180, 60, 30, "",#PB_String_ReadOnly)
    SetGadgetFont(#String_2, FontID1)
    TextGadget(#Text_0, 20, 40, 30, 30, "R")
    SetGadgetFont(#Text_0, FontID1)
    TextGadget(#Text_1, 20, 110, 30, 30, "G")
    SetGadgetFont(#Text_1, FontID1)
    TextGadget(#Text_2, 20, 180, 30, 30, "B")
    SetGadgetFont(#Text_2, FontID1)
    
    ;EndIf
  EndIf
EndProcedure

Open_Window_0()
Gradient_Line(213,140,15)
Begunok(213,70+1,40+30+2)
Begunok(140,70+1,110+30+2)
Begunok(15,70+1,180+30+2)

;{ основной цикл
Repeat
  
  event=WaitWindowEvent()
  
  If Event=#WM_LBUTTONDOWN      
    If WindowMouseX(#Window_0) >=70 And WindowMouseX(#Window_0)<=325 And  WindowMouseY(#Window_0)>=40+30 And WindowMouseY(#Window_0)<=40+30+30
      While WaitWindowEvent(100)<>#WM_LBUTTONUP
        If WindowMouseX(#Window_0) <> Tmx
          Tmx=WindowMouseX(#Window_0)
          Begunok(Tmx-70,70+1,40+30+2)
        EndIf
      Wend  
    ElseIf WindowMouseX(#Window_0) >=70 And WindowMouseX(#Window_0)<=325 And  WindowMouseY(#Window_0)>=110+30 And WindowMouseY(#Window_0)<=110+30+30    
      While WaitWindowEvent(100)<>#WM_LBUTTONUP
        If WindowMouseX(#Window_0) <> Tmx
          Tmx=WindowMouseX(#Window_0)
          Begunok(Tmx-70,70+1,110+30+2)
        EndIf
      Wend  
    ElseIf  WindowMouseX(#Window_0) >=70 And WindowMouseX(#Window_0)<=325 And  WindowMouseY(#Window_0)>=180+30 And WindowMouseY(#Window_0)<=180+30+30      
      While WaitWindowEvent(100)<>#WM_LBUTTONUP
        If WindowMouseX(#Window_0) <> Tmx
          Tmx=WindowMouseX(#Window_0)
          Begunok(Tmx-70,70+1,180+30+2)
        EndIf
      Wend   
      
    EndIf  
    
  EndIf  
  
Until event=#PB_Event_CloseWindow
;}

End

0

Lucagin · Поделиться**104**08.01.2011 17:38:01

Пётр написал(а):

У меня быстро цифры обновляются в обоих случаях.
Но попробуй такой вариант.

Всё равно конечно, ImageGadget() обновляет цифры на порядок быстрее, чем StringGadget() :dontknow:

Думаю врят ли скорость обновления StringGadget() зависит от мощности процессора… :question:

А что лучше использовать WaitWindowEvent(100)<>#WM_LBUTTONUP вместо WindowEvent()<>#WM_LBUTTONUP??? Вроде второй вариант позволяет немного сократить код программы… :question:

Отредактировано Lucagin (08.01.2011 18:01:19)

0

Пётр · Поделиться**105**08.01.2011 18:14:14

Lucagin написал(а):

А что лучше использовать WaitWindowEvent(100)<>#WM_LBUTTONUP вместо WindowEvent()<>#WM_LBUTTONUP???

Первый вариант не грузит процессор на 100%, в отличии от второго.
Вот и вся разница.

0

Lucagin · Поделиться**106**08.01.2011 18:41:22

Пётр написал(а):

Первый вариант не грузит процессор на 100%, в отличии от второго.Вот и вся разница.

Да!!! Буду знать. Спасибо!!!

0

Дмитрий · Поделиться**107**09.01.2011 22:50:30

Вечер добрый ребят :-) два вопроса вот код:

Код:

Structure WideChar 
Hi.c 
Lo.c 
EndStructure
Structure TMibIfRow 
wszName.WideChar[256] 
dwIndex.l 
dwType.l 
dwMtu.l 
dwSpeed.l 
dwPhysAddrLen.l 
bPhysAddr.c[8] 
dwAdminStatus.l 
dwOperStatus.l 
dwLastChange.l 
dwInOctets.l 
dwInUcastPkts.l 
dwInNUCastPkts.l 
dwInDiscards.l 
dwInErrors.l 
dwInUnknownProtos.l 
dwOutOctets.l 
dwOutUCastPkts.l 
dwOutNUCastPkts.l 
dwOutDiscards.l 
dwOutErrors.l 
dwOutQLen.l 
dwDescrLen.l 
bDescr.c[256] 
EndStructure 
Structure TMibIfArray 
Array.TMibIfRow[513] 
EndStructure
Structure TMac 
Array.c[8] 
EndStructure
Structure TMibIfTable 
dwNumEntries.l 
Table.TMibIfArray 
EndStructure 
Structure Infa
 AllTrafic.q
 All_InTrafic.q
 All_OutTrafic.q
 VspOknoState.c
 VspOknoType.c
 PrOkno.c
 AutoRunState.c
 LimitState.c
 Limit.l
 LimitTypeTrafic.c
 LimitCountMessage.l
 VspTime1.c
 VspTime2.c
EndStructure

Procedure$ GetMAC(*Value.TMac, Length.l) 
Protected Result$ 
Static i.l 
 If Length 
  For i = 0 To Length-2 
    Result$ + RSet(Hex(*Value\Array[i]),2,"0") + "-" 
  Next 
  Result$ + RSet(Hex(*Value\Array[Length-1]),2,"0") 
 Else 
  Result$ = "00-00-00-00-00-00" 
 EndIf 
ProcedureReturn Result$ 
EndProcedure 
Procedure.l Traffic(*Speed) 
Protected Speed.l=0 
Static i.l, Size.l, FLibHandle.l, Table.TMibIfTable, *GetIfTable 
Size = SizeOf(TMibIfTable) 
 If GetIfTable_(@Table,@Size,#False) = 0 
  For i = 0 To (Table\dwNumEntries - 1) 
   If Table\Table\Array[i]\dwType=23 And GetMAC(@Table\Table\Array[i]\bPhysAddr, Table\Table\Array[i]\dwPhysAddrLen) <> "00-00-00-00-00-00"  
    Speed = Table\Table\Array[i]\dwSpeed 
    Break
   EndIf 
  Next 
EndIf 
PokeL(*Speed,Speed)
ProcedureReturn #True
EndProcedure 
Procedure.l CheckConnection() 
  If InternetGetConnectedState_(0, 0)  
    ProcedureReturn #True 
  Else 
   ProcedureReturn #False
  EndIf 
EndProcedure 
Repeat
  If CheckConnection() = #True
    ConnectionName.s=Space(256)
  InternetGetConnectedStateEx_(@lpdwFlags.l, @ConnectionName, 256, 0)
  Traffic(@Speed)
   PicInp=Input-OldInput    
Debug StrF(PicInp/1024,3)
    EndIf
ForEver

Почему результат всегда нули? Код честно украден с чужой программки которая 100% работает!? И второй вопрос, может есть у кого соображения по поводу того как сделать тень от окна? Даже представить не могу как это можно сделать!

0

Пётр · Поделиться**108**09.01.2011 23:04:25

А вот так?

Код:

Structure WideChar 
  Hi.c 
  Lo.c 
EndStructure
Structure TMibIfRow 
  wszName.WideChar[256] 
  dwIndex.l 
  dwType.l 
  dwMtu.l 
  dwSpeed.l 
  dwPhysAddrLen.l 
  bPhysAddr.c[8] 
  dwAdminStatus.l 
  dwOperStatus.l 
  dwLastChange.l 
  dwInOctets.l 
  dwInUcastPkts.l 
  dwInNUCastPkts.l 
  dwInDiscards.l 
  dwInErrors.l 
  dwInUnknownProtos.l 
  dwOutOctets.l 
  dwOutUCastPkts.l 
  dwOutNUCastPkts.l 
  dwOutDiscards.l 
  dwOutErrors.l 
  dwOutQLen.l 
  dwDescrLen.l 
  bDescr.c[256] 
EndStructure 
Structure TMibIfArray 
  Array.TMibIfRow[513] 
EndStructure
Structure TMac 
  Array.c[8] 
EndStructure
Structure TMibIfTable 
  dwNumEntries.l 
  Table.TMibIfArray 
EndStructure 
Structure Infa
  AllTrafic.q
  All_InTrafic.q
  All_OutTrafic.q
  VspOknoState.c
  VspOknoType.c
  PrOkno.c
  AutoRunState.c
  LimitState.c
  Limit.l
  LimitTypeTrafic.c
  LimitCountMessage.l
  VspTime1.c
  VspTime2.c
EndStructure

Procedure$ GetMAC(*Value.TMac, Length.l) 
  Protected Result$ 
  Static i.l 
  If Length 
    For i = 0 To Length-2 
      Result$ + RSet(Hex(*Value\Array[i]),2,"0") + "-" 
    Next 
    Result$ + RSet(Hex(*Value\Array[Length-1]),2,"0") 
  Else 
    Result$ = "00-00-00-00-00-00" 
  EndIf 
  ProcedureReturn Result$ 
EndProcedure 
Procedure.l Traffic(*Speed) 
  Protected Speed.l=0 
  Static i.l, Size.l, FLibHandle.l, Table.TMibIfTable, *GetIfTable 
  Size = SizeOf(TMibIfTable) 
  If GetIfTable_(@Table,@Size,#False) = 0 
    For i = 0 To (Table\dwNumEntries - 1) 
      If GetMAC(@Table\Table\Array[i]\bPhysAddr, Table\Table\Array[i]\dwPhysAddrLen) <> "00-00-00-00-00-00"  
        Speed = Table\Table\Array[i]\dwInOctets;Table\Table\Array[i]\dwSpeed 
        Break
      EndIf 
    Next 
  EndIf 
  PokeL(*Speed,Speed)
  ProcedureReturn #True
EndProcedure 
Procedure.l CheckConnection() 
  If InternetGetConnectedState_(0, 0)  
    ProcedureReturn #True 
  Else 
    ProcedureReturn #False
  EndIf 
EndProcedure 
Traffic(@Speed)
OldInput=Speed
Repeat
  If CheckConnection() = #True
    ConnectionName.s=Space(256)
    InternetGetConnectedStateEx_(@lpdwFlags.l, @ConnectionName, 256, 0)
    Traffic(@Speed)
    PicInp=Speed-OldInput
    OldInput=Speed
    Debug StrF(PicInp/1024,3)
    Delay(1000)
  EndIf
ForEver

0

Дмитрий · Поделиться**109**10.01.2011 00:40:50

Почему то всё равно не корректно работает, показывает минус 450 , то есть input = 0, OldInput = 450! Вообще ни че не пойму!

0

ВиниПур · Поделиться**110**10.01.2011 08:18:27

Дмитрий написал(а):

Код честно украден с чужой программки которая 100% работает!

Да, даже не верится, что всего 4 года назад у меня был диалап, лимитированный Интернет http://pbasic.spb.ru/phpBB2/viewtopic.php?t=211
К стати, код подправленный Петром у меня работает корректно - по крайней мере если запускаю параллельно код тот, что по ссылке и этот код, то показания сходятся.

Дмитрий написал(а):

как сделать тень от окна?

Тут есть немного разных кодов, в т.ч. код "Форма с тенью"
http://purebasic.info/phpBB2/viewtopic.php?t=1335

0

Lucagin · Поделиться**111**10.01.2011 13:22:52

Ребята подскажите, как нарисовать в PB такие фигуры? :question: фон вокруг черный, фигура однородно красная…

0

Пётр · Поделиться**112**10.01.2011 14:27:21

Lucagin написал(а):

Ребята подскажите, как нарисовать в PB такие фигуры?

Нужно вывести формулу, по которой будет рисоваться этот рисунок с помощью Plot

0

Lucagin · Поделиться**113**10.01.2011 14:51:03

Пётр написал(а):

Нужно вывести формулу, по которой будет рисоваться этот рисунок с помощью Plot

Ясно, будем искать формулы сложных фигур…

0

Пётр · Поделиться**114**10.01.2011 14:53:44

Ну как-то так:

Код:

ToRad.d = 0.0453
If OpenWindow(0, 0, 0, 200, 200, "2DDrawing Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  If CreateImage(0, 200, 200) And StartDrawing(ImageOutput(0))
    z.f=1
    For x=0 To 198
      color=RGB(255, 255-(198-x), 0)
      For t=0 To z
        Plot(Sin(x*ToRad)*50+30+(z/2+t),x,color)
      Next t
      ToRad-0.00004
      z+0.4
    Next x
    StopDrawing() 
    ImageGadget(0, 0, 0, 200, 200, ImageID(0))
  EndIf
  
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf

0

Lucagin · Поделиться**115**10.01.2011 14:55:53

Пётр написал(а):

Ну как-то так:

Здорово, Спасибо!!! :cool:

0

Lucagin · Поделиться**116**10.01.2011 15:14:04

А как получить случайно дробное число ? Так: a.f=1/Random(100) или есть отдельная команда для получения случайных дробных чисел??

0

Пётр · Поделиться**117**10.01.2011 15:19:52

С помощью Random можно получать только случайные целые числа, но ведь никто не мешает поделить полученный результат чтобы было дробное число.

0

Lucagin · Поделиться**118**10.01.2011 15:25:03

Пётр написал(а):

С помощью Random можно получать только случайные целые числа, но ведь никто не мешает поделить полученный результат чтобы было дробное число.

Ясно, значит именно делением…

0

max · [1985-03-29]

Всем привет!
Можно ли как-то вывести картинки, добавленные rtf или просто несколько картинок?

0

ВиниПур · Поделиться**120**10.01.2011 20:40:27

max написал(а):

Можно ли как-то вывести картинки, добавленные rtf или просто несколько картинок?

А можно как то понятнее задать вопрос? Куда вывести картнки - в rtf? из Rtf на диск? Просто куда и откуда?

0

Какая версия?	OffTop	03.10.2021
Мне постоянно пищет вот это	Вопросы по PureBasic	14.10.2011
Размер экрана в пикселях	Вопросы по PureBasic	13.02.2011
консоль	Вопросы по PureBasic	19.03.2015
Полноэкранные приложения на purebasic	Вопросы по PureBasic	08.03.2011

PureBasic - форум

Меню навигации

Пользовательские ссылки

Информация о пользователе

Вопросы новичка (продолжение…)

Сообщений 91 страница 120 из 974

Поделиться9106.01.2011 15:21:11

Поделиться9207.01.2011 01:11:05

Поделиться9307.01.2011 01:45:20

Поделиться9407.01.2011 09:29:02

Поделиться9507.01.2011 14:27:18

Поделиться9607.01.2011 15:59:26

Поделиться9707.01.2011 16:56:18

Поделиться9807.01.2011 19:47:39

Поделиться9907.01.2011 21:04:17

Поделиться10007.01.2011 21:08:27

Поделиться10108.01.2011 03:02:46

Поделиться10208.01.2011 16:34:05

Поделиться10308.01.2011 17:16:07

Поделиться10408.01.2011 17:38:01

Поделиться10508.01.2011 18:14:14

Поделиться10608.01.2011 18:41:22

Поделиться10709.01.2011 22:50:30

Поделиться10809.01.2011 23:04:25

Поделиться10910.01.2011 00:40:50

Поделиться11010.01.2011 08:18:27

Поделиться11110.01.2011 13:22:52

Поделиться11210.01.2011 14:27:21

Поделиться11310.01.2011 14:51:03

Поделиться11410.01.2011 14:53:44

Поделиться11510.01.2011 14:55:53

Поделиться11610.01.2011 15:14:04

Поделиться11710.01.2011 15:19:52

Поделиться11810.01.2011 15:25:03

Поделиться11910.01.2011 16:46:18

Поделиться12010.01.2011 20:40:27

Похожие темы