source: tags/1.0.0/UCore.pas

Last change on this file was 23, checked in by chronos, 3 years ago
  • Added: Snap package definition file.
  • Fixed: Selected theme in settings also changed language.
  • Modified: Load correctly language files if installed on Linux.
File size: 13.6 KB
Line 
1unit UCore;
2
3{$mode delphi}{$H+}
4
5interface
6
7uses
8 Classes, SysUtils, FileUtil, Controls, ActnList, Forms, Dialogs,
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 AGenerate: TAction;
30 AFindDuplicate: TAction;
31 AFileMerge: TAction;
32 ASettings: TAction;
33 AFileOpenRecent: TAction;
34 AHomePage: TAction;
35 AFileClose: TAction;
36 AFileSaveAs: TAction;
37 AFileSave: TAction;
38 AFileOpen: TAction;
39 AFileNew: TAction;
40 AExit: TAction;
41 ActionList1: TActionList;
42 ApplicationInfo1: TApplicationInfo;
43 Translator: TTranslator;
44 ImageList1: TImageList;
45 LastOpenedList1: TLastOpenedList;
46 OpenDialog1: TOpenDialog;
47 PersistentForm1: TPersistentForm;
48 SaveDialog1: TSaveDialog;
49 ScaleDPI1: TScaleDPI;
50 ThemeManager1: TThemeManager;
51 procedure AAboutExecute(Sender: TObject);
52 procedure AExitExecute(Sender: TObject);
53 procedure AFileMergeExecute(Sender: TObject);
54 procedure AFileNewExecute(Sender: TObject);
55 procedure AFileOpenExecute(Sender: TObject);
56 procedure AFileOpenRecentExecute(Sender: TObject);
57 procedure AFileSaveExecute(Sender: TObject);
58 procedure AFileSaveAsExecute(Sender: TObject);
59 procedure AFileCloseExecute(Sender: TObject);
60 procedure AFindDuplicateExecute(Sender: TObject);
61 procedure AGenerateExecute(Sender: TObject);
62 procedure AHomePageExecute(Sender: TObject);
63 procedure ASettingsExecute(Sender: TObject);
64 procedure DataModuleCreate(Sender: TObject);
65 procedure DataModuleDestroy(Sender: TObject);
66 procedure LastOpenedList1Change(Sender: TObject);
67 private
68 InitializeStarted: Boolean;
69 InitializeFinished: Boolean;
70 procedure FileModified(Sender: TObject);
71 function FindFirstNonOption: string;
72 procedure UpdateFile;
73 procedure LoadConfig;
74 procedure SaveConfig;
75 public
76 DefaultDataFileClass: TDataFileClass;
77 DataFile: TDataFile;
78 FileClosed: Boolean;
79 ReopenLastFileOnStart: Boolean;
80 ToolbarVisible: Boolean;
81 procedure FileNew;
82 procedure FileOpen(FileName: string);
83 procedure FileClose;
84 function FileMerge(FileName: string): TMergeResult;
85 procedure Initialize;
86 procedure UpdateInterface;
87 end;
88
89var
90 Core: TCore;
91
92
93implementation
94
95{$R *.lfm}
96
97uses
98 UFormMain, UFormAbout, UFormSettings, UContact, UFormContacts, UFormFindDuplicity,
99 UFormGenerate;
100
101resourcestring
102 SAppExit = 'Application exit';
103 SAppExitQuery = 'File was modified. Do you want to save it before exit?';
104 SFileNotFound = 'File ''%s'' not found.';
105 SMergedContacts = 'Contacts merged. Loaded: %d, New: %d, Updated: %d';
106
107{ TMergeResult }
108
109procedure TMergeResult.Clear;
110begin
111 Loaded := 0;
112 New := 0;
113 Updated := 0;
114end;
115
116class operator TMergeResult.Add(const A, B: TMergeResult): TMergeResult;
117begin
118 Result.Loaded := A.Loaded + B.Loaded;
119 Result.New := A.New + B.New;
120 Result.Updated := A.Updated + B.Updated;
121end;
122
123{ TCore }
124
125procedure TCore.AExitExecute(Sender: TObject);
126begin
127 FormMain.Close;
128end;
129
130procedure TCore.AFileMergeExecute(Sender: TObject);
131var
132 TempFile: TDataFile;
133 I: Integer;
134 MergeResult: TMergeResult;
135 TotalMergeResult: TMergeResult;
136begin
137 TempFile := DefaultDataFileClass.Create;
138 try
139 OpenDialog1.Filter := TempFile.GetFileFilter;
140 finally
141 TempFile.Free;
142 end;
143 OpenDialog1.DefaultExt := '';
144 if Assigned(DataFile) then begin
145 OpenDialog1.InitialDir := ExtractFileDir(DataFile.FileName);
146 OpenDialog1.FileName := ExtractFileName(DataFile.FileName);
147 end;
148 OpenDialog1.Options := OpenDialog1.Options + [ofAllowMultiSelect];
149 if OpenDialog1.Execute then begin
150 TotalMergeResult.Clear;
151 for I := 0 to OpenDialog1.Files.Count - 1 do begin
152 MergeResult := FileMerge(OpenDialog1.Files[I]);
153 TotalMergeResult := TotalMergeResult + MergeResult;
154 end;
155 ShowMessage(Format(SMergedContacts, [TotalMergeResult.Loaded,
156 TotalMergeResult.New, TotalMergeResult.Updated]));
157 UpdateFile;
158 end;
159end;
160
161procedure TCore.AAboutExecute(Sender: TObject);
162begin
163 AboutDialog1.Show;
164end;
165
166procedure TCore.AFileCloseExecute(Sender: TObject);
167begin
168 FileClose;
169 UpdateFile;
170end;
171
172procedure TCore.AFindDuplicateExecute(Sender: TObject);
173begin
174 FormFindDuplicity := TFormFindDuplicity.Create(nil);
175 with FormFindDuplicity do begin
176 Contacts := TContactsFile(DataFile).Contacts;
177 ShowModal;
178 FormContacts.ReloadList;
179 FormMain.UpdateInterface;
180 Free;
181 end;
182end;
183
184procedure TCore.AGenerateExecute(Sender: TObject);
185begin
186 FormGenerate := TFormGenerate.Create(nil);
187 with FormGenerate do begin
188 Contacts := TContactsFile(DataFile).Contacts;
189 ShowModal;
190 FormContacts.ReloadList;
191 FormContacts.UpdateInterface;
192 DataFile.Modified := True;
193 FormMain.UpdateInterface;
194 Free;
195 end;
196end;
197
198procedure TCore.AHomePageExecute(Sender: TObject);
199begin
200 OpenWebPage(ApplicationInfo1.HomePage);
201end;
202
203procedure TCore.ASettingsExecute(Sender: TObject);
204begin
205 FormSettings := TFormSettings.Create(nil);
206 try
207 FormSettings.LoadData;
208 if FormSettings.ShowModal = mrOK then begin
209 FormSettings.SaveData;
210 ThemeManager1.UseTheme(FormMain);
211 ThemeManager1.UseTheme(FormContacts);
212 end;
213 finally
214 FormSettings.Free;
215 end;
216end;
217
218procedure TCore.AFileNewExecute(Sender: TObject);
219begin
220 FileNew;
221 UpdateFile;
222end;
223
224procedure TCore.AFileOpenExecute(Sender: TObject);
225var
226 TempFile: TDataFile;
227begin
228 TempFile := DefaultDataFileClass.Create;
229 try
230 OpenDialog1.Filter := TempFile.GetFileFilter;
231 finally
232 TempFile.Free;
233 end;
234 OpenDialog1.DefaultExt := '';
235 if Assigned(DataFile) then begin
236 OpenDialog1.InitialDir := ExtractFileDir(DataFile.FileName);
237 OpenDialog1.FileName := ExtractFileName(DataFile.FileName);
238 end;
239 OpenDialog1.Options := OpenDialog1.Options - [ofAllowMultiSelect];
240 if OpenDialog1.Execute then begin
241 FileOpen(OpenDialog1.FileName);
242 UpdateFile;
243 end;
244end;
245
246procedure TCore.AFileOpenRecentExecute(Sender: TObject);
247begin
248 FileOpen(TMenuItem(Sender).Caption);
249 UpdateFile;
250end;
251
252procedure TCore.AFileSaveAsExecute(Sender: TObject);
253begin
254 SaveDialog1.DefaultExt := DataFile.GetFileExt;
255 SaveDialog1.Filter := DataFile.GetFileFilter;
256 SaveDialog1.InitialDir := ExtractFileDir(DataFile.FileName);
257 SaveDialog1.FileName := ExtractFileName(DataFile.FileName);
258 if SaveDialog1.Execute then begin
259 DataFile.SaveToFile(SaveDialog1.FileName);
260 LastOpenedList1.AddItem(SaveDialog1.FileName);
261 UpdateFile;
262 end;
263end;
264
265procedure TCore.AFileSaveExecute(Sender: TObject);
266begin
267 if FileExists(DataFile.FileName) then begin
268 DataFile.SaveToFile(DataFile.FileName);
269 LastOpenedList1.AddItem(DataFile.FileName);
270 UpdateFile;
271 end else AFileSaveAs.Execute;
272end;
273
274procedure TCore.DataModuleCreate(Sender: TObject);
275const
276 LinuxLanguagesDir = '/usr/share/vCardStudio/Languages';
277begin
278 {$IFDEF Linux}
279 // If installed in Linux system then use installation directory for po files
280 if not DirectoryExists(Translator.POFilesFolder) and DirectoryExists(LinuxLanguagesDir) then
281 Translator.POFilesFolder := LinuxLanguagesDir;
282 {$ENDIF}
283
284 DataFile := nil;
285 DefaultDataFileClass := TContactsFile;
286 FileClosed := True;
287end;
288
289procedure TCore.DataModuleDestroy(Sender: TObject);
290begin
291 FileClose;
292 SaveConfig;
293end;
294
295procedure TCore.LastOpenedList1Change(Sender: TObject);
296begin
297 LastOpenedList1.LoadToMenuItem(FormMain.MenuItemFileOpenRecent, AFileOpenRecentExecute);
298 LastOpenedList1.LoadToMenuItem(FormMain.PopupMenuOpenRecent.Items, AFileOpenRecentExecute);
299end;
300
301procedure TCore.FileModified(Sender: TObject);
302begin
303 UpdateFile;
304end;
305
306procedure TCore.FileOpen(FileName: string);
307begin
308 if FileExists(FileName) then begin
309 FileClose;
310 if FileClosed then begin
311 FileNew;
312 DataFile.LoadFromFile(FileName);
313 LastOpenedList1.AddItem(FileName);
314 end;
315 end else ShowMessage(Format(SFileNotFound, [FileName]));
316end;
317
318procedure TCore.FileClose;
319var
320 ModalResult: TModalResult;
321 DoClose: Boolean;
322begin
323 DoClose := False;
324 if Assigned(DataFile) then begin
325 if DataFile.Modified then begin
326 ModalResult := MessageDlg(SAppExit, SAppExitQuery,
327 mtConfirmation, [mbYes, mbNo, mbCancel], 0);
328 if ModalResult = mrYes then begin
329 AFileSave.Execute;
330 DoClose := True;
331 end
332 else if ModalResult = mrNo then begin
333 DoClose := True;
334 end else FileClosed := False;
335 end else DoClose := True;
336 end else DoClose := True;
337 if DoClose then begin
338 if Assigned(DataFile) then FreeAndNil(DataFile);
339 FileClosed := True;
340 end;
341end;
342
343function TCore.FileMerge(FileName: string): TMergeResult;
344var
345 TempFile: TContactsFile;
346 NewContact: TContact;
347 I: Integer;
348begin
349 Result.Clear;
350 if FileExists(FileName) then begin
351 TempFile := TContactsFile.Create;
352 try
353 TempFile.LoadFromFile(FileName);
354 Result.Loaded := TempFile.Contacts.Count;
355 for I := 0 to TempFile.Contacts.Count - 1 do begin
356 NewContact := TContactsFile(DataFile).Contacts.Search(TContact(TempFile.Contacts[I]).FullName);
357 if not Assigned(NewContact) then begin
358 NewContact := TContact.Create;
359 NewContact.Parent := TContactsFile(DataFile);
360 NewContact.Assign(TContact(TempFile.Contacts[I]));
361 TContactsFile(DataFile).Contacts.Add(NewContact);
362 Inc(Result.New);
363 end else begin
364 if NewContact.UpdateFrom(TContact(TempFile.Contacts[I])) then
365 Inc(Result.Updated);
366 end;
367 end;
368 TContactsFile(DataFile).Modified := True;
369 finally
370 TempFile.Free;
371 end;
372 end else ShowMessage(Format(SFileNotFound, [FileName]));
373end;
374
375procedure TCore.FileNew;
376begin
377 FileClose;
378 if FileClosed then begin
379 DataFile := DefaultDataFileClass.Create;
380 DataFile.OnModify := FileModified;
381 end;
382end;
383
384procedure TCore.UpdateFile;
385begin
386 UpdateInterface;
387 FormMain.UpdateInterface;
388 if Assigned(FormContacts) then begin
389 if Assigned(DataFile) then
390 FormContacts.Contacts := TContactsFile(DataFile).Contacts
391 else FormContacts.Contacts := nil;
392 FormContacts.ReloadList;
393 end;
394end;
395
396procedure TCore.LoadConfig;
397begin
398 PersistentForm1.RegistryContext := ApplicationInfo1.GetRegistryContext;
399 LastOpenedList1.LoadFromRegistry(TRegistryContext.Create(ApplicationInfo1.RegistryRoot,
400 ApplicationInfo1.RegistryKey + '\RecentFiles'));
401
402 with TRegistryEx.Create do
403 try
404 CurrentContext := ApplicationInfo1.GetRegistryContext;
405 if ValueExists('LanguageCode') then
406 Translator.Language := Translator.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', ''))
407 else Translator.Language := Translator.Languages.SearchByCode('');
408 if ValueExists('Theme') then
409 ThemeManager1.Theme := ThemeManager1.Themes.FindByName(ReadStringWithDefault('Theme', 'System'))
410 else ThemeManager1.Theme := ThemeManager1.Themes.FindByName('System');
411 FormMain.MenuItemToolbar.Checked := ReadBoolWithDefault('ToolBarVisible', True);
412 ReopenLastFileOnStart := ReadBoolWithDefault('ReopenLastFileOnStart', True);
413 finally
414 Free;
415 end;
416end;
417
418procedure TCore.SaveConfig;
419begin
420 LastOpenedList1.SaveToRegistry(TRegistryContext.Create(ApplicationInfo1.RegistryRoot,
421 ApplicationInfo1.RegistryKey + '\RecentFiles'));
422
423 with TRegistryEx.Create do
424 try
425 CurrentContext := ApplicationInfo1.GetRegistryContext;
426 if Assigned(Translator.Language) and (Translator.Language.Code <> '') then
427 WriteString('LanguageCode', Translator.Language.Code)
428 else DeleteValue('LanguageCode');
429 if Assigned(ThemeManager1.Theme) and (ThemeManager1.Theme.Name <> '') then
430 WriteString('Theme', ThemeManager1.Theme.Name)
431 else DeleteValue('Theme');
432 WriteBool('ToolBarVisible', FormMain.MenuItemToolbar.Checked);
433 WriteBool('ReopenLastFileOnStart', ReopenLastFileOnStart);
434 finally
435 Free;
436 end;
437end;
438
439procedure TCore.UpdateInterface;
440begin
441 AFileSave.Enabled := Assigned(DataFile) and DataFile.Modified;
442 AFileSaveAs.Enabled := Assigned(DataFile);
443 AFileClose.Enabled := Assigned(DataFile);
444end;
445
446procedure TCore.Initialize;
447var
448 FileNameOption: string;
449begin
450 if not InitializeStarted then begin
451 InitializeStarted := True;
452 LoadConfig;
453
454 FileNameOption := FindFirstNonOption;
455 if FileNameOption <> '' then begin
456 // Open file specified as command line parameter
457 AFileNew.Execute;
458 DataFile.LoadFromFile(FileNameOption);
459 LastOpenedList1.AddItem(FileNameOption);
460 end else
461 if (LastOpenedList1.Items.Count > 0) and FileExists(LastOpenedList1.Items[0]) then begin
462 // Open last opened file
463 AFileNew.Execute;
464 DataFile.LoadFromFile(LastOpenedList1.Items[0])
465 end else AFileNew.Execute;
466
467 UpdateFile;
468 InitializeFinished := True;
469 end;
470end;
471
472function TCore.FindFirstNonOption: string;
473var
474 S: string;
475 I: Integer;
476begin
477 Result := '';
478 for I := 1 to Application.ParamCount do begin
479 S := Application.Params[I];
480 if S[1] = Application.OptionChar then Continue;
481 Result := S;
482 Break;
483 end;
484end;
485
486end.
487
Note: See TracBrowser for help on using the repository browser.