source: tags/1.2.0/UCore.pas

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