source: trunk/ConfigApps/MainFormUnit.pas

Last change on this file was 458, checked in by ataylor, 3 years ago

Update ConfigApps to use dynamic font size & scaling, version set to 1.2.1.
Added SetColumnWidth method to MultiColumnListBox control.
File size: 12.6 KB
RevLine 
[413]1Unit MainFormUnit;
2
3Interface
4
5Uses
[414]6 Classes, Forms, Graphics, StdCtrls, Buttons, MultiColumnListBox, Dialogs, ACLLanguageUnit;
[413]7
8const
[458]9 AppVersion = 'V1.2.1'; // $SS_REQUIRE_NEW_VERSION$
[413]10
11type
12 TProgramType =
13 (
14 idBrowser,
15 idMail,
16 idNews,
17 idFTP,
18 idIRC
19 );
20
21Type
22 TMainForm = Class (TForm)
23 PathEdit: TEdit;
24 BrowsePathButton: TButton;
25 SelectDirectoryButton: TButton;
26 WorkingDirectoryEdit: TEdit;
27 ItemsListbox: TMultiColumnListBox;
28 ApplyButton: TButton;
29 CloseButton: TButton;
30 PathLabel: TLabel;
31 WorkingDirectoryLabel: TLabel;
32 OpenDialog: TSystemOpenDialog;
33 ChangeDirDialog: TChangeDirDialog;
34 RestoreButton: TButton;
35 ParametersEdit: TEdit;
36 ParametersLabel: TLabel;
37 VersionLabel: TLabel;
[414]38 LngItems: String;
39 LngPath: String;
40 LngWebBrowser: String;
41 LngEmail: String;
42 LngNewsgroups: String;
43 LngFtp: String;
44 LngIrc: String;
45 LngDiscardChanges: String;
46 LngExitAndDiscardChanges: String;
47 LngFileDoesNotExist: String;
48 LngProgramNotFoundInPath: String;
49 LngDirectoryDoesNotExist: String;
50 LngSaveAnyway: String;
[458]51 Procedure MainFormOnSetupShow (Sender: TObject);
[413]52 Procedure ParametersEditOnChange (Sender: TObject);
53 Procedure RestoreButtonOnClick (Sender: TObject);
54 Procedure MainFormOnCloseQuery (Sender: TObject; Var CanClose: Boolean);
55 Procedure WorkingDirectoryEditOnChange (Sender: TObject);
56 Procedure ApplyButtonOnClick (Sender: TObject);
57 Procedure SelectDirectoryButtonOnClick (Sender: TObject);
58 Procedure BrowsePathButtonOnClick (Sender: TObject);
59 Procedure PathEditOnChange (Sender: TObject);
60 Procedure ItemsListboxOnItemFocus (Sender: TObject; Index: LongInt);
61 Procedure MainFormOnCreate (Sender: TObject);
62 Private
63 {Insert private declarations here}
64 FLastItem: TProgramType;
65 FLastItemSet: boolean;
66 Displaying: boolean;
67 Changed: boolean;
[414]68 Protected
69 Procedure OnLanguageEvent( Language: TLanguageFile; const Apply: boolean );
[413]70 Public
71 {Insert public declarations here}
72 Function SelectedType: TProgramType;
73 Procedure StoreEdits( P: TProgramType );
74 Procedure LoadCurrentSettings;
75 End;
76
77Var
78 MainForm: TMainForm;
79
80Implementation
81
82Uses
83 PMWin, PMSHL,
84 SysUtils,
85 ACLFileUtility, ACLUtility, ACLStringUtility,
86 ControlsUtility, ACLDialogs;
87
[414]88{$R Images}
89
[413]90type
91 TProgramSettings = record
92 ProgramType: TProgramType;
93 Name: string;
94 PathKey: string;
95 WorkingDirectoryKey: string;
96 ParametersKey: string;
97 end;
98
99 TCurrentSettings = record
100 Path: string;
101 WorkingDirectory: string;
102 Parameters: string;
103 end;
104
105const
106 Programs: array[ Low( TProgramType ).. High( TProgramType ) ] of TProgramSettings =
107 (
108 ( ProgramType: idBrowser;
109 Name: 'Web Browser';
110 PathKey: 'DefaultBrowserExe';
111 WorkingDirectoryKey: 'DefaultWorkingDir';
112 ParametersKey: 'DefaultParameters' ),
113 ( ProgramType: idMail;
114 Name: 'Email';
115 PathKey: 'DefaultMailExe';
116 WorkingDirectoryKey: 'DefaultMailWorkingDir';
117 ParametersKey: 'DefaultMailParameters' ),
118 ( ProgramType: idNews;
119 Name: 'Newsgroups';
120 PathKey: 'DefaultNewsExe';
121 WorkingDirectoryKey: 'DefaultNewsWorkingDir';
122 ParametersKey: 'DefaultNewsParameters' ),
123 ( ProgramType: idFTP;
124 Name: 'FTP';
125 PathKey: 'DefaultFTPExe';
126 WorkingDirectoryKey: 'DefaultFTPWorkingDir';
127 ParametersKey: 'DefaultFTPParameters' ),
128 ( ProgramType: idIRC;
129 Name: 'IRC';
130 PathKey: 'DefaultIRCExe';
131 WorkingDirectoryKey: 'DefaultIRCWorkingDir';
132 ParametersKey: 'DefaultIRCParameters' )
133 );
134
135var
[414]136 ProgramNames: array[ Low( TProgramType ).. High( TProgramType ) ] of String = (
137 'Web Browser', 'Email', 'Newsgroups', 'FTP', 'IRC'
138 );
139
[413]140 CurrentSettings: array[ Low( TProgramType ).. High( TProgramType ) ] of TCurrentSettings;;
141
142Procedure SetProgramPath( P: TProgramSettings;
143 const V: string );
144begin
145 SetUserProfileString( 'WPURLDEFAULTSETTINGS',
146 P.PathKey,
147 V );
148end;
149
150Procedure SetWorkingDirectory( P: TProgramSettings;
151 const V: string );
152begin
153 SetUserProfileString( 'WPURLDEFAULTSETTINGS',
154 P.WorkingDirectoryKey,
155 V );
156end;
157
158Procedure SetParameters( P: TProgramSettings;
159 Const V: string );
160begin
161 SetUserProfileString( 'WPURLDEFAULTSETTINGS',
162 P.ParametersKey,
163 V );
164end;
165
166Function GetProgramPath( P: TProgramSettings ): string;
167begin
168 Result := GetUserProfileString( 'WPURLDEFAULTSETTINGS',
169 P.PathKey,
170 '' );
171end;
172
173Function GetWorkingDirectory( P: TProgramSettings ): string;
174begin
175 Result := GetUserProfileString( 'WPURLDEFAULTSETTINGS',
176 P.WorkingDirectoryKey,
177 '' );
178end;
179
180Function GetParameters( P: TProgramSettings ): string;
181begin
182 Result := GetUserProfileString( 'WPURLDEFAULTSETTINGS',
183 P.ParametersKey,
184 '' );
185end;
186
[458]187Procedure TMainForm.MainFormOnSetupShow (Sender: TObject);
188Begin
189 ScaleForm( self, 7, 14 );
190 ItemsListBox.SetColumnWidth( 0, trunc( Width * 0.3 ));
191End;
192
[413]193Procedure TMainForm.ParametersEditOnChange (Sender: TObject);
194Begin
195 if not Displaying then
196 Changed := true;
197End;
198
199Procedure TMainForm.RestoreButtonOnClick (Sender: TObject);
200Begin
201 LoadCurrentSettings;
202End;
203
204Procedure TMainForm.MainFormOnCloseQuery (Sender: TObject;
205 Var CanClose: Boolean);
206Begin
207 if Changed then
[414]208 if not DoConfirmDlg( LngDiscardChanges,
209 LngExitAndDiscardChanges ) then
[413]210 CanClose := false;
211
212End;
213
214Procedure TMainForm.WorkingDirectoryEditOnChange (Sender: TObject);
215Begin
216 if not Displaying then
217 Changed := true;
218
219End;
220
221Procedure TMainForm.ApplyButtonOnClick (Sender: TObject);
222var
223 ProgramType: TProgramType;
224 P: TProgramSettings;
225 FoundPath: string; // dummy
226Begin
227 StoreEdits( SelectedType );
228 // validate.
229 for ProgramType := Low( TProgramType ) to High( TProgramType ) do
230 begin
231 p := Programs[ ProgramType ];
232
233 with CurrentSettings[ ProgramType ] do
234 begin
235 if Trim( Path ) <> '' then
236 begin
237 if ExtractFilePath( Path ) <> '' then
238 begin
239 // they specified a path...
240 if not FileExists( Path ) then
[414]241 if not DoConfirmDlg( ProgramNames[ ProgramType ],
242 LngFileDoesNotExist + EndLine
[413]243 + Path + EndLine
[414]244 + LngSaveAnyway ) then
[413]245 exit;
246 end
247 else
248 begin
249 // no directory, search path
250 if not SearchPath( 'PATH',
251 Path,
252 FoundPath ) then
[414]253 if not DoConfirmDlg( ProgramNames[ ProgramType ],
254 LngProgramNotFoundInPath + EndLine
[413]255 + Path + EndLine
[414]256 + LngSaveAnyway ) then
[413]257 exit;
258 end;
259 if not DirectoryExists( WorkingDirectory ) then
[414]260 if not DoConfirmDlg( ProgramNames[ ProgramType ],
261 LngDirectoryDoesNotExist + EndLine
262 + WorkingDirectory + EndLine
263 + LngSaveAnyway ) then
[413]264 exit;
265 end;
266 end;
267 end;
268
269 for ProgramType := Low( TProgramType ) to High( TProgramType ) do
270 begin
271 p := Programs[ ProgramType ];
272
273 SetProgramPath( P, CurrentSettings[ ProgramType ].Path );
274 SetWorkingDirectory( P, CurrentSettings[ ProgramType ].WorkingDirectory );
275 SetParameters( p, CurrentSettings[ ProgramType ].Parameters );
276 end;
277
278 Changed := false;
279End;
280
281Procedure TMainForm.SelectDirectoryButtonOnClick (Sender: TObject);
282Begin
283 ChangeDirDialog.Directory := WorkingDirectoryEdit.Text;
284 if not ChangeDirDialog.Execute then
285 exit;
286 WorkingDirectoryEdit.Text := ChangeDirDialog.Directory;
287End;
288
289Procedure TMainForm.BrowsePathButtonOnClick (Sender: TObject);
290Begin
291 OpenDialog.Filename := ExtractFilePath( PathEdit.Text ) + '*.exe' ;
292 if not OpenDialog.Execute then
293 exit;
294
295 PathEdit.Text := OpenDialog.FileName;
296End;
297
298Procedure TMainForm.PathEditOnChange (Sender: TObject);
299Begin
300 if not Displaying then
301 begin
302 StoreEdits( SelectedType );
303 Changed := true;
304 end;
305End;
306
307Function TMainForm.SelectedType: TProgramType;
308begin
309 Result := TProgramType( ItemsListBox.Items.Objects[ ItemsListBox.ItemIndex ] );
310end;
311
312Procedure TMainForm.StoreEdits( P: TProgramType );
313var
314 i: longint;
315begin
316 CurrentSettings[ P ].Path := PathEdit.Text;
317 CurrentSettings[ P ].WorkingDirectory := WorkingDirectoryEdit.Text;
318 CurrentSettings[ P ].Parameters := ParametersEdit.Text;
319
320 for i := 0 to ItemsListBox.Items.Count - 1 do
321 if TProgramType( ItemsListBox.Items.Objects[ i ] ) = p then
[414]322 ItemsListBox.Items[ i ] := ProgramNames[ p ]
[413]323 + #9
324 + PathEdit.Text;
325end;
326
327Procedure TMainForm.ItemsListboxOnItemFocus (Sender: TObject; Index: LongInt);
328Begin
329 if FLastItemSet then
330 begin
331 StoreEdits( FLastItem );
332 end;
333
334 Displaying := true;
335 PathEdit.Text := CurrentSettings[ SelectedType ].Path;
336 WorkingDirectoryEdit.Text := CurrentSettings[ SelectedType ].WorkingDirectory;
337 ParametersEdit.Text := CurrentSettings[ SelectedType ].Parameters;
338
339 Displaying := false;
340 FLastItem := SelectedType;
341 FLastItemSet := true;
342End;
343
344Procedure TMainForm.MainFormOnCreate (Sender: TObject);
345Begin
346 Font := GetNiceDefaultFont;
347
[414]348 Forms.FormIconResourceID := 1;
349
350 RegisterForLanguages( OnLanguageEvent );
351
[413]352 VersionLabel.Caption := AppVersion;
[414]353 LoadDefaultLanguage('cfgapps');
[413]354 LoadCurrentSettings;
[414]355
[416]356 if Width > Screen.Width then
357 Width := Screen.Width;
358 if Height > Screen.Height then
359 Height := Screen.Height;
360 Left := ( Screen.Width - Width ) div 2;
361 Bottom := ( Screen.Height - Height ) div 2;
362
[458]363 ItemsListBox.ItemHeight := Font.Height + 2;
364 ItemsListBox.HeaderHeight := Font.Height + 2;
365
[413]366end;
367
368Procedure TMainForm.LoadCurrentSettings;
369var
370 ProgramType: TProgramType;
371 P: TProgramSettings;
372begin
373 ItemsListBox.Items.Clear;
374 for ProgramType := Low( TProgramType ) to High( TProgramType ) do
375 begin
376 p := Programs[ ProgramType ];
377 CurrentSettings[ ProgramType ].Path := GetProgramPath( p );
378 CurrentSettings[ ProgramType ].WorkingDirectory := GetWorkingDirectory( p );
379 CurrentSettings[ ProgramType ].Parameters := GetParameters( p );
380
[414]381 ItemsListBox.Items.AddObject( ProgramNames[ ProgramType ]
[413]382 + #9
383 + CurrentSettings[ ProgramType ].Path,
384 TObject( P.ProgramType ) );
385 end;
386
387 FLastItemSet := false;
388 Displaying := false;
389 Changed := false;
390 ItemsListBox.ItemIndex := 0;
391End;
392
[414]393Procedure TMainForm.OnLanguageEvent( Language: TLanguageFile;
394 const Apply: boolean );
395Var
396 ProgramType: TProgramType;
397 P: TProgramSettings;
398Begin
399 Language.LoadComponentLanguage( self, Apply );
400
401 Language.LL( Apply, LngWebBrowser, 'ProgramWebBrowser', 'Web Browser' );
402 Language.LL( Apply, LngEmail, 'ProgramEmail', 'Email' );
403 Language.LL( Apply, LngNewsgroups, 'ProgramNewsgroups', 'Newsgroups' );
404 Language.LL( Apply, LngFtp, 'ProgramFTP', 'FTP' );
405 Language.LL( Apply, LngIrc, 'ProgramIRC', 'IRC' );
406 Language.LL( Apply, LngDiscardChanges, 'DiscardChanges', 'Discard changes?' );
407 Language.LL( Apply, LngExitAndDiscardChanges, 'ExitAndDiscardChanges', 'Exit and discard changes?' );
408 Language.LL( Apply, LngFileDoesNotExist, 'FileDoesNotExist', 'File does not exist: ' );
409 Language.LL( Apply, LngProgramNotFoundInPath, 'ProgramNotFoundInPath', 'Program not found in path: ' );
410 Language.LL( Apply, LngDirectoryDoesNotExist, 'DirectoryDoesNotExist', 'Directory does not exist: ' );
411 Language.LL( Apply, LngSaveAnyway, 'SaveAnyway', 'Save anyway?' );
412
413 ProgramNames[ idBrowser ] := LngWebBrowser;
414 ProgramNames[ idMail ] := LngEmail;
415 ProgramNames[ idNews ] := LngNewsgroups;
416 ProgramNames[ idFTP ] := LngFtp;
417 ProgramNames[ idIRC ] := LngIrc;
418
419End;
420
[413]421Initialization
422 RegisterClasses ([TMainForm, TEdit, TButton, TMultiColumnListBox, TLabel,
423 TSystemOpenDialog, TChangeDirDialog]);
424End.
Note: See TracBrowser for help on using the repository browser.