' ############################################################################## ' # +-------+ # ' # DiskManager v 1.0 | # | # ' # | 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,clr as integer) end type type tmouse as integer x as integer y as integer wheel as integer key as tdot button declare sub reload() end type type tbox as tsquare button as integer returned as integer grab end type type tprog as tsquare button as integer returned end type ' ---------- Deklarationen ----------------------------------------------------- dim Mouse as tmouse dim Disk(1 to 255) as tdisk dim box as tbox dim prog as tprog dim grab as integer dim key as string*1 dim i as integer dim shared retry as integer=true 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,number as integer) declare sub adress(byref disk as tdisk) declare sub save (disk() as tdisk) declare sub load (disk() as tdisk) ' ---------- Sprite-Daten ------------------------------------------------------ const name_back="Background.bmp" const name_disk="DiskBig.bmp" const name_dbox="DiskBox.bmp" const name_prog="ProgMenu.bmp" 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 prog.button.p1.x=504 prog.button.p1.y=11 prog.button.p2.x=631 prog.button.p2.y=105 ' Lade-Routine load(disk()) do do put (0,0),ptr_back ' Hintergrund setzen key=inkey ' Tastatur abfragen mouse.reload() ' Maus abfragen screenlock 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 if inside(prog.button,mouse.button)=true then for i=1 to 255 if disk(i).grab=true and prog.returned=false then prog.returned=true screenunlock adress(disk(i)) screenlock exit for end if next i end if else for i=1 to 255:disk(i).grab=false:next i ' \ grab=false ' \ prog.returned=false ' / Wenn die Maus nich gedrückt wird, setze alles auf "NORMAL" box.returned=false ' / end if if mouse.key=2 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 screenunlock label(disk(),i) screenlock end if next i end if for i=255 to 1 step -1 ' Alle Disketten aktualisieren 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 ' / Die Disk-Button-Funktion aktualisieren disk(i).button.p2.y=disk(i).y+128 ' / if disk(i).grab=true then ' \ disk(i).x=mouse.x-64 ' } Disketten an Mausposition, wenn gegriffen disk(i).y=mouse.y-64 ' / end if if disk(i).visible=true then disk(i).create(ptr_disk,disk(i),i,&H0000FF)' Diskette zeichnen next i screenunlock sleep 20,1 cls loop until key=chr(27) ' Ende mit ESC ' SPEICHER-ROUTINE save(disk()) loop until retry=false 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() ' Maus aktualisieren with this getmouse .x,.y,.wheel,.key .button.x=.x .button.y=.y end with end sub sub tdisk.create (buffer as any ptr,disk as tdisk,number as integer,clr as integer)' Disketten-zeichnen-Routine put (disk.x,disk.y),buffer,trans draw string (disk.x+65,disk.y+94),str(number),&HFF0000 draw string (disk.x+56,disk.y+106),disk.caption,clr 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"":wend dim wheel_old as integer dim wheel_new as integer dim wheel_dir as integer dim max as integer=ubound(disk) wheel_old=-1 setmouse (,,0) do key=inkey mouse.reload() ' Maus aktualisieren if incoming=true then if mouse.key=0 then incoming=false mouse.key=0 end if screenlock put(1,1),back,pset getmouse(mouse.x,mouse.y,wheel_new) ' \ if mouse.button.x<>-1 and mouse.button.y<>-1 then ' \ wheel_dir=-sgn(wheel_new-wheel_old) ' / Die Drehrichtung herausfinden wheel_old=wheel_new ' / end if ' / select case wheel_dir case -1 if show<=1 then if page<=0 then show=1 page=0 else show=1 page-=1 end if else show-=1 end if case 1 if show>=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,add,255 draw string (120+(i-1)*130,259),str(i+page),&HFF0000 draw string (110+(i-1)*130,271),disk(i+page).caption,&H0000FF 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,&H0000FF else put (55+(i-1)*130,165),sprite,trans draw string (120+(i-1)*130,259),str(i+page),&HFF0000 draw string (110+(i-1)*130,271),disk(i+page).caption,&H0000FF end if end if next i if mouse.key=1 and show<>0 then if disk(show+page).visible=false then number+=1 disk(show+page).visible=true disk(show+page).x=(number-1)*32 disk(show+page).y=(number-1)*32 end if screenunlock sleep 20,1 cls loop until (mouse.key=2 or key<>"") setmouse ,,1 end sub ' ********** Diskette beschriften ********************************************** sub label (disk() as tdisk,number as integer) dim i as integer dim finish as integer=0 dim diskname as string dim key as string dim mouse as tmouse while inkey<>"":wend dim ptr_back as any ptr = imagecreate(640,480) ' Erstelle Hintergrund-Sprite get(0,0)-(639,479),ptr_back ' = Ehemaliger Hintergrund dim ptr_disk as any ptr=imagecreate(128,128) ' Erstelle Disk-Sprite bload "DiskBig.bmp",ptr_disk dim ptr_pen as any ptr=imagecreate(128,128) ' erstelle Stift-Sprite bload "Pencil.bmp",ptr_pen disk(number).caption="" ' Lösche alte Caption do key=inkey ' Tastatur abfragen mouse.reload() ' Maus abfragen screenlock cls put (0,0),ptr_back,pset ' Hintergrund zeichnen for i=255 to 1 step -1 if disk(i).visible=true then if i=number then disk(i).create(ptr_disk,disk(i),i,&HFFFF00) ' Disketten zeichnen else disk(i).create(ptr_disk,disk(i),i,&H0000FF) ' Disketten zeichnen end if end if next i put(disk(number).x+62+len(diskname)*8,disk(number).y+114),ptr_pen,trans ' Stift zeichnen ' Hier beginnt die eigentliche Routine der Beschriftung if key<>"" then ' Beginne, wenn eine Taste gedrückt wird select case asc(left(key,1)) ' Was für ein Zeichen ist KEY ? case 13 ' -> Enter finish=1 ' Beende LABEL case 8 ' -> Backspace if len(diskname)>0 then diskname=left(diskname,len(diskname)-1)' Lösche letztes zeichen case else ' -> Sonst if len(diskname)<8 then diskname+=key ' Füge gegebenes Zeichen zum namen hinzu end select disk(number).caption=diskname ' Abtualisiere die Disk.Caption end if screenunlock sleep 20,1 loop until finish=1 if ptr_back<>0 then imagedestroy ptr_back ' \ if ptr_disk<>0 then imagedestroy ptr_disk ' } Speicherbereinigung von Sprites if ptr_pen <>0 then imagedestroy ptr_pen ' / end sub ' ********** Laufwerksmenü ***************************************************** sub adress(byref disk as tdisk) dim ptr_back as any ptr=imagecreate(640,480) bload "Progmenu.bmp",ptr_back dim mouse(2) as tmouse dim mouse_dir(2) as integer dim key as string dim cursor as tdot dim page as integer dim i as integer dim n as integer dim finish as integer dim show_cap as string ' Variablen für Cursorbewegung dim MK_old(255) as integer dim MK_new(255) as integer dim getchr as integer dim p_old as integer dim p_new as integer ' Variablen für die Radbewegung dim wheel_new as integer dim wheel_old as integer dim wheel_dir as integer mouse(2).x=1 mouse(2).y=1 cursor.x=1 cursor.y=1 if disk.caption="" then show_cap="No Name" else show_cap=disk.caption do mouse(1).reload() wheel_new=mouse(1).wheel sleep 10,1 ' \ if mouse(1).button.x<>-1 and mouse(1).button.y<>-1 then ' \ mouse_dir(1)=mouse(2).x-mouse(1).x ' } Die Bewegung herausfinden mouse_dir(2)=mouse(2).y-mouse(1).y ' / mouse(2)=mouse(1) ' / end if wheel_dir=-sgn(wheel_new-wheel_old) wheel_old=wheel_new key=inkey ' Pfeilastenabfrage p_old=p_new for i=1 to 150 MK_old(i)=MK_new(i) MK_new(i)=multikey(i) if MK_new(i)=0 then if MK_old(i)=0 then ' Empty else if i=&H01 then finish=1 p_new=false end if else if MK_old(i)=0 then p_new=true else ' Empty end if end if next i getchr=p_new-p_old ' Ende Pfeiltasten while len(inkey):wend screenlock cls put (0,0),ptr_back,pset ' Hintergrund setzen if mouse(1).key=1 then if (mouse(1).y-6)/12>1 then cursor.y=(mouse(1).y-6)/12 ' Bei Mausklick den Cursor versetzen end if select case wheel_dir ' \ case -1 ' \ if page>0 then page-=1 ' \ case 1 ' / Bei Mausrad-Drehung die Seite scrollen if page<215 then page+=1 ' / end select ' / select case asc(left(key,1)) case 32 to 165 ' Sinnvolle Taste if cursor.x<33 then disk.program(cursor.y+page)+=left(key,1) case 8 ' Backspace disk.program(cursor.y+page)=left(disk.program(cursor.y+page),len(disk.program(cursor.y+page))-1) if cursor.x=1 then if page>0 and cursor.y=1 then page-=1 else cursor.y-=1 end if end if end select if getchr=true then if multikey(&H48) then ' Oben if cursor.y=1 and page>0 then page-=1 else cursor.y-=1 end if end if if multikey(&H50) or multikey(&H1C) then ' Enter oder Unten if cursor.y=40 then if page<215 then page+=1 end if else cursor.y+=1 end if end if end if cursor.x=len(disk.program(cursor.y+page))+1 ' Den Cursor-X an die Rechte Seite setzen if cursor.y<1 then cursor.y=1 ' \ if cursor.y>40 then cursor.y=40 ' / Überprüfen, ob Cursor-Y im güligen Bereich liegt draw string (544,0),show_cap,&H009900 if cursor.x=33 then line(cursor.x*12+38,(cursor.y-1)*12)-(cursor.x*12+46,(cursor.y-1)*12+12),&HFF0000,BF for n=1 to 40 ' Zeichen-Routine von Strings for i=1 to 32 if i=cursor.x and n=cursor.y then line(i*12+38,(n-1)*12)-(i*12+46,(n-1)*12+12),&H00FF00,BF draw string(i*12+38,(n-1)*12),mid(disk.program(n+page),i,1),&HAF0000 else draw string(i*12+38,(n-1)*12),mid(disk.program(n+page),i,1),&H0000AF end if next i draw string (1,(n-1)*12),str(n+page),&H00AF00 next n screenunlock sleep 10,1 loop until finish=1 disk.x=128 disk.y=128 if ptr_back<>0 then imagedestroy ptr_back while len(inkey):wend end sub ' ********** SPEICHERN ********************************************************* sub save(disk() as tdisk) dim i as integer dim n as integer dim rpos as integer dim choice as string*1 dim outstr as string dim ff as integer=freefile for i=1 to 255 for n=1 to 255 for rpos=1 to len(disk(i).program(n)) if mid(disk(i).program(n),rpos,1)="," then mid(disk(i).program(n),rpos,1)="." end if next rpos next n next i if open("DISKS.DAT" for binary as #ff)=0 then retry=false for i=1 to ubound(disk) outstr=disk(i).caption+string(8-len(disk(i).caption),255)+"," for n=1 to 255 if disk(i).program(n)<>"" then outstr+=disk(i).program(n)+"," else outstr+=chr(27)+"," end if next n print #ff,outstr next i else print "ATTENTION! Data could not be saved!" input "Do you wish to return to workbench? ";choice if ucase(choice)="Y" then retry=true else retry=false exit sub end if end sub ' ********** LADEN ************************************************************* sub load(disk() as tdisk) dim i as integer dim n as integer dim rpos as integer dim inpstr as string dim choice as string*1 dim ff as integer=freefile if open("DISKS.DAT" for input as #ff)=0 then i=0 do ' Disketten Wechsel i+=1 line input #ff,inpstr print inpstr inpstr:sleep 5,1 ' Caption for n=1 to 8 'Caption Zeichen if mid(inpstr,n,1)<>chr(255) then disk(i).caption+=mid(inpstr,n,1) next n ' Programme n=1 for rpos=1 to len(inpstr) if rpos<10 then continue for select case mid(inpstr,rpos,1) case chr(27) disk(i).program(n)="" case "," n+=1 case else disk(i).program(n)+=mid(inpstr,rpos,1) end select next rpos loop until i>254 else print "ATTENTION! Data could not be load!" input "Do you wish to retry? ";choice if ucase(choice)="Y" then retry=true else retry=false exit sub end if end sub