source: trunk/UCore.pas@ 93

Last change on this file since 93 was 90, checked in by chronos, 3 years ago
  • Modified: Build under Lazarus 2.2.0.
  • Modified: Updated Common package.
  • Added: Read Me file with app description and development information.
  • Added: Test form available in debug mode from Tools menu with list of test cases to better support app testability.
File size: 16.8 KB
Line 
1unit UCore;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, FileUtil, Controls, ActnList, Forms, Dialogs, ExtCtrls,
9 ULastOpenedList, UApplicationInfo, UPersistentForm, UScaleDPI, UCommon,
10 UTranslator, UDataFile, Menus, URegistry, UTheme, UAboutDialog, Registry;
11
12type
13
14 { TCore }
15
16 TCore = class(TDataModule)
17 AAbout: TAction;
18 AboutDialog1: TAboutDialog;
19 ATest: TAction;
20 AFind: TAction;
21 AFileSplit: TAction;
22 AGenerate: TAction;
23 AFindDuplicate: TAction;
24 AFileCombine: TAction;
25 ASettings: TAction;
26 AFileOpenRecent: TAction;
27 AHomePage: TAction;
28 AFileClose: TAction;
29 AFileSaveAs: TAction;
30 AFileSave: TAction;
31 AFileOpen: TAction;
32 AFileNew: TAction;
33 AExit: TAction;
34 ActionList1: TActionList;
35 ApplicationInfo1: TApplicationInfo;
36 SelectDirectoryDialog1: TSelectDirectoryDialog;
37 Translator: TTranslator;
38 ImageList1: TImageList;
39 LastOpenedList1: TLastOpenedList;
40 OpenDialog1: TOpenDialog;
41 PersistentForm1: TPersistentForm;
42 SaveDialog1: TSaveDialog;
43 ScaleDPI1: TScaleDPI;
44 ThemeManager1: TThemeManager;
45 procedure AAboutExecute(Sender: TObject);
46 procedure AExitExecute(Sender: TObject);
47 procedure AFileCombineExecute(Sender: TObject);
48 procedure AFileNewExecute(Sender: TObject);
49 procedure AFileOpenExecute(Sender: TObject);
50 procedure AFileOpenRecentExecute(Sender: TObject);
51 procedure AFileSaveExecute(Sender: TObject);
52 procedure AFileSaveAsExecute(Sender: TObject);
53 procedure AFileCloseExecute(Sender: TObject);
54 procedure AFileSplitExecute(Sender: TObject);
55 procedure AFindDuplicateExecute(Sender: TObject);
56 procedure AFindExecute(Sender: TObject);
57 procedure AGenerateExecute(Sender: TObject);
58 procedure AHomePageExecute(Sender: TObject);
59 procedure ASettingsExecute(Sender: TObject);
60 procedure ATestExecute(Sender: TObject);
61 procedure DataModuleCreate(Sender: TObject);
62 procedure DataModuleDestroy(Sender: TObject);
63 procedure LastOpenedList1Change(Sender: TObject);
64 private
65 InitializeStarted: Boolean;
66 InitializeFinished: Boolean;
67 LoadErrors: string;
68 ProfileImage: TImage;
69 LastSplitDir: string;
70 ProfilePhotoFileName: string;
71 procedure FileModified(Sender: TObject);
72 function FindFirstNonOption: string;
73 procedure UpdateFile;
74 procedure LoadConfig;
75 procedure SaveConfig;
76 procedure DoError(Text: string; Line: Integer);
77 public
78 DefaultDataFileClass: TDataFileClass;
79 DataFile: TDataFile;
80 FileClosed: Boolean;
81 ReopenLastFileOnStart: Boolean;
82 LastContactTabIndex: Integer;
83 LastContactFileName: string;
84 LastPropertyValueFileName: string;
85 GenerateCount: Integer;
86 ToolbarVisible: Boolean;
87 DefaultVcardVersion: string;
88 function GetProfileImage: TImage;
89 procedure FileNew;
90 procedure FileOpen(FileName: string);
91 procedure FileClose;
92 procedure Initialize;
93 procedure UpdateInterface;
94 end;
95
96var
97 Core: TCore;
98
99
100implementation
101
102{$R *.lfm}
103
104uses
105 UFormMain, UFormSettings, UContact, UFormContacts, UFormFindDuplicity,
106 UFormGenerate, UFormError, UFormFind, UFormTest;
107
108resourcestring
109 SAppExit = 'Application exit';
110 SAppExitQuery = 'File was modified. Do you want to save it before exit?';
111 SFileSplit = 'Contacts split';
112 SFileSplitFinishedOpenDirectory = 'Total %d contact files saved. Do you want to open the directory %s?';
113 SFileNotFound = 'File ''%s'' not found.';
114 SCombinedContacts = 'Combined %d contact files.';
115 SLine = 'Line %d: %s';
116
117{ TCore }
118
119procedure TCore.AExitExecute(Sender: TObject);
120begin
121 FormMain.Close;
122end;
123
124procedure TCore.AFileCombineExecute(Sender: TObject);
125var
126 TempFile: TDataFile;
127 I: Integer;
128 LoadedFiles: Integer;
129begin
130 TempFile := DefaultDataFileClass.Create;
131 try
132 OpenDialog1.Filter := TempFile.GetFileFilter;
133 finally
134 TempFile.Free;
135 end;
136 OpenDialog1.DefaultExt := '';
137 if Assigned(DataFile) then begin
138 OpenDialog1.InitialDir := ExtractFileDir(DataFile.FileName);
139 OpenDialog1.FileName := ExtractFileName(DataFile.FileName);
140 end;
141 OpenDialog1.Options := OpenDialog1.Options + [ofAllowMultiSelect];
142 if OpenDialog1.Execute then begin
143 LoadedFiles := 0;
144 for I := 0 to OpenDialog1.Files.Count - 1 do begin
145 if FileExists(OpenDialog1.Files[I]) then begin
146 TempFile := TContactsFile.Create;
147 try
148 TempFile.LoadFromFile(OpenDialog1.Files[I]);
149 TContactsFile(DataFile).Contacts.AddContacts(TContactsFile(TempFile).Contacts);
150 Inc(LoadedFiles);
151 finally
152 TempFile.Free;
153 end;
154 end;
155 end;
156 if LoadedFiles > 0 then TContactsFile(DataFile).Modified := True;
157 ShowMessage(Format(SCombinedContacts, [LoadedFiles]));
158 UpdateFile;
159 end;
160end;
161
162procedure TCore.AAboutExecute(Sender: TObject);
163begin
164 AboutDialog1.Show;
165end;
166
167procedure TCore.AFileCloseExecute(Sender: TObject);
168begin
169 FileClose;
170 UpdateFile;
171end;
172
173procedure TCore.AFileSplitExecute(Sender: TObject);
174var
175 I: Integer;
176 C: Integer;
177 FileName: string;
178 ModalResult: TModalResult;
179begin
180 C := 0;
181 SelectDirectoryDialog1.FileName := LastSplitDir;
182 if SelectDirectoryDialog1.Execute then begin
183 LastSplitDir := SelectDirectoryDialog1.FileName;
184 with TContactsFile(DataFile).Contacts do
185 for I := 0 to Count - 1 do begin
186 if Items[I].Fields[cfFullName] <> '' then begin
187 FileName := SelectDirectoryDialog1.FileName + DirectorySeparator +
188 Items[I].FullNameToFileName + VCardFileExt;
189 Items[I].SaveToFile(FileName);
190 Inc(C);
191 end;
192 end;
193 ModalResult := MessageDlg(SFileSplit,
194 Format(SFileSplitFinishedOpenDirectory, [C,
195 SelectDirectoryDialog1.FileName]), mtConfirmation, [mbYes, mbNo], 0);
196 if ModalResult = mrYes then begin
197 {$IFDEF WINDOWS}
198 ExecuteProgram('explorer.exe', ['"' + SelectDirectoryDialog1.FileName + '"']);
199 {$ENDIF}
200 {$IFDEF LINUX}
201 ExecuteProgram('/usr/bin/xdg-open', [SelectDirectoryDialog1.FileName]);
202 {$ENDIF}
203 end;
204 end;
205end;
206
207procedure TCore.AFindDuplicateExecute(Sender: TObject);
208begin
209 with TFormFindDuplicity.Create(nil) do
210 try
211 Contacts := TContactsFile(DataFile).Contacts;
212 ShowModal;
213 FormContacts.ReloadList;
214 FormMain.UpdateInterface;
215 finally
216 Free;
217 end;
218end;
219
220procedure TCore.AFindExecute(Sender: TObject);
221begin
222 with TFormFind.Create(nil) do
223 try
224 Contacts := TContactsFile(DataFile).Contacts;
225 ShowModal;
226 FormContacts.ReloadList;
227 FormMain.UpdateInterface;
228 finally
229 Free;
230 end;
231end;
232
233procedure TCore.AGenerateExecute(Sender: TObject);
234begin
235 with TFormGenerate.Create(nil) do
236 try
237 Contacts := TContactsFile(DataFile).Contacts;
238 ShowModal;
239 FormContacts.ReloadList;
240 FormContacts.UpdateInterface;
241 DataFile.Modified := True;
242 FormMain.UpdateInterface;
243 finally
244 Free;
245 end;
246end;
247
248procedure TCore.AHomePageExecute(Sender: TObject);
249begin
250 OpenWebPage(ApplicationInfo1.HomePage);
251end;
252
253procedure TCore.ASettingsExecute(Sender: TObject);
254begin
255 with TFormSettings.Create(nil) do
256 try
257 LoadData;
258 if ShowModal = mrOK then begin
259 SaveData;
260 ThemeManager1.UseTheme(FormMain);
261 ThemeManager1.UseTheme(FormContacts);
262 end;
263 finally
264 Free;
265 end;
266end;
267
268procedure TCore.ATestExecute(Sender: TObject);
269begin
270 with TFormTest.Create(nil) do
271 try
272 ShowModal;
273 finally
274 Free;
275 end;
276end;
277
278procedure TCore.AFileNewExecute(Sender: TObject);
279begin
280 FileNew;
281 UpdateFile;
282end;
283
284procedure TCore.AFileOpenExecute(Sender: TObject);
285var
286 TempFile: TDataFile;
287begin
288 TempFile := DefaultDataFileClass.Create;
289 try
290 OpenDialog1.Filter := TempFile.GetFileFilter;
291 finally
292 TempFile.Free;
293 end;
294 OpenDialog1.DefaultExt := '';
295 if Assigned(DataFile) then begin
296 OpenDialog1.InitialDir := ExtractFileDir(DataFile.FileName);
297 OpenDialog1.FileName := ExtractFileName(DataFile.FileName);
298 end;
299 OpenDialog1.Options := OpenDialog1.Options - [ofAllowMultiSelect];
300 if OpenDialog1.Execute then begin
301 FileOpen(OpenDialog1.FileName);
302 UpdateFile;
303 end;
304end;
305
306procedure TCore.AFileOpenRecentExecute(Sender: TObject);
307begin
308 FileOpen(TMenuItem(Sender).Caption);
309 UpdateFile;
310end;
311
312procedure TCore.AFileSaveAsExecute(Sender: TObject);
313begin
314 SaveDialog1.DefaultExt := DataFile.GetFileExt;
315 SaveDialog1.Filter := DataFile.GetFileFilter;
316 SaveDialog1.InitialDir := ExtractFileDir(DataFile.FileName);
317 SaveDialog1.FileName := ExtractFileName(DataFile.FileName);
318 if SaveDialog1.Execute then begin
319 DataFile.SaveToFile(SaveDialog1.FileName);
320 LastOpenedList1.AddItem(SaveDialog1.FileName);
321 UpdateFile;
322 end;
323end;
324
325procedure TCore.AFileSaveExecute(Sender: TObject);
326begin
327 if FileExists(DataFile.FileName) then begin
328 DataFile.SaveToFile(DataFile.FileName);
329 LastOpenedList1.AddItem(DataFile.FileName);
330 UpdateFile;
331 end else AFileSaveAs.Execute;
332end;
333
334procedure TCore.DataModuleCreate(Sender: TObject);
335{$IFDEF Linux}
336const
337 LinuxDataFilesDir = '/usr/share/vCardStudio';
338 LinuxLanguagesDir = LinuxDataFilesDir + '/Languages';
339 LinuxImagesDir = LinuxDataFilesDir + '/Images';
340{$ENDIF}
341begin
342 ProfilePhotoFileName := 'Images/Profile.png';
343 {$IFDEF Linux}
344 // If installed in Linux system then use installation directory for po files
345 if not DirectoryExists(Translator.POFilesFolder) and DirectoryExists(LinuxLanguagesDir) then begin
346 Translator.POFilesFolder := LinuxLanguagesDir;
347 end;
348 // If installed in Linux system then use installation directory for images files
349 if not DirectoryExists('Images') and DirectoryExists(LinuxImagesDir) then begin
350 ProfilePhotoFileName := LinuxImagesDir + DirectorySeparator + 'Profile.png';
351 end;
352 {$ENDIF}
353
354 DataFile := nil;
355 DefaultDataFileClass := TContactsFile;
356 FileClosed := True;
357end;
358
359procedure TCore.DataModuleDestroy(Sender: TObject);
360begin
361 FileClose;
362 SaveConfig;
363 if Assigned(ProfileImage) then
364 FreeAndNil(ProfileImage);
365end;
366
367procedure TCore.LastOpenedList1Change(Sender: TObject);
368begin
369 LastOpenedList1.LoadToMenuItem(FormMain.MenuItemFileOpenRecent, AFileOpenRecentExecute);
370 LastOpenedList1.LoadToMenuItem(FormMain.PopupMenuOpenRecent.Items, AFileOpenRecentExecute);
371end;
372
373procedure TCore.FileModified(Sender: TObject);
374begin
375 UpdateFile;
376end;
377
378procedure TCore.FileOpen(FileName: string);
379begin
380 if FileExists(FileName) then begin
381 FileClose;
382 if FileClosed then begin
383 FileNew;
384 LoadErrors := '';
385 DataFile.LoadFromFile(FileName);
386 LastOpenedList1.AddItem(FileName);
387 if LoadErrors <> '' then begin
388 FormError := TFormError.Create(nil);
389 FormError.MemoErrors.Text := LoadErrors;
390 FormError.ShowModal;
391 FreeAndNil(FormError);
392 end;
393 end;
394 end else ShowMessage(Format(SFileNotFound, [FileName]));
395end;
396
397procedure TCore.FileClose;
398var
399 ModalResult: TModalResult;
400 DoClose: Boolean;
401begin
402 DoClose := False;
403 if Assigned(DataFile) then begin
404 if DataFile.Modified then begin
405 ModalResult := MessageDlg(SAppExit, SAppExitQuery,
406 mtConfirmation, [mbYes, mbNo, mbCancel], 0);
407 if ModalResult = mrYes then begin
408 AFileSave.Execute;
409 DoClose := True;
410 end
411 else if ModalResult = mrNo then begin
412 DoClose := True;
413 end else FileClosed := False;
414 end else DoClose := True;
415 end else DoClose := True;
416 if DoClose then begin
417 if Assigned(DataFile) then FreeAndNil(DataFile);
418 FileClosed := True;
419 UpdateFile;
420 end;
421end;
422
423procedure TCore.FileNew;
424begin
425 FileClose;
426 if FileClosed then begin
427 DataFile := DefaultDataFileClass.Create;
428 DataFile.OnModify := FileModified;
429 TContactsFile(DataFile).OnError := DoError;
430 end;
431end;
432
433procedure TCore.UpdateFile;
434begin
435 UpdateInterface;
436 FormMain.UpdateInterface;
437 if Assigned(FormContacts) then begin
438 if Assigned(DataFile) then
439 FormContacts.Contacts := TContactsFile(DataFile).Contacts
440 else FormContacts.Contacts := nil;
441 FormContacts.ReloadList;
442 FormContacts.UpdateInterface;
443 end;
444end;
445
446procedure TCore.LoadConfig;
447begin
448 PersistentForm1.RegistryContext := ApplicationInfo1.GetRegistryContext;
449 LastOpenedList1.LoadFromRegistry(TRegistryContext.Create(ApplicationInfo1.RegistryRoot,
450 ApplicationInfo1.RegistryKey + '\RecentFiles'));
451
452 with TRegistryEx.Create do
453 try
454 CurrentContext := ApplicationInfo1.GetRegistryContext;
455 if ValueExists('LanguageCode') then
456 Translator.Language := Translator.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', ''))
457 else Translator.Language := Translator.Languages.SearchByCode('');
458 if ValueExists('Theme') then
459 ThemeManager1.Theme := ThemeManager1.Themes.FindByName(ReadStringWithDefault('Theme', 'System'))
460 else ThemeManager1.Theme := ThemeManager1.Themes.FindByName('System');
461 FormMain.MenuItemToolbar.Checked := ReadBoolWithDefault('ToolBarVisible', True);
462 ReopenLastFileOnStart := ReadBoolWithDefault('ReopenLastFileOnStart', True);
463 LastContactTabIndex := ReadIntegerWithDefault('LastContactTabIndex', 0);
464 LastContactFileName := ReadStringWithDefault('LastContactFileName', '');
465 LastSplitDir := ReadStringWithDefault('LastSplitDir', '');
466 LastPropertyValueFileName := ReadStringWithDefault('LastPropertyValueFileName', '');
467 GenerateCount := ReadIntegerWithDefault('GenerateCount', 1);
468 DefaultVcardVersion := ReadStringWithDefault('DefaultVcardVersion', '2.1');
469 finally
470 Free;
471 end;
472end;
473
474procedure TCore.SaveConfig;
475begin
476 LastOpenedList1.SaveToRegistry(TRegistryContext.Create(ApplicationInfo1.RegistryRoot,
477 ApplicationInfo1.RegistryKey + '\RecentFiles'));
478
479 with TRegistryEx.Create do
480 try
481 CurrentContext := ApplicationInfo1.GetRegistryContext;
482 if Assigned(Translator.Language) and (Translator.Language.Code <> '') then
483 WriteString('LanguageCode', Translator.Language.Code)
484 else DeleteValue('LanguageCode');
485 if Assigned(ThemeManager1.Theme) and (ThemeManager1.Theme.Name <> '') then
486 WriteString('Theme', ThemeManager1.Theme.Name)
487 else DeleteValue('Theme');
488 WriteBool('ToolBarVisible', FormMain.MenuItemToolbar.Checked);
489 WriteBool('ReopenLastFileOnStart', ReopenLastFileOnStart);
490 WriteInteger('LastContactTabIndex', LastContactTabIndex);
491 WriteString('LastContactFileName', LastContactFileName);
492 WriteString('LastSplitDir', LastSplitDir);
493 WriteString('LastPropertyValueFileName', LastPropertyValueFileName);
494 WriteInteger('GenerateCount', GenerateCount);
495 WriteString('DefaultVcardVersion', DefaultVcardVersion);
496 finally
497 Free;
498 end;
499end;
500
501procedure TCore.DoError(Text: string; Line: Integer);
502begin
503 LoadErrors := LoadErrors + Format(SLine, [Line, Text]) + LineEnding;
504end;
505
506function TCore.GetProfileImage: TImage;
507begin
508 if not Assigned(ProfileImage) then begin
509 ProfileImage := TImage.Create(nil);
510 if FileExists(ProfilePhotoFileName) then
511 ProfileImage.Picture.LoadFromFile(ProfilePhotoFileName);
512 end;
513 Result := ProfileImage;
514end;
515
516procedure TCore.UpdateInterface;
517begin
518 AFileSave.Enabled := Assigned(DataFile) and DataFile.Modified;
519 AFileSaveAs.Enabled := Assigned(DataFile);
520 AFileClose.Enabled := Assigned(DataFile);
521 AFileSplit.Enabled := Assigned(DataFile);
522 AFileCombine.Enabled := Assigned(DataFile);
523 AFind.Enabled := Assigned(DataFile);
524 AFindDuplicate.Enabled := Assigned(DataFile);
525 AGenerate.Enabled := Assigned(DataFile);
526 {$IFOPT D+}
527 ATest.Enabled := True;
528 {$ENDIF}
529 {$IFOPT D-}
530 ATest.Enabled := False;
531 {$ENDIF}
532 ATest.Visible := ATest.Enabled;
533end;
534
535procedure TCore.Initialize;
536var
537 FileNameOption: string;
538begin
539 if not InitializeStarted then begin
540 InitializeStarted := True;
541 LoadConfig;
542
543 FileNameOption := FindFirstNonOption;
544 if FileNameOption <> '' then begin
545 // Open file specified as command line parameter
546 AFileNew.Execute;
547 DataFile.LoadFromFile(FileNameOption);
548 LastOpenedList1.AddItem(FileNameOption);
549 end else
550 if ReopenLastFileOnStart and (LastOpenedList1.Items.Count > 0) and FileExists(LastOpenedList1.Items[0]) then begin
551 // Open last opened file
552 AFileNew.Execute;
553 DataFile.LoadFromFile(LastOpenedList1.Items[0])
554 end else AFileNew.Execute;
555
556 UpdateFile;
557 InitializeFinished := True;
558 end;
559end;
560
561function TCore.FindFirstNonOption: string;
562var
563 S: string;
564 I: Integer;
565begin
566 Result := '';
567 for I := 1 to Application.ParamCount do begin
568 S := Application.Params[I];
569 if S[1] = Application.OptionChar then Continue;
570 Result := S;
571 Break;
572 end;
573end;
574
575end.
576
Note: See TracBrowser for help on using the repository browser.