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
  csCancelSceneRequest.Acquire;
  try
    FCancelSceneRequest := false;
  finally
    csCancelSceneRequest.Release;
  end;
 
  {$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 (we would need a stack instead of PrevDecisionScene/CurDecisionScene)
    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 19	Rev 20
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, SyncObjs;	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	function cbWait(ASender: TGame; AMilliseconds: integer): boolean;	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	49	private
50	FCancelSceneRequest: boolean;	50	FCancelSceneRequest: boolean;
51	csCancelSceneRequest: TCriticalSection;	51	csCancelSceneRequest: TCriticalSection;
52	public	52	public
53	game: TGame;	53	game: TGame;
54	end;	54	end;
55		55
56	var	56	var
57	MainForm: TMainForm;	57	MainForm: TMainForm;
58		58
59	implementation	59	implementation
60		60
61	{$R *.dfm}	61	{$R *.dfm}
62		62
63	uses	63	uses
64	MMSystem, IniFiles, Math, GameBinStruct;	64	MMSystem, IniFiles, Math, GameBinStruct;
65		65
66	function AddThouSeps(const S: string): string;	66	function AddThouSeps(const S: string): string;
67	var	67	var
68	LS, L2, I, N: Integer;	68	LS, L2, I, N: Integer;
69	Temp: string;	69	Temp: string;
70	begin	70	begin
71	// http://www.delphigroups.info/2/11/471892.html	71	// http://www.delphigroups.info/2/11/471892.html
72	result := S ;	72	result := S ;
73	LS := Length(S);	73	LS := Length(S);
74	N := 1 ;	74	N := 1 ;
75	if LS > 1 then	75	if LS > 1 then
76	begin	76	begin
77	if S [1] = '-' then // check for negative value	77	if S [1] = '-' then // check for negative value
78	begin	78	begin
79	N := 2;	79	N := 2;
80	LS := LS - 1;	80	LS := LS - 1;
81	end;	81	end;
82	end;	82	end;
83	if LS <= 3 then exit;	83	if LS <= 3 then exit;
84	L2 := (LS - 1) div 3;	84	L2 := (LS - 1) div 3;
85	Temp := '';	85	Temp := '';
86	for I := 1 to L2 do	86	for I := 1 to L2 do
87	begin	87	begin
88	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;
89	end;	89	end;
90	Result := Copy (S, N, (LS - 1) mod 3 + 1) + Temp;	90	Result := Copy (S, N, (LS - 1) mod 3 + 1) + Temp;
91	if N > 1 then Result := '-' + Result;	91	if N > 1 then Result := '-' + Result;
92	end;	92	end;
93		93
94	{ TMainForm }	94	{ TMainForm }
95		95
96	procedure TMainForm.cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType);	96	procedure TMainForm.cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType);
97	resourcestring	97	resourcestring
98	S_YOUR_SCORE = 'Your score is: %s';	98	S_YOUR_SCORE = 'Your score is: %s';
99	begin	99	begin
-		100	csCancelSceneRequest.Acquire;
-		101	try
-		102	FCancelSceneRequest := false;
-		103	finally
-		104	csCancelSceneRequest.Release;
-		105	end;
-		106
100	{$IFDEF DEBUG}	107	{$IFDEF DEBUG}
101	Caption := AFileName;	108	Caption := AFileName;
102	{$ENDIF}	109	{$ENDIF}
103		110
104	if FileExists(AFilename) then	111	if FileExists(AFilename) then
105	begin	112	begin
106	Image1.Visible := false;	113	Image1.Visible := false;
107	try	114	try
108	Image1.Picture.LoadFromFile(AFilename);	115	Image1.Picture.LoadFromFile(AFilename);
109	Image1.Autosize := true;	116	Image1.Autosize := true;
110	finally	117	finally
111	// This speeds up the picture loading on very old computers	118	// This speeds up the picture loading on very old computers
112	Image1.Visible := true;	119	Image1.Visible := true;
113	end;	120	end;
114		121
115	// Make form bigger if necessary	122	// Make form bigger if necessary
116	if Image1.Width > ClientWidth then	123	if Image1.Width > ClientWidth then
117	begin	124	begin
118	ClientWidth := Min(Image1.Width, Screen.Width);	125	ClientWidth := Min(Image1.Width, Screen.Width);
119	if (ClientWidth >= Screen.Width) then FullscreenMode := true;	126	if (ClientWidth >= Screen.Width) then FullscreenMode := true;
120	Position := poScreenCenter;	127	Position := poScreenCenter;
121	end;	128	end;
122	if Image1.Height > ClientHeight then	129	if Image1.Height > ClientHeight then
123	begin	130	begin
124	ClientHeight := Min(Image1.Height, Screen.Height);	131	ClientHeight := Min(Image1.Height, Screen.Height);
125	if (ClientHeight >= Screen.Height) then FullscreenMode := true;	132	if (ClientHeight >= Screen.Height) then FullscreenMode := true;
126	Position := poScreenCenter;	133	Position := poScreenCenter;
127	end;	134	end;
128		135
129	// Center image	136	// Center image
130	Image1.Left := ClientWidth div 2 - Image1.Width div 2;	137	Image1.Left := ClientWidth div 2 - Image1.Width div 2;
131	Image1.Top := ClientHeight div 2 - Image1.Height div 2;	138	Image1.Top := ClientHeight div 2 - Image1.Height div 2;
132	end	139	end
133	else	140	else
134	begin	141	begin
135	ShowMessageFmt('File not found: %s', [AFileName]);	142	ShowMessageFmt('File not found: %s', [AFileName]);
136	Image1.Picture := nil;	143	Image1.Picture := nil;
137	end;	144	end;
138		145
139	if FullScreenMode then	146	if FullScreenMode then
140	begin	147	begin
141	BorderStyle := bsNone;	148	BorderStyle := bsNone;
142	FormStyle := fsStayOnTop;	149	FormStyle := fsStayOnTop;
143	Case AType of	150	Case AType of
144	ptDia: Screen.Cursor := -1;	151	ptDia: Screen.Cursor := -1;
145	ptDecision: Screen.Cursor := 0;	152	ptDecision: Screen.Cursor := 0;
146	End;	153	End;
147	end;	154	end;
148		155
149	Panel1.Caption := Format(S_YOUR_SCORE, [AddThouSeps(IntToStr(ASender.Score))]);	156	Panel1.Caption := Format(S_YOUR_SCORE, [AddThouSeps(IntToStr(ASender.Score))]);
150	Panel1.Left := 8;	157	Panel1.Left := 8;
151	Panel1.Top := Min(ClientHeight, Screen.Height) - Panel1.Height - 8;	158	Panel1.Top := Min(ClientHeight, Screen.Height) - Panel1.Height - 8;
152	Panel1.Visible := AType = ptDecision;	159	Panel1.Visible := AType = ptDecision;
153	end;	160	end;
154		161
155	procedure TMainForm.cbAsyncSound(ASender: TGame; AFilename: string);	162	procedure TMainForm.cbAsyncSound(ASender: TGame; AFilename: string);
156	begin	163	begin
157	PlaySound(nil, hinstance, 0);	164	PlaySound(nil, hinstance, 0);
158	if FileExists(AFilename) then	165	if FileExists(AFilename) then
159	begin	166	begin
160	PlaySound(PChar(AFilename), hinstance, SND_FILENAME or SND_ASYNC);	167	PlaySound(PChar(AFilename), hinstance, SND_FILENAME or SND_ASYNC);
161	end;	168	end;
162	end;	169	end;
163		170
164	procedure TMainForm.cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);	171	procedure TMainForm.cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);
165	begin	172	begin
166	FHotspots[AIndex] := AHotspot;	173	FHotspots[AIndex] := AHotspot;
167	end;	174	end;
168		175
169	procedure TMainForm.cbClearHotspots(ASender: TGame);	176	procedure TMainForm.cbClearHotspots(ASender: TGame);
170	var	177	var
171	i: Integer;	178	i: Integer;
172	begin	179	begin
173	for i := Low(FHotspots) to High(FHotspots) - 1 do	180	for i := Low(FHotspots) to High(FHotspots) - 1 do
174	begin	181	begin
175	FHotspots[i].lpAction := nil;	182	FHotspots[i].lpAction := nil;
176	end;	183	end;
177	end;	184	end;
178		185
179	procedure TMainForm.cbExit(ASender: TGame);	186	procedure TMainForm.cbExit(ASender: TGame);
180	begin	187	begin
181	Application.Terminate;	188	Application.Terminate;
182	end;	189	end;
183		190
184	function TMainForm.cbWait(ASender: TGame; AMilliseconds: integer): boolean;	191	function TMainForm.cbWait(ASender: TGame; AMilliseconds: integer): boolean;
185	var	192	var
186	FirstTickCount: DWord;	193	FirstTickCount: DWord;
187	begin	194	begin
188	//Cursor := crHourglass;	195	//Cursor := crHourglass;
189	try	196	try
190	result := false; // don't cancel	197	result := false; // don't cancel
191	FirstTickCount := GetTickCount; // TODO: Attention, GetTickCount can overflow	198	FirstTickCount := GetTickCount; // TODO: Attention, GetTickCount can overflow
192	while not Application.Terminated and ((GetTickCount - FirstTickCount) < AMilliseconds) do	199	while not Application.Terminated and ((GetTickCount - FirstTickCount) < AMilliseconds) do
193	begin	200	begin
194	csCancelSceneRequest.Acquire;	201	csCancelSceneRequest.Acquire;
195	try	202	try
196	if FCancelSceneRequest then	203	if FCancelSceneRequest then
197	begin	204	begin
198	FCancelSceneRequest := false;	205	FCancelSceneRequest := false;
199	result := true; // cancel	206	result := true; // cancel
200	exit;	207	exit;
201	end;	208	end;
202	finally	209	finally
203	csCancelSceneRequest.Release;	210	csCancelSceneRequest.Release;
204	end;	211	end;
205	Application.ProcessMessages;	212	Application.ProcessMessages;
206	Sleep(0);	213	Sleep(0);
207	end;	214	end;
208	finally	215	finally
209	//Cursor := crDefault;	216	//Cursor := crDefault;
210	end;	217	end;
211	end;	218	end;
212		219
213	procedure TMainForm.FormCreate(Sender: TObject);	220	procedure TMainForm.FormCreate(Sender: TObject);
214	var	221	var
215	ini: TMemIniFile;	222	ini: TMemIniFile;
216	iniFilename: string;	223	iniFilename: string;
217	begin	224	begin
218	csCancelSceneRequest := TCriticalSection.Create;	225	csCancelSceneRequest := TCriticalSection.Create;
219	iniFilename := ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini');	226	iniFilename := ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini');
220		227
221	DoubleBuffered := true;	228	DoubleBuffered := true;
222		229
223	if FileExists(iniFilename) then	230	if FileExists(iniFilename) then
224	begin	231	begin
225	ini := TMemIniFile.Create(iniFilename);	232	ini := TMemIniFile.Create(iniFilename);
226	try	233	try
227	Caption := ini.ReadString('Config', 'Title', '');	234	Caption := ini.ReadString('Config', 'Title', '');
228	finally	235	finally
229	FreeAndNil(ini);	236	FreeAndNil(ini);
230	end;	237	end;
231	end;	238	end;
232		239
233	try	240	try
234	StartupTimer.Enabled := true;	241	StartupTimer.Enabled := true;
235	except	242	except
236	Application.Terminate;	243	Application.Terminate;
237	end;	244	end;
238	end;	245	end;
239		246
240	procedure TMainForm.FormDestroy(Sender: TObject);	247	procedure TMainForm.FormDestroy(Sender: TObject);
241	begin	248	begin
242	FreeAndNil(Game);	249	FreeAndNil(Game);
243		250
244	// Without this, some audio drivers could crash if you press ESC to end the game.	251	// Without this, some audio drivers could crash if you press ESC to end the game.
245	// (VPC 2007 with Win95; cpsman.dll crashes sometimes)	252	// (VPC 2007 with Win95; cpsman.dll crashes sometimes)
246	PlaySound(nil, hinstance, 0);	253	PlaySound(nil, hinstance, 0);
247	FreeAndNil(csCancelSceneRequest);	254	FreeAndNil(csCancelSceneRequest);
248	if Assigned(Game) then FreeAndNil(Game);	255	if Assigned(Game) then FreeAndNil(Game);
249	end;	256	end;
250		257
251	procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;	258	procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
252	Shift: TShiftState);	259	Shift: TShiftState);
253	begin	260	begin
254	if Key = VK_SPACE then	261	if Key = VK_SPACE then
255	begin	262	begin
256	if MediaPlayer1.Mode = mpPlaying then MediaPlayer1.Stop;	263	if MediaPlayer1.Mode = mpPlaying then MediaPlayer1.Stop;
257	end;	264	end;
258	if KEY = VK_RETURN then	265	if KEY = VK_RETURN then
259	begin	266	begin
260	if MediaPlayer1.Mode = mpPlaying then	267	if MediaPlayer1.Mode = mpPlaying then
261	begin	268	begin
262	MediaPlayer1.Position := MediaPlayer1.EndPos;	269	MediaPlayer1.Position := MediaPlayer1.EndPos;
263	end;	270	end;
264	csCancelSceneRequest.Acquire;	271	csCancelSceneRequest.Acquire;
265	try	272	try
266	FCancelSceneRequest := true;	273	FCancelSceneRequest := true;
267	finally	274	finally
268	csCancelSceneRequest.Release;	275	csCancelSceneRequest.Release;
269	end;	276	end;
270	end;	277	end;
271	if Key = VK_ESCAPE then Close;	278	if Key = VK_ESCAPE then Close;
272	end;	279	end;
273		280
274	procedure TMainForm.ClickEvent(X, Y: Integer);	281	procedure TMainForm.ClickEvent(X, Y: Integer);
275	var	282	var
276	i: integer;	283	i: integer;
277	ac: TActionDef;	284	ac: TActionDef;
278	begin	285	begin
279	// Debug: Go to prev decision by clicking on the top left edge	286	// Debug: Go to prev decision by clicking on the top left edge
280	if (X < 20) and (Y < 20) then	287	if (X < 20) and (Y < 20) then
281	begin	288	begin
282	// TODO: Also allow to go back multiple steps	289	// TODO: Also allow to go back multiple steps (we would need a stack instead of PrevDecisionScene/CurDecisionScene)
283	ac.scoreDelta := 0;	290	ac.scoreDelta := 0;
284	ac.nextSceneID := SCENEID_PREVDECISION;	291	ac.nextSceneID := SCENEID_PREVDECISION;
285	ac.sceneSegment := 0;	292	ac.sceneSegment := 0;
286	Game.PerformAction(@ac);	293	Game.PerformAction(@ac);
287	Exit;	294	Exit;
288	end;	295	end;
289		296
290	// If hotspots are overlaying, the lowest action will be chosen (same behavior as original game)	297	// If hotspots are overlaying, the lowest action will be chosen (same behavior as original game)
291	for i := Low(FHotspots) to High(FHotspots) do	298	for i := Low(FHotspots) to High(FHotspots) do
292	begin	299	begin
293	if Assigned(FHotspots[i].lpAction) and	300	if Assigned(FHotspots[i].lpAction) and
294	(X >= FHotspots[i].cHotspotTopLeft.X) and	301	(X >= FHotspots[i].cHotspotTopLeft.X) and
295	(Y >= FHotspots[i].cHotspotTopLeft.Y) and	302	(Y >= FHotspots[i].cHotspotTopLeft.Y) and
296	(X <= FHotspots[i].cHotspotBottomRight.X) and	303	(X <= FHotspots[i].cHotspotBottomRight.X) and
297	(Y <= FHotspots[i].cHotspotBottomRight.Y) then	304	(Y <= FHotspots[i].cHotspotBottomRight.Y) then
298	begin	305	begin
299	FHotspots[i].Game.PerformAction(FHotspots[i].lpAction);	306	FHotspots[i].Game.PerformAction(FHotspots[i].lpAction);
300	Exit;	307	Exit;
301	end;	308	end;
302	end;	309	end;
303	end;	310	end;
304		311
305	procedure TMainForm.ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);	312	procedure TMainForm.ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
306	begin	313	begin
307	{$IFDEF HOTSPOT_RELATIVE_ORIGIN}	314	{$IFDEF HOTSPOT_RELATIVE_ORIGIN}
308	ClickEvent(X, Y);	315	ClickEvent(X, Y);
309	{$ELSE}	316	{$ELSE}
310	ClickEvent(X+TControl(Sender).Left, Y+TControl(Sender).Top);	317	ClickEvent(X+TControl(Sender).Left, Y+TControl(Sender).Top);
311	{$ENDIF}	318	{$ENDIF}
312	end;	319	end;
313		320
314	procedure TMainForm.StartupTimerTimer(Sender: TObject);	321	procedure TMainForm.StartupTimerTimer(Sender: TObject);
315	begin	322	begin
316	StartupTimer.Enabled := false;	323	StartupTimer.Enabled := false;
317		324
318	if FileExists('INTRO.AVI') then	325	if FileExists('INTRO.AVI') then
319	begin	326	begin
320	MediaPlayer1.FileName := 'INTRO.AVI';	327	MediaPlayer1.FileName := 'INTRO.AVI';
321	MediaPlayer1.Open;	328	MediaPlayer1.Open;
322		329
323	Panel2.Visible := true;	330	Panel2.Visible := true;
324	Panel2.Top := 0;	331	Panel2.Top := 0;
325	Panel2.Left := 0;	332	Panel2.Left := 0;
326	Panel2.Width := MediaPlayer1.DisplayRect.Right;	333	Panel2.Width := MediaPlayer1.DisplayRect.Right;
327	Panel2.Height := MediaPlayer1.DisplayRect.Bottom;	334	Panel2.Height := MediaPlayer1.DisplayRect.Bottom;
328		335
329	ClientWidth := Panel2.Width;	336	ClientWidth := Panel2.Width;
330	if (ClientWidth >= Screen.Width) then FullscreenMode := true;	337	if (ClientWidth >= Screen.Width) then FullscreenMode := true;
331	ClientHeight := Panel2.Height;	338	ClientHeight := Panel2.Height;
332	if (ClientHeight >= Screen.Height) then FullscreenMode := true;	339	if (ClientHeight >= Screen.Height) then FullscreenMode := true;
333	Position := poScreenCenter;	340	Position := poScreenCenter;
334		341
335	if FullScreenMode then	342	if FullScreenMode then
336	begin	343	begin
337	BorderStyle := bsNone;	344	BorderStyle := bsNone;
338	FormStyle := fsStayOnTop;	345	FormStyle := fsStayOnTop;
339	Screen.Cursor := -1;	346	Screen.Cursor := -1;
340	end;	347	end;
341		348
342	// For some reason, "Position := poScreenCenter" causes the video handle to break!	349	// For some reason, "Position := poScreenCenter" causes the video handle to break!
343	// we need to close+open it again!	350	// we need to close+open it again!
344	MediaPlayer1.Close;	351	MediaPlayer1.Close;
345	MediaPlayer1.Open;	352	MediaPlayer1.Open;
346		353
347	MediaPlayer1.Play;	354	MediaPlayer1.Play;
348	while MediaPlayer1.Mode <> mpStopped do	355	while MediaPlayer1.Mode <> mpStopped do
349	begin	356	begin
350	Sleep(100);	357	Sleep(100);
351	Application.ProcessMessages;	358	Application.ProcessMessages;
352	if Application.Terminated then break;	359	if Application.Terminated then break;
353	end;	360	end;
354		361
355	MediaPlayer1.Close;	362	MediaPlayer1.Close;
356	Panel2.Visible := false;	363	Panel2.Visible := false;
357	Screen.Cursor := 0;	364	Screen.Cursor := 0;
358	end;	365	end;
359		366
360	try	367	try
361	Game := TGame.Create('.');	368	Game := TGame.Create('.');
362	Game.PictureShowCallback := cbPictureShow;	369	Game.PictureShowCallback := cbPictureShow;
363	Game.AsyncSoundCallback := cbAsyncSound;	370	Game.AsyncSoundCallback := cbAsyncSound;
364	Game.ExitCallback := cbExit;	371	Game.ExitCallback := cbExit;
365	Game.WaitCallback := cbWait;	372	Game.WaitCallback := cbWait;
366	Game.SetHotspotCallback := cbSetHotspot;	373	Game.SetHotspotCallback := cbSetHotspot;
367	Game.ClearHotspotsCallback := cbClearHotspots;	374	Game.ClearHotspotsCallback := cbClearHotspots;
368	Game.Run;	375	Game.Run;
369	except	376	except
370	on E: Exception do	377	on E: Exception do
371	begin	378	begin
372	MessageDlg(E.Message, mtError, [mbOK], 0);	379	MessageDlg(E.Message, mtError, [mbOK], 0);
373	Close;	380	Close;
374	end;	381	end;
375	end;	382	end;
376	end;	383	end;
377		384
378	end.	385	end.
379		386

Subversion Repositories plumbers

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