Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/musikbox/trunk/Config.pas
Revision: 2
Committed: Sat Nov 10 16:57:29 2018 UTC (22 months, 1 week ago) by daniel-marschall
Content type: text/x-pascal
File size: 4002 byte(s)
Log Message:
Released source code of version 1.5 (20 February 2007) into SVN

File Contents

# Content
1 unit Config;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls,
7 ActnList, StdActns, ShlObj;
8
9 type
10 TConfigForm = class(TForm)
11 btnAbbrechen: TButton;
12 btnSpeichern: TButton;
13 grpMusikOrdner: TGroupBox;
14 lstMusikOrdner: TListBox;
15 btnOrdnerErstellen: TButton;
16 btnOrdnerEntfernen: TButton;
17 procedure btnAbbrechenClick(Sender: TObject);
18 procedure btnSpeichernClick(Sender: TObject);
19 procedure FormShow(Sender: TObject);
20 procedure btnOrdnerEntfernenClick(Sender: TObject);
21 procedure btnOrdnerErstellenClick(Sender: TObject);
22 private
23 lg_StartFolder: String;
24 end;
25
26 var
27 ConfigForm: TConfigForm;
28
29 implementation
30
31 uses
32 Main;
33
34 {$R *.dfm}
35
36 procedure TConfigForm.btnAbbrechenClick(Sender: TObject);
37 begin
38 close;
39 end;
40
41 procedure TConfigForm.btnSpeichernClick(Sender: TObject);
42 var
43 i: integer;
44 begin
45 setlength(MainForm.MusikArray, 0);
46 for i := 0 to lstMusikOrdner.Items.Count-1 do
47 begin
48 setlength(MainForm.MusikArray, length(MainForm.MusikArray)+1);
49 MainForm.MusikArray[length(MainForm.MusikArray)-1] := lstMusikOrdner.Items.Strings[i];
50 end;
51
52 MainForm.InitDirectories();
53 MainForm.SchreibeEinstellung();
54
55 close;
56 end;
57
58 procedure TConfigForm.FormShow(Sender: TObject);
59 var
60 i: integer;
61 begin
62 lstMusikOrdner.Items.Clear;
63 for i := 0 to length(MainForm.MusikArray)-1 do
64 lstMusikOrdner.Items.Add(MainForm.MusikArray[i]);
65 end;
66
67 procedure TConfigForm.btnOrdnerEntfernenClick(Sender: TObject);
68 begin
69 if lstMusikOrdner.ItemIndex <> -1 then
70 lstMusikOrdner.Items.Delete(lstMusikOrdner.ItemIndex);
71 end;
72
73 ///////////////////////////////////////////////////////////////////
74 // Call back function used to set the initial browse directory.
75 ///////////////////////////////////////////////////////////////////
76 function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT;
77 lParam, lpData: LPARAM): Integer stdcall;
78 begin
79 if uMsg = BFFM_INITIALIZED then
80 SendMessage(Wnd,BFFM_SETSELECTION,1,Integer(@configform.lg_StartFolder[1]));
81 result := 0;
82 end;
83
84 ///////////////////////////////////////////////////////////////////
85 // This function allows the user to browse for a folder
86 //
87 // Arguments:-
88 // browseTitle : The title to display on the browse dialog.
89 // NewFolder : Allow to create a new folder
90 // initialFolder : Optional argument. Use to specify the folder
91 // initially selected when the dialog opens.
92 //
93 // Returns: The empty string if no folder was selected (i.e. if the
94 // user clicked cancel), otherwise the full folder path.
95 ///////////////////////////////////////////////////////////////////
96 function BrowseForFolder(const browseTitle: String; const NewFolder: boolean = false;
97 const initialFolder: String =''): String;
98 var
99 browse_info: TBrowseInfo;
100 folder: array[0..MAX_PATH] of char;
101 find_context: PItemIDList;
102 const
103 BIF_NEWDIALOGSTYLE=$40;
104 begin
105 FillChar(browse_info,SizeOf(browse_info),#0);
106 configform.lg_StartFolder := initialFolder;
107 browse_info.pszDisplayName := @folder[0];
108 browse_info.lpszTitle := PChar(browseTitle);
109 if NewFolder then
110 browse_info.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE
111 else
112 browse_info.ulFlags := BIF_RETURNONLYFSDIRS;
113 browse_info.hwndOwner := Application.Handle;
114 if initialFolder <> '' then
115 browse_info.lpfn := BrowseForFolderCallBack;
116 find_context := SHBrowseForFolder(browse_info);
117 if Assigned(find_context) then
118 begin
119 if SHGetPathFromIDList(find_context,folder) then
120 result := folder
121 else
122 result := '';
123 GlobalFreePtr(find_context);
124 end
125 else
126 result := '';
127 end;
128
129 procedure TConfigForm.btnOrdnerErstellenClick(Sender: TObject);
130 var
131 fol: string;
132 begin
133 fol := BrowseForFolder('Neuen Ordner hinzuf├╝gen', true, 'C:\');
134 if fol <> '' then
135 lstMusikOrdner.Items.Add(fol);
136 end;
137
138 end.