fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Problem mit neuem Modul

Uploader:	FB_RML
Datum/Zeit:	06.04.2008 22:29:26
'raph ael gab mir im FreBasic-Forum den Tip, den Quellcode

'des Projektes hier einzustellen. Dies will ich gerne tun.

'Als Grundlage habe ich das Beispiel "OpenFile", das im

'Verzeichnis ...\Projects\Samples enthalten ist, verwendet.

'Das Modul OpenFile.Bas sieht jetzt so aus:



'_________________________________________________________

'Pfad = ...\FreeBasic\inc

#Include Once "windows.bi"

#Include Once "win/commdlg.bi"

#Include "OpenFile.bi"



Declare Sub FileOpen()



Declare Function DlgProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer



   'Dialogform anzeigen

   hInstance=GetModuleHandle(NULL)

   DialogBoxParam(hInstance,Cast(ZString Ptr,IDD_DLG1), NULL, @DlgProc, NULL)



   ExitProcess(0)

   End

'____________________________________________________________

Sub FileOpen()



   Dim hWin As HWND

   '250000 Zeichen als Leerstring vorgeben (Damit auch ganz viele Dateien ausgewählt werden können

   '(überflüssige Leerzeichen werden später wieder entfernt)

   Dim As String *250000 strFile = Space(249999)+ Chr(0)

   Dim OFN As OpenFileName, RetStr As String, Liste() As String

   Dim X As Integer, Y As Integer, Z As Integer



   Const szNULL=!"\0"

   Const szFilter   = "MP3-Dateien (*.mp3)" & szNULL & "*.mp3" & szNULL



   With OFN

      .lStructSize = SizeOf(OpenFileName)

      .hwndOwner = hWin

      .hInstance = hInstance

      '"Arbeitsplatz" als Ausgangsordner vorgeben - ansprechen über Class ID

      .lpstrInitialDir = StrPtr("::{20D04FE0-3AEA-1069-A2D8-08002B30309D}")

      .lpstrFile = StrPtr(strFile)

      .nMaxFile = SizeOf(strFile)

      .lpstrFilter = StrPtr(szFilter)

      .lpstrTitle = StrPtr(" MP3-Datei auswählen (Mehrfachauswahl möglich)")

      'Flags: &H200   = Mehrfachauswahl möglich

      '       &H4&    = Kontrollkästchen "Schreibgeschützt" wird versteckt

      '       &H80000 = Dialoge des Win-Explorer werden genutzt

      .flags = &H200 Or &H4& Or &H80000

   End With



   If GetOpenFileName(@OFN) Then

      Y = 0

      ReDim Liste(Y)

      RetStr = Trim(strFile)

      'Prüfen, ob Chr(0) im Rückgabestring enthalten (wenn ja -> mehrere Dateien markiert)

      If InStr(RetStr, Chr(0)) Then

         'Mehrere Dateien ausgwählt -> Rückgabestring zerlegen und in Liste aufnehmen (jeder Listen-

         'eintrag = eine Datei);   WICHTIG: Chr(0) anhängen - letzter Teil wird sonst "vergessen"

         RetStr = RetStr & Chr(0)

         Do While InStr(RetStr, Chr(0))

            X = InStr(RetStr, Chr(0))

            Liste(Y) = Left(RetStr, X - 1)

            'Rückgabestring um ausgelesenen Teil verkürzen

            RetStr = Right(RetStr, Len(RetStr) - X)

            Y = Y + 1

            ReDim Preserve Liste(Y)

         Loop



         For X = 1 To Ubound(Liste)

            'Liste(0) = Verzeichnis; jeweiliger Dateiname wird mit "\" & Liste(X) angehängt

            'MessageBox nur temporär zur Anzeige; Später werden Dateien an die Audiogenie.Dll

            'von Stefan Töngi übergeben

            MessageBox(hWin, Liste(0) & "\" & Liste(X), "Ausgewählte Datei", 64)

         Next

      Else

         'Nur eine Datei ausgewählt - RetStr enthält kompletten Pfad

         MessageBox(hWin, RetStr, "Ausgewählte Datei", 64)

      End If

   Else

      'Nix ausgewählt

      MessageBox(hWin, "Keine Dateien ausgewählt", "Keine Auswahl", 48)

   End If



End Sub

'____________________________________________________________

Function DlgProc(ByVal hWin As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, _

   ByVal lParam As LPARAM) As Integer



   Dim As Long id, Event, x, y

   Dim hBtn As HWND

   Dim rect As RECT

   Dim buff As ZString * 250



   Select Case uMsg

      Case WM_INITDIALOG

         '

      Case WM_CLOSE

         EndDialog(hWin, 0)

         '

      Case WM_COMMAND

         id=LoWord(wParam)

         Event=HiWord(wParam)

         Select Case id

            Case SF_FileOpen

               FileOpen()

               '

         End Select

      Case WM_SIZE

         '

      Case Else

         Return FALSE

         '

   End Select

   Return TRUE



End Function



'____________________________________________________________



'Das Modul OpenFile.Bi ist recht kurz:



#Define IDD_DLG1    1000

#Define SF_FileOpen 1001



Dim Shared hInstance As HINSTANCE







Im Modul OpenFile.Rc ist lediglich die Dialogform "IDD_DLG" mit einer Schalftfläche (Name= SF_FileOpen) enthalten.



Die OpenFile.fbp sieht so aus:

[Project]

Version=2

Description=Open file dialog

Api=fb (FreeBASIC),win (Windows)

Grouping=1

AddMainFiles=1

ResExport=

[Make]

Recompile=0

Module=Module Build,fbc -c

Current=1

1=Windows GUI,fbc -s gui

2=Windows GUI (Debug),fbc -s gui -g

Output=

Run=

[File]

1=OpenFile.Bas

2=OpenFile.Bi

3=OpenFile.Rc

1001=

4=

[FileInfo]

1=0,74,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

2=0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

3=0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

1001=0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

4=0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

[ReallyRad]

IDD_DLG1=,,



'Beim Anlegen eines neuen Modules und dem Verschieben der Sub

'FilenOpen() in dieses kommt es zu Problemen, die ich im

'Forum beschrieben habe.