source: trunk/Forms/FormMain.pas

Last change on this file was 145, checked in by chronos, 5 weeks ago
  • Modified: Updated Common package.
File size: 10.9 KB
Line 
1unit FormMain;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
7 ExtCtrls, Engine, LCLType, Types, Translator, ApplicationInfo,
8 RegistryEx, PersistentForm, FormImages;
9
10type
11
12 { TFormMain }
13
14 TFormMain = class(TForm)
15 ApplicationInfo1: TApplicationInfo;
16 PaintBox1: TPaintBox;
17 Timer1: TTimer;
18 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
19 procedure FormCreate(Sender: TObject);
20 procedure FormDestroy(Sender: TObject);
21 procedure FormKeyPress(Sender: TObject; var Key: char);
22 procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
23 procedure FormShow(Sender: TObject);
24 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
25 Shift: TShiftState; X, Y: Integer);
26 procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
27 Y: Integer);
28 procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
29 Shift: TShiftState; X, Y: Integer);
30 procedure PaintBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
31 MousePos: TPoint; var Handled: Boolean);
32 procedure PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
33 MousePos: TPoint; var Handled: Boolean);
34 procedure PaintBox1Paint(Sender: TObject);
35 procedure PaintBox1Resize(Sender: TObject);
36 procedure Timer1Timer(Sender: TObject);
37 private
38 Initialized: Boolean;
39 procedure FullScreenChangeExecute(Sender: TObject; Active: Boolean);
40 procedure ExitExecute(Sender: TObject);
41 procedure LoadConfig;
42 procedure SaveConfig;
43 procedure LoadGraphicAssets;
44 procedure DarkModeChangeExecute(Sender: TObject);
45 procedure CopyImage(DestBmp: TBitmap; SourceBmp: TBitmap; Grayed: Boolean = False);
46 public
47 Engine: TEngine;
48 procedure EraseBackground(DC: HDC); override;
49 end;
50
51
52implementation
53
54{$R *.lfm}
55
56uses
57 PixelPointer, Core, FormTests, TestCases;
58
59{ TFormMain }
60
61procedure TFormMain.FormCreate(Sender: TObject);
62{$IFDEF UNIX}
63const
64 UnixLanguagesDir = '/usr/share/TransLines/languages';
65 {$ENDIF}
66begin
67 {$IFDEF UNIX}
68 // If installed in UNIX system then use installation directory for po files
69 if not DirectoryExists(Core.Core.Translator1.POFilesFolder) and DirectoryExists(UnixLanguagesDir) then
70 Core.Core.Translator1.POFilesFolder := UnixLanguagesDir;
71 {$ENDIF}
72
73 Engine := TEngine.Create(nil);
74 Engine.RegistryContext := ApplicationInfo1.GetRegistryContext;
75 Engine.Translator := Core.Core.Translator1;
76 Engine.OnFullScreenChange := FullScreenChangeExecute;
77 Engine.OnExit := ExitExecute;
78 LoadConfig;
79 // Load cities after language core is loaded to have city names translated
80 Engine.InitCities;
81 Engine.LoadFromRegistry;
82 //PaintBox1.ControlStyle := [csOpaque];
83 Randomize;
84end;
85
86procedure TFormMain.FormDestroy(Sender: TObject);
87begin
88 SaveConfig;
89 FreeAndNil(Engine);
90end;
91
92procedure TFormMain.FormShow(Sender: TObject);
93begin
94 if not Initialized then begin
95 Initialized := True;
96 Core.Core.PersistentForm1.RegistryContext := ApplicationInfo1.GetRegistryContext;
97 Core.Core.PersistentForm1.Load(Self, False, True);
98 Engine.FullScreen := Core.Core.PersistentForm1.FormFullScreen;
99 Engine.InitMenus;
100 Engine.OnDarkModeChange := DarkModeChangeExecute;
101 Engine.Map.Size := Point(PaintBox1.Width, PaintBox1.Height);
102 Engine.View.DestRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height);
103 Engine.MainMenu;
104 LoadGraphicAssets;
105 end;
106end;
107
108procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
109begin
110 Core.Core.PersistentForm1.Save(Self);
111 Application.Terminate;
112end;
113
114procedure TFormMain.FormKeyPress(Sender: TObject; var Key: char);
115begin
116 if Key = #32 then begin
117 if Engine.State = gsRunning then Engine.State := gsPaused
118 else if Engine.State = gsPaused then Engine.State := gsRunning;
119 end;
120end;
121
122procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
123 );
124const
125 KeyF11 = 122;
126{$IFDEF DEBUG}
127 KeyF12 = 123;
128{$ENDIF}
129var
130 FormTest: TFormTests;
131begin
132 if Key = KeyF11 then begin
133 Engine.FullScreen := not Engine.FullScreen;
134 end else
135{$IFDEF DEBUG}
136 if Key = KeyF12 then begin
137 FormTest := TFormTests.Create(nil);
138 try
139 FormTest.TestCases := InitTestCases;
140 try
141 FormTest.ShowModal;
142 finally
143 FormTest.TestCases.Free;
144 end;
145 finally
146 FormTest.Free;
147 end;
148 end else
149{$ENDIF}
150 Engine.KeyUp(Key);
151end;
152
153procedure TFormMain.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
154 Shift: TShiftState; X, Y: Integer);
155begin
156 Engine.MouseDown(Button, Point(X, Y));
157end;
158
159procedure TFormMain.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
160 Y: Integer);
161begin
162 Engine.MouseMove(Point(X, Y));
163end;
164
165procedure TFormMain.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
166 Shift: TShiftState; X, Y: Integer);
167begin
168 Engine.MouseUp(Button, Point(X, Y));
169end;
170
171procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
172 Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
173begin
174 Engine.View.Zoom := Engine.View.Zoom / 1.2;
175end;
176
177procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
178 MousePos: TPoint; var Handled: Boolean);
179begin
180 Engine.View.Zoom := Engine.View.Zoom * 1.2;
181end;
182
183procedure TFormMain.PaintBox1Paint(Sender: TObject);
184begin
185 Engine.View.DestRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height);
186 Engine.Paint(PaintBox1.Canvas, Point(PaintBox1.Width, PaintBox1.Height));
187end;
188
189procedure TFormMain.PaintBox1Resize(Sender: TObject);
190begin
191 Engine.Redraw;
192end;
193
194procedure TFormMain.Timer1Timer(Sender: TObject);
195begin
196 Engine.Tick;
197 if Engine.RedrawPending then
198 PaintBox1.Repaint;
199end;
200
201procedure TFormMain.FullScreenChangeExecute(Sender: TObject; Active: Boolean);
202begin
203 Core.Core.PersistentForm1.SetFullScreen(Active);
204end;
205
206procedure TFormMain.ExitExecute(Sender: TObject);
207begin
208 Close;
209end;
210
211procedure TFormMain.EraseBackground(DC: HDC);
212begin
213 // Do nothing, all background space covered by controls
214end;
215
216procedure TFormMain.LoadConfig;
217var
218 LangCode: string;
219begin
220 with TRegistryEx.Create do
221 try
222 CurrentContext := ApplicationInfo1.GetRegistryContext;
223
224 if ValueExists('LanguageCode') then begin
225 LangCode := ReadStringWithDefault('LanguageCode', '');
226 Core.Core.Translator1.Language := Core.Core.Translator1.Languages.SearchByCode(LangCode);
227 end else Core.Core.Translator1.Language := Core.Core.Translator1.Languages.SearchByCode('');
228 Engine.LoadFromRegistry;
229 finally
230 Free;
231 end;
232end;
233
234procedure TFormMain.SaveConfig;
235begin
236 with TRegistryEx.Create do
237 try
238 CurrentContext := ApplicationInfo1.GetRegistryContext;
239
240 if Assigned(Core.Core.Translator1.Language) and (Core.Core.Translator1.Language.Code <> '') then
241 WriteString('LanguageCode', Core.Core.Translator1.Language.Code)
242 else DeleteValue('LanguageCode');
243 Engine.SaveToRegistry;
244 finally
245 Free;
246 end;
247end;
248
249procedure TFormMain.LoadGraphicAssets;
250var
251 FormImages: TFormImages;
252begin
253 FormImages := TFormImages.Create(nil);
254
255 CopyImage(Engine.ImagePassenger.Bitmap, FormImages.ImagePassenger.Picture.Bitmap);
256 CopyImage(Engine.ImagePassenger.BitmapDisabled, FormImages.ImagePassenger.Picture.Bitmap, True);
257 CopyImage(Engine.ImageLocomotive.Bitmap, FormImages.ImageLocomotive.Picture.Bitmap);
258 CopyImage(Engine.ImageLocomotive.BitmapDisabled, FormImages.ImageLocomotive.Picture.Bitmap, True);
259 CopyImage(Engine.ImageLine.Bitmap, FormImages.ImageLine.Picture.Bitmap);
260 CopyImage(Engine.ImageLine.BitmapDisabled, FormImages.ImageLine.Picture.Bitmap, True);
261 CopyImage(Engine.ImageTerminal.Bitmap, FormImages.ImageTerminal.Picture.Bitmap);
262 CopyImage(Engine.ImageTerminal.BitmapDisabled, FormImages.ImageTerminal.Picture.Bitmap, True);
263 CopyImage(Engine.ImageTunnel.Bitmap, FormImages.ImageTunnel.Picture.Bitmap);
264 CopyImage(Engine.ImageTunnel.BitmapDisabled, FormImages.ImageTunnel.Picture.Bitmap, True);
265 CopyImage(Engine.ImageCarriage.Bitmap, FormImages.ImageCarriage.Picture.Bitmap);
266 CopyImage(Engine.ImageCarriage.BitmapDisabled, FormImages.ImageCarriage.Picture.Bitmap, True);
267 CopyImage(Engine.ButtonBack.Bitmap, FormImages.ImageLeftArrow.Picture.Bitmap);
268 CopyImage(Engine.ButtonBack.BitmapDisabled, FormImages.ImageLeftArrow.Picture.Bitmap, True);
269 CopyImage(Engine.ImagePlay.Bitmap, FormImages.ImagePlay.Picture.Bitmap);
270 CopyImage(Engine.ImagePlay.BitmapDisabled, FormImages.ImagePlay.Picture.Bitmap, True);
271 CopyImage(Engine.ImagePause.Bitmap, FormImages.ImagePause.Picture.Bitmap);
272 CopyImage(Engine.ImagePause.BitmapDisabled, FormImages.ImagePause.Picture.Bitmap, True);
273 CopyImage(Engine.ImageFastForward.Bitmap, FormImages.ImageFastForward.Picture.Bitmap);
274 CopyImage(Engine.ImageFastForward.BitmapDisabled, FormImages.ImageFastForward.Picture.Bitmap, True);
275 CopyImage(Engine.ImageAchievement.Bitmap, FormImages.ImageAchievement.Picture.Bitmap);
276 CopyImage(Engine.ImageAchievement.BitmapDisabled, FormImages.ImageAchievement.Picture.Bitmap, True);
277 if Engine.DarkMode then begin
278 BitmapInvert(Engine.ImagePassenger.Bitmap);
279 BitmapInvert(Engine.ImagePassenger.BitmapDisabled);
280 BitmapInvert(Engine.ImageLocomotive.Bitmap);
281 BitmapInvert(Engine.ImageLocomotive.BitmapDisabled);
282 BitmapInvert(Engine.ImageLine.Bitmap);
283 BitmapInvert(Engine.ImageLine.BitmapDisabled);
284 BitmapInvert(Engine.ImageTerminal.Bitmap);
285 BitmapInvert(Engine.ImageTerminal.BitmapDisabled);
286 BitmapInvert(Engine.ImageTunnel.Bitmap);
287 BitmapInvert(Engine.ImageTunnel.BitmapDisabled);
288 BitmapInvert(Engine.ImageCarriage.Bitmap);
289 BitmapInvert(Engine.ImageCarriage.BitmapDisabled);
290 BitmapInvert(Engine.ButtonBack.Bitmap);
291 BitmapInvert(Engine.ButtonBack.BitmapDisabled);
292 BitmapInvert(Engine.ImagePlay.Bitmap);
293 BitmapInvert(Engine.ImagePlay.BitmapDisabled);
294 BitmapInvert(Engine.ImagePause.Bitmap);
295 BitmapInvert(Engine.ImagePause.BitmapDisabled);
296 BitmapInvert(Engine.ImageFastForward.Bitmap);
297 BitmapInvert(Engine.ImageFastForward.BitmapDisabled);
298 BitmapInvert(Engine.ImageAchievement.Bitmap);
299 BitmapInvert(Engine.ImageAchievement.BitmapDisabled);
300 end;
301 Engine.ImageNewTrain.Bitmap.Assign(Engine.ImageLocomotive.Bitmap);
302 Engine.ImageNewTrain.BitmapDisabled.Assign(Engine.ImageLocomotive.BitmapDisabled);
303
304 FreeAndNil(FormImages);
305end;
306
307procedure TFormMain.DarkModeChangeExecute(Sender: TObject);
308begin
309 LoadGraphicAssets;
310end;
311
312procedure TFormMain.CopyImage(DestBmp: TBitmap; SourceBmp: TBitmap;
313 Grayed: Boolean);
314begin
315 DestBmp.PixelFormat := SourceBmp.PixelFormat;
316 DestBmp.SetSize(0, 0);
317 DestBmp.SetSize(SourceBmp.Width, SourceBmp.Height);
318 BitmapCopyRect(DestBmp, Bounds(0, 0, DestBmp.Width, DestBmp.Height), SourceBmp,
319 Point(0, 0));
320 if Grayed then BitmapBlendColor(DestBmp, $ffffffff);
321end;
322
323end.
324
Note: See TracBrowser for help on using the repository browser.