source: trunk/Core.pas

Last change on this file was 227, checked in by chronos, 42 hours ago
  • Modified: Do not reference global Core object if possible.
File size: 8.1 KB
Line 
1unit Core;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Acronym, Translator, PersistentForm,
7 JobProgressView, ScaleDPI, Forms, Controls, ExtCtrls, Menus, LazFileUtils,
8 RegistryEx, ApplicationInfo, Registry, Theme, FormMain;
9
10type
11
12 { TCore }
13
14 TCore = class(TDataModule)
15 ApplicationInfo1: TApplicationInfo;
16 ThemeManager: TThemeManager;
17 Translator: TTranslator;
18 ImageListSmall: TImageList;
19 ImageListLarge: TImageList;
20 MenuItem1: TMenuItem;
21 MenuItem19: TMenuItem;
22 MenuItem2: TMenuItem;
23 MenuItem26: TMenuItem;
24 MenuItem27: TMenuItem;
25 MenuItem28: TMenuItem;
26 MenuItem3: TMenuItem;
27 PersistentForm1: TPersistentForm;
28 PopupMenuTrayIcon: TPopupMenu;
29 ScaleDPI1: TScaleDPI;
30 TrayIcon1: TTrayIcon;
31 procedure TranslatorTranslate(Sender: TObject);
32 procedure DataModuleCreate(Sender: TObject);
33 procedure DataModuleDestroy(Sender: TObject);
34 procedure TrayIcon1Click(Sender: TObject);
35 private
36 FAlwaysOnTop: Boolean;
37 StoredDimension: TControlDimension;
38 procedure SetAlwaysOnTop(AValue: Boolean);
39 function FindFirstNonOption: string;
40 procedure WriteLnConsole(Text: string);
41 public
42 FormMain: TFormMain;
43 AcronymDb: TAcronymDb;
44 StartOnLogon: Boolean;
45 StartMinimizedToTray: Boolean;
46 ReopenLastFileOnStart: Boolean;
47 InitializeStarted: Boolean;
48 InitializeFinished: Boolean;
49 function GetAppShareDir(Dir: string): string;
50 procedure Initialize;
51 procedure LoadConfig;
52 procedure SaveConfig;
53 procedure ScaleDPI;
54 property AlwaysOnTop: Boolean read FAlwaysOnTop write SetAlwaysOnTop;
55 end;
56
57var
58 Core: TCore;
59
60
61implementation
62
63uses
64 FormEx;
65
66const
67 ExampleFile = 'Example acronyms.adp';
68 DefaultOverrideFile = 'Default.txt';
69
70resourcestring
71 SStartMinimizedInTray = 'Start minimized in system tray';
72 SShowThisHelp = 'Show this help';
73 SOptions = 'options';
74 SProjectFile = 'project file';
75
76
77{$R *.lfm}
78
79procedure TCore.DataModuleCreate(Sender: TObject);
80begin
81 Translator.POFilesFolder := GetAppShareDir('Languages');
82
83 AcronymDb := nil;
84 InitializeStarted := False;
85 InitializeFinished := False;
86 StoredDimension := TControlDimension.Create;
87
88 TFormEx.ScaleDPI := ScaleDPI1;
89 TFormEx.Translator := Translator;
90 TFormEx.ThemeManager := ThemeManager;
91 TFormEx.PersistentForm := PersistentForm1;
92
93 Application.CreateForm(TFormMain, FormMain);
94end;
95
96procedure TCore.DataModuleDestroy(Sender: TObject);
97begin
98 FreeAndNil(StoredDimension);
99 FreeAndNil(AcronymDb);
100end;
101
102procedure TCore.TrayIcon1Click(Sender: TObject);
103begin
104 if not FormMain.Visible then FormMain.AShow.Execute
105 else FormMain.Hide;
106end;
107
108procedure TCore.TranslatorTranslate(Sender: TObject);
109begin
110 Acronym.Translate;
111end;
112
113procedure TCore.SetAlwaysOnTop(AValue: Boolean);
114begin
115 if FAlwaysOnTop = AValue then Exit;
116 FAlwaysOnTop := AValue;
117 if FAlwaysOnTop then FormMain.FormStyle := fsSystemStayOnTop
118 else FormMain.FormStyle := fsNormal;
119end;
120
121procedure TCore.WriteLnConsole(Text: string);
122begin
123 {$IFDEF WINDOWS}
124 if not IsConsole then begin
125 IsConsole := True;
126 SysInitStdIO;
127 end;
128 {$ENDIF}
129 WriteLn(Text);
130end;
131
132function TCore.GetAppShareDir(Dir: string): string;
133{$IFDEF UNIX}
134var
135 NewDir: string;
136{$ENDIF}
137begin
138 Result := ExtractFileDir(Application.ExeName) + DirectorySeparator + Dir;
139 {$IFDEF UNIX}
140 // If installed in Linux system then try to use different installation directory
141 if not DirectoryExists(Result) then begin
142 NewDir := ExtractFileDir(Application.ExeName) + DirectorySeparator + '..' +
143 DirectorySeparator + 'share' + DirectorySeparator +
144 ExtractFileNameOnly(Application.ExeName) + DirectorySeparator + Dir;
145 if DirectoryExists(NewDir) then Result := NewDir;
146 end;
147 {$ENDIF}
148end;
149
150procedure TCore.Initialize;
151var
152 FileNameOption: string;
153 ExampleFileName: string;
154 DefaultOverrideFileName: string;
155 ExamplesDir: string;
156 Lines: TStringList;
157 Output: string;
158begin
159 if not InitializeStarted then begin
160 InitializeStarted := True;
161 LoadConfig;
162
163 if Application.HasOption('h', 'help') then begin
164 Output := 'AcronymDecoder [' + SOptions + '] <' + SProjectFile + '>' + LineEnding;
165 Output := Output + ' -t --tray ' + SStartMinimizedInTray + LineEnding;
166 Output := Output + ' -h --help ' + SShowThisHelp + LineEnding;
167 WriteLnConsole(Output);
168 Application.Terminate;
169 Exit;
170 end;
171
172 if Application.HasOption('t', 'tray') then begin
173 FormMain.Visible := False;
174 end;
175
176 ExamplesDir := GetAppShareDir('Examples');
177 ExampleFileName := ExamplesDir + DirectorySeparator + ExampleFile;
178
179 // To override default project file put new project name to default file
180 DefaultOverrideFileName := ExamplesDir + DirectorySeparator + DefaultOverrideFile;
181 if FileExists(DefaultOverrideFileName) then begin
182 Lines := TStringList.Create;
183 Lines.LoadFromFile(DefaultOverrideFileName);
184 if Lines.Count > 0 then
185 ExampleFileName := ExamplesDir + DirectorySeparator + Lines[0];
186 Lines.Free;
187 end;
188
189 FileNameOption := FindFirstNonOption;
190 if FileNameOption <> '' then begin
191 // Open file specified as command line parameter
192 FormMain.ProjectOpen(FileNameOption);
193 end else
194 if ReopenLastFileOnStart and (FormMain.LastOpenedList1.Items.Count > 0) and
195 FileExists(FormMain.LastOpenedList1.Items[0]) then begin
196 // Open last opened file
197 FormMain.ProjectOpen(FormMain.LastOpenedList1.Items[0])
198 end else
199 if FileExists(ExampleFileName) then begin
200 // Open default database with examples if no item is in recent openned history
201 FormMain.ProjectOpen(ExampleFileName);
202 end else begin
203 // Create empty file
204 FormMain.AFileNew.Execute;
205 end;
206
207 //ImageListSmall.Assign(ImageListLarge);
208
209 ScaleDPI;
210 FormMain.UpdateAcronymsList;
211 FormMain.ListViewFilter1.UpdateFromListView(FormMain.ListViewAcronyms);
212 InitializeFinished := True;
213 end;
214end;
215
216procedure TCore.LoadConfig;
217begin
218 FormMain.LoadConfig;
219
220 with TRegistryEx.Create do
221 try
222 RootKey := RegistryRootHKEY[ApplicationInfo1.RegistryRoot];
223 OpenKey(ApplicationInfo1.RegistryKey, True);
224 ScaleDPI1.DPI := Point(ReadIntegerWithDefault('DPIX', 96), ReadIntegerWithDefault('DPIY', 96));
225 ScaleDPI1.AutoDetect := ReadBoolWithDefault('DPIAuto', True);
226 if ValueExists('LanguageCode') then
227 Translator.Language := Translator.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', ''))
228 else Translator.Language := Translator.Languages.SearchByCode('');
229 AlwaysOnTop := ReadBoolWithDefault('AlwaysOnTop', False);
230 StartMinimizedToTray := ReadBoolWithDefault('StartMinimizedToTray', False);
231 ReopenLastFileOnStart := ReadBoolWithDefault('ReopenLastFileOnStart', True);
232 ThemeManager.Theme := ThemeManager.Themes.FindByName(ReadStringWithDefault('Theme', 'System'));
233 finally
234 Free;
235 end;
236end;
237
238procedure TCore.SaveConfig;
239begin
240 FormMain.SaveConfig;
241
242 with TRegistryEx.Create do
243 try
244 RootKey := RegistryRootHKEY[ApplicationInfo1.RegistryRoot];
245 OpenKey(ApplicationInfo1.RegistryKey, True);
246 WriteInteger('DPIX', ScaleDPI1.DPI.X);
247 WriteInteger('DPIY', ScaleDPI1.DPI.Y);
248 WriteBool('DPIAuto', ScaleDPI1.AutoDetect);
249 if Assigned(Translator.Language) and (Translator.Language.Code <> '') then
250 WriteString('LanguageCode', Translator.Language.Code)
251 else DeleteValue('LanguageCode');
252 WriteBool('AlwaysOnTop', AlwaysOnTop);
253 WriteBool('StartMinimizedToTray', StartMinimizedToTray);
254 WriteBool('ReopenLastFileOnStart', ReopenLastFileOnStart);
255 WriteString('Theme', ThemeManager.Theme.Name);
256 finally
257 Free;
258 end;
259end;
260
261procedure TCore.ScaleDPI;
262begin
263 // TODO: Transparent image scaling not working properly under linux Gtk2
264 // Also screen DPI is not correctly detected under linux Gtk2
265 //Core.ScaleDPI1.DPI := Point(200, 200);
266 //{$IFDEF WINDOWS}
267 Core.ScaleDPI1.ScaleImageList(ImageListSmall, Core.ScaleDPI1.DesignDPI);
268 //{$ENDIF}
269end;
270
271function TCore.FindFirstNonOption: string;
272var
273 S: string;
274 I: Integer;
275begin
276 Result := '';
277 for I := 1 to Application.ParamCount do begin
278 S := Application.Params[I];
279 if S[1] = Application.OptionChar then Continue;
280 Result := S;
281 Break;
282 end;
283end;
284
285end.
286
Note: See TracBrowser for help on using the repository browser.