fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
sGUI modifizierter Filerequester mit "cd.." Button

Uploader:	Muttonhead
Datum/Zeit:	23.06.2011 21:14:34
'folgende .bas aus dem Verzeichnis "sGUI" müssen v o r h e r includiert sein:

'#include "sGUI\sGUI.bas"

'#include "sGUI\SimpleGadget.bas"

'#include "sGUI\StringGadget.bas"

'#include "sGUI\Arrows.bas"

'#include "sGUI\Sliders.bas"

'#include "sGUI\ListBox.bas"

'                                  ...und!!!!!!

'InitGFX m u s s aufgerufen sein





declare function FileRequester(posx as integer,posy as integer,bt as string,path as string, file as string="") as string

declare sub SearchDir(t as string,array() as string )



function FileRequester(posx as integer,posy as integer,bt as string,path as string, file as string="") as string

  function=""



  dim as integer ptr gfxbackup

  gfxbackup=imagecreate(400,300)

  get (posx,posy)-(posx+399,posy+299),gfxbackup



  dim as string sep,drive,originpath=curdir

  'Windows Variante

  #ifdef __fb_win32__

    sep="\"

  #endif

  'Tux Variante

  #ifdef __FB_LINUX__

    sep="/"

  #endif



  dim as integer rows

  if fontheight=8  then rows=22

  if fontheight=14 then rows=12

  if fontheight=16 then rows=11



  redim as string content(0)

  dim as string entry,GoToFolder

  GoToFolder=""

  entry=""

  chdir path

  path=curdir

  drive=left(path,1)

  SearchDir("D",content())

  SearchDir("F",content())



  dim as EventHandle ptr event

  event=CreateEventHandle



  dim as Gadget ptr doit,cancel,strpath,strfile,contlist,cd



  strpath=AddStringGadget(event,posx+52,posy+25,38,256,path,1)

  contlist=AddListBox(event,posx+5,posy+54,46,rows,content())

  strfile=AddStringGadget(event,posx+62,posy+242,29,256,file)

  doit=AddSimpleGadget(event,posx+309,posy+242,85,23,bt)

  cancel=AddSimpleGadget(event,posx+309,posy+271,85,23,"Abbruch")'"Cancel"

  cd=AddSimpleGadget(event,posx+370,posy+25,24,23,"..")





  FillA(posx,posy,400,300,GadgetColor,0)

  FrameB(posx+2,posy+21,396,277,1)

  ClearBox(posx+3,posy+22,394,275)

  draw string (posx+5, posy+3),bt & "..."

  draw string (posx+5, posy+28),"Pfad:" '"Path:"

  draw string (posx+5, posy+245),"Datei:"'"File:"



  GadgetOn(strpath)

  GadgetOn(contlist)

  GadgetOn(strfile)

  GadgetOn(doit)

  GadgetOn(cancel)

  GadgetOn(cd)

  do

    event->xSleep(1,0)

    if event->GADGETMESSAGE then

      select case event->GADGETMESSAGE



        'Pfadeingabe

        case strpath

          chdir UExport(GetString(strpath))           'Wechsel ins Directory

          path=UImport(curdir)                        'Setze aktuellen Pfad

          redim content(0)                            'Rücksetzen Array

          SearchDir("D",content())                    'Suche nach Verzeichnissen

          SearchDir("F",content())                    'Suche nach Dateien

          InitNewListArray(contlist,content())            'übergebe "neues" Array an ListBox

          SetString(strpath,path)                     'Aktualisiere die Pfadanzeige



        case contlist

          entry=content(GetListBoxVal(contlist))

                    if entry<>"" then

            if left(entry,6)="<DIR> " then                'wenn entry ein Directory

              GoToFolder=right(entry,len(entry)-6)

              chdir UExport(GoToFolder)                   'Wechsel ins Directory

              path=UImport(curdir)                        'Setze aktuellen Pfad

              redim content(0)                            'Rücksetzen Array

              SearchDir("D",content())                    'Suche nach Verzeichnissen

              SearchDir("F",content())                    'Suche nach Dateien

              InitNewListArray(contlist,content())            'übergebe "neues" Array an ListBox

              SetString(strpath,path)                     'Aktualisiere die Pfadanzeige

            else                                          'ansonsten ist entry ein Dateiname

              file=entry

              SetString(strfile,file)

            end if

          end if



        case cd

          chdir ".."                                  'Wechsel ins übergeordnete Directory

          path=UImport(curdir)                        'Setze aktuellen Pfad

          redim content(0)                            'Rücksetzen Array

          SearchDir("D",content())                    'Suche nach Verzeichnissen

          SearchDir("F",content())                    'Suche nach Dateien

          InitNewListArray(contlist,content())            'übergebe "neues" Array an ListBox

          SetString(strpath,path)                     'Aktualisiere die Pfadanzeige



                'Beenden und Rückabe eines Strings

        case strfile,doit

          file=GetString(strfile)

          if file<>"" then

            if right(path,1)<> sep then

              function=UExport(path) & sep & UExport(file)

            else

              function=UExport(path) & file

            end if

            event->EXITEVENT=1

          end if



        'Abbruch des FileRequesters

        case cancel

          event->EXITEVENT=1

          function=""



      end select

    end if

  loop until event->EXITEVENT

  DestroyEventHandle(event)

  chdir originpath

  put (posx,posy),gfxbackup,pset

  imagedestroy gfxbackup

end function





sub SearchDir(t as string,array() as string )

  dim as integer entrycount, attr

  dim as string entryname,pre

  attr=0

  if ucase(t)="D" then 'bei "D" suche nach Verzeichnissen

    attr=&H10 + &H01

    pre="<DIR> "       '"Vorsilbe" um Verzeichnisse von Dateien unterscheiden zu können

  end if

  if ucase(t)="F" then  'bei "F" suche nach Dateien

    attr=&H00

    pre=""

  end if

  entrycount=ubound(array)



  entryname=dir("*",attr)

  do



    if len(entryname) and entryname<>"." and entryname<>".." then

      entrycount +=1

      redim preserve array(entrycount)

      array(entrycount)=pre & UImport(entryname)

    end if

    entryname=dir

  loop while len(entryname)

end sub