1 {(*}
2 (*------------------------------------------------------------------------------
3 Delphi Code formatter source code
4
5 The Original Code is fMain.pas, released April 2000.
6 The Initial Developer of the Original Code is Anthony Steele.
7 Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
8 All Rights Reserved.
9 Contributor(s): Michael Beck.
10
11 The contents of this file are subject to the Mozilla Public License Version 1.1
12 (the "License"). you may not use this file except in compliance with the License.
13 You may obtain a copy of the License at http://www.mozilla.org/NPL/
14
15 Software distributed under the License is distributed on an "AS IS" basis,
16 WITHOUT WARRANTY OF ANY KIND, either express or implied.
17 See the License for the specific language governing rights and limitations
18 under the License.
19
20 Alternatively, the contents of this file may be used under the terms of
21 the GNU General Public License Version 2 or later (the "GPL")
22 See http://www.gnu.org/licenses/gpl.html
23 ------------------------------------------------------------------------------*)
24 {*)}
25
26 unit fMain;
27
28 { Created AFS 27 November 1999
29 Main form for code formatting utility program
30 }
31
32
33 {$I ..\Include\JcfGlobal.inc}
34
35 interface
36
37 uses
38 { delphi }
39 SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Menus,
40 ActnList, StdActns, ToolWin, ImgList, ShellAPI,
41 { local }
42 FileConverter, JcfSettings, ConvertTypes,
43 frBasicSettings, JvMRUManager, JvFormPlacement,
44 JvMemo, frDrop, frmBaseSettingsFrame, JvComponent, JvExStdCtrls,
45 JvComponentBase;
46
47 type
48 TfrmMain = class(TForm)
49 mnuMain: TMainMenu;
50 mnuFile: TMenuItem;
51 mnuGo: TMenuItem;
52 mnuClose: TMenuItem;
53 mnuHelp: TMenuItem;
54 mnuAbout: TMenuItem;
55 tlbTop: TToolBar;
56 tbtnOpenFiles: TToolButton;
57 btnGo: TToolButton;
58 btnAbout: TToolButton;
59 tbtnToolButton6: TToolButton;
60 btnSettings: TToolButton;
61 ilStandardImages: TImageList;
62 tbtnToolButton8: TToolButton;
63 tbtnToolButton2: TToolButton;
64 ActionList: TActionList;
65 aOpenFiles: TAction;
66 aOptions: TAction;
67 aGo: TAction;
68 aAbout: TAction;
69 aExit: TAction;
70 tbtnToolButton4: TToolButton;
71 btnClose: TToolButton;
72 OpenFile1: TMenuItem;
73 mnuFormatSettings: TMenuItem;
74 mnuViewLog: TMenuItem;
75 dlgSaveConfig: TSaveDialog;
76 actHelpContents: THelpContents;
77 mnuContents: TMenuItem;
78 tbHelp: TToolButton;
79 mnuSettings: TMenuItem;
80 mnuRegistrySettings: TMenuItem;
81 mruFiles: TJvMRUManager;
82 dlgOpen: TOpenDialog;
83 frBasic: TfrBasic;
84 N1: TMenuItem;
85 mnuSaveSettingsAs: TMenuItem;
86 aSaveSettingsAs: TAction;
87 JvFormStorage1: TJvFormStorage;
88 mOutput: TJvMemo;
89 lblLog: TLabel;
90 N2: TMenuItem;
91 procedure FormCreate(Sender: TObject);
92 procedure FormDestroy(Sender: TObject);
93 procedure mnuGoClick(Sender: TObject);
94 procedure mnuCloseClick(Sender: TObject);
95 procedure aFormatExecute(Sender: TObject);
96 procedure aAboutExecue(Sender: TObject);
97 procedure aExitExecute(Sender: TObject);
98 procedure mnuAboutClick(Sender: TObject);
99 procedure aOpenFilesExecute(Sender: TObject);
100 procedure aOptionsExecute(Sender: TObject);
101 procedure mnuViewLogClick(Sender: TObject);
102 procedure mnuSaveSettingsAsClick(Sender: TObject);
103 procedure actHelpContentsExecute(Sender: TObject);
104 procedure mnuRegistrySettingsClick(Sender: TObject);
105 procedure mruFilesClick(Sender: TObject; const RecentName, Caption: string;
106 UserData: integer);
107 procedure FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
108 procedure FormResize(Sender: TObject);
109 procedure frBasicsbOpenClick(Sender: TObject);
110 private
111 fcConverter: TFileConverter;
112
113 procedure ShowStatusMesssage(const psFile, psMessage: string;
114 const peMessageType: TStatusMessageType;
115 const piY, piX: integer);
116
117 procedure DoFormat;
118 procedure ShowAbout;
119 procedure SettingsChange(Sender: TObject);
120
121 public
122 end;
123
124 var
125 frmMain: TfrmMain;
126
127 implementation
128
129 {$ifdef FPC}
130 {$R *.lfm}
131 {$else}
132 {$R *.dfm}
133 {$endif}
134
135 uses
136 { deplhi }
137 Windows,
138 { jcl }
139 JclFileUtils,
140 { local }
141 fAbout, fAllSettings, fRegistrySettings,
142 SettingsStream, JcfHelp, JcfRegistrySettings, JcfFontSetFunctions;
143
OkDialognull144 function OkDialog(const psMsg: string): boolean;
145 begin
146 Result := MessageDlg(psMsg, mtWarning, [mbYes, mbCancel], 0) = mrYes;
147 end;
148
149 procedure ErrorDialog(const psMsg: string);
150 begin
151 MessageDlg(psMsg, mtError, [mbOK], 0);
152 end;
153
154 {------------------------------------------------------------------------------
155 worker procs }
156
157
158 procedure TfrmMain.DoFormat;
159 var
160 lcRegSet: TJCFRegistrySettings;
161 lsSource, lsFileDesc, lsMessage: string;
162 begin
163 frBasic.Write;
164
165 lcRegSet := GetRegSettings;
166
167 lsSource := lcRegSet.Input;
168
169 if (lcRegSet.SourceMode = fmSingleFile) and (ExtractFileName(lsSource) = '') then
170 begin
171 ErrorDialog('No file specified in direcory');
172 Exit;
173 end;
174
175 if (lsSource = '') then
176 begin
177 ErrorDialog('No files to format');
178 exit;
179 end;
180
181 if lcRegSet.SourceMode = fmSingleFile then
182 lsFileDesc := 'the file ' + ExtractFileName(lsSource)
183 else
184 lsFileDesc := 'the files in ' + lsSource;
185
186 { confirm before obfuscate }
187 if FormatSettings.Obfuscate.Enabled then
188 begin
189 lsMessage := 'Are you sure that you want to obfuscate ' + lsFileDesc;
190
191 if lcRegSet.BackupMode = cmInPlace then
192 lsMessage := lsMessage + ' without backup';
193
194 lsMessage := lsMessage + '?';
195 if not OkDialog(lsMessage) then
196 exit;
197 end
198 else if (lcRegSet.BackupMode = cmInPlace) then
199 begin
200 lsMessage := 'Are you sure you want to convert ' + lsFileDesc + ' without backup?';
201 if not OkDialog(lsMessage) then
202 exit;
203 end;
204
205 fcConverter.Input := lsSource;
206 fcConverter.BackupMode := frBasic.GetCurrentBackupMode;
207 fcConverter.SourceMode := frBasic.GetCurrentSourceMode;
208
209 fcConverter.Convert;
210 end;
211
212 procedure TfrmMain.ShowAbout;
213 var
214 fAbout: TfrmAboutBox;
215 begin
216 fAbout := TfrmAboutBox.Create(self);
217 try
218 fAbout.ShowModal;
219 finally
220 fAbout.Release;
221 end;
222 end;
223
224
225
226 {------------------------------------------------------------------------------
227 event handlers}
228
229 procedure TfrmMain.FormCreate(Sender: TObject);
230 begin
231 SetObjectFontToSystemFont(Self);
232
233 Application.HelpFile := GetHelpFilePath;
234
235 Randomize;
236
237 GetRegSettings.MRUFiles := mruFiles.Strings;
238 GetRegSettings.ReadAll;
239
240 fcConverter := TFileConverter.Create;
241 fcConverter.OnStatusMessage := ShowStatusMesssage;
242
243 frBasic.mruFiles := mruFiles;
244 frBasic.Read;
245 frBasic.OnChange := SettingsChange;
246 SettingsChange(nil);
247
248 FormResize(nil);
249 end;
250
251 procedure TfrmMain.FormDestroy(Sender: TObject);
252 begin
253 frBasic.Write;
254 FreeAndNil(fcConverter);
255
256 GetRegSettings.WriteAll;
257 GetRegSettings.MRUFiles := nil;
258 end;
259
260
261 procedure TfrmMain.ShowStatusMesssage(const psFile, psMessage: string;
262 const peMessageType: TStatusMessageType;
263 const piY, piX: integer);
264 var
265 lsMessage: string;
266 begin
267 { show the message }
268 lsMessage := psMessage;
269 if (piX > 0) and (piY > 0) then
270 lsMessage := lsMessage + ' near line ' + IntToStr(piY) + ' col ' + IntToStr(piX);
271 mOutput.Lines.Add(lsMessage);
272
273 { scroll into view and check the srollbar }
274 mOutput.CurrentLine := mOutput.Lines.Count - 1;
275 if mOutput.Lines.Count > 1 then
276 mOutput.ScrollBars := ssVertical
277 else
278 mOutput.ScrollBars := ssNone;
279
280 Application.ProcessMessages;
281 end;
282
283 procedure TfrmMain.mnuGoClick(Sender: TObject);
284 begin
285 DoFormat;
286 end;
287
288 procedure TfrmMain.mnuCloseClick(Sender: TObject);
289 begin
290 Close;
291 end;
292
293 procedure TfrmMain.aFormatExecute(Sender: TObject);
294 begin
295 DoFormat;
296 end;
297
298 procedure TfrmMain.aAboutExecue(Sender: TObject);
299 begin
300 ShowAbout;
301 end;
302
303 procedure TfrmMain.aExitExecute(Sender: TObject);
304 begin
305 Close;
306 end;
307
308 procedure TfrmMain.mnuAboutClick(Sender: TObject);
309 begin
310 ShowAbout;
311 end;
312
313 procedure TfrmMain.aOpenFilesExecute(Sender: TObject);
314 begin
315 frBasic.DoFileOpen;
316 end;
317
318 procedure TfrmMain.aOptionsExecute(Sender: TObject);
319 var
320 lfSet: TFormAllSettings;
321 begin
322 lfSet := TFormAllSettings.Create(Self);
323 try
324 lfSet.Execute;
325 frBasic.DisplayOutputFile;
326 finally
327 lfSet.Release;
328 end;
329 end;
330
331 procedure TfrmMain.SettingsChange(Sender: TObject);
332 begin
333 btnGo.Hint := frBasic.GetGoHint;
334
335 if frBasic.GetCurrentSourceMode = fmSingleFile then
336 tbtnOpenFiles.Hint := 'Select a source file'
337 else
338 tbtnOpenFiles.Hint := 'Select a source directory';
339 end;
340
341 procedure TfrmMain.mnuViewLogClick(Sender: TObject);
342 begin
343 GetRegSettings.ViewLog;
344 end;
345
346
347 const
348 CONFIG_FILTER = 'Config files (*.cfg)|*.cfg|Text files (*.txt)|' +
349 '*.txt|XML files (*.xml)|*.xml|All files (*.*)|*.*';
350
351 procedure TfrmMain.mnuSaveSettingsAsClick(Sender: TObject);
352 var
353 lsName: string;
354 dlgSaveConfig: TSaveDialog;
355 lcFile: TSettingsStreamOutput;
356 begin
357 lsName := '';
358
359 dlgSaveConfig := TSaveDialog.Create(self);
360 try
361 dlgSaveConfig.FileName := 'Saved.cfg';
362 dlgSaveConfig.InitialDir := ExtractFilePath(Application.ExeName);
363 dlgSaveConfig.DefaultExt := '.cfg';
364 dlgSaveCOnfig.Filter := CONFIG_FILTER;
365
366 if dlgSaveConfig.Execute then
367 begin
368 lsName := dlgSaveCOnfig.FileName;
369 end;
370
371 if lsName = '' then
372 exit;
373
374 finally
375 dlgSaveConfig.Free;
376 end;
377
378 lcFile := TSettingsStreamOutput.Create(lsName);
379 try
380 FormatSettings.ToStream(lcFile);
381 finally
382 lcFile.Free;
383 end;
384 end;
385
386 procedure TfrmMain.actHelpContentsExecute(Sender: TObject);
387 begin
388 try
389 Application.HelpContext(HELP_MAIN);
390 except
391 if FileExists(Application.HelpFile) then
392 ShellExecute(Handle, 'open', PChar(Application.HelpFile), nil, nil, SW_SHOWNORMAL);
393 end;
394 end;
395
396 procedure TfrmMain.mnuRegistrySettingsClick(Sender: TObject);
397 var
398 lfSettings: TfmRegistrySettings;
399 begin
400 lfSettings := TfmRegistrySettings.Create(self);
401 try
402 lfSettings.Execute;
403 frBasic.DisplayOutputFile;
404 finally
405 lfSettings.Release;
406 end;
407 end;
408
409 procedure TfrmMain.mruFilesClick(Sender: TObject; const RecentName, Caption: string;
410 UserData: integer);
411 begin
412 frBasic.DoFileOpen(RecentName);
413 end;
414
415 procedure TfrmMain.FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState);
416 begin
417 if Key = VK_F1 then
418 try
419 Application.HelpContext(HELP_MAIN);
420 except
421 if FileExists(Application.HelpFile) then
422 ShellExecute(Handle, 'open', PChar(Application.HelpFile),
423 nil, nil, SW_SHOWNORMAL);
424 end;
425 end;
426
427 procedure TfrmMain.FormResize(Sender: TObject);
428 begin
429 {frBasic.Left := 0;
430 frBasic.Top := tlbTop.Top + tlbTop.Height;
431 frBasic.Width := ClientWidth;
432
433 mOutput.Left := 2;
434 mOutput.Width := ClientWidth - 4;
435 mOutput.Top := lblLog.Top + lblLog.Height + 4;
436 mOutput.Height := ClientHeight - (mOutput.Top + 4);}
437 end;
438
439 procedure TfrmMain.frBasicsbOpenClick(Sender: TObject);
440 begin
441 frBasic.sbOpenClick(Sender);
442 end;
443
444 end.
445