WebSVN – plumbers – Diff – /trunk/Win32_Player/Main.pas


unit Main;
 
// BUG: If you drag the window, the dia show will stop playing, but the sound continues! This makes everything out of sync.
// TODO: When the windows is only resized a little bit (A few pixels), the window should not centered
//       ... Calc the width and height of ALL pictures, and then size the form to the biggest value?
//       ... or hard code the resolution in the INI file?
// Idea: Ini Parameter if fullscreen is applied or not
// Idea: Savestates, speedup, pause, Use Space bar to go to the next decision point.
 
// -----------------------------------------------------------------------------
 
// HOTSPOT_RELATIVE_ORIGIN is a new behavior which is not compatible with the original engine.
// With HOTSPOT_RELATIVE_ORIGIN enabled, the coordinates will be relative to the picture
// The original game has the origin at the top left corner of the screen.
// This is a problem because the game as well as the scene editor does not know the
// desired resolution, as it is automatically determined.
// If we would hardcode the desired canvas (640x480) in <ExeName>.ini, then
// it would work, but then, the scene Editor can not know the desired resolution...
{$DEFINE HOTSPOT_RELATIVE_ORIGIN}
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Game, MPlayer, SyncObjs;
 
type
  TMainForm = class(TForm)
    Image1: TImage;
    Panel1: TPanel;
    StartupTimer: TTimer;
    MediaPlayer1: TMediaPlayer;
    Panel2: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure StartupTimerTimer(Sender: TObject);
    procedure ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
  private
    FHotspots: array[0..2] of THotspot;
    FullscreenMode: boolean;
    procedure cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType);
    procedure cbAsyncSound(ASender: TGame; AFilename: string);
    procedure cbExit(ASender: TGame);
    function cbWait(ASender: TGame; AMilliseconds: integer): boolean;
    procedure cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);
    procedure cbClearHotspots(ASender: TGame);
    procedure ClickEvent(X, Y: Integer);
  private
    FCancelSceneRequest: boolean;
    csCancelSceneRequest: TCriticalSection;
  public
    game: TGame;
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.dfm}
 
uses
  MMSystem, IniFiles, Math, GameBinStruct;
 
 
 
 
 
 
 
 
 
 
 
 
 
function AddThouSeps(const S: string): string;
var
  LS, L2, I, N: Integer;
  Temp: string;
begin
  // http://www.delphigroups.info/2/11/471892.html
  result := S ;
  LS := Length(S);
  N := 1 ;
  if LS > 1 then
  begin
    if S [1] = '-' then  // check for negative value
    begin
      N := 2;
      LS := LS - 1;
    end;
  end;
  if LS <= 3 then exit;
  L2 := (LS - 1) div 3;
  Temp := '';
  for I := 1 to L2 do
  begin
    Temp := {$IF not Declared(ThousandSeparator)}FormatSettings.{$IFEND}ThousandSeparator + Copy (S, LS - 3 * I + 1, 3) + Temp;
  end;
  Result := Copy (S, N, (LS - 1) mod 3 + 1) + Temp;
  if N > 1 then Result := '-' + Result;
end;
 
{ TMainForm }
 
procedure TMainForm.cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType);
resourcestring
  S_YOUR_SCORE = 'Your score is: %s';
begin
  {$IFDEF DEBUG}
  Caption := AFileName;
  {$ENDIF}
 
  if FileExists(AFilename) then
  begin
    Image1.Visible := false;
    try
      Image1.Picture.LoadFromFile(AFilename);
      Image1.Autosize := true;
    finally
      // This speeds up the picture loading on very old computers
      Image1.Visible := true;
    end;
 
    // Make form bigger if necessary
    if Image1.Width > ClientWidth then
    begin
      ClientWidth := Min(Image1.Width, Screen.Width);
      if (ClientWidth >= Screen.Width) then FullscreenMode := true;
      Position := poScreenCenter;
    end;
    if Image1.Height > ClientHeight then
    begin
      ClientHeight := Min(Image1.Height, Screen.Height);
      if (ClientHeight >= Screen.Height) then FullscreenMode := true;
      Position := poScreenCenter;
    end;
 
    // Center image
    Image1.Left := ClientWidth div 2 - Image1.Width div 2;
    Image1.Top := ClientHeight div 2 - Image1.Height div 2;
  end
  else
  begin
    ShowMessageFmt('File not found: %s', [AFileName]);
    Image1.Picture := nil;
  end;
 
  if FullScreenMode then
  begin
    BorderStyle := bsNone;
    FormStyle := fsStayOnTop;
    Case AType of
      ptDia: Screen.Cursor := -1;
      ptDecision: Screen.Cursor := 0;
    End;
  end;
 
  Panel1.Caption := Format(S_YOUR_SCORE, [AddThouSeps(IntToStr(ASender.Score))]);
  Panel1.Left := 8;
  Panel1.Top := Min(ClientHeight, Screen.Height) - Panel1.Height - 8;
  Panel1.Visible := AType = ptDecision;
end;
 
procedure TMainForm.cbAsyncSound(ASender: TGame; AFilename: string);
begin
  PlaySound(nil, hinstance, 0);
  if FileExists(AFilename) then
  begin
    PlaySound(PChar(AFilename), hinstance, SND_FILENAME or SND_ASYNC);
  end;
end;
 
procedure TMainForm.cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);
begin
  FHotspots[AIndex] := AHotspot;
end;
 
procedure TMainForm.cbClearHotspots(ASender: TGame);
var
  i: Integer;
begin
  for i := Low(FHotspots) to High(FHotspots) - 1 do
  begin
    FHotspots[i].lpAction := nil;
  end;
end;
 
procedure TMainForm.cbExit(ASender: TGame);
begin
  Application.Terminate;
end;
 
function TMainForm.cbWait(ASender: TGame; AMilliseconds: integer): boolean;
var
  FirstTickCount: DWord;
begin
  //Cursor := crHourglass;
  try
    result := false; // don't cancel
    FirstTickCount := GetTickCount; // TODO: Attention, GetTickCount can overflow
    while not Application.Terminated and ((GetTickCount - FirstTickCount) < AMilliseconds) do
    begin
      csCancelSceneRequest.Acquire;
      try
        if FCancelSceneRequest then
        begin
          FCancelSceneRequest := false;
          result := true; // cancel
          exit;
        end;
      finally
        csCancelSceneRequest.Release;
      end;
      Application.ProcessMessages;
      Sleep(0);
    end;
  finally
    //Cursor := crDefault;
  end;
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
var
  ini: TMemIniFile;
  iniFilename: string;
begin
  csCancelSceneRequest := TCriticalSection.Create;
  iniFilename := ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini');
 
  DoubleBuffered := true;
 
  if FileExists(iniFilename) then
  begin
    ini := TMemIniFile.Create(iniFilename);
    try
      Caption := ini.ReadString('Config', 'Title', '');
    finally
      FreeAndNil(ini);
    end;
  end;
 
  try
    StartupTimer.Enabled := true;
  except
    Application.Terminate;
  end;
end;
 
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(Game);
 
  // Without this, some audio drivers could crash if you press ESC to end the game.
  // (VPC 2007 with Win95; cpsman.dll crashes sometimes)
  PlaySound(nil, hinstance, 0);
  FreeAndNil(csCancelSceneRequest);
  if Assigned(Game) then FreeAndNil(Game);
end;
 
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_SPACE then
  begin
    if MediaPlayer1.Mode = mpPlaying then MediaPlayer1.Stop;
  end;
  if KEY = VK_RETURN then
  begin
    if MediaPlayer1.Mode = mpPlaying then
    begin
      MediaPlayer1.Position := MediaPlayer1.EndPos;
    end;
    csCancelSceneRequest.Acquire;
    try
      FCancelSceneRequest := true;
    finally
      csCancelSceneRequest.Release;
    end;
  end;
  if Key = VK_ESCAPE then Close;
end;
 
procedure TMainForm.ClickEvent(X, Y: Integer);
var
  i: integer;
  ac: TActionDef;
begin
  // Debug: Go to prev decision by clicking on the top left edge
  if (X < 20) and (Y < 20) then
  begin
    // TODO: Also allow to go back multiple steps
    ac.scoreDelta := 0;
    ac.nextSceneID := SCENEID_PREVDECISION;
    ac.sceneSegment := 0;
    Game.PerformAction(@ac);
    Exit;
  end;
 
  // If hotspots are overlaying, the lowest action will be chosen (same behavior as original game)
  for i := Low(FHotspots) to High(FHotspots) do
  begin
    if Assigned(FHotspots[i].lpAction) and
       (X >= FHotspots[i].cHotspotTopLeft.X) and
       (Y >= FHotspots[i].cHotspotTopLeft.Y) and
       (X <= FHotspots[i].cHotspotBottomRight.X) and
       (Y <= FHotspots[i].cHotspotBottomRight.Y) then
    begin
      FHotspots[i].Game.PerformAction(FHotspots[i].lpAction);
      Exit;
    end;
  end;
end;
 
procedure TMainForm.ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  {$IFDEF HOTSPOT_RELATIVE_ORIGIN}
  ClickEvent(X, Y);
  {$ELSE}
  ClickEvent(X+TControl(Sender).Left, Y+TControl(Sender).Top);
  {$ENDIF}
end;
 
procedure TMainForm.StartupTimerTimer(Sender: TObject);
begin
  StartupTimer.Enabled := false;
 
  if FileExists('INTRO.AVI') then
  begin
    MediaPlayer1.FileName := 'INTRO.AVI';
    MediaPlayer1.Open;
 
    Panel2.Visible := true;
    Panel2.Top := 0;
    Panel2.Left := 0;
    Panel2.Width  := MediaPlayer1.DisplayRect.Right;
    Panel2.Height := MediaPlayer1.DisplayRect.Bottom;
 
    ClientWidth := Panel2.Width;
    if (ClientWidth >= Screen.Width) then FullscreenMode := true;
    ClientHeight := Panel2.Height;
    if (ClientHeight >= Screen.Height) then FullscreenMode := true;
    Position := poScreenCenter;
 
    if FullScreenMode then
    begin
      BorderStyle := bsNone;
      FormStyle := fsStayOnTop;
      Screen.Cursor := -1;
    end;
 
    // For some reason, "Position := poScreenCenter" causes the video handle to break!
    // we need to close+open it again!
    MediaPlayer1.Close;
    MediaPlayer1.Open;
 
    MediaPlayer1.Play;
    while MediaPlayer1.Mode <> mpStopped do
    begin
      Sleep(100);
      Application.ProcessMessages;
      if Application.Terminated then break;
    end;
 
    MediaPlayer1.Close;
    Panel2.Visible := false;
    Screen.Cursor := 0;
  end;
 
  try
    Game := TGame.Create('.');
    Game.PictureShowCallback := cbPictureShow;
    Game.AsyncSoundCallback := cbAsyncSound;
    Game.ExitCallback := cbExit;
    Game.WaitCallback := cbWait;
    Game.SetHotspotCallback := cbSetHotspot;
    Game.ClearHotspotsCallback := cbClearHotspots;
    Game.Run;
  except
    on E: Exception do
    begin
      MessageDlg(E.Message, mtError, [mbOK], 0);
      Close;
    end;
  end;
end;
 
end.
 

Rev 17	Rev 19
1	unit Main;	1	unit Main;
2		2
3	// BUG: If you drag the window, the dia show will stop playing, but the sound continues! This makes everything out of sync.	3	// BUG: If you drag the window, the dia show will stop playing, but the sound continues! This makes everything out of sync.
4	// TODO: When the windows is only resized a little bit (A few pixels), the window should not centered	4	// TODO: When the windows is only resized a little bit (A few pixels), the window should not centered
5	// ... Calc the width and height of ALL pictures, and then size the form to the biggest value?	5	// ... Calc the width and height of ALL pictures, and then size the form to the biggest value?
6	// ... or hard code the resolution in the INI file?	6	// ... or hard code the resolution in the INI file?
7	// Idea: Ini Parameter if fullscreen is applied or not	7	// Idea: Ini Parameter if fullscreen is applied or not
8	// Idea: Savestates, speedup, pause, Use Space bar to go to the next decision point.	8	// Idea: Savestates, speedup, pause, Use Space bar to go to the next decision point.
9		9
10	// -----------------------------------------------------------------------------	10	// -----------------------------------------------------------------------------
11		11
12	// HOTSPOT_RELATIVE_ORIGIN is a new behavior which is not compatible with the original engine.	12	// HOTSPOT_RELATIVE_ORIGIN is a new behavior which is not compatible with the original engine.
13	// With HOTSPOT_RELATIVE_ORIGIN enabled, the coordinates will be relative to the picture	13	// With HOTSPOT_RELATIVE_ORIGIN enabled, the coordinates will be relative to the picture
14	// The original game has the origin at the top left corner of the screen.	14	// The original game has the origin at the top left corner of the screen.
15	// This is a problem because the game as well as the scene editor does not know the	15	// This is a problem because the game as well as the scene editor does not know the
16	// desired resolution, as it is automatically determined.	16	// desired resolution, as it is automatically determined.
17	// If we would hardcode the desired canvas (640x480) in <ExeName>.ini, then	17	// If we would hardcode the desired canvas (640x480) in <ExeName>.ini, then
18	// it would work, but then, the scene Editor can not know the desired resolution...	18	// it would work, but then, the scene Editor can not know the desired resolution...
19	{$DEFINE HOTSPOT_RELATIVE_ORIGIN}	19	{$DEFINE HOTSPOT_RELATIVE_ORIGIN}
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;
31	StartupTimer: TTimer;	31	StartupTimer: TTimer;
32	MediaPlayer1: TMediaPlayer;	32	MediaPlayer1: TMediaPlayer;
33	Panel2: TPanel;	33	Panel2: TPanel;
34	procedure FormCreate(Sender: TObject);	34	procedure FormCreate(Sender: TObject);
35	procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);	35	procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
36	procedure StartupTimerTimer(Sender: TObject);	36	procedure StartupTimerTimer(Sender: TObject);
37	procedure ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);	37	procedure ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
38	procedure FormDestroy(Sender: TObject);	38	procedure FormDestroy(Sender: TObject);
39	private	39	private
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
54	MainForm: TMainForm;	57	MainForm: TMainForm;
55		58
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;
79	begin	70	begin
80	// http://www.delphigroups.info/2/11/471892.html	71	// http://www.delphigroups.info/2/11/471892.html
81	result := S ;	72	result := S ;
82	LS := Length(S);	73	LS := Length(S);
83	N := 1 ;	74	N := 1 ;
84	if LS > 1 then	75	if LS > 1 then
85	begin	76	begin
86	if S [1] = '-' then // check for negative value	77	if S [1] = '-' then // check for negative value
87	begin	78	begin
88	N := 2;	79	N := 2;
89	LS := LS - 1;	80	LS := LS - 1;
90	end;	81	end;
91	end;	82	end;
92	if LS <= 3 then exit;	83	if LS <= 3 then exit;
93	L2 := (LS - 1) div 3;	84	L2 := (LS - 1) div 3;
94	Temp := '';	85	Temp := '';
95	for I := 1 to L2 do	86	for I := 1 to L2 do
96	begin	87	begin
97	Temp := {$IF not Declared(ThousandSeparator)}FormatSettings.{$IFEND}ThousandSeparator + Copy (S, LS - 3 * I + 1, 3) + Temp;	88	Temp := {$IF not Declared(ThousandSeparator)}FormatSettings.{$IFEND}ThousandSeparator + Copy (S, LS - 3 * I + 1, 3) + Temp;
98	end;	89	end;
99	Result := Copy (S, N, (LS - 1) mod 3 + 1) + Temp;	90	Result := Copy (S, N, (LS - 1) mod 3 + 1) + Temp;
100	if N > 1 then Result := '-' + Result;	91	if N > 1 then Result := '-' + Result;
101	end;	92	end;
102		93
103	{ TMainForm }	94	{ TMainForm }
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);
114	Image1.Autosize := true;	109	Image1.Autosize := true;
115	finally	110	finally
116	// This speeds up the picture loading on very old computers	111	// This speeds up the picture loading on very old computers
117	Image1.Visible := true;	112	Image1.Visible := true;
118	end;	113	end;
119		114
120	// Make form bigger if necessary	115	// Make form bigger if necessary
121	if Image1.Width > ClientWidth then	116	if Image1.Width > ClientWidth then
122	begin	117	begin
123	ClientWidth := Min(Image1.Width, Screen.Width);	118	ClientWidth := Min(Image1.Width, Screen.Width);
124	if (ClientWidth >= Screen.Width) then FullscreenMode := true;	119	if (ClientWidth >= Screen.Width) then FullscreenMode := true;
125	Position := poScreenCenter;	120	Position := poScreenCenter;
126	end;	121	end;
127	if Image1.Height > ClientHeight then	122	if Image1.Height > ClientHeight then
128	begin	123	begin
129	ClientHeight := Min(Image1.Height, Screen.Height);	124	ClientHeight := Min(Image1.Height, Screen.Height);
130	if (ClientHeight >= Screen.Height) then FullscreenMode := true;	125	if (ClientHeight >= Screen.Height) then FullscreenMode := true;
131	Position := poScreenCenter;	126	Position := poScreenCenter;
132	end;	127	end;
133		128
134	// Center image	129	// Center image
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
145	BorderStyle := bsNone;	141	BorderStyle := bsNone;
146	FormStyle := fsStayOnTop;	142	FormStyle := fsStayOnTop;
147	Case AType of	143	Case AType of
148	ptDia: Screen.Cursor := -1;	144	ptDia: Screen.Cursor := -1;
149	ptDecision: Screen.Cursor := 0;	145	ptDecision: Screen.Cursor := 0;
150	End;	146	End;
151	end;	147	end;
152		148
153	Panel1.Caption := Format(S_YOUR_SCORE, [AddThouSeps(IntToStr(ASender.Score))]);	149	Panel1.Caption := Format(S_YOUR_SCORE, [AddThouSeps(IntToStr(ASender.Score))]);
154	Panel1.Left := 8;	150	Panel1.Left := 8;
155	Panel1.Top := Min(ClientHeight, Screen.Height) - Panel1.Height - 8;	151	Panel1.Top := Min(ClientHeight, Screen.Height) - Panel1.Height - 8;
156	Panel1.Visible := AType = ptDecision;	152	Panel1.Visible := AType = ptDecision;
157	end;	153	end;
158		154
159	procedure TMainForm.cbAsyncSound(ASender: TGame; AFilename: string);	155	procedure TMainForm.cbAsyncSound(ASender: TGame; AFilename: string);
160	begin	156	begin
161	PlaySound(nil, hinstance, 0);	157	PlaySound(nil, hinstance, 0);
162	if FileExists(AFilename) then	158	if FileExists(AFilename) then
163	begin	159	begin
164	PlaySound(PChar(AFilename), hinstance, SND_FILENAME or SND_ASYNC);	160	PlaySound(PChar(AFilename), hinstance, SND_FILENAME or SND_ASYNC);
165	end;	161	end;
166	end;	162	end;
167		163
168	procedure TMainForm.cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);	164	procedure TMainForm.cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);
169	begin	165	begin
170	FHotspots[AIndex] := AHotspot;	166	FHotspots[AIndex] := AHotspot;
171	end;	167	end;
172		168
173	procedure TMainForm.cbClearHotspots(ASender: TGame);	169	procedure TMainForm.cbClearHotspots(ASender: TGame);
174	var	170	var
175	i: Integer;	171	i: Integer;
176	begin	172	begin
177	for i := Low(FHotspots) to High(FHotspots) - 1 do	173	for i := Low(FHotspots) to High(FHotspots) - 1 do
178	begin	174	begin
179	FHotspots[i].lpAction := nil;	175	FHotspots[i].lpAction := nil;
180	end;	176	end;
181	end;	177	end;
182		178
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
208	begin	224	begin
209	ini := TMemIniFile.Create(iniFilename);	225	ini := TMemIniFile.Create(iniFilename);
210	try	226	try
211	Caption := ini.ReadString('Config', 'Title', '');	227	Caption := ini.ReadString('Config', 'Title', '');
212	finally	228	finally
213	FreeAndNil(ini);	229	FreeAndNil(ini);
214	end;	230	end;
215	end;	231	end;
216		232
217	try	233	try
218	StartupTimer.Enabled := true;	234	StartupTimer.Enabled := true;
219	except	235	except
220	Application.Terminate;	236	Application.Terminate;
221	end;	237	end;
222	end;	238	end;
223		239
224	procedure TMainForm.FormDestroy(Sender: TObject);	240	procedure TMainForm.FormDestroy(Sender: TObject);
225	begin	241	begin
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
252	(Y >= FHotspots[i].cHotspotTopLeft.Y) and	295	(Y >= FHotspots[i].cHotspotTopLeft.Y) and
253	(X <= FHotspots[i].cHotspotBottomRight.X) and	296	(X <= FHotspots[i].cHotspotBottomRight.X) and
254	(Y <= FHotspots[i].cHotspotBottomRight.Y) then	297	(Y <= FHotspots[i].cHotspotBottomRight.Y) then
255	begin	298	begin
256	FHotspots[i].Game.PerformAction(FHotspots[i].lpAction);	299	FHotspots[i].Game.PerformAction(FHotspots[i].lpAction);
257	Exit;	300	Exit;
258	end;	301	end;
259	end;	302	end;
260	end;	303	end;
261		304
262	procedure TMainForm.ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);	305	procedure TMainForm.ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
263	begin	306	begin
264	{$IFDEF HOTSPOT_RELATIVE_ORIGIN}	307	{$IFDEF HOTSPOT_RELATIVE_ORIGIN}
265	ClickEvent(X, Y);	308	ClickEvent(X, Y);
266	{$ELSE}	309	{$ELSE}
267	ClickEvent(X+TControl(Sender).Left, Y+TControl(Sender).Top);	310	ClickEvent(X+TControl(Sender).Left, Y+TControl(Sender).Top);
268	{$ENDIF}	311	{$ENDIF}
269	end;	312	end;
270		313
271	procedure TMainForm.StartupTimerTimer(Sender: TObject);	314	procedure TMainForm.StartupTimerTimer(Sender: TObject);
272	begin	315	begin
273	StartupTimer.Enabled := false;	316	StartupTimer.Enabled := false;
274		317
275	if FileExists('INTRO.AVI') then	318	if FileExists('INTRO.AVI') then
276	begin	319	begin
277	MediaPlayer1.FileName := 'INTRO.AVI';	320	MediaPlayer1.FileName := 'INTRO.AVI';
278	MediaPlayer1.Open;	321	MediaPlayer1.Open;
279		322
280	Panel2.Visible := true;	323	Panel2.Visible := true;
281	Panel2.Top := 0;	324	Panel2.Top := 0;
282	Panel2.Left := 0;	325	Panel2.Left := 0;
283	Panel2.Width := MediaPlayer1.DisplayRect.Right;	326	Panel2.Width := MediaPlayer1.DisplayRect.Right;
284	Panel2.Height := MediaPlayer1.DisplayRect.Bottom;	327	Panel2.Height := MediaPlayer1.DisplayRect.Bottom;
285		328
286	ClientWidth := Panel2.Width;	329	ClientWidth := Panel2.Width;
287	if (ClientWidth >= Screen.Width) then FullscreenMode := true;	330	if (ClientWidth >= Screen.Width) then FullscreenMode := true;
288	ClientHeight := Panel2.Height;	331	ClientHeight := Panel2.Height;
289	if (ClientHeight >= Screen.Height) then FullscreenMode := true;	332	if (ClientHeight >= Screen.Height) then FullscreenMode := true;
290	Position := poScreenCenter;	333	Position := poScreenCenter;
291		334
292	if FullScreenMode then	335	if FullScreenMode then
293	begin	336	begin
294	BorderStyle := bsNone;	337	BorderStyle := bsNone;
295	FormStyle := fsStayOnTop;	338	FormStyle := fsStayOnTop;
296	Screen.Cursor := -1;	339	Screen.Cursor := -1;
297	end;	340	end;
298		341
299	// For some reason, "Position := poScreenCenter" causes the video handle to break!	342	// For some reason, "Position := poScreenCenter" causes the video handle to break!
300	// we need to close+open it again!	343	// we need to close+open it again!
301	MediaPlayer1.Close;	344	MediaPlayer1.Close;
302	MediaPlayer1.Open;	345	MediaPlayer1.Open;
303		346
304	MediaPlayer1.Play;	347	MediaPlayer1.Play;
305	while MediaPlayer1.Mode <> mpStopped do	348	while MediaPlayer1.Mode <> mpStopped do
306	begin	349	begin
307	Sleep(100);	350	Sleep(100);
308	Application.ProcessMessages;	351	Application.ProcessMessages;
309	if Application.Terminated then break;	352	if Application.Terminated then break;
310	end;	353	end;
311		354
312	MediaPlayer1.Close;	355	MediaPlayer1.Close;
313	Panel2.Visible := false;	356	Panel2.Visible := false;
314	Screen.Cursor := 0;	357	Screen.Cursor := 0;
315	end;	358	end;
316		359
317	try	360	try
318	Game := TGame.Create('.');	361	Game := TGame.Create('.');
319	Game.PictureShowCallback := cbPictureShow;	362	Game.PictureShowCallback := cbPictureShow;
320	Game.AsyncSoundCallback := cbAsyncSound;	363	Game.AsyncSoundCallback := cbAsyncSound;
321	Game.ExitCallback := cbExit;	364	Game.ExitCallback := cbExit;
322	Game.WaitCallback := cbWait;	365	Game.WaitCallback := cbWait;
323	Game.SetHotspotCallback := cbSetHotspot;	366	Game.SetHotspotCallback := cbSetHotspot;
324	Game.ClearHotspotsCallback := cbClearHotspots;	367	Game.ClearHotspotsCallback := cbClearHotspots;
325	Game.Run;	368	Game.Run;
326	except	369	except
327	on E: Exception do	370	on E: Exception do
328	begin	371	begin
329	MessageDlg(E.Message, mtError, [mbOK], 0);	372	MessageDlg(E.Message, mtError, [mbOK], 0);
330	Close;	373	Close;
331	end;	374	end;
332	end;	375	end;
333	end;	376	end;
334		377
335	end.	378	end.
336		379

Subversion Repositories plumbers

plumbers/trunk/Win32_Player/Main.pas – Rev 17 → 19