PureBasic Forums - English

Code: Select all

;
; Lots of code from sverson & others http://www.purebasic.fr/english/viewtopic.php?f=13&t=23314&start=4
; From em_uk 2012  v1.1
;
; Advanced Path Requester : Source http://forum.purebasic.com/english/viewtopic.php?f=13&t=48978
; oryaaaaa     v1.0

NewList PathRequesterAdvanceFolderList.s()

Procedure.l PathRequesterAdvanceCallback(hwnd, msg, wParam, lParam)
  Shared PRA_ExplorerTreeNo.l, PRA_ListIconNo.l, PRA_oldwproc.i, PRA_dpi.b,PathRequesterAdvanceFolderList()
  Protected lpht.TV_HITTESTINFO
  Protected result.l, itemID.l, itemNo.l, itemState.l, itemString.s, ListPos.l
  Protected ExplorerTreeID.l = GadgetID(PRA_ExplorerTreeNo)
  result = CallWindowProc_(PRA_oldwproc, hwnd, msg, wParam, lParam)
  If msg = #WM_KEYDOWN ;/ THX breeze4me http://www.purebasic.fr/english/viewtopic.php?p=158317 (modyfied)
    If wParam = #VK_SPACE
      itemID     = SendMessage_(ExplorerTreeID, #TVM_GETNEXTITEM, #TVGN_CARET,0)
      itemState  = (SendMessage_(ExplorerTreeID, #TV_FIRST + 39, itemID, #TVIS_STATEIMAGEMASK)>>12) - 1
      itemString = GetGadgetText(PRA_ExplorerTreeNo)
      ListPos = -1
      ForEach PathRequesterAdvanceFolderList()
        If itemString=PathRequesterAdvanceFolderList()
          ListPos=ListIndex(PathRequesterAdvanceFolderList())
          Break
        EndIf
      Next
      If itemState
        If ListPos=-1
          AddElement(PathRequesterAdvanceFolderList())
          PathRequesterAdvanceFolderList() = GetGadgetText(PRA_ExplorerTreeNo)
          If Len(PathRequesterAdvanceFolderList())>PRA_dpi
            AddGadgetItem(PRA_ListIconNo,-1, Left(PathRequesterAdvanceFolderList(),3)+"..."+Right(Mid(PathRequesterAdvanceFolderList(), 4),PRA_dpi))
          Else
            AddGadgetItem(PRA_ListIconNo,-1, PathRequesterAdvanceFolderList()) 
          EndIf
        EndIf
      ElseIf ListPos>-1
        RemoveGadgetItem(PRA_ListIconNo,ListPos)
        DeleteElement(PathRequesterAdvanceFolderList(), ListPos) 
      EndIf
    EndIf
  EndIf
  If msg= #WM_LBUTTONDOWN ;/ THX breeze4me http://www.purebasic.fr/english/viewtopic.php?p=158317 (modyfied)
    GetCursorPos_(@lpht\pt)
    ScreenToClient_(ExplorerTreeID,lpht\pt)
    itemID = SendMessage_(ExplorerTreeID,#TVM_HITTEST,0,lpht)
    SendMessage_(ExplorerTreeID,#TVM_SELECTITEM,#TVGN_CARET,itemID)
    itemState  = (SendMessage_(ExplorerTreeID, #TV_FIRST + 39, itemID, #TVIS_STATEIMAGEMASK)>>12) - 1
    itemString = GetGadgetText(PRA_ExplorerTreeNo)
    ListPos = -1
    ForEach PathRequesterAdvanceFolderList()
      If itemString=PathRequesterAdvanceFolderList()
        ListPos=ListIndex(PathRequesterAdvanceFolderList())
        Break
      EndIf
    Next
    If itemState
      If ListPos=-1
        AddElement(PathRequesterAdvanceFolderList())
        PathRequesterAdvanceFolderList() = GetGadgetText(PRA_ExplorerTreeNo)
        If Len(PathRequesterAdvanceFolderList())>PRA_dpi
          AddGadgetItem(PRA_ListIconNo,-1, Left(PathRequesterAdvanceFolderList(),3)+"..."+Right(Mid(PathRequesterAdvanceFolderList(), 4),PRA_dpi))
        Else
          AddGadgetItem(PRA_ListIconNo,-1, PathRequesterAdvanceFolderList()) 
        EndIf
      EndIf
    ElseIf ListPos>-1
      RemoveGadgetItem(PRA_ListIconNo,ListPos)
      DeleteElement(PathRequesterAdvanceFolderList(), ListPos) 
    EndIf
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.s PathRequesterAdvance(Title.s, InitialPath.s)
  Shared PRA_ExplorerTreeNo.l, PRA_ListIconNo.l, PRA_oldwproc.i, PRA_dpi.b,PathRequesterAdvanceFolderList()
  Protected PRA_Win.l, Text_FolderPath.l, Text_SelectedFiles.l, frame.l, Btn_OK.l, Btn_Cancel.l
  Protected hdc.i, hDpi.i, ScreenDpi.f, fnt.l, finfo.LOGFONT, systemfontname.s, ReturnPath.s
  hdc = GetDC_(GetDesktopWindow_())
  If hdc
    hDpi = GetDeviceCaps_(hdc, #LOGPIXELSX)
    ReleaseDC_(GetDesktopWindow_(), hdc)
    ScreenDpi = 96/hDpi
  Else
    ScreenDpi = 1.0 
  EndIf
  PRA_dpi = 50 ; Listview charactors 
  fnt.l=GetStockObject_(#DEFAULT_GUI_FONT)
  If fnt
    GetObject_(fnt,SizeOf(LOGFONT),@finfo)
    systemfontname = PeekS(@finfo\lfFaceName[0])
  Else
    systemfontname ="System"
  EndIf 
  fnt = LoadFont(#PB_Any, systemfontname, Round(10*ScreenDpi, #PB_Round_Down))
  PRA_Win = OpenWindow(#PB_Any, 0, 0, 636, 479,Title, #PB_Window_SystemMenu|#PB_window_Tool |#PB_Window_TitleBar|#PB_Window_ScreenCentered)
  If PRA_Win
    ClearList(PathRequesterAdvanceFolderList())
    UseGadgetList(WindowID(PRA_Win))
    PRA_ExplorerTreeNo=ExplorerTreeGadget(#PB_Any, 10, 38, 204, 386, InitialPath, #PB_Explorer_NoDriveRequester|#PB_Explorer_AutoSort|#PB_Explorer_NoFiles|#PB_Explorer_AlwaysShowSelection)
    SetWindowLong_(GadgetID(PRA_ExplorerTreeNo),#GWL_STYLE, $50200123) 
    SetGadgetFont(PRA_ExplorerTreeNo, FontID(fnt))
    Text_FolderPath=TextGadget(#PB_Any, 12, 15, 162, 20, "Folder Path")
    SetGadgetFont(Text_FolderPath, FontID(fnt))
    Text_SelectedFiles=TextGadget(#PB_Any, 223, 17, 177, 20, "Selected in folder")
    SetGadgetFont(Text_SelectedFiles, FontID(fnt))
    PRA_ListIconNo=ListViewGadget(#PB_Any, 221, 38, 400, 386,#PB_ListView_Multiselect)
    ClearGadgetItems(PRA_ListIconNo)
    SetGadgetFont(PRA_ListIconNo, FontID(fnt)) 
    frame=Frame3DGadget(#PB_Any, 5, 0, 623, 432, "")
    Btn_OK = ButtonGadget(#PB_Any, 490, 440, 50, 30, "OK")
    SetGadgetFont(Btn_OK, FontID(fnt))
    Btn_Cancel = ButtonGadget(#PB_Any, 555, 440, 65, 30, "Cancel")
    SetGadgetFont(Btn_Cancel, FontID(fnt)) 
    PRA_oldwproc  = SetWindowLong_(GadgetID(PRA_ExplorerTreeNo), #GWL_WNDPROC, @PathRequesterAdvanceCallback()) 
    Repeat
      Select WaitWindowEvent() 
        Case #PB_Event_Gadget 
          Select EventGadget() 
            Case Btn_OK
              ForEach PathRequesterAdvanceFolderList()
                If ListIndex(PathRequesterAdvanceFolderList())=0
                  ReturnPath = PathRequesterAdvanceFolderList()
                Else
                  ReturnPath + Chr(10) + PathRequesterAdvanceFolderList()
                EndIf
              Next
              CloseWindow(PRA_Win)
              FreeFont(fnt)
              ProcedureReturn ReturnPath  
            Case Btn_Cancel
              CloseWindow(PRA_Win)
              FreeFont(fnt)
              ProcedureReturn "" 
          EndSelect 
        Case #PB_Event_CloseWindow
          Select EventWindow()
            Case PRA_Win
              CloseWindow(PRA_Win)
              FreeFont(fnt)
              ProcedureReturn ""
          EndSelect
      EndSelect
    ForEver  
  EndIf 
EndProcedure

Path.s = PathRequesterAdvance("Advance Path Requester", "D:\")
pathcount = CountString(Path, Chr(10))

If pathcount =0
  Debug Path
Else
  For no=0 To pathcount
    Debug StringField(Path, no+1, Chr(10))
  Next
EndIf

End