source: tags/1.3.0/UCore.pas

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