source: trunk/UCore.pas

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