Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Problem mit BrowseForFolder

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
UBE



Anmeldungsdatum: 19.08.2005
Beiträge: 2

BeitragVerfasst am: 19.08.2005, 22:46    Titel: Problem mit BrowseForFolder Antworten mit Zitat

Hallo,

der nachfolgende Code zeigt den BrowseForFolder Dialog an. Im Abschnitt Case BFFM_INITIALIZED soll dann mit SendMessage der von mir übergebene Ordner selectiert werden Call SendMessage(hWnd, BFFM_SETSELECTIONA, -1, lpData). Irgendwie funzt das mit der Übergabe des Parameters lpData nicht. In C und C++ habe ich das schon mehrfach erfolgreich programmiert.

Weis jemand einen Rat?

Viele Grüße
UBE

Code:

Option Explicit
'--------------------------------------------------------------------------------------------------
#Include Once "win/user32.bi"
#Include Once "win/shellapi.bi"
'--------------------------------------------------------------------------------------------------
#define CSIDL_DRIVES     17
#define BFFM_INITIALIZED  1
#define BFFM_SELCHANGED   2
#define BFFM_SETSTATUSTEXTA (WM_USER + 100)
#define BFFM_SETSELECTIONA  (WM_USER + 102)
'--------------------------------------------------------------------------------------------------
Declare Sub CoInitialize Lib "ole32" (ByRef pvReserved As Any)
Declare Sub CoUninitialize Lib "ole32" ()
Declare Sub CoTaskMemFree Lib "ole32" (ByRef pv As Any)
Declare Sub SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, _
                                                      ByVal nFolder As Integer, ByRef ppidl As Integer)
'--------------------------------------------------------------------------------------------------
Dim Shared sFolder As String
'--------------------------------------------------------------------------------------------------
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As UInteger, _
                                    ByVal lParam As UInteger, ByVal lpData As UInteger) As Integer
    Dim sPath As String
    Dim iLen  As Integer

    Select Case uMsg
    Case BFFM_INITIALIZED
        Call SendMessage(hWnd, BFFM_SETSELECTIONA, -1, lpData)
    Case BFFM_SELCHANGED
        sPath = String$(520,0)
      If SHGetPathFromIDList(lParam, sPath) <> 0 Then
            Call SendMessage(hWnd, BFFM_SETSTATUSTEXTA, 0, ByVal sPath)
        End If
   End Select
    Function = 0
End Function
'--------------------------------------------------------------------------------------------------
Public Function BrowseForFolder(ByVal hWnd As Long, ByVal Prompt As String, _
                                ByVal Flags As Integer, ByVal DefaultFolder As String) As String
    Dim bi         As BROWSEINFO
    Dim pidlReturn As integer
    Dim pidlStart  As integer
    Dim sRetval    As String
    Dim iPos       As Integer

    Call CoInitialize(0)
    Call SHGetSpecialFolderLocation(0, CSIDL_DRIVES, pidlStart)

    bi.pidlRoot   = pidlStart
    bi.hOwner     = hWnd
    Prompt        = Prompt + Chr$(0)
    bi.lpszTitle  = StrPtr(Prompt)
    bi.ulFlags    = Flags
    bi.lpfn       = @BrowseCallbackProc
    DefaultFolder = DefaultFolder + Chr$(0)
    bi.lParam     = StrPtr(DefaultFolder)
   
   pidlReturn = SHBrowseForFolder(bi)
   Call CoTaskMemFree(pidlStart)
   If pidlReturn <> 0 Then
        sRetval = String$(260, 0)
        Call SHGetPathFromIDList(pidlReturn, sRetval)
        Call CoTaskMemFree(pidlReturn)
        iPos = InStr(sRetval, Chr$(0))
        If iPos <> 0 Then
            sRetval = Left$(sRetval, iPos - 1)
        End If
    End If
    Call CoUninitialize()
    Function = sRetval
End Function
'--------------------------------------------------------------------------------------------------
Print BrowseForFolder(0, "Das ist ein Test", BIF_RETURNONLYFSDIRS Or BIF_STATUSTEXT, "C:\WINDOWS")
Sleep
'--------------------------------------------------------------------------------------------------
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
UBE



Anmeldungsdatum: 19.08.2005
Beiträge: 2

BeitragVerfasst am: 20.08.2005, 11:35    Titel: Lösung Antworten mit Zitat

Sollte jemanden die Lösung Interessieren:

Code:

Option Explicit
'--------------------------------------------------------------------------------------------------
#Include Once "win/user32.bi"
#Include Once "win/shellapi.bi"
#Include Once "win/kernel32.bi"
'--------------------------------------------------------------------------------------------------
#define CSIDL_DRIVES     17
#define BFFM_INITIALIZED  1
#define BFFM_SELCHANGED   2
#define BFFM_SETSTATUSTEXTA (WM_USER + 100)
#define BFFM_SETSELECTIONA  (WM_USER + 102)
#define LANG_GERMAN   7
'--------------------------------------------------------------------------------------------------
Declare Sub CoInitialize Lib "ole32" (ByRef pvReserved As Any)
Declare Sub CoUninitialize Lib "ole32" ()
Declare Sub CoTaskMemFree Lib "ole32" (ByRef pv As Any)
Declare Sub SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, _
                                                      ByVal nFolder As Integer, ByRef ppidl As Integer)
'--------------------------------------------------------------------------------------------------
Dim Shared sFolder As String
'--------------------------------------------------------------------------------------------------
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As UInteger, _
                                    ByVal lParam As UInteger, ByVal lpData As UInteger) As Integer
    Dim sTmp  As String
    Dim sPath As String
    Dim bLang As Integer

    Select Case uMsg
    Case BFFM_INITIALIZED
        Call SendMessage(hWnd, BFFM_SETSELECTIONA, -1, ByVal sFolder)
    Case BFFM_SELCHANGED
        bLang = (LoByte(GetUserDefaultLangID()) = LANG_GERMAN)
        If bLang Then
            sTmp = "Pfad: "
        Else
            sTmp = "Path: "
        End If
        sPath = String$(MAX_PATH * 2,0)
      If SHGetPathFromIDList(lParam, sPath) = 0 Then
            If bLang Then
                sPath$ = sTmp$ + "Unbekannt" + Chr$(0)
            Else
                sPath$ = sTmp$ + "Unknow"    + Chr$(0)
            End If
        Else
            sPath = sTmp + sPath
        End If
        Call SendMessage(hWnd, BFFM_SETSTATUSTEXTA, 0, ByVal sPath)
   End Select
    Function = 0
End Function
'--------------------------------------------------------------------------------------------------
Public Function BrowseForFolder(ByVal hWnd As Long, ByRef Prompt As String, _
                                ByVal Flags As Integer, ByRef DefaultFolder As String) As String
    Dim bi         As BROWSEINFO
    Dim pidlReturn As Integer
    Dim pidlStart  As Integer
    Dim sTmp       As String
    Dim sRetval    As String
    Dim i          As Integer

    Call CoInitialize(0)
    Call SHGetSpecialFolderLocation(0, CSIDL_DRIVES, pidlStart)

    bi.pidlRoot   = pidlStart
    bi.hOwner     = hWnd
    sTmp          = Prompt + Chr$(0)
    bi.lpszTitle  = StrPtr(sTmp)
    bi.ulFlags    = Flags
   bi.lpfn       = @BrowseCallbackProc
    sFolder       = DefaultFolder + Chr$(0)
   
   pidlReturn = SHBrowseForFolder(bi)
   Call CoTaskMemFree(pidlStart)
   If pidlReturn <> 0 Then
        sTmp = String$(MAX_PATH, 0)
        Call SHGetPathFromIDList(pidlReturn, sTmp)
        Call CoTaskMemFree(pidlReturn)
        For i = 1 To MAX_PATH
            If Asc(Mid$(sTmp, i, 1)) = 0 Then
                sRetval = Left$(sTmp, i - 1)
                Exit For
            End If
        Next
    End If
    Call CoUninitialize()
    Function = sRetval
End Function
'--------------------------------------------------------------------------------------------------
Print BrowseForFolder(0, "Das ist ein Test", BIF_RETURNONLYFSDIRS Or BIF_USENEWUI, "C:\WINDOWS")


Gruß
UBE
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 25.09.2005, 16:27    Titel: Probleme mit BrowseForFolder Antworten mit Zitat

Hi Allemann, insbesondere UBE,
die LÖSUNG funktioniert allerbest und hat mir damit eine Menge Zeit erspart..
Nebenbei habe ich noch eine interessante Entdeckung gemacht:
Ich habe eine Datei UBE-BrowseForFolder.Bas
Bevor ich daran Änderungen vorgenommen habe, kopierte ich sie auf
UBE-BrowseForFolder.GT.Bas
(.GT ist eine Erweiterung, die bei mir für 'geht' steht)
Nach meinen Änderungen lief die Datei nicht mehr und ich habe die .GT
neu übersetzen wollen, aber das ging auch nicht mehr, warum???
Na, der Compiler kommt offensichtlich NICHT mit der doppelten Erweiterung .GT.Bas klar, eigentlich schade..
Ist das jetzt ein Bug oder ein Feature ? happy
BTW:Lösungen sind immer interessant, man muß nur erst mal Probleme dafür finden zwinkern
Viele Grüße
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
psygate



Anmeldungsdatum: 05.04.2005
Beiträge: 304
Wohnort: Wien und der Computer

BeitragVerfasst am: 25.09.2005, 21:26    Titel: Antworten mit Zitat

Das liegt daran, dass der punkt eigentlich ein reserviertes zeichen in einem datei namen ist. Er gilt als trenner zwischen endung und dateiname. Wenn du zwei mal punkt hast, kann der kopiler wahrscheinlich cniht mehr or´dentlich auswerten, was das nun für eine datei ist...
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
tilli



Anmeldungsdatum: 10.09.2005
Beiträge: 73

BeitragVerfasst am: 29.09.2005, 16:52    Titel: Antworten mit Zitat

Moin

wenn du es im Dateinamen haben willst, sollte ein angehängtes _gt die Lösung sein. Ich mache das mit einem _01 bis _56 oder so für die verschiedenen Versionen - so habe ich gleich Sichrheitskopien lächeln für die unbemerkten Fehler, die sich immer einschleichen.

CU2
Tilli
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC. Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz