Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

AminTest

Uploader:MitgliedMuttonhead
Datum/Zeit:31.08.2011 18:01:24

type obj
  posx as integer
  posy as integer

  MoveIt as integer          'löst Anim/Bewegung in gewünschter Richtung aus
  AnimInProgress as integer'ist >0(1,2,3,4) während Anim/Bewegung

  animright(3) as integer ptr  'rechts
  animrightframe as integer
  animleft(3) as integer ptr  'links
  animleftframe as integer
  animtop(3) as integer ptr  'oben
  animtopframe as integer
  animbottom(3) as integer ptr  'unten
  animbottomframe as integer

  actVisible as integer ptr'direkter Link zum zuletzt angezeigten Bild, bei Stillstand benötigt

  newpos as integer     'Hilfsvariable Zielpunkt der Bewegung
  fract as single       'Hilfsvariable um Anim von Objektbewegung zu trennen
end type

declare sub UeberdenkeObjektPosition (byref o as obj)
declare sub raster
screen 19,32
dim as integer ptr  Bildm, Bildo, Bildu, Bildr, Bildl

Bildm= imagecreate(16,16,&H0)
Bildo= imagecreate(16,16,&H0)
Bildu= imagecreate(16,16,&H0)
Bildr= imagecreate(16,16,&H0)
Bildl= imagecreate(16,16,&H0)

circle Bildm,(7,7),3,&HFF6600,,,,f
circle Bildo,(7,3),3,&HFF6600,,,,f
circle Bildu,(7,12),3,&HFF6600,,,,f
circle Bildr,(12,7),3,&HFF6600,,,,f
circle Bildl,(3,7),3,&HFF6600,,,,f

dim as obj Figur
Figur.posx=16*4
Figur.posy=16*3

'Animationsreihenfolge festlegen
Figur.animright(0)=Bildm'Ball mitte
Figur.animright(1)=Bildo'Ball oben
Figur.animright(2)=Bildm'Ball mitte
Figur.animright(3)=Bildu'Ball rechts

Figur.animleft(0)=Bildm'Ball mitte
Figur.animleft(1)=Bildu'Ball unten
Figur.animleft(2)=Bildm'Ball mitte
Figur.animleft(3)=Bildo'Ball oben

Figur.animtop(0)=Bildm'Ball mitte
Figur.animtop(1)=Bildr'Ball rechts
Figur.animtop(2)=Bildm'Ball mitte
Figur.animtop(3)=Bildl'Ball links

Figur.animbottom(0)=Bildm'Ball mitte
Figur.animbottom(1)=Bildl'Ball links
Figur.animbottom(2)=Bildm'Ball mitte
Figur.animbottom(3)=Bildr'Ball rechts

Figur.actVisible=Figur.animright(0)'StartBild festlegen
Figur.animrightframe=0



dim as string key
do
  key=inkey
  if key="d" then Figur.MoveIt=1'rechts
  if key="a" then Figur.MoveIt=2'links
  if key="w" then Figur.MoveIt=3'oben
  if key="s" then Figur.MoveIt=4'unten
  screenlock
    cls
    raster
    UeberdenkeObjektPosition (Figur)'eigentliche Bewegung/Anim erfolgt hier
  screenunlock
  sleep 1
loop until key=chr(27)

imagedestroy Bildm
imagedestroy Bildo
imagedestroy Bildu
imagedestroy Bildr
imagedestroy Bildl

end



sub UeberdenkeObjektPosition (byref o as obj)
  if (o.MoveIt>0) and (o.AnimInProgress=0) then'Wenn Anim gewünscht und keine andere läuft
    select case o.MoveIt
      case 1
        o.newpos = o.posx+16    'neue Zielposition ist 16 Pixel entfernt
      case 2
        o.newpos = o.posx-16
      case 3
        o.newpos = o.posy-16
      case 4
        o.newpos = o.posy+16
    end select
    o.AnimInProgress=o.MoveIt  '"Flag" setzen das ab jetzt etwas im Gange ist
    o.MoveIt=0'Richtungswunsch wird nun nicht mehr benötigt
 end if

 if o.AnimInProgress then        'wenn eine Bewegung/Anim gesetzt ist
   select case o.AnimInProgress
     case 1                    'wenn Richtung rechts
        o.posx +=1        'Objekt nach rechts verschieben
        o.fract +=.8     'mit fract wird versucht, daß nicht in jedem Durchgang
        if o.fract>1 then 'ein neues Bild erscheint, sonst sieht das sehr hyperaktiv aus
          o.animrightframe = ((o.animrightframe+1) mod 4)'<-Rotation des Bildindex
          o.fract=0
        end if
         if o.posx = o.newpos then'wenn Objekt seine neue Zielposition erreicht hat
          o.AnimInProgress=0      'Freigeben für neue Anim
          o.animrightframe=0          'bestimmtes Bild bei Stillstand setzen
        end if
        o.actVisible=o.animright(o.animrightframe)

      case 2
        o.posx -=1
        o.fract +=.8
        if o.fract>1 then
          o.animleftframe = ((o.animleftframe+1) mod 4)
          o.fract=0
        end if
        if o.posx = o.newpos then
          o.AnimInProgress=0
          o.animleftframe=0
        end if
        o.actVisible=o.animleft(o.animleftframe)

      case 3
        o.posy -=1
        o.fract +=.8
        if o.fract>1 then
          o.animtopframe = ((o.animtopframe+1) mod 4)
          o.fract=0
        end if
        if o.posy = o.newpos then
          o.AnimInProgress=0
          o.animtopframe=0
        end if
        o.actVisible=o.animtop(o.animtopframe)

      case 4
        o.posy +=1
        o.fract +=.8
        if o.fract>1 then
          o.animbottomframe = ((o.animbottomframe+1) mod 4)
          o.fract=0
        end if
        if o.posy = o.newpos then
          o.AnimInProgress=0
          o.animbottomframe=0
        end if
        o.actVisible=o.animbottom(o.animbottomframe)

    end select
  end if

  put (o.posx,o.posy),o.actVisible'Anzeigen
end sub

sub raster
  for k as integer=0 to 30
    for i as integer=0 to 30
      line(i*16,k*16)-(i*16+15,k*16+15),&HFFFFFF,b
    next i
  next k
end sub