Subversion Repositories plumbers

unit Main;

// TODO: When the windows is only resized a little bit (A few pixels), the window should not centered

// Idea: Calc the width and height of ALL pictures, and then size the form to the biggest value?

// BUG: if bitmap is not existing, then the error "ReadBitmapFile(): Unable to open bitmap file" appears. Not good.

// BUG: If you drag the window, the dia show will stop playing, but the sound continues! This makes everything out of sync.

// TODO: Ini Parameter if fullscreen is applied or not

// TODO: Check out if hotspot coords should have their origin at the picture or the form position.

// Idea: Savestates. Speedup. Pause.

// Idea: Use Space bar to go to the next decision point.

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, StdCtrls, Game;

type

  TMainForm = class(TForm)

    Image1: TImage;

    Panel1: TPanel;

    StartupTimer: TTimer;

    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);

    procedure cbWait(ASender: TGame; AMilliseconds: integer);

    procedure cbSetHotspot(ASender: TGame; AIndex: THotspotIndex; AHotspot: THotspot);

    procedure cbClearHotspots(ASender: TGame);

    procedure ClickEvent(X, Y: Integer);

  public

    game: TGame;

  end;

var

  MainForm: TMainForm;

implementation

{$R *.dfm}

uses

  MMSystem, IniFiles, Math;

procedure Delay(const Milliseconds: DWord);

var

  FirstTickCount: DWord;

begin

  FirstTickCount := GetTickCount; // TODO: Attention, GetTickCount can overflow

  while not Application.Terminated and ((GetTickCount - FirstTickCount) < Milliseconds) do

  begin

    Application.ProcessMessages;

    Sleep(0);

  end;

end;

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 := 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);

begin

  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 := Image1.Width;

      if (ClientWidth >= Screen.Width) then FullscreenMode := true;

      Position := poScreenCenter;

    end;

    if Image1.Height > ClientHeight then

    begin

      ClientHeight := Image1.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

    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('Your score is: %s', [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;

procedure TMainForm.cbWait(ASender: TGame; AMilliseconds: integer);

begin

  //Cursor := crHourglass;

  try

    Delay(AMilliseconds);

  finally

    //Cursor := crDefault;

  end;

end;

procedure TMainForm.FormCreate(Sender: TObject);

var

  ini: TMemIniFile;

  iniFilename: string;

begin

  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

    Game := TGame.Create('.');

    Game.PictureShowCallback := cbPictureShow;

    Game.AsyncSoundCallback := cbAsyncSound;

    Game.ExitCallback := cbExit;

    Game.WaitCallback := cbWait;

    Game.SetHotspotCallback := cbSetHotspot;

    Game.ClearHotspotsCallback := cbClearHotspots;

    StartupTimer.Enabled := true;

  except

    Application.Terminate;

  end;

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

  // 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);

end;

procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

  if Key = VK_ESCAPE then Close;

end;

procedure TMainForm.ClickEvent(X, Y: Integer);

var

  i: integer;

begin

  // TODO: if hotspots are overlaying; which hotspot will be prefered? the top ones? check out the 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

  ClickEvent(X+TControl(Sender).Left, Y+TControl(Sender).Top);

end;

procedure TMainForm.StartupTimerTimer(Sender: TObject);

begin

  StartupTimer.Enabled := false;

  Game.Run;

end;

end.