Rev 17 | Rev 20 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 17 | Rev 19 | ||
---|---|---|---|
Line 20... | Line 20... | ||
20 | 20 | ||
21 | interface |
21 | interface |
22 | 22 | ||
23 | uses |
23 | uses |
24 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, |
24 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, |
25 | Dialogs, ExtCtrls, StdCtrls, Game, MPlayer; |
25 | Dialogs, ExtCtrls, StdCtrls, Game, MPlayer, SyncObjs; |
26 | 26 | ||
27 | type |
27 | type |
28 | TMainForm = class(TForm) |
28 | TMainForm = class(TForm) |
29 | Image1: TImage; |
29 | Image1: TImage; |
30 | Panel1: TPanel; |
30 | Panel1: TPanel; |
Line 40... | Line 40... | ||
40 | FHotspots: array[0..2] of THotspot; |
40 | FHotspots: array[0..2] of THotspot; |
41 | FullscreenMode: boolean; |
41 | FullscreenMode: boolean; |
42 | procedure cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType); |
42 | procedure cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType); |
43 | procedure cbAsyncSound(ASender: TGame; AFilename: string); |
43 | procedure cbAsyncSound(ASender: TGame; AFilename: string); |
44 | procedure cbExit(ASender: TGame); |
44 | procedure cbExit(ASender: TGame); |
45 | procedure cbWait(ASender: TGame; AMilliseconds: integer); |
45 | function cbWait(ASender: TGame; AMilliseconds: integer): boolean; |
46 | procedure cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot); |
46 | procedure cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot); |
47 | procedure cbClearHotspots(ASender: TGame); |
47 | procedure cbClearHotspots(ASender: TGame); |
48 | procedure ClickEvent(X, Y: Integer); |
48 | procedure ClickEvent(X, Y: Integer); |
- | 49 | private |
|
- | 50 | FCancelSceneRequest: boolean; |
|
- | 51 | csCancelSceneRequest: TCriticalSection; |
|
49 | public |
52 | public |
50 | game: TGame; |
53 | game: TGame; |
51 | end; |
54 | end; |
52 | 55 | ||
53 | var |
56 | var |
Line 56... | Line 59... | ||
56 | implementation |
59 | implementation |
57 | 60 | ||
58 | {$R *.dfm} |
61 | {$R *.dfm} |
59 | 62 | ||
60 | uses |
63 | uses |
61 | MMSystem, IniFiles, Math; |
64 | MMSystem, IniFiles, Math, GameBinStruct; |
62 | - | ||
63 | procedure Delay(const Milliseconds: DWord); |
- | |
64 | var |
- | |
65 | FirstTickCount: DWord; |
- | |
66 | begin |
- | |
67 | FirstTickCount := GetTickCount; // TODO: Attention, GetTickCount can overflow |
- | |
68 | while not Application.Terminated and ((GetTickCount - FirstTickCount) < Milliseconds) do |
- | |
69 | begin |
- | |
70 | Application.ProcessMessages; |
- | |
71 | Sleep(0); |
- | |
72 | end; |
- | |
73 | end; |
- | |
74 | 65 | ||
75 | function AddThouSeps(const S: string): string; |
66 | function AddThouSeps(const S: string): string; |
76 | var |
67 | var |
77 | LS, L2, I, N: Integer; |
68 | LS, L2, I, N: Integer; |
78 | Temp: string; |
69 | Temp: string; |
Line 104... | Line 95... | ||
104 | 95 | ||
105 | procedure TMainForm.cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType); |
96 | procedure TMainForm.cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType); |
106 | resourcestring |
97 | resourcestring |
107 | S_YOUR_SCORE = 'Your score is: %s'; |
98 | S_YOUR_SCORE = 'Your score is: %s'; |
108 | begin |
99 | begin |
- | 100 | {$IFDEF DEBUG} |
|
- | 101 | Caption := AFileName; |
|
- | 102 | {$ENDIF} |
|
- | 103 | ||
109 | if FileExists(AFilename) then |
104 | if FileExists(AFilename) then |
110 | begin |
105 | begin |
111 | Image1.Visible := false; |
106 | Image1.Visible := false; |
112 | try |
107 | try |
113 | Image1.Picture.LoadFromFile(AFilename); |
108 | Image1.Picture.LoadFromFile(AFilename); |
Line 135... | Line 130... | ||
135 | Image1.Left := ClientWidth div 2 - Image1.Width div 2; |
130 | Image1.Left := ClientWidth div 2 - Image1.Width div 2; |
136 | Image1.Top := ClientHeight div 2 - Image1.Height div 2; |
131 | Image1.Top := ClientHeight div 2 - Image1.Height div 2; |
137 | end |
132 | end |
138 | else |
133 | else |
139 | begin |
134 | begin |
- | 135 | ShowMessageFmt('File not found: %s', [AFileName]); |
|
140 | Image1.Picture := nil; |
136 | Image1.Picture := nil; |
141 | end; |
137 | end; |
142 | 138 | ||
143 | if FullScreenMode then |
139 | if FullScreenMode then |
144 | begin |
140 | begin |
Line 183... | Line 179... | ||
183 | procedure TMainForm.cbExit(ASender: TGame); |
179 | procedure TMainForm.cbExit(ASender: TGame); |
184 | begin |
180 | begin |
185 | Application.Terminate; |
181 | Application.Terminate; |
186 | end; |
182 | end; |
187 | 183 | ||
188 | procedure TMainForm.cbWait(ASender: TGame; AMilliseconds: integer); |
184 | function TMainForm.cbWait(ASender: TGame; AMilliseconds: integer): boolean; |
- | 185 | var |
|
- | 186 | FirstTickCount: DWord; |
|
189 | begin |
187 | begin |
190 | //Cursor := crHourglass; |
188 | //Cursor := crHourglass; |
191 | try |
189 | try |
- | 190 | result := false; // don't cancel |
|
- | 191 | FirstTickCount := GetTickCount; // TODO: Attention, GetTickCount can overflow |
|
- | 192 | while not Application.Terminated and ((GetTickCount - FirstTickCount) < AMilliseconds) do |
|
- | 193 | begin |
|
- | 194 | csCancelSceneRequest.Acquire; |
|
- | 195 | try |
|
- | 196 | if FCancelSceneRequest then |
|
- | 197 | begin |
|
- | 198 | FCancelSceneRequest := false; |
|
- | 199 | result := true; // cancel |
|
- | 200 | exit; |
|
- | 201 | end; |
|
- | 202 | finally |
|
- | 203 | csCancelSceneRequest.Release; |
|
- | 204 | end; |
|
- | 205 | Application.ProcessMessages; |
|
192 | Delay(AMilliseconds); |
206 | Sleep(0); |
- | 207 | end; |
|
193 | finally |
208 | finally |
194 | //Cursor := crDefault; |
209 | //Cursor := crDefault; |
195 | end; |
210 | end; |
196 | end; |
211 | end; |
197 | 212 | ||
198 | procedure TMainForm.FormCreate(Sender: TObject); |
213 | procedure TMainForm.FormCreate(Sender: TObject); |
199 | var |
214 | var |
200 | ini: TMemIniFile; |
215 | ini: TMemIniFile; |
201 | iniFilename: string; |
216 | iniFilename: string; |
202 | begin |
217 | begin |
- | 218 | csCancelSceneRequest := TCriticalSection.Create; |
|
203 | iniFilename := ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini'); |
219 | iniFilename := ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini'); |
204 | 220 | ||
205 | DoubleBuffered := true; |
221 | DoubleBuffered := true; |
206 | 222 | ||
207 | if FileExists(iniFilename) then |
223 | if FileExists(iniFilename) then |
Line 226... | Line 242... | ||
226 | FreeAndNil(Game); |
242 | FreeAndNil(Game); |
227 | 243 | ||
228 | // Without this, some audio drivers could crash if you press ESC to end the game. |
244 | // Without this, some audio drivers could crash if you press ESC to end the game. |
229 | // (VPC 2007 with Win95; cpsman.dll crashes sometimes) |
245 | // (VPC 2007 with Win95; cpsman.dll crashes sometimes) |
230 | PlaySound(nil, hinstance, 0); |
246 | PlaySound(nil, hinstance, 0); |
- | 247 | FreeAndNil(csCancelSceneRequest); |
|
- | 248 | if Assigned(Game) then FreeAndNil(Game); |
|
231 | end; |
249 | end; |
232 | 250 | ||
233 | procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; |
251 | procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; |
234 | Shift: TShiftState); |
252 | Shift: TShiftState); |
235 | begin |
253 | begin |
236 | if Key = VK_SPACE then |
254 | if Key = VK_SPACE then |
237 | begin |
255 | begin |
238 | if MediaPlayer1.Mode = mpPlaying then MediaPlayer1.Stop; |
256 | if MediaPlayer1.Mode = mpPlaying then MediaPlayer1.Stop; |
239 | end; |
257 | end; |
- | 258 | if KEY = VK_RETURN then |
|
- | 259 | begin |
|
- | 260 | if MediaPlayer1.Mode = mpPlaying then |
|
- | 261 | begin |
|
- | 262 | MediaPlayer1.Position := MediaPlayer1.EndPos; |
|
- | 263 | end; |
|
- | 264 | csCancelSceneRequest.Acquire; |
|
- | 265 | try |
|
- | 266 | FCancelSceneRequest := true; |
|
- | 267 | finally |
|
- | 268 | csCancelSceneRequest.Release; |
|
- | 269 | end; |
|
- | 270 | end; |
|
240 | if Key = VK_ESCAPE then Close; |
271 | if Key = VK_ESCAPE then Close; |
241 | end; |
272 | end; |
242 | 273 | ||
243 | procedure TMainForm.ClickEvent(X, Y: Integer); |
274 | procedure TMainForm.ClickEvent(X, Y: Integer); |
244 | var |
275 | var |
245 | i: integer; |
276 | i: integer; |
- | 277 | ac: TActionDef; |
|
- | 278 | begin |
|
- | 279 | // Debug: Go to prev decision by clicking on the top left edge |
|
- | 280 | if (X < 20) and (Y < 20) then |
|
246 | begin |
281 | begin |
- | 282 | // TODO: Also allow to go back multiple steps |
|
- | 283 | ac.scoreDelta := 0; |
|
- | 284 | ac.nextSceneID := SCENEID_PREVDECISION; |
|
- | 285 | ac.sceneSegment := 0; |
|
- | 286 | Game.PerformAction(@ac); |
|
- | 287 | Exit; |
|
- | 288 | end; |
|
- | 289 | ||
247 | // If hotspots are overlaying, the lowest action will be chosen (same behavior as original game) |
290 | // If hotspots are overlaying, the lowest action will be chosen (same behavior as original game) |
248 | for i := Low(FHotspots) to High(FHotspots) do |
291 | for i := Low(FHotspots) to High(FHotspots) do |
249 | begin |
292 | begin |
250 | if Assigned(FHotspots[i].lpAction) and |
293 | if Assigned(FHotspots[i].lpAction) and |
251 | (X >= FHotspots[i].cHotspotTopLeft.X) and |
294 | (X >= FHotspots[i].cHotspotTopLeft.X) and |