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


unit Main;
 
(*
 * Plumbers Don't Wear Ties - Inofficial Win32 Player
 * Copyright 2017 - 2020 Daniel Marschall, ViaThinkSoft
 *
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *)
 
// 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: Cardinal): 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: Cardinal): 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
  if Assigned(Game) then 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);
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: EAbort do
    begin
      Close;
    end;
    on E: Exception do
    begin
      MessageDlg(E.Message, mtError, [mbOK], 0);
      Close;
    end;
  end;
end;
 
end.
 

Rev 24	Rev 25
1	unit Main;	1	unit Main;
2		2
-		3	(*
-		4	* Plumbers Don't Wear Ties - Inofficial Win32 Player
-		5	* Copyright 2017 - 2020 Daniel Marschall, ViaThinkSoft
-		6	*
-		7	* Licensed under the Apache License, Version 2.0 (the "License");
-		8	* you may not use this file except in compliance with the License.
-		9	* You may obtain a copy of the License at
-		10	*
-		11	* http://www.apache.org/licenses/LICENSE-2.0
-		12	*
-		13	* Unless required by applicable law or agreed to in writing, software
-		14	* distributed under the License is distributed on an "AS IS" BASIS,
-		15	* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-		16	* See the License for the specific language governing permissions and
-		17	* limitations under the License.
-		18	*)
-		19
3	// BUG: If you drag the window, the dia show will stop playing, but the sound continues! This makes everything out of sync.	20	// 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	21	// 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?	22	// ... 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?	23	// ... or hard code the resolution in the INI file?
7	// Idea: Ini Parameter if fullscreen is applied or not	24	// Idea: Ini Parameter if fullscreen is applied or not
8	// Idea: Savestates, speedup, pause, Use Space bar to go to the next decision point.	25	// Idea: Savestates, speedup, pause, Use Space bar to go to the next decision point.
9		26
10	// -----------------------------------------------------------------------------	27	// -----------------------------------------------------------------------------
11		28
12	// HOTSPOT_RELATIVE_ORIGIN is a new behavior which is not compatible with the original engine.	29	// 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	30	// 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.	31	// 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	32	// 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.	33	// desired resolution, as it is automatically determined.
17	// If we would hardcode the desired canvas (640x480) in <ExeName>.ini, then	34	// 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...	35	// it would work, but then, the scene Editor can not know the desired resolution...
19	{$DEFINE HOTSPOT_RELATIVE_ORIGIN}	36	{$DEFINE HOTSPOT_RELATIVE_ORIGIN}
20		37
21	interface	38	interface
22		39
23	uses	40	uses
24	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,	41	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
25	Dialogs, ExtCtrls, StdCtrls, Game, MPlayer, SyncObjs;	42	Dialogs, ExtCtrls, StdCtrls, Game, MPlayer, SyncObjs;
26		43
27	type	44	type
28	TMainForm = class(TForm)	45	TMainForm = class(TForm)
29	Image1: TImage;	46	Image1: TImage;
30	Panel1: TPanel;	47	Panel1: TPanel;
31	StartupTimer: TTimer;	48	StartupTimer: TTimer;
32	MediaPlayer1: TMediaPlayer;	49	MediaPlayer1: TMediaPlayer;
33	Panel2: TPanel;	50	Panel2: TPanel;
34	procedure FormCreate(Sender: TObject);	51	procedure FormCreate(Sender: TObject);
35	procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);	52	procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
36	procedure StartupTimerTimer(Sender: TObject);	53	procedure StartupTimerTimer(Sender: TObject);
37	procedure ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);	54	procedure ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
38	procedure FormDestroy(Sender: TObject);	55	procedure FormDestroy(Sender: TObject);
39	private	56	private
40	FHotspots: array[0..2] of THotspot;	57	FHotspots: array[0..2] of THotspot;
41	FullscreenMode: boolean;	58	FullscreenMode: boolean;
42	procedure cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType);	59	procedure cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType);
43	procedure cbAsyncSound(ASender: TGame; AFilename: string);	60	procedure cbAsyncSound(ASender: TGame; AFilename: string);
44	procedure cbExit(ASender: TGame);	61	procedure cbExit(ASender: TGame);
45	function cbWait(ASender: TGame; AMilliseconds: Cardinal): boolean;	62	function cbWait(ASender: TGame; AMilliseconds: Cardinal): boolean;
46	procedure cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);	63	procedure cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);
47	procedure cbClearHotspots(ASender: TGame);	64	procedure cbClearHotspots(ASender: TGame);
48	procedure ClickEvent(X, Y: Integer);	65	procedure ClickEvent(X, Y: Integer);
49	private	66	private
50	FCancelSceneRequest: boolean;	67	FCancelSceneRequest: boolean;
51	csCancelSceneRequest: TCriticalSection;	68	csCancelSceneRequest: TCriticalSection;
52	public	69	public
53	game: TGame;	70	game: TGame;
54	end;	71	end;
55		72
56	var	73	var
57	MainForm: TMainForm;	74	MainForm: TMainForm;
58		75
59	implementation	76	implementation
60		77
61	{$R *.dfm}	78	{$R *.dfm}
62		79
63	uses	80	uses
64	MMSystem, IniFiles, Math, GameBinStruct;	81	MMSystem, IniFiles, Math, GameBinStruct;
65		82
66	function AddThouSeps(const S: string): string;	83	function AddThouSeps(const S: string): string;
67	var	84	var
68	LS, L2, I, N: Integer;	85	LS, L2, I, N: Integer;
69	Temp: string;	86	Temp: string;
70	begin	87	begin
71	// http://www.delphigroups.info/2/11/471892.html	88	// http://www.delphigroups.info/2/11/471892.html
72	result := S ;	89	result := S ;
73	LS := Length(S);	90	LS := Length(S);
74	N := 1 ;	91	N := 1 ;
75	if LS > 1 then	92	if LS > 1 then
76	begin	93	begin
77	if S [1] = '-' then // check for negative value	94	if S [1] = '-' then // check for negative value
78	begin	95	begin
79	N := 2;	96	N := 2;
80	LS := LS - 1;	97	LS := LS - 1;
81	end;	98	end;
82	end;	99	end;
83	if LS <= 3 then exit;	100	if LS <= 3 then exit;
84	L2 := (LS - 1) div 3;	101	L2 := (LS - 1) div 3;
85	Temp := '';	102	Temp := '';
86	for I := 1 to L2 do	103	for I := 1 to L2 do
87	begin	104	begin
88	Temp := {$IF not Declared(ThousandSeparator)}FormatSettings.{$IFEND}ThousandSeparator + Copy (S, LS - 3 * I + 1, 3) + Temp;	105	Temp := {$IF not Declared(ThousandSeparator)}FormatSettings.{$IFEND}ThousandSeparator + Copy (S, LS - 3 * I + 1, 3) + Temp;
89	end;	106	end;
90	Result := Copy (S, N, (LS - 1) mod 3 + 1) + Temp;	107	Result := Copy (S, N, (LS - 1) mod 3 + 1) + Temp;
91	if N > 1 then Result := '-' + Result;	108	if N > 1 then Result := '-' + Result;
92	end;	109	end;
93		110
94	{ TMainForm }	111	{ TMainForm }
95		112
96	procedure TMainForm.cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType);	113	procedure TMainForm.cbPictureShow(ASender: TGame; AFilename: string; AType: TPictureType);
97	resourcestring	114	resourcestring
98	S_YOUR_SCORE = 'Your score is: %s';	115	S_YOUR_SCORE = 'Your score is: %s';
99	begin	116	begin
100	csCancelSceneRequest.Acquire;	117	csCancelSceneRequest.Acquire;
101	try	118	try
102	FCancelSceneRequest := false;	119	FCancelSceneRequest := false;
103	finally	120	finally
104	csCancelSceneRequest.Release;	121	csCancelSceneRequest.Release;
105	end;	122	end;
106		123
107	{$IFDEF DEBUG}	124	{$IFDEF DEBUG}
108	Caption := AFileName;	125	Caption := AFileName;
109	{$ENDIF}	126	{$ENDIF}
110		127
111	if FileExists(AFilename) then	128	if FileExists(AFilename) then
112	begin	129	begin
113	Image1.Visible := false;	130	Image1.Visible := false;
114	try	131	try
115	Image1.Picture.LoadFromFile(AFilename);	132	Image1.Picture.LoadFromFile(AFilename);
116	Image1.Autosize := true;	133	Image1.Autosize := true;
117	finally	134	finally
118	// This speeds up the picture loading on very old computers	135	// This speeds up the picture loading on very old computers
119	Image1.Visible := true;	136	Image1.Visible := true;
120	end;	137	end;
121		138
122	// Make form bigger if necessary	139	// Make form bigger if necessary
123	if Image1.Width > ClientWidth then	140	if Image1.Width > ClientWidth then
124	begin	141	begin
125	ClientWidth := Min(Image1.Width, Screen.Width);	142	ClientWidth := Min(Image1.Width, Screen.Width);
126	if (ClientWidth >= Screen.Width) then FullscreenMode := true;	143	if (ClientWidth >= Screen.Width) then FullscreenMode := true;
127	Position := poScreenCenter;	144	Position := poScreenCenter;
128	end;	145	end;
129	if Image1.Height > ClientHeight then	146	if Image1.Height > ClientHeight then
130	begin	147	begin
131	ClientHeight := Min(Image1.Height, Screen.Height);	148	ClientHeight := Min(Image1.Height, Screen.Height);
132	if (ClientHeight >= Screen.Height) then FullscreenMode := true;	149	if (ClientHeight >= Screen.Height) then FullscreenMode := true;
133	Position := poScreenCenter;	150	Position := poScreenCenter;
134	end;	151	end;
135		152
136	// Center image	153	// Center image
137	Image1.Left := ClientWidth div 2 - Image1.Width div 2;	154	Image1.Left := ClientWidth div 2 - Image1.Width div 2;
138	Image1.Top := ClientHeight div 2 - Image1.Height div 2;	155	Image1.Top := ClientHeight div 2 - Image1.Height div 2;
139	end	156	end
140	else	157	else
141	begin	158	begin
142	// ShowMessageFmt('File not found: %s', [AFileName]);	159	// ShowMessageFmt('File not found: %s', [AFileName]);
143	Image1.Picture := nil;	160	Image1.Picture := nil;
144	end;	161	end;
145		162
146	if FullScreenMode then	163	if FullScreenMode then
147	begin	164	begin
148	BorderStyle := bsNone;	165	BorderStyle := bsNone;
149	FormStyle := fsStayOnTop;	166	FormStyle := fsStayOnTop;
150	Case AType of	167	Case AType of
151	ptDia: Screen.Cursor := -1;	168	ptDia: Screen.Cursor := -1;
152	ptDecision: Screen.Cursor := 0;	169	ptDecision: Screen.Cursor := 0;
153	End;	170	End;
154	end;	171	end;
155		172
156	Panel1.Caption := Format(S_YOUR_SCORE, [AddThouSeps(IntToStr(ASender.Score))]);	173	Panel1.Caption := Format(S_YOUR_SCORE, [AddThouSeps(IntToStr(ASender.Score))]);
157	Panel1.Left := 8;	174	Panel1.Left := 8;
158	Panel1.Top := Min(ClientHeight, Screen.Height) - Panel1.Height - 8;	175	Panel1.Top := Min(ClientHeight, Screen.Height) - Panel1.Height - 8;
159	Panel1.Visible := AType = ptDecision;	176	Panel1.Visible := AType = ptDecision;
160	end;	177	end;
161		178
162	procedure TMainForm.cbAsyncSound(ASender: TGame; AFilename: string);	179	procedure TMainForm.cbAsyncSound(ASender: TGame; AFilename: string);
163	begin	180	begin
164	PlaySound(nil, hinstance, 0);	181	PlaySound(nil, hinstance, 0);
165	if FileExists(AFilename) then	182	if FileExists(AFilename) then
166	begin	183	begin
167	PlaySound(PChar(AFilename), hinstance, SND_FILENAME or SND_ASYNC);	184	PlaySound(PChar(AFilename), hinstance, SND_FILENAME or SND_ASYNC);
168	end;	185	end;
169	end;	186	end;
170		187
171	procedure TMainForm.cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);	188	procedure TMainForm.cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);
172	begin	189	begin
173	FHotspots[AIndex] := AHotspot;	190	FHotspots[AIndex] := AHotspot;
174	end;	191	end;
175		192
176	procedure TMainForm.cbClearHotspots(ASender: TGame);	193	procedure TMainForm.cbClearHotspots(ASender: TGame);
177	var	194	var
178	i: Integer;	195	i: Integer;
179	begin	196	begin
180	for i := Low(FHotspots) to High(FHotspots) - 1 do	197	for i := Low(FHotspots) to High(FHotspots) - 1 do
181	begin	198	begin
182	FHotspots[i].lpAction := nil;	199	FHotspots[i].lpAction := nil;
183	end;	200	end;
184	end;	201	end;
185		202
186	procedure TMainForm.cbExit(ASender: TGame);	203	procedure TMainForm.cbExit(ASender: TGame);
187	begin	204	begin
188	Application.Terminate;	205	Application.Terminate;
189	end;	206	end;
190		207
191	function TMainForm.cbWait(ASender: TGame; AMilliseconds: Cardinal): boolean;	208	function TMainForm.cbWait(ASender: TGame; AMilliseconds: Cardinal): boolean;
192	var	209	var
193	FirstTickCount: DWord;	210	FirstTickCount: DWord;
194	begin	211	begin
195	//Cursor := crHourglass;	212	//Cursor := crHourglass;
196	try	213	try
197	result := false; // don't cancel	214	result := false; // don't cancel
198	FirstTickCount := GetTickCount; // TODO: Attention, GetTickCount can overflow	215	FirstTickCount := GetTickCount; // TODO: Attention, GetTickCount can overflow
199	while not Application.Terminated and ((GetTickCount - FirstTickCount) < AMilliseconds) do	216	while not Application.Terminated and ((GetTickCount - FirstTickCount) < AMilliseconds) do
200	begin	217	begin
201	csCancelSceneRequest.Acquire;	218	csCancelSceneRequest.Acquire;
202	try	219	try
203	if FCancelSceneRequest then	220	if FCancelSceneRequest then
204	begin	221	begin
205	FCancelSceneRequest := false;	222	FCancelSceneRequest := false;
206	result := true; // cancel	223	result := true; // cancel
207	exit;	224	exit;
208	end;	225	end;
209	finally	226	finally
210	csCancelSceneRequest.Release;	227	csCancelSceneRequest.Release;
211	end;	228	end;
212	Application.ProcessMessages;	229	Application.ProcessMessages;
213	Sleep(0);	230	Sleep(0);
214	end;	231	end;
215	finally	232	finally
216	//Cursor := crDefault;	233	//Cursor := crDefault;
217	end;	234	end;
218	end;	235	end;
219		236
220	procedure TMainForm.FormCreate(Sender: TObject);	237	procedure TMainForm.FormCreate(Sender: TObject);
221	var	238	var
222	ini: TMemIniFile;	239	ini: TMemIniFile;
223	iniFilename: string;	240	iniFilename: string;
224	begin	241	begin
225	csCancelSceneRequest := TCriticalSection.Create;	242	csCancelSceneRequest := TCriticalSection.Create;
226	iniFilename := ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini');	243	iniFilename := ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini');
227		244
228	DoubleBuffered := true;	245	DoubleBuffered := true;
229		246
230	if FileExists(iniFilename) then	247	if FileExists(iniFilename) then
231	begin	248	begin
232	ini := TMemIniFile.Create(iniFilename);	249	ini := TMemIniFile.Create(iniFilename);
233	try	250	try
234	Caption := ini.ReadString('Config', 'Title', '');	251	Caption := ini.ReadString('Config', 'Title', '');
235	finally	252	finally
236	FreeAndNil(ini);	253	FreeAndNil(ini);
237	end;	254	end;
238	end;	255	end;
239		256
240	try	257	try
241	StartupTimer.Enabled := true;	258	StartupTimer.Enabled := true;
242	except	259	except
243	Application.Terminate;	260	Application.Terminate;
244	end;	261	end;
245	end;	262	end;
246		263
247	procedure TMainForm.FormDestroy(Sender: TObject);	264	procedure TMainForm.FormDestroy(Sender: TObject);
248	begin	265	begin
249	if Assigned(Game) then FreeAndNil(Game);	266	if Assigned(Game) then FreeAndNil(Game);
250		267
251	// Without this, some audio drivers could crash if you press ESC to end the game.	268	// Without this, some audio drivers could crash if you press ESC to end the game.
252	// (VPC 2007 with Win95; cpsman.dll crashes sometimes)	269	// (VPC 2007 with Win95; cpsman.dll crashes sometimes)
253	PlaySound(nil, hinstance, 0);	270	PlaySound(nil, hinstance, 0);
254	FreeAndNil(csCancelSceneRequest);	271	FreeAndNil(csCancelSceneRequest);
255	end;	272	end;
256		273
257	procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;	274	procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
258	Shift: TShiftState);	275	Shift: TShiftState);
259	begin	276	begin
260	if Key = VK_SPACE then	277	if Key = VK_SPACE then
261	begin	278	begin
262	if MediaPlayer1.Mode = mpPlaying then MediaPlayer1.Stop;	279	if MediaPlayer1.Mode = mpPlaying then MediaPlayer1.Stop;
263	end;	280	end;
264	if KEY = VK_RETURN then	281	if KEY = VK_RETURN then
265	begin	282	begin
266	if MediaPlayer1.Mode = mpPlaying then	283	if MediaPlayer1.Mode = mpPlaying then
267	begin	284	begin
268	MediaPlayer1.Position := MediaPlayer1.EndPos;	285	MediaPlayer1.Position := MediaPlayer1.EndPos;
269	end;	286	end;
270	csCancelSceneRequest.Acquire;	287	csCancelSceneRequest.Acquire;
271	try	288	try
272	FCancelSceneRequest := true;	289	FCancelSceneRequest := true;
273	finally	290	finally
274	csCancelSceneRequest.Release;	291	csCancelSceneRequest.Release;
275	end;	292	end;
276	end;	293	end;
277	if Key = VK_ESCAPE then Close;	294	if Key = VK_ESCAPE then Close;
278	end;	295	end;
279		296
280	procedure TMainForm.ClickEvent(X, Y: Integer);	297	procedure TMainForm.ClickEvent(X, Y: Integer);
281	var	298	var
282	i: integer;	299	i: integer;
283	ac: TActionDef;	300	ac: TActionDef;
284	begin	301	begin
285	// Debug: Go to prev decision by clicking on the top left edge	302	// Debug: Go to prev decision by clicking on the top left edge
286	if (X < 20) and (Y < 20) then	303	if (X < 20) and (Y < 20) then
287	begin	304	begin
288	// TODO: Also allow to go back multiple steps (we would need a stack instead of PrevDecisionScene/CurDecisionScene)	305	// TODO: Also allow to go back multiple steps (we would need a stack instead of PrevDecisionScene/CurDecisionScene)
289	ac.scoreDelta := 0;	306	ac.scoreDelta := 0;
290	ac.nextSceneID := SCENEID_PREVDECISION;	307	ac.nextSceneID := SCENEID_PREVDECISION;
291	ac.sceneSegment := 0;	308	ac.sceneSegment := 0;
292	Game.PerformAction(@ac);	309	Game.PerformAction(@ac);
293	Exit;	310	Exit;
294	end;	311	end;
295		312
296	// If hotspots are overlaying, the lowest action will be chosen (same behavior as original game)	313	// If hotspots are overlaying, the lowest action will be chosen (same behavior as original game)
297	for i := Low(FHotspots) to High(FHotspots) do	314	for i := Low(FHotspots) to High(FHotspots) do
298	begin	315	begin
299	if Assigned(FHotspots[i].lpAction) and	316	if Assigned(FHotspots[i].lpAction) and
300	(X >= FHotspots[i].cHotspotTopLeft.X) and	317	(X >= FHotspots[i].cHotspotTopLeft.X) and
301	(Y >= FHotspots[i].cHotspotTopLeft.Y) and	318	(Y >= FHotspots[i].cHotspotTopLeft.Y) and
302	(X <= FHotspots[i].cHotspotBottomRight.X) and	319	(X <= FHotspots[i].cHotspotBottomRight.X) and
303	(Y <= FHotspots[i].cHotspotBottomRight.Y) then	320	(Y <= FHotspots[i].cHotspotBottomRight.Y) then
304	begin	321	begin
305	FHotspots[i].Game.PerformAction(FHotspots[i].lpAction);	322	FHotspots[i].Game.PerformAction(FHotspots[i].lpAction);
306	Exit;	323	Exit;
307	end;	324	end;
308	end;	325	end;
309	end;	326	end;
310		327
311	procedure TMainForm.ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);	328	procedure TMainForm.ControlClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
312	begin	329	begin
313	{$IFDEF HOTSPOT_RELATIVE_ORIGIN}	330	{$IFDEF HOTSPOT_RELATIVE_ORIGIN}
314	ClickEvent(X, Y);	331	ClickEvent(X, Y);
315	{$ELSE}	332	{$ELSE}
316	ClickEvent(X+TControl(Sender).Left, Y+TControl(Sender).Top);	333	ClickEvent(X+TControl(Sender).Left, Y+TControl(Sender).Top);
317	{$ENDIF}	334	{$ENDIF}
318	end;	335	end;
319		336
320	procedure TMainForm.StartupTimerTimer(Sender: TObject);	337	procedure TMainForm.StartupTimerTimer(Sender: TObject);
321	begin	338	begin
322	StartupTimer.Enabled := false;	339	StartupTimer.Enabled := false;
323		340
324	if FileExists('INTRO.AVI') then	341	if FileExists('INTRO.AVI') then
325	begin	342	begin
326	MediaPlayer1.FileName := 'INTRO.AVI';	343	MediaPlayer1.FileName := 'INTRO.AVI';
327	MediaPlayer1.Open;	344	MediaPlayer1.Open;
328		345
329	Panel2.Visible := true;	346	Panel2.Visible := true;
330	Panel2.Top := 0;	347	Panel2.Top := 0;
331	Panel2.Left := 0;	348	Panel2.Left := 0;
332	Panel2.Width := MediaPlayer1.DisplayRect.Right;	349	Panel2.Width := MediaPlayer1.DisplayRect.Right;
333	Panel2.Height := MediaPlayer1.DisplayRect.Bottom;	350	Panel2.Height := MediaPlayer1.DisplayRect.Bottom;
334		351
335	ClientWidth := Panel2.Width;	352	ClientWidth := Panel2.Width;
336	if (ClientWidth >= Screen.Width) then FullscreenMode := true;	353	if (ClientWidth >= Screen.Width) then FullscreenMode := true;
337	ClientHeight := Panel2.Height;	354	ClientHeight := Panel2.Height;
338	if (ClientHeight >= Screen.Height) then FullscreenMode := true;	355	if (ClientHeight >= Screen.Height) then FullscreenMode := true;
339	Position := poScreenCenter;	356	Position := poScreenCenter;
340		357
341	if FullScreenMode then	358	if FullScreenMode then
342	begin	359	begin
343	BorderStyle := bsNone;	360	BorderStyle := bsNone;
344	FormStyle := fsStayOnTop;	361	FormStyle := fsStayOnTop;
345	Screen.Cursor := -1;	362	Screen.Cursor := -1;
346	end;	363	end;
347		364
348	// For some reason, "Position := poScreenCenter" causes the video handle to break!	365	// For some reason, "Position := poScreenCenter" causes the video handle to break!
349	// we need to close+open it again!	366	// we need to close+open it again!
350	MediaPlayer1.Close;	367	MediaPlayer1.Close;
351	MediaPlayer1.Open;	368	MediaPlayer1.Open;
352		369
353	MediaPlayer1.Play;	370	MediaPlayer1.Play;
354	while MediaPlayer1.Mode <> mpStopped do	371	while MediaPlayer1.Mode <> mpStopped do
355	begin	372	begin
356	Sleep(100);	373	Sleep(100);
357	Application.ProcessMessages;	374	Application.ProcessMessages;
358	if Application.Terminated then break;	375	if Application.Terminated then break;
359	end;	376	end;
360		377
361	MediaPlayer1.Close;	378	MediaPlayer1.Close;
362	Panel2.Visible := false;	379	Panel2.Visible := false;
363	Screen.Cursor := 0;	380	Screen.Cursor := 0;
364	end;	381	end;
365		382
366	try	383	try
367	Game := TGame.Create('.');	384	Game := TGame.Create('.');
368	Game.PictureShowCallback := cbPictureShow;	385	Game.PictureShowCallback := cbPictureShow;
369	Game.AsyncSoundCallback := cbAsyncSound;	386	Game.AsyncSoundCallback := cbAsyncSound;
370	Game.ExitCallback := cbExit;	387	Game.ExitCallback := cbExit;
371	Game.WaitCallback := cbWait;	388	Game.WaitCallback := cbWait;
372	Game.SetHotspotCallback := cbSetHotspot;	389	Game.SetHotspotCallback := cbSetHotspot;
373	Game.ClearHotspotsCallback := cbClearHotspots;	390	Game.ClearHotspotsCallback := cbClearHotspots;
374	Game.Run;	391	Game.Run;
375	except	392	except
376	on E: EAbort do	393	on E: EAbort do
377	begin	394	begin
378	Close;	395	Close;
379	end;	396	end;
380	on E: Exception do	397	on E: Exception do
381	begin	398	begin
382	MessageDlg(E.Message, mtError, [mbOK], 0);	399	MessageDlg(E.Message, mtError, [mbOK], 0);
383	Close;	400	Close;
384	end;	401	end;
385	end;	402	end;
386	end;	403	end;
387		404
388	end.	405	end.
389		406

Subversion Repositories plumbers

plumbers/trunk/Win32_Player/Main.pas – Rev 24 → 25