source: tags/1.1.0/UCore.pas

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