Neuer code im neuen post

REM Projekt: Texter
REM erstellt: 09.02.2010

set window on

sync rate 40

global txt$
global dirs$
global savename$
global loadfile$
global txtactive
global nfoactive
global htmactive
global zeile

dim txt$(0)
empty array txt$(0)
array insert at bottom txt$(0)

dim dirs$()
empty array dirs$()
array insert at bottom dirs$()

line 0,0,0,text height("A")
line 1,1,1,text height("A")

get image 1,0,0,1,text height("A")

cls

box 0,0,20,20,rgb(150,150,150),rgb(150,150,150),rgb(150,150,150),rgb(150,150,150)
box 2,2,18,18,rgb(0,0,0),rgb(0,0,0),rgb(0,0,0),rgb(0,0,0)

ink rgb(150,150,150),0

for uparrow=4 to 16
   line 10,4,uparrow,16
next uparrow

get image 2,0,0,20,20

cls

box 0,0,20,20,rgb(150,150,150),rgb(150,150,150),rgb(150,150,150),rgb(150,150,150)
box 2,2,18,18,rgb(0,0,0),rgb(0,0,0),rgb(0,0,0),rgb(0,0,0)

ink rgb(150,150,150),0

for downarrow=4 to 16
   line downarrow,4,10,16
next downarrow

get image 3,0,0,20,20

cls

xwidth=text width("A")
zeile=0
top=22
y=top
time=500
txtactive=1

ink rgb(150,150,150),0


do

if x<0 and zeile=0 then x=0
y=(zeile*15)+22
x=len(txt$(zeile))*xwidth

   if returnkey()=0 and keystate(14)=0
      if inkeytimer<timer() and inkey$()>""
         txt$(zeile)=txt$(zeile)+inkey$()
         if inkeytimeout=0 then inkeytimer=timer()+time : inkeytimeout=1
      endif
   endif

   rem löschen
   if backspacetimer<timer() and keystate(14)=1
      txt2$=left$(txt$(zeile),len(txt$(zeile))-1)
      x=x-xwidth
      txt$(zeile)=txt2$
      if x<0 and zeile>0 and keystate(14)=1
         zeile=zeile-1
         array delete element txt$(0),zeile+1
      endif
      if backspacetimeout=0 then backspacetimer=timer()+time : backspacetimeout=1
   endif

   rem enter
   if returntimer<timer() and returnkey()=1
      array insert at bottom txt$(0)
      zeile=zeile+1
      if returntimeout=0 then returntimer=timer()+time : returntimeout=1
   endif



   if inkey$()="" then inkeytimeout=0 : inkeytimer=0
   if keystate(14)=0 then backspacetimeout=0 : backspacetimer=0
   if returnkey()=0 then returntimeout=0 : returntimer=0

   cls
   clspart(0,15*zeile+top,screen width(),(15*zeile+top)+text height("A"),80,80,80)

   paste image 1,x,y


   for abc= 0 to zeile
      text 0,15*abc+top,txt$(abc)
   next abc


   rem speichern, laden und beenden btn
   clspart(0,0,screen width(),top,50,50,50)

   btn(1,1,rgb(150,150,150),rgb(0,0,0),1)
   btn(143,1,rgb(150,150,150),rgb(0,0,0),2)
   btn(563,1,rgb(150,150,150),rgb(0,0,0),5)
loop

function clspart(x1,y1,x2,y2,r,g,b)
   box x1,y1,x2,y2,rgb(r,g,b),rgb(r,g,b),rgb(r,g,b),rgb(r,g,b)
endfunction

function btn(x,y,c1,c2,func)

   if func=1 then name$="Speichern"
   if func=2 then name$="Laden"
   if func=3 then name$="Speichern"
   if func=4 then name$="Laden"
   if func=5 then name$="X"
   if func=6 then name$="Abbrechen"

   x2=x+text width(name$)+68

   box x,y,x2,y+20,c1,c1,c1,c1
   box x+2,y+2,x2-2,y+18,c2,c2,c2,c2
   text (x/2)+(x2/2)-(text width(name$)/2),(y+10)-(text height("A")/2),name$

   if func=1
      if mousex()>x-1 and mousey()>y-1 and mousex()<x+text width(name$)+69 and mousey()<y+21 and mouseclick() then savewin(rgb(150,150,150),rgb(0,0,0))
   endif

   if func=2
      if mousex()>x-1 and mousey()>y-1 and mousex()<x+text width(name$)+69 and mousey()<y+21 and mouseclick() then loadwin(rgb(150,150,150),rgb(0,0,0))
   endif

   if func=3
      if mousex()>x-1 and mousey()>y-1 and mousex()<x+text width(name$)+69 and mousey()<y+21 and mouseclick() then save() : output=3
   endif

   if func=4
      if mousex()>x-1 and mousey()>y-1 and mousex()<x+text width(name$)+69 and mousey()<y+21 and mouseclick() then load() : output=4
   endif

   if func=5
      if mousex()>x-1 and mousey()>y-1 and mousex()<x+text width(name$)+69 and mousey()<y+21 and mouseclick() then end
   endif

   if func=6
      if mousex()>x-1 and mousey()>y-1 and mousex()<x+text width(name$)+69 and mousey()<y+21 and mouseclick() then output=6
   endif

endfunction output

function savewin(c1,c2)
   get image 9,0,0,screen width(),screen height()

   filey=280
   count=0

   find first
   repeat
      if get file type()=1 then dirs$(count)=get file name$() : count=count+1 : array insert at bottom dirs$()
      find next
   until get file type()=-1

   do
   cls
   paste image 9,0,0

   ``window
   box 35,50,screen width()-35,screen height()-45,c1,c1,c1,c1
   box 37,52,screen width()-37,screen height()-47,c2,c2,c2,c2

   ``title
   box 250,40,screen width()-250,60,c1,c1,c1,c1
   box 252,42,screen width()-252,58,c2,c2,c2,c2
   text screen width()/2-text width("Speichern")/2,50-text height("A")/2,"Speichern"

   text 70,80,"Dateiname:"
   clspart(70,110,screen width()-70,130,80,80,80)

   text 70,150,"Dateityp:"
   clspart(70,180,screen width()-70,235,80,80,80)
   if txtactive=1 then text 70,185,"[X] Textdatei  ( .txt )" else text 70,185,"[ ] Textdatei  ( .txt )"
   if nfoactive=1 then text 70,200,"[X] Infodatei  ( .nfo )" else text 70,200,"[ ] Infodatei  ( .nfo )"
   if htmactive=1 then text 70,215,"[X] HTML Datei ( .htm )" else text 70,215,"[ ] HTML Datei ( .htm )"
   if mousex()>69 and mousey()>185 and mousex()<screen width()-69 and mousey()<195 and mouseclick() then txtactive=1 : nfoactive=0 : htmactive=0
   if mousex()>69 and mousey()>200 and mousex()<screen width()-69 and mousey()<210 and mouseclick() then txtactive=0 : nfoactive=1 : htmactive=0
   if mousex()>69 and mousey()>215 and mousex()<screen width()-69 and mousey()<225 and mouseclick() then txtactive=0 : nfoactive=0 : htmactive=1

   text 70,255,"Speicherort:"
   clspart(70,275,screen width()-70,400,80,80,80)
   for t=0 to array count(dirs$())
      filey2=filey+(t*11)
      if filey2>275 and filey2<385 then text 70,filey2,dirs$(t)
      if filey2>275 and filey2<385 and mousex()>69 and mousey()>filey2-1 and mousex()<70+text width(dirs$(t)) and mousey()<filey2+11 and mouseclick()
         set dir dirs$(t)
         count=0
         filey=280
         empty array dirs$()
         array insert at bottom dirs$()
         find first
         repeat
            if get file type()=1 then dirs$(count)=get file name$() : count=count+1 : array insert at bottom dirs$()
            find next
         until get file type()=-1
         wait 100
      endif
   next t

   paste image 2,screen width()-95,280
   paste image 3,screen width()-95,375

   if mousex()>screen width()-96 and mousey()>279 and mousex()<screen width()-74 and mousey()<301 and mouseclick() then filey=filey+2
   if mousex()>screen width()-96 and mousey()>374 and mousex()<screen width()-74 and mousey()<396 and mouseclick() then filey=filey-2

      if mousex()>69 and mousey()>109 and mousex()<screen width()-69 and mousey()<131 and mouseclick()
         set cursor 70,111
         input "",savename$
      endif
      text 72,111,savename$

      i=btn(70,410,rgb(150,150,150),rgb(0,0,0),3)
      j=btn(270,410,rgb(150,150,150),rgb(0,0,0),6)
      if i=3 or j=6 then exit
   loop

endfunction

function loadwin(c1,c2)
   get image 9,0,0,screen width(),screen height()
   filey=280
   count=0

   find first
   repeat
      if get file type()=1 then dirs$(count)=get file name$() : count=count+1 : array insert at bottom dirs$()
      if get file type()=0
         if right$(get file name$(),len(get file name$())-5)=".txt" or right$(get file name$(),len(get file name$())-5)=".nfo" or right$(get file name$(),len(get file name$())-5)=".htm"
            dirs$(count)=get file name$() : count=count+1 : array insert at bottom dirs$()
         endif
      endif
      find next
   until get file type()=-1

   do
   cls
   paste image 9,0,0

   ``window
   box 35,50,screen width()-35,screen height()-45,c1,c1,c1,c1
   box 37,52,screen width()-37,screen height()-47,c2,c2,c2,c2

   ``title
   box 250,40,screen width()-250,60,c1,c1,c1,c1
   box 252,42,screen width()-252,58,c2,c2,c2,c2
   text screen width()/2-text width("Laden")/2,50-text height("A")/2,"Laden"

   text 70,80,"Dateiname:"
   clspart(70,110,screen width()-70,130,80,80,80)
   text 72,111,loadfile$

   text 70,255,"Ladeort:"
   clspart(70,275,screen width()-70,400,80,80,80)
   for t=0 to array count(dirs$())
      filey2=filey+(t*11)
      if filey2>275 and filey2<385 then text 70,filey2,dirs$(t)
      if filey2>275 and filey2<385 and mousex()>69 and mousey()>filey2-1 and mousex()<70+text width(dirs$(t)) and mousey()<filey2+11 and mouseclick()
         if right$(dirs$(t),len(dirs$(t))-5)=".txt" or right$(dirs$(t),len(dirs$(t))-5)=".nfo" or right$(dirs$(t),len(dirs$(t))-5)=".htm" then loadfile$=dirs$(t) else set dir dirs$(t)
         count=0
         filey=280
         empty array dirs$()
         array insert at bottom dirs$()
         find first
         repeat
            if get file type()=1 then dirs$(count)=get file name$() : count=count+1 : array insert at bottom dirs$()
            if get file type()=0
               if right$(get file name$(),len(get file name$())-5)=".txt" or right$(get file name$(),len(get file name$())-5)=".nfo" or right$(get file name$(),len(get file name$())-5)=".htm"
                  dirs$(count)=get file name$() : count=count+1 : array insert at bottom dirs$()
               endif
            endif
            find next
         until get file type()=-1
         wait 100
      endif
   next t

   paste image 2,screen width()-95,280
   paste image 3,screen width()-95,375

   if mousex()>screen width()-96 and mousey()>279 and mousex()<screen width()-74 and mousey()<301 and mouseclick() then filey=filey+2
   if mousex()>screen width()-96 and mousey()>374 and mousex()<screen width()-74 and mousey()<396 and mouseclick() then filey=filey-2

      i=btn(70,410,rgb(150,150,150),rgb(0,0,0),4)
      j=btn(270,410,rgb(150,150,150),rgb(0,0,0),6)
      if i=4 or j=6 then exit
   loop

endfunction

function load()
   zeile=0
   if loadfile$>""
      if file exist(loadfile$)
         open to read 1,loadfile$

         empty array txt$(0)

         repeat
            array insert at bottom txt$(0)
            read string 1,txt$(zeile)
            zeile=zeile+1
         until file end(1)
         array insert at bottom txt$(0)
         close file 1
      endif
   endif

endfunction

function save()

   if savename$>""
      if txtactive=1 then ext$=".txt"
      if nfoactive=1 then ext$=".nfo"
      if htmactive=1 then ext$=".htm"
      savefile$=savename$+ext$
      if file exist(savefile$) then delete file savefile$
      open to write 1,savefile$

      for tyzx=0 to array count(txt$(0))
         write string 1,txt$(tyzx)
      next tyzx
      close file 1
   endif

endfunction