source: tags/1.5.0/UCore.pas

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