Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [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

sGUI modifizierter Filerequester mit "cd.." Button

Uploader:MitgliedMuttonhead
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