Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue55/Splat/main.pas

Pascal/Delphi Source File | 2000-01-26 | 7.8 KB | 273 lines

unit Main;

interface

// Splat.
// Silly little game that displays a shape and plays a sound when
// the user presses any key or mouse button.
//
// Copyright ⌐ 2000 Tempest Software, Inc.

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, AppEvnts, ExtCtrls, Shapes;

type
  TMainForm = class(TForm)
    AppEvents: TApplicationEvents;
    Image: TImage;
    Timer: TTimer;
    procedure AppEventsMessage(var Msg: tagMSG; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure AppEventsDeactivate(Sender: TObject);
  private
    { Private declarations }
    DoubleBuffer: TBitmap;
    ShapeList: TShapeList;
    WaveList: TStringList;
    procedure CreateShape(X: Integer = -1; Y: Integer = -1);
    procedure HandleKeyDown(KeyCode: Word);
    procedure PlayWave(const Name: string);
    procedure PlayRandomWave;
    procedure RedrawShapes;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses MMSystem, Types, KeyText;

{$R *.DFM}

// Return True if running under control of the Delphi debugger.
function IsDebuggerPresent: Boolean;
begin
  Result := DebugHook <> 0;
end;

// Windows 98 does not let one thread steal the keyboard focus from
// another thread. Ordinarily, this is a good thing, but Splat is special.
// The workaround (read "hack") is to attach the current thread to the input
// the foreground thread, then set the foreground window. I learned this
// trick from Karl Peterson's web site:
// http://www.mvps.org/vb/samples.htm
function ForceForegroundWindow(Handle: HWND): Boolean;
var
  Foreground: HWND;
  ForegroundThreadID, ThisThreadID: DWORD;
begin
  Foreground := GetForegroundWindow;
  if Foreground = Handle then
    Result := True
  else
  begin
    ForegroundThreadID := GetWindowThreadProcessId(Foreground, nil);
    ThisThreadID := GetWindowThreadProcessId(Handle, nil);

    AttachThreadInput(ThisThreadID, ForegroundThreadID, True);
    SetForegroundWindow(Handle);
    AttachThreadInput(ThisThreadID, ForegroundThreadID, False);

    // Return True if the trick worked.
    Result := GetForegroundWindow = Handle;
  end;
end;

// Return a string for a resource name or identifier. A resource name
// can be a string or a numeric identifier. Convert a numeric
// identifier to a string as a hexadecimal constant (e.g., $12A).
// The dollar sign makes it easy to convert back to a number and
// to distinguish a numeric ID from a string name.
function ResIDToString(ResName: PChar): string;
begin
  if LongRec(ResName).Hi = 0 then
    Result := Format('$%x', [Integer(ResName)])
  else
    Result := ResName;
end;

// Convert a string back to a resource identifier.
function StringToResID(const ResText: string): PChar;
var
  ID: Word;
begin
  if (ResText = '') or (ResText[1] <> '$') then
    Result := PChar(ResText)
  else
  begin
    ID := StrToInt(ResText);  // Make sure the ID is within the proper bounds.
    Result := PChar(ID);
  end;
end;

// Collect a list of all WAVE resources, to pick a random one to play
// when the user clicks the mouse.
function EnumWaves(hInstance: THandle; const ResType, ResName: PChar;
    Strings: TStrings): LongBool; stdcall;
begin
  Strings.Add(ResIDToString(ResName));
  Result := True;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // Do not randomize when debugging, so the behavior is predictable.
  if not IsDebuggerPresent then
    Randomize;

  // Get a list of all the sound resources, so they can be played back randomly.
  WaveList := TStringList.Create;
  EnumResourceNames(hInstance, 'WAVE', @EnumWaves, LParam(WaveList));

  // Create a bitmap to double-buffer the main TImage.
  DoubleBuffer := TBitmap.Create;

  if not IsDebuggerPresent then
  begin
    // Make this window the cover the full screen
    // and be topmost of all windows in all applications.
    SetBounds(0, 0, Screen.Width, Screen.Height);
    Win32Check(SetWindowPos(Handle, Hwnd_TopMost, 0, 0, 0, 0, Swp_NoMove or Swp_NoSize));
  end;

  // Wait until the window size is known before creating the shape list.
  ShapeList := TShapeList.Create(Width, Height);
  ShapeList.AddHelp;

  DoubleBuffer.Height := Image.ClientHeight;
  DoubleBuffer.Width  := Image.ClientWidth;
  RedrawShapes;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(DoubleBuffer);
  FreeAndNil(ShapeList);
  FreeAndNil(WaveList);
end;

// Intercept all keystroke events and play a WAVE file for each key press
// without interpreting the key event.
procedure TMainForm.AppEventsMessage(var Msg: tagMSG;
  var Handled: Boolean);
begin
  case Msg.Message of
  Wm_KeyDown,
  Wm_SysKeyDown:
    begin
      // Handle key down events by playing a sound and drawing a shape.
      HandleKeyDown(Msg.wParam);
      Handled := True;
    end;
  Wm_DeadChar,
  Wm_Char,
  Wm_KeyUp,
  Wm_SysKeyUp:
    // Ignore up and other key events.
    Handled := True;
  else
    {Skip};
  end;
end;

// Pick a WAVE file to play based on the key that the user pressed.
procedure TMainForm.HandleKeyDown(KeyCode: Word);
begin
  if KeyCode = Vk_Escape then
    Close
  else
  begin
    PlayWave(KeyCodeToText(KeyCode));
    CreateShape;
  end;
end;

// Periodically transform all the shapes into the next generation
// and redraw the shapes. Typically shapes grow and fade color.
procedure TMainForm.TimerTimer(Sender: TObject);
begin
  if not IsDebuggerPresent then
  begin
    ForceForegroundWindow(Handle);
    if Handle <> GetTopWindow(0) then
      SetWindowPos(Handle, HWnd_Top, 0, 0, 0, 0, Swp_NoSize or Swp_NoMove);
  end;
  ShapeList.NextGeneration;
  RedrawShapes;
end;

// Draw all the shapes to a background bitmap, and replace
// the image's bitmap with the other bitmap. This use of a
// double buffer minimizes screen flicker.
procedure TMainForm.RedrawShapes;
begin
  DoubleBuffer.Canvas.Brush.Color := clBlack;
  DoubleBuffer.Canvas.FillRect(Image.BoundsRect);
  ShapeList.Draw(DoubleBuffer.Canvas);
  Image.Picture.Bitmap := DoubleBuffer;
end;

// Play the named WAVE resource. The resource might be located in
// the locale-specific DLL or in the main application. Try the DLL
// first, then the application. If all else fails, use a default beep.
procedure TMainForm.PlayWave(const Name: string);
var
  ResName: PChar;
begin
  ResName := StringToResID(Name);
  if not PlaySound(ResName, hInstance, Snd_Resource or Snd_ASync) then
    Beep;
end;

// Pick a WAV resource at random and play it.
procedure TMainForm.PlayRandomWave;
var
  ResName: PChar;
begin
  if WaveList.Count = 0 then
    Beep
  else
  begin
    ResName := StringToResID(WaveList[Random(WaveList.Count)]);
    if not PlaySound(ResName, hInstance, Snd_Resource or Snd_ASync) then
      Beep;
  end;
end;

// Create a new shape at (X, Y), or generate a random position.
procedure TMainForm.CreateShape(X, Y: Integer);
begin
  if X < 0 then
    X := Random(Width);
  if Y < 0 then
    Y := Random(Height);
  ShapeList.AddShape(X, Y);
  RedrawShapes;
end;

// When the TImage gets a mouse down event, generate a new shape
// at the mouse position, and play a random sound.
procedure TMainForm.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  CreateShape(X, Y);
  PlayRandomWave;
end;

// If another application tries to take control, bring attention back here.
procedure TMainForm.AppEventsDeactivate(Sender: TObject);
begin
  if not IsDebuggerPresent then
    Win32Check(SetWindowPos(Handle, Hwnd_Top, 0, 0, 0, 0, Swp_NoSize or Swp_NoMove));
end;

end.