|
Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
Autor |
Nachricht |
UBE
Anmeldungsdatum: 19.08.2005 Beiträge: 2
|
Verfasst am: 19.08.2005, 22:46 Titel: Problem mit BrowseForFolder |
|
|
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 |
|
|
UBE
Anmeldungsdatum: 19.08.2005 Beiträge: 2
|
Verfasst am: 20.08.2005, 11:35 Titel: Lösung |
|
|
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 |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005 Beiträge: 2624 Wohnort: Machteburch
|
Verfasst am: 25.09.2005, 16:27 Titel: Probleme mit BrowseForFolder |
|
|
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 ?
BTW:Lösungen sind immer interessant, man muß nur erst mal Probleme dafür finden
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 |
|
|
psygate
Anmeldungsdatum: 05.04.2005 Beiträge: 304 Wohnort: Wien und der Computer
|
Verfasst am: 25.09.2005, 21:26 Titel: |
|
|
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 |
|
|
tilli
Anmeldungsdatum: 10.09.2005 Beiträge: 73
|
Verfasst am: 29.09.2005, 16:52 Titel: |
|
|
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 für die unbemerkten Fehler, die sich immer einschleichen.
CU2
Tilli |
|
Nach oben |
|
|
|
|
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.
|
|