1 | unit UFormMain;
|
---|
2 |
|
---|
3 | {$mode delphi}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, Math,
|
---|
9 | ActnList, ExtCtrls, StdCtrls, UGame, UPersistentForm, UApplicationInfo,
|
---|
10 | LCLType, Syncobjs, DateUtils;
|
---|
11 |
|
---|
12 | type
|
---|
13 | TFormMain = class;
|
---|
14 |
|
---|
15 | { TMoveThread }
|
---|
16 |
|
---|
17 | TMoveThread = class(TThread)
|
---|
18 | FormMain: TFormMain;
|
---|
19 | procedure Execute; override;
|
---|
20 | end;
|
---|
21 |
|
---|
22 | { TFormMain }
|
---|
23 |
|
---|
24 | TFormMain = class(TForm)
|
---|
25 | MainMenu1: TMainMenu;
|
---|
26 | MenuItem1: TMenuItem;
|
---|
27 | MenuItem2: TMenuItem;
|
---|
28 | MenuItem3: TMenuItem;
|
---|
29 | MenuItem4: TMenuItem;
|
---|
30 | MenuItem5: TMenuItem;
|
---|
31 | MenuItemFullScreen: TMenuItem;
|
---|
32 | MenuItemMovesHistory: TMenuItem;
|
---|
33 | MenuItemTools: TMenuItem;
|
---|
34 | MenuItemNew: TMenuItem;
|
---|
35 | MenuItemExit: TMenuItem;
|
---|
36 | MenuItemHelp: TMenuItem;
|
---|
37 | MenuItemAbout: TMenuItem;
|
---|
38 | MenuItemGame: TMenuItem;
|
---|
39 | TimerDraw: TTimer;
|
---|
40 | procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
---|
41 | procedure FormCreate(Sender: TObject);
|
---|
42 | procedure FormDestroy(Sender: TObject);
|
---|
43 | procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
44 | procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
45 | Shift: TShiftState; X, Y: Integer);
|
---|
46 | procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
---|
47 | procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
48 | Shift: TShiftState; X, Y: Integer);
|
---|
49 | procedure FormPaint(Sender: TObject);
|
---|
50 | procedure FormShow(Sender: TObject);
|
---|
51 | procedure MenuItemFullScreenClick(Sender: TObject);
|
---|
52 | procedure TimerDrawTimer(Sender: TObject);
|
---|
53 | procedure EraseBackground(DC: HDC); override;
|
---|
54 | private
|
---|
55 | DrawDuration: TDateTime;
|
---|
56 | MouseStart: TPoint;
|
---|
57 | MouseDown: Boolean;
|
---|
58 | RedrawPending: Boolean;
|
---|
59 | MoveBuffer: array of TMoveDirection;
|
---|
60 | MoveBufferLock: TCriticalSection;
|
---|
61 | FullScreen: Boolean;
|
---|
62 | procedure AddToMoveBuffer(Direction: TMoveDirection);
|
---|
63 | procedure ProcessMoveBuffer;
|
---|
64 | procedure ToggleFullscreen;
|
---|
65 | public
|
---|
66 | MoveThread: TMoveThread;
|
---|
67 | procedure Redraw;
|
---|
68 | procedure UpdateInterface;
|
---|
69 | end;
|
---|
70 |
|
---|
71 | var
|
---|
72 | FormMain: TFormMain;
|
---|
73 |
|
---|
74 | implementation
|
---|
75 |
|
---|
76 | {$R *.lfm}
|
---|
77 |
|
---|
78 | uses
|
---|
79 | UCore;
|
---|
80 |
|
---|
81 | { TMoveThread }
|
---|
82 |
|
---|
83 | procedure TMoveThread.Execute;
|
---|
84 | begin
|
---|
85 | while not Terminated do begin
|
---|
86 | FormMain.ProcessMoveBuffer;
|
---|
87 | Sleep(10);
|
---|
88 | end;
|
---|
89 | end;
|
---|
90 |
|
---|
91 | { TFormMain }
|
---|
92 |
|
---|
93 | procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
94 | const
|
---|
95 | KeyLeft = 37;
|
---|
96 | KeyUp = 38;
|
---|
97 | KeyRight = 39;
|
---|
98 | KeyDown = 40;
|
---|
99 | begin
|
---|
100 | if Core.Game.Running then begin
|
---|
101 | case Key of
|
---|
102 | KeyLeft: AddToMoveBuffer(drLeft);
|
---|
103 | KeyUp: AddToMoveBuffer(drUp);
|
---|
104 | KeyRight: AddToMoveBuffer(drRight);
|
---|
105 | KeyDown: AddToMoveBuffer(drDown);
|
---|
106 | end;
|
---|
107 | //ProcessMoveBuffer;
|
---|
108 | end;
|
---|
109 | end;
|
---|
110 |
|
---|
111 | procedure TFormMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
|
---|
112 | Shift: TShiftState; X, Y: Integer);
|
---|
113 | begin
|
---|
114 | MouseStart := Point(X, Y);
|
---|
115 | MouseDown := True;
|
---|
116 | end;
|
---|
117 |
|
---|
118 | function AngleOfLine(const P1, P2: TPoint): Double;
|
---|
119 | begin
|
---|
120 | if P2.X = P1.X then
|
---|
121 | if P2.Y > P1.Y then
|
---|
122 | Result := 90
|
---|
123 | else
|
---|
124 | Result := 270
|
---|
125 | else
|
---|
126 | Result := RadToDeg(ArcTan2(P2.Y - P1.Y, P2.X - P1.X));
|
---|
127 | if Result < 0 then
|
---|
128 | Result := Result + 360;
|
---|
129 | end;
|
---|
130 |
|
---|
131 | procedure TFormMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
|
---|
132 | Y: Integer);
|
---|
133 | var
|
---|
134 | D: Real;
|
---|
135 | Angle: Real;
|
---|
136 | begin
|
---|
137 | if MouseDown then begin;
|
---|
138 | D := MouseStart.Distance(Point(X, Y));
|
---|
139 | if D > ScaleX(100, 96) then begin
|
---|
140 | MouseDown := False;
|
---|
141 | Angle := AngleOfLine(MouseStart, Point(X, Y));
|
---|
142 | if (Angle > 315) or (Angle <= 45) then AddToMoveBuffer(drRight)
|
---|
143 | else if (Angle > 45) and (Angle <= 135) then AddToMoveBuffer(drDown)
|
---|
144 | else if (Angle > 135) and (Angle <= 225) then AddToMoveBuffer(drLeft)
|
---|
145 | else if (Angle > 225) and (Angle <= 315) then AddToMoveBuffer(drUp);
|
---|
146 | //ProcessMoveBuffer;
|
---|
147 | end;
|
---|
148 | end;
|
---|
149 | end;
|
---|
150 |
|
---|
151 | procedure TFormMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
|
---|
152 | Shift: TShiftState; X, Y: Integer);
|
---|
153 | begin
|
---|
154 | MouseDown := False;
|
---|
155 | end;
|
---|
156 |
|
---|
157 | procedure TFormMain.FormPaint(Sender: TObject);
|
---|
158 | var
|
---|
159 | TimeStart: TDateTime;
|
---|
160 | begin
|
---|
161 | {$IFDEF DEBUG}
|
---|
162 | TimeStart := Now;
|
---|
163 | {$ENDIF}
|
---|
164 | Core.Game.Render(Canvas, Point(Width, Height - MainMenu1.Height));
|
---|
165 | {$IFDEF DEBUG}
|
---|
166 | DrawDuration := Now - TimeStart;
|
---|
167 | {$ENDIF}
|
---|
168 | end;
|
---|
169 |
|
---|
170 | procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
---|
171 | begin
|
---|
172 | Core.PersistentForm1.Save(Self);
|
---|
173 | end;
|
---|
174 |
|
---|
175 | procedure TFormMain.FormCreate(Sender: TObject);
|
---|
176 | begin
|
---|
177 | Core.Translator1.TranslateComponentRecursive(Self);
|
---|
178 | MoveBufferLock := TCriticalSection.Create;
|
---|
179 | MoveThread := TMoveThread.Create(True);
|
---|
180 | MoveThread.FormMain := Self;
|
---|
181 | MoveThread.FreeOnTerminate := False;
|
---|
182 | MoveThread.Start;
|
---|
183 | ControlStyle := ControlStyle + [csOpaque];
|
---|
184 | end;
|
---|
185 |
|
---|
186 | procedure TFormMain.FormDestroy(Sender: TObject);
|
---|
187 | begin
|
---|
188 | FreeAndNil(MoveThread);
|
---|
189 | FreeAndNil(MoveBufferLock);
|
---|
190 | end;
|
---|
191 |
|
---|
192 | procedure TFormMain.FormShow(Sender: TObject);
|
---|
193 | begin
|
---|
194 | Core.PersistentForm1.RegistryContext := Core.ApplicationInfo1.GetRegistryContext;
|
---|
195 | Core.PersistentForm1.Load(Self);
|
---|
196 | FullScreen := Core.PersistentForm1.FormFullScreen;
|
---|
197 | Core.ThemeManager1.UseTheme(Self);
|
---|
198 | UpdateInterface;
|
---|
199 | if Core.Game.Board.GetEmptyTilesCount > Core.Game.Board.Size.X * Core.Game.Board.Size.Y -
|
---|
200 | InitialTileCount then
|
---|
201 | Core.Game.New;
|
---|
202 | end;
|
---|
203 |
|
---|
204 | procedure TFormMain.MenuItemFullScreenClick(Sender: TObject);
|
---|
205 | begin
|
---|
206 | ToggleFullscreen;
|
---|
207 | end;
|
---|
208 |
|
---|
209 | procedure TFormMain.TimerDrawTimer(Sender: TObject);
|
---|
210 | begin
|
---|
211 | if RedrawPending then begin
|
---|
212 | RedrawPending := False;
|
---|
213 | Repaint;
|
---|
214 | {$IFDEF DEBUG}
|
---|
215 | //Caption := FloatToStr(Round(DrawDuration / OneMillisecond));
|
---|
216 | {$ENDIF}
|
---|
217 | end;
|
---|
218 | end;
|
---|
219 |
|
---|
220 | procedure TFormMain.EraseBackground(DC: HDC);
|
---|
221 | begin
|
---|
222 | // Do nothing
|
---|
223 | end;
|
---|
224 |
|
---|
225 | procedure TFormMain.AddToMoveBuffer(Direction: TMoveDirection);
|
---|
226 | begin
|
---|
227 | MoveBufferLock.Acquire;
|
---|
228 | try
|
---|
229 | SetLength(MoveBuffer, Length(MoveBuffer) + 1);
|
---|
230 | MoveBuffer[Length(MoveBuffer) - 1] := Direction;
|
---|
231 | finally
|
---|
232 | MoveBufferLock.Release;
|
---|
233 | end;
|
---|
234 | end;
|
---|
235 |
|
---|
236 | procedure TFormMain.ProcessMoveBuffer;
|
---|
237 | begin
|
---|
238 | if not Core.Game.Moving then begin
|
---|
239 | MoveBufferLock.Acquire;
|
---|
240 | while Length(MoveBuffer) > 0 do begin
|
---|
241 | MoveBufferLock.Release;
|
---|
242 | Core.Game.MoveAllAndUpdate(MoveBuffer[0], Core.Game.AnimationDuration > 0);
|
---|
243 | MoveBufferLock.Acquire;
|
---|
244 | if Length(MoveBuffer) > 1 then
|
---|
245 | Move(MoveBuffer[1], MoveBuffer[0], (Length(MoveBuffer) - 1) * SizeOf(TMoveDirection));
|
---|
246 | if Length(MoveBuffer) > 0 then
|
---|
247 | SetLength(MoveBuffer, Length(MoveBuffer) - 1);
|
---|
248 | end;
|
---|
249 | MoveBufferLock.Release;
|
---|
250 | end;
|
---|
251 | end;
|
---|
252 |
|
---|
253 | procedure TFormMain.ToggleFullscreen;
|
---|
254 | begin
|
---|
255 | FullScreen := not FullScreen;
|
---|
256 | Core.PersistentForm1.SetFullScreen(FormMain.FullScreen);
|
---|
257 | UpdateInterface;
|
---|
258 | end;
|
---|
259 |
|
---|
260 | procedure TFormMain.Redraw;
|
---|
261 | begin
|
---|
262 | RedrawPending := True;
|
---|
263 | end;
|
---|
264 |
|
---|
265 | procedure TFormMain.UpdateInterface;
|
---|
266 | var
|
---|
267 | I: Integer;
|
---|
268 | ToolsVisible: Boolean;
|
---|
269 | begin
|
---|
270 | MenuItemFullScreen.Checked := FullScreen;
|
---|
271 | MenuItemMovesHistory.Visible := Core.Game.RecordHistory;
|
---|
272 | ToolsVisible := False;
|
---|
273 | for I := 0 to MenuItemTools.Count - 1 do
|
---|
274 | if MenuItemTools.Items[I].Visible then begin
|
---|
275 | ToolsVisible := True;
|
---|
276 | Break;
|
---|
277 | end;
|
---|
278 | MenuItemTools.Visible := ToolsVisible;
|
---|
279 | end;
|
---|
280 |
|
---|
281 | end.
|
---|
282 |
|
---|