' ############################################################################## ' # +-------+ # ' # DiskManager v pre0.3 | # | # ' # | O. | # ' # 11.12.2011 Alexander Dahmen ] | # ' # +-------+ # ' # # ' ############################################################################## ' -- Definitionen -- #define false 0 #define true not(false) #define nul chr(0) ' ---------- Screen ------------------------------------------------------------ screen 18,32 ' ---------- Typen ------------------------------------------------------------- type tdot as integer x as integer y end type type tsquare as tdot p1 as tdot p2 end type type tdisk as integer x as integer y as integer visible as integer grab as string caption as string program(255) as tsquare button declare sub create (buffer as any ptr,disk as tdisk,number as integer,mode as integer) end type type tmouse as integer x as integer y as integer wheel as integer key as tdot button declare sub reload(byref Mouse as tmouse) end type type tbox as tsquare button as integer result(1 to 255) as integer returned as integer grab end type ' ---------- Deklarationen ----------------------------------------------------- dim Mouse as tmouse dim Disk(1 to 255) as tdisk dim box as tbox dim disknumber as integer dim grab as integer dim key as string*1 dim i as integer declare function inside(sqare as tsquare,dot as tdot) as integer declare sub diskbox(disk() as tdisk,sprite as any ptr,back as any ptr) declare sub label(disk as tdisk,caption as string,prog() as string) ' ---------- Sprite-Daten ------------------------------------------------------ const name_back="Background.bmp" const name_disk="DiskBig.bmp" const name_dbox="DiskBox.bmp" const name_menu="" dim ptr_back as any ptr dim ptr_disk as any ptr dim ptr_dbox as any ptr ptr_back=imagecreate(640,480) ptr_disk=imagecreate(128,128) ptr_dbox=imagecreate(640,480) bload name_back,ptr_back bload name_disk,ptr_disk bload name_dbox,ptr_dbox ' ---------- HAUPTPROGRAMM ----------------------------------------------------- for i=1 to 3 disk(i).x=100+i*10 disk(i).y=200+i*10 disk(i).visible=true disk(i).caption="TEST" next i for i=4 to 255 disk(i).visible=false next box.button.p1.x=516 box.button.p1.y=378 box.button.p2.x=631 box.button.p2.y=477 do screenlock put (0,0),ptr_back ' Hintergrund setzen key=inkey ' Tastatur abfragen mouse.reload(mouse) ' \ mouse.button.x=mouse.x ' } Maus abfagen mouse.button.y=mouse.y ' / if mouse.key=1 then ' Disketten bewegen if grab=false then for i=1 to 255 if inside(disk(i).button,mouse.button)=true and _ disk(i).grab=false and _ disk(i).visible=true then disk(i).grab=true ' Den Parameter für Greifen einstellen grab=true ' Keine weiteren Disketten greifen exit for end if next i end if if inside(box.button,mouse.button) and box.returned=false then ' Ist der Button für die Diskettenbox gedrückt? for i=1 to 255 if disk(i).grab=true then ' \ box.grab=true ' \ disk(i).visible=false ' / Lasse eine Diskette in der Box verschwinden exit for ' / else box.grab=false end if next i screenunlock box.returned=true if box.grab=false then diskbox(disk(),ptr_disk,ptr_dbox) ' Rufe, wenn keine Diskette abgelegt wurde, screenlock ' das Boxmenü auf end if else for i=1 to 255:disk(i).grab=false:next i ' \ grab=false ' } Wenn die Maus nich gedrückt wird, setze alles auf "NORMAL" box.returned=false ' / end if for i=255 to 1 step -1 ' Diskettensprites zeichnen disk(i).button.p1.x=disk(i).x disk(i).button.p1.y=disk(i).y disk(i).button.p2.x=disk(i).x+128 disk(i).button.p2.y=disk(i).y+128 if disk(i).grab=true then disk(i).x=mouse.x-64 disk(i).y=mouse.y-64 end if if disk(i).visible=true then disk(i).create(ptr_disk,disk(i),i,0) next i screenunlock sleep 10,1 cls loop until key=chr(27) ' Ende mit ESC if ptr_disk <> 0 then imagedestroy ptr_back ' \ if ptr_back <> 0 then imagedestroy ptr_disk ' } Sprites-Speicher freigeben if ptr_dbox <> 0 then imagedestroy ptr_dbox ' / end ' ---------- Subs -------------------------------------------------------------- sub tmouse.reload(byref mouse as tmouse) ' Maus aktualisieren with mouse getmouse .x,.y,.wheel,.key end with end sub sub tdisk.create (buffer as any ptr,disk as tdisk,number as integer,mode as integer)' Diskette zeichnen if mode=0 then put (disk.x,disk.y),buffer,pset else put (disk.x,disk.y),buffer,preset end if draw string (disk.x+65,disk.y+94),str(number),&HFF0000 draw string (disk.x+55,disk.y+106),disk.caption,&H00FF00 end sub function inside(square as tsquare,dot as tdot) as integer ' Prüfen, ob ein Punkt in einer Fläche liegt if (dot.x>square.p1.x and dot.xsquare.p1.y and dot.y=4 then if page>=(max-4) then show=4 page=(max-4) else show=4 page+=1 end if else show+=1 end if end select for i=1 to 4 if show=i then put (55+(i-1)*130,165),sprite,and draw string (120+(i-1)*130,259),str(i+page),&HFF0000 draw string (110+(i-1)*130,271),disk(i+page).caption,&H00FF00 else if disk(i+page).visible=true then put (55+(i-1)*130,165),sprite,alpha,63 draw string (120+(i-1)*130,259),str(i+page),&HFF0000 draw string (110+(i-1)*130,271),disk(i+page).caption,&H00FF00 else put (55+(i-1)*130,165),sprite,pset draw string (120+(i-1)*130,259),str(i+page),&HFF0000 draw string (110+(i-1)*130,271),disk(i+page).caption,&H00FF00 end if end if next i if mouse.key=1 then disk(show+page).visible=true disk(show+page).x=1 disk(show+page).y=1 end if screenunlock sleep 10,1 cls loop until (mouse.key=2 or key<>"") setmouse ,,1 end sub ' ********** Diskette beschriften ********************************************** sub label (byref disk as tdisk,caption as string,prog() as string) ' Disketten beschriften dim i as integer ' ================================================================================================================== ' ================================================================================================================== ' ================================================================================================================== ' =============================================== HIER WEITERMACHEN !! ============================================= ' ================================================================================================================== ' ================================================================================================================== ' ================================================================================================================== disk.caption=caption for i=1 to 255 select case prog(i) case nul disk.program(i)="" case "" disk.program(i)=disk.program(i) case else disk.program(i)=prog(i) end select next i end sub