PathRequesterFix V 1.00

[Andesdaf]

Hallo!

ich hab hier einfach mal einen PathRequester zusammengesetzt, bei dem
man auch ohne API den Titeltext verändern kann:

Code: Alles auswählen

Procedure.s PathRequesterFix(psTitle.s,psMessage.s,psInitialPath.s)
  Protected iWH.i
  Protected iTH.i
  Protected iEH.i
  Protected iB1.i
  Protected iB2.i
  Protected iB3.i
  Protected iEvent.i
  
  iWH = OpenWindow(#PB_Any,#PB_Ignore,#PB_Ignore,315,348,psTitle,#PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
  If iWH
    iTH = TextGadget(#PB_Any,15,10,277,45,psMessage)
    iEH = ExplorerTreeGadget(#PB_Any,15,60,285,240,psInitialPath,#PB_Explorer_NoLines | #PB_Explorer_NoFiles | #PB_Explorer_AutoSort)
    iB1 = ButtonGadget(#PB_Any,10,312,125,23,"&Neuen Ordner erstellen")
    iB2 = ButtonGadget(#PB_Any,138,312,80,23,"OK",#PB_Button_Default)
    iB3 = ButtonGadget(#PB_Any,223,312,80,23,"Abbrechen")
  EndIf
  
  WindowBounds(iWH,315,275,#PB_Ignore,#PB_Ignore)
  
  Repeat
    iEvent = WaitWindowEvent()
    
    Select iEvent
      
      Case #PB_Event_Gadget
        Select EventGadget()
        
          Case iB1
            CreateDirectory(GetGadgetText(iEH)+"Neuer Ordner")
            
          Case iB2
            ProcedureReturn GetGadgetText(iEH)
            
          Case iB3
            ProcedureReturn ""
            iEvent = #PB_Event_CloseWindow
        
        EndSelect
        
      Case #PB_Event_SizeWindow
        ResizeGadget(iTH,#PB_Ignore,#PB_Ignore,WindowWidth(iWH)-30,#PB_Ignore)
        ResizeGadget(iEH,#PB_Ignore,#PB_Ignore,WindowWidth(iWH)-30,WindowHeight(iWH)-12-GadgetHeight(iB1)-12-GadgetY(iEH))
        ResizeGadget(iB1,#PB_Ignore,WindowHeight(iWH)-12-GadgetHeight(iB1),#PB_Ignore,#PB_Ignore)
        ResizeGadget(iB2,#PB_Ignore,WindowHeight(iWH)-12-GadgetHeight(iB2),#PB_Ignore,#PB_Ignore)
        ResizeGadget(iB3,#PB_Ignore,WindowHeight(iWH)-12-GadgetHeight(iB3),#PB_Ignore,#PB_Ignore)
        
      
    EndSelect
    
  Until iEvent = #PB_Event_CloseWindow
  CloseWindow(iWH)
EndProcedure

PathRequesterFix("Ordner waehlen","nochmal",GetHomeDirectory())

[Andesdaf]

wie ich sehe besteht kein sonderliches Interesse

[ts-soft]

wie ich sehe besteht kein sonderliches Interesse

Ich nutze lieber die API, bietet mehr Möglichkeiten ,
bzw. der Titel hat mich eigentlich noch nie interessiert. Aber getestet hab ich
es schon vor Wochen. Wird schon der ein oder andere "heimlich" benutzen,
darfste nicht drüber nachdenken

[Andesdaf]

danke, aber ein Thread mit einer Null an Posts sieht eben traurig aus.

[al90]

danke, aber ein Thread mit einer Null an Posts sieht eben traurig aus.

Iss ja nun nicht mehr leer.

[sibru]

Hab´ hier ´ne Version mit API und vollem Funktions-Umfang

Code: Alles auswählen

;Modul      PfadRequester Version 1.00 vom 26.09.2008
;
;Funktion:  Pfad-Auswahl mit korrektem Titel und immer voll sichtbar (korrigierter PathRequester)
;           Dieses Modul ersetzt die PB-Funktion "PathRequester()", wobei
;           folgende Unterschiede bestehen:
;           - hier wird der Titel lt. Funktions-Übergabe zum deutlichen
;             Fenster-Titel (PathRequester: immer "Ordner suchen")
;           - hier wird das Fenster immer nach ganz oben verschoben und
;             sollte somit auch immer voll sichtbar sein (PathRequester ist
;             oft zu tief und die Schalterleiste ist nicht mehr sichtbar...)
;
;Aufruf:    Pfad$ = PfadRequester(Titel$, StartPfad$)
;           Titel$ = Fenster-Überschrift
;           StartPfad$ = voreingestellter Verzeichniss-Pfad
;

 ;#jaPBeExt exit
Global ReqHook, Req_PromptID, Req_OrgProc

Procedure Req_CallBack(hwnd.l, msg.l, wParam.l, lParam.l)
  Protected Titel$, Prompt$
  Protected rect.RECT, result
  result.l = CallWindowProc_(Req_OrgProc, hwnd, msg, wParam, lParam)
  Select msg
    Case #WM_CTLCOLORSTATIC
      If Req_PromptID = 0 : Req_PromptID = lParam  ;nur beim 1. #WM_CTLCOLORSTATIC !!! (das ist die Baum-Überschrift...)
        Titel$ = Space(500) : GetWindowText_(hwnd, @Titel$, 500)  ;Fenster-Titel ("Ordner suchen")
        Prompt$ = Space(500) : GetWindowText_(Req_PromptID, @Prompt$, 500)  ;Prompt = Baum-Überschrift
        SetWindowText_(hwnd, @Prompt$)  ;Überschrift wird Fenster-Titel...
        SetWindowText_(Req_PromptID, @Titel$)  ;... und umgekehrt
      EndIf
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure Req_CBTProc(nCode.l, wParam.l, lParam.l)
  Protected result.l = CallNextHookEx_(ReqHook, nCode, wParam, lParam)
  Protected *cbt_cw.CBT_CREATEWND = lParam
  Protected *lpcs.CREATESTRUCT
  If nCode = #HCBT_CREATEWND  ;vor Aufbau des Requesters
    *lpcs = * cbt_cw\lpcs
      If * lpcs\lpszClass = 32770  ;unser Requester ?
      *lpcs\y = 1  ;ganz oben auf´m Monitor positionieren
    EndIf
    result = 0
  EndIf
  If nCode = #HCBT_ACTIVATE  ;Requester wird aktiviert
    Req_OrgProc = SetWindowLong_(wParam, #GWL_WNDPROC, @Req_CallBack())
    If ReqHook : UnhookWindowsHookEx_(ReqHook) : ReqHook = 0 : EndIf  ;Manipulationen abschließen
    result = 0
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.s PfadRequester(PR_Titel$, PR_StartPfad$)
  #WH_CBT = 5
  Req_PromptID = 0
  ReqHook = SetWindowsHookEx_(#WH_CBT, @Req_CBTProc(), 0, GetCurrentThreadId_())
  ProcedureReturn PathRequester(PR_Titel$, PR_StartPfad$)
EndProcedure

Gruss SiBru

[ts-soft]

> Hab´ hier ´ne Version mit API und vollem Funktions-Umfang
Den vollen Funktionsumfang kann ich aber nicht entdecken. Sieh Dir mal die
BrowseForFolder - API an, da gibts aber sehr viele Flags

Code: Alles auswählen

Procedure BrowseCallbackProc(hwnd, msg, lParam, lData)
  Protected szDir.s = Space(#MAX_PATH)
  Select msg
    Case #BFFM_INITIALIZED
      SendMessage_(hwnd, #BFFM_SETSELECTION, #BFFM_INITIALIZED, lData)
    Case #BFFM_SELCHANGED
      If SHGetPathFromIDList_(lParam, @szDir)
        SendMessage_(hwnd, #BFFM_SETSTATUSTEXT, 0, @szDir)
      EndIf
  EndSelect
EndProcedure

Procedure.s BrowseForFolder(Style, Titel.s, Path.s)
  Protected Folder.s = Space(#MAX_PATH)
  Protected Dir.BROWSEINFO
  Protected result.l
  Dir\hwndOwner = GetActiveWindow_()
  Dir\pszDisplayName = @Folder
  Dir\lpszTitle = @Titel
  Dir\ulFlags = Style
  Dir\lpfn = @BrowseCallbackProc()
  Dir\lParam = @Path
  CoInitialize_(#Null)
  result = SHBrowseForFolder_(@Dir)
  SHGetPathFromIDList_(result, @Folder)
  If Folder <> ""
    If FileSize(Folder) = - 2
      If Right(Folder, 1) <> "\" : Folder + "\" : EndIf
    EndIf
  EndIf
  CoTaskMemFree_(result)
  ProcedureReturn Folder
EndProcedure

Mit Ordner erstellen oder ohne, mit oder ohne Edit-Fenster, alter oder
neuer Stil, mit Dateien oder nur Ordner usw.

Siehe hier: http://tinyurl.com/nq3hod

Gruß

Thomas

[Andesdaf]

@sibru und ts-soft,
danke für die Hinweise/Codes.