fsupselector.class

Gambas is a graphical development environment based on a Basic interpreter, like Visual Basic. It us

PRIVATE SUB MakeMenu()

  DIM hMenu AS Menu
  DIM hMenuExplorer AS Menu

  hMenuExplorer = NEW Menu(ME.Window, TRUE)
  'hMenuExplorer.Visible = TRUE
  'hMenuExplorer.Visible = FALSE
  arMenu.add(hMenuExplorer)
'
  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ("&Bookmark this directory")
  hMenu.Picture = Picture["img/16/todir.png"]
  hMenu.Shortcut = "CTRL+B"
  hmenu.Visible = FALSE
  hMenu.Tag = 1
  arMenu.Add(hMenu)
'
    hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ("&Remove current bookmark")
  hMenu.Tag = 2
  hmenu.Visible = FALSE
  arMenu.Add(hMenu)
'
    hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ""
  'hMenu.Tag = 3
  hmenu.Visible = FALSE
  arMenu.Add(hMenu)
'
    hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ("&Cut")
  hMenu.Picture = Picture["img/16/cut.png"]
  hMenu.Shortcut = "CTRL+X"
  hMenu.Tag = 3
  arMenu.Add(hMenu)

  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ("&Copy")
  hMenu.Picture = Picture["img/16/copy.png"]
  hMenu.Shortcut = "CTRL+C"
  hMenu.Tag = 4
  arMenu.Add(hMenu)

  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ("&Paste")
  hMenu.Picture = Picture["img/16/paste.png"]
  hMenu.Shortcut = "CTRL+V"
  hMenu.Tag = 5
  arMenu.Add(hMenu)

  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ""
  arMenu.Add(hMenu)

  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ("Rename")
  hMenu.Shortcut = "F2"
  hMenu.Tag = 6
  arMenu.Add(hMenu)

  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ""
  arMenu.Add(hMenu)

  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ("Delete")
  hMenu.Picture = Picture["img/16/kill.png"]
  hMenu.Shortcut = "CTRL+Del"
  hMenu.Tag = 7
  arMenu.Add(hMenu)

  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ""
  arMenu.Add(hMenu)

  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ("Show preview picture")
  hMenu.Picture = Picture["img/16/image.png"]
  'hMenu.Shortcut = "Del"
  hMenu.Checked= PreviewImg
  hMenu.Tag = 8
  arMenu.Add(hMenu)

  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ("Show hidden files")
  hMenu.Picture = Picture["img/16/zoom.png"]

  hMenu.Checked = ShowHidden
  hMenu.Tag = 9
  arMenu.Add(hMenu)

  hMenu = NEW Menu(hMenuExplorer) AS "MenuExp"
  hMenu.Text = ("Refresh")
  hMenu.Picture = Picture["img/16/refresh.png"]
  hMenu.Shortcut = "F5"
  hMenu.Tag = 10
  arMenu.Add(hMenu)

END

PUBLIC SUB Explorer_Menu()

  DIM i AS Integer
  DIM sText AS String

  IF NOT Explorer.Available THEN RETURN

  FOR i = 1 TO 3
    arMenu[i].Visible = FALSE
  NEXT

  FOR i = 4 TO 11
   arMenu[i].Visible = TRUE
  NEXT

  IF Explorer.Key THEN
    IF Exist(File.Dir(Explorer.Key) &/ ".project") OR Explorer.Current.Text = ".." THEN

      arMenu[4].Visible = FALSE

      FOR i = 4 TO 9
        arMenu[i].Visible = FALSE
      NEXT

    ENDIF
  ENDIF

  iMenuFrom = 1
  arMenu[0].Popup()

END


PUBLIC SUB TreeExplorer_Menu()

  DIM i AS Integer

  'IF IsDir(TreeExplorer.Current.Key) THEN
    FOR i = 1 TO 4
      arMenu[i].Visible = TRUE
    NEXT
  'ELSE
  '
  FOR i = 3 TO 10
     arMenu[i].Visible = FALSE
  NEXT
  'ENDIF

  IF CoolTab.Count() <= CoolTab.StaticButton OR CoolTab.Current.Tag < CoolTab.StaticButton OR Len(TreeSequence) > 1 THEN arMenu[2].Visible = FALSE
  iMenuFrom = 0

  arMenu[0].Popup()

END

PUBLIC SUB MenuExp_Click()

  DIM sClipStore AS String
  DIM sPath AS String
  DIM Value AS Integer

  IF iMenuFrom = 0 THEN
    sPath = Mid(TreeExplorer.Key,2)
  ELSE
    sPath = Explorer.Key
  ENDIF

  SELECT CASE LAST.Tag

    CASE 1 'Add Bookmark
      IF TreeExplorer.Key AND AccessTest(TreeExplorer.Key) THEN
        CoolTab.Button_Unselect()
        CoolTab.AddButton(sPath)
        CoolTab.Button_Select(CoolTab.Current.Tag)
      ENDIF

    CASE 2 'remove Bookmark
    Value = Message.Question(("Do you really want to remove this bookmark ?"), ("Remove"), ("Cancel"))

      IF value = 1 THEN
        CoolTab.Remove(CoolTab.Current.Tag)
      ENDIF

    CASE 3 'Cut
      isCutMode = TRUE
      IF Exist(sPath) THEN
        Clipboard.Copy("file:" & sPath, FILE_CLIPBOARD_FORMAT)
      ENDIF

    CASE 4 'Copy
      IF Exist(Explorer.Key) THEN
        Clipboard.Copy("file:" & sPath, FILE_CLIPBOARD_FORMAT)
      ENDIF

    CASE 5 'Paste

       IF NOT Exist(Mid(ClipBoard.Paste(),6)) THEN RETURN

          IF ClipBoard.Format = FILE_CLIPBOARD_FORMAT OR ClipBoard.Format = "text/plain"  AND Left(Clipboard.Paste(),5) = "file:" THEN
              sClipStore = ClipBoard.Paste()

              IF NOT IsDir(Mid(sClipStore,6)) THEN
                TRY COPY Mid(sClipStore,6) TO CurrentPath &/ File.Name(Mid(sClipStore,6))
                IF ERROR THEN
                  '$BM
                  Message.Error(Subst(("Cannot copy file &1\n\n&2"), sClipStore, Error.Text))
                  'Message.Warning((Error.Text & "\nI can't copy the file : \n" & ClipBoard.Paste()))
                  RETURN
                ENDIF
                IF IsCutMode THEN DeleteFile(Mid(sClipStore,6))
                btnRefresh_Click()
              ELSE
                IF NOT CopyDir (Mid(sClipStore,6)) THEN RETURN
                IF IsCutMode THEN DeleteFile(Mid(sClipStore,6))
                btnRefresh_Click()
              ENDIF

          ENDIF

    CASE 6 'Rename
      Explorer.Current.Editable = TRUE
      StkCurStr = File.Name(Explorer.Key)
      Explorer.Current.Rename()

    CASE 7 'Delete
      DeleteFile(sPath)

    CASE 8 'ShowPreview
      PreviewImg = NOT PreviewImg
      arMenu[12].Checked = PreviewImg
      RefreshExplorer

    CASE 9 'ShowHiddenFile
      ShowHidden = NOT ShowHidden
      arMenu[13].Checked = ShowHidden
      'RefreshExplorer
      btnRefresh_Click()

    CASE 10 'Refresh
      btnRefresh_Click()

  END SELECT

END


PRIVATE FUNCTION DeleteFile(sPath AS String) AS Boolean

  DIM Value AS Integer

  IsCutMode = FALSE
  'sPath = Conv$(sPath, Desktop.Charset, System.Charset)
  'Message(sPath)

  IF TestProtected(sPath) THEN RETURN

  IF Message.Delete(("Do you really want to delete this file ?"), ("Delete"), ("Cancel")) <> 1 THEN RETURN

  IF IsDir(sPath) THEN
    RMDIR sPath
  ELSE
    KILL sPath
  END IF

  btnRefresh_Click()
  RETURN TRUE

CATCH

  Message.Error(("Unable to delete this file.") & "\n\n" & Error.Text)

END


PRIVATE FUNCTION RenameFile(sPath AS String) AS Boolean

  DIM bConf AS Boolean

  bConf = NOT $bDoNotConfirm
  $bDoNotConfirm = FALSE

  IF stkCurStr = File.Name(sPath) THEN RETURN

  IF TestProtected(sPath, TRUE) THEN RETURN

  IF bConf THEN
    IF Message.Question(("Do you really want to rename this file ?"), ("Rename"), ("Cancel")) <> 1 THEN RETURN
  ENDIF

  RENAME File.Dir(sPath) &/ stkCurStr AS sPath
  btnRefresh_Click
  RETURN TRUE

CATCH

  Message.Error(("Unable to rename this file.") & "\n\n" & Error.Text)

END

PUBLIC SUB Explorer_Rename()

  IF File.Name(Explorer.Key) <> Explorer.Current.Text THEN
    IF NOT RenameFile(File.Dir( Explorer.Key) &/ Explorer.Current.Text) THEN  Explorer.Current.Text = stkCurStr
  ELSE
    Explorer.Current.Editable = FALSE
  ENDIF

END


PRIVATE FUNCTION CopyDir(sPath AS String) AS Boolean

  'DIM arFile AS String[]
  DIM sDir AS String
  DIM bOldHide AS Boolean
  DIM DirRoot AS String

  DirRoot = CurrentPath &/ File.Name(sPath)
  'Message(DirRoot)
  arFile.Add(sPath)
  FileArray(sPath)
  'arFile.Sort

  FOR EACH sDir IN arFile
    IF IsDir(sDir) THEN
      MKDIR (DirRoot &/ Mid(sDir,Len(sPath) + 1))
    ELSE
      COPY sDir TO DirRoot &/ Mid(sDir,Len(sPath) + 1)
      'IF ERROR THEN
      '  'Message.Warning(Error.Text & "\nI can't copy the file : \n" & sDir)
      '  Message.Error(Subst(("Cannot copy file &1\n\n&2"), sDir, Error.Text))
      '  RETURN FALSE
      'ENDIF
    ENDIF
  NEXT

  RETURN TRUE

CATCH

  Message.Error(Subst(("Cannot copy file &1\n\n&2"), sDir, Error.Text))
  'Message.Warning((Error.Text & "\nI can't copy the file : \n" & sDir))
  RETURN FALSE

END


PRIVATE SUB FileArray(sPath AS String)

  DIM sDir AS String
  DIM prearFile AS NEW String[]

  IF arFile.Count = 0 THEN RETURN

  INC iLevel

  'IF iLevel >= 6 THEN
  '  Message.Warning(("You must choose a directory who have less than 6 level depth !"))
  '  arFile.Clear
  '  RETURN
  'ENDIF

  FOR EACH sDir IN Dir(sPath)
    arFile.Add(sPath &/ sDir)
    prearFile.Add(sPath &/ sDir)
  NEXT

  FOR EACH sDir IN prearFile
  'Message (sDir)
    IF IsDir(sDir) THEN
      FileArray(sDir)
    ENDIF
  NEXT

  DEC iLevel

END


PUBLIC SUB Form_Close()

  ' $BM Ceci débloque les références circulaires
  arMenu[0] = NULL
  'mnuTab = NULL

  ' $FB Voilà comme ceci les tabs sont sauvegardé dans tous les cas de figure !
  SaveTabs()
  'Message(TreeSequence)
END

PUBLIC SUB SaveTabs()

  DIM i AS Integer

  'PRINT "SaveTabs"

  Settings["/SelectorTabs/Count"] = CoolTab.Count() - CoolTab.StaticButton

  FOR i = CoolTab.StaticButton TO CoolTab.Count() - 1
    Settings["/SelectorTabs/Tab[" & CStr(i - CoolTab.StaticButton) & "]"] = CoolTab.GetTabUrl(i)
  NEXT

  IF Key THEN
    Settings[Key &/ "ExplorerType"] = TExplorer
    Settings[Key &/ "Splitter"] = Splitter.Layout
    Settings[Key &/ "TreeSequence"] = TreeSequence
    Settings[Key &/ "PreviewImg"] = PreviewImg
    Settings[Key &/ "ShowHidden"] = ShowHidden
  ENDIF

END


PUBLIC SUB GetTabs()

  DIM i AS Integer
  DIM sDtab AS String

  IF DoNotShowCustomTabs THEN RETURN

  FOR i = 0 TO Settings["/SelectorTabs/Count", 0]
    Cooltab.AddButton(Settings["/SelectorTabs/Tab[" & CStr(i) & "]"])
  NEXT

END

PUBLIC SUB TreeExplorer_Activate()

  DIM sPath AS String
  'Message(TreeExplorer.Current.Key)
  sPath = Mid(TreeExplorer.Key,2)

  IF AccessTest(sPath) THEN
    CurrentPath = sPath
    Fill_Explorer(CurrentPath)
    IF Validate(sPath) THEN
      txtFile.Text = TreeExplorer.Current.Text
      RaiseSelect
    ENDIF
 ENDIF

END


PRIVATE FUNCTION MyVal(sVal AS String) AS Integer

  TRY RETURN Val(sVal)

END


PRIVATE FUNCTION TestProtected(sPath AS String, OPTIONAL bWithMsg AS Boolean) AS Boolean

  IF Project.Path THEN
    IF sPath LIKE Project.Path &/ "*" THEN
      IF bWithMsg THEN Message.Warning(("The current project files are protected.\nYou cannot rename nor delete them."))
      RETURN TRUE
    ENDIF
  ENDIF

END


PRIVATE SUB RaiseSelect()

  IF OKButton THEN OKButton.Value = TRUE

END

PUBLIC SUB btnNewDir_Click()

  DIM iInd AS Integer
  DIM sNewDir AS String

  FOR iInd = 0 TO 99

    sNewDir = ("New directory")
    IF iInd THEN sNewDir = sNewDir & " " & CStr(iInd + 1)
    sNewDir = CurrentPath &/ sNewDir
    IF NOT Exist(sNewDir) THEN BREAK

  NEXT

  MKDIR sNewDir
  btnRefresh_Click

  WITH Explorer[sNewDir]
    .Selected = TRUE
    .EnsureVisible
    .Editable = TRUE
     StkCurStr = File.Name(sNewDir)
     $bDoNotConfirm = TRUE
    .Rename()
  END WITH

CATCH

  Message.Error(("Cannot create directory.") & "\n\n" & Error.Text)

END