home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / SWAT.ZIP / SWAT.PAS next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  13.3 KB  |  517 lines
  1. {************************************************}
  2. {                                                }
  3. {   Demo program                                 }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Swat;
  9.  
  10. {$R Swat}
  11.  
  12. uses
  13.   WinTypes, WinProcs, OWindows, ODialogs, Strings, BWCC;
  14.  
  15. const
  16.   idm_Reset    = 100;
  17.   idm_Option   = 101;
  18.   idm_About    = 102;
  19.   idm_Pause    = 103;
  20.   idm_Stop     = 104;
  21.  
  22.   InputEditBox = 109;
  23.   LiveTimeSB   = 101;
  24.   PopSB        = 102;
  25.  
  26.   MissedPoints = -2;
  27.   HitPoints    =  5;
  28.   MissedCritter = -1;
  29.   CritterSize  = 72;
  30.  
  31.   MaxPop       = 35;
  32.   MaxLiveTime  = 30;
  33.  
  34.   Holes: array[1..5] of TPoint = ((X: 10; Y: 10), (X: 200; Y: 10),
  35.     (X: 100; Y: 100), (X: 10; Y: 200), (X: 200; Y: 200));
  36.  
  37. type
  38.   TApp = object(TApplication)
  39.     procedure InitMainWindow; virtual;
  40.   end;
  41.  
  42.   THole = record
  43.     Time: Word;
  44.     Dead: Boolean;
  45.   end;
  46.  
  47.   PGameWindow = ^TGameWindow;
  48.   TGameWindow = object(TWindow)
  49.     Live, Dead, GameOver, ScoreBoard: HBitMap;
  50.     CursorDown, CursorUp: HCursor;
  51.     Counter, Score, LiveTime, Frequence, GameTime: Integer;
  52.     Hits, Miss, Escaped: Integer;
  53.     IsGameOver, IsPause: Boolean;
  54.     HoleInfo: array[1..5] of THole;
  55.     constructor Init(AParent: PWindowsObject; Title: PChar);
  56.     procedure About(var Message: TMessage); virtual cm_First + idm_About;
  57.     procedure DrawBMP(DC: HDC; X, Y, BitMap: HBitmap);
  58.     procedure DrawGameOver(DC: HDC);
  59.     procedure DrawCritter(DC: HDC; CritterNumber: Byte);
  60.     procedure DrawScoreBoard(DC: HDC);
  61.     procedure GetWindowClass(var WndClass: TWndClass); virtual;
  62.     procedure Options(var Message: TMessage); virtual cm_First + idm_Option;
  63.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  64.     procedure Pause(var Message: TMessage); virtual cm_First + idm_Pause;
  65.     procedure ResetGame(var Message: TMessage); virtual cm_First + idm_Reset;
  66.     procedure SetUpWindow; virtual;
  67.     procedure Stop(var Message: TMessage); virtual cm_First + idm_Stop;
  68.     procedure StopGame;
  69.     procedure WMDestroy(var Message: TMessage); virtual wm_Destroy;
  70.     procedure WMLButtonDown(var Message: TMessage); virtual wm_LButtonDown;
  71.     procedure WMLButtonUp(var Message: TMessage); virtual wm_LButtonUp;
  72.     procedure WMTimer(var Message: TMessage); virtual wm_Timer + wm_First;
  73.     procedure WMSize(var Message: TMessage); virtual wm_Size;
  74.     procedure WriteScore(DC: HDC);
  75.   end;
  76.  
  77. TOptionDialog = object(TDialog)
  78.   procedure OK(var Message: TMessage); virtual id_First + id_Ok;
  79.   procedure SetUpWindow; virtual;
  80.   procedure WMHScroll(var Message: TMessage); virtual wm_HScroll;
  81. end;
  82.  
  83. {--------------- TOptionDialog ---------------}
  84.  
  85. procedure TOptionDialog.SetUpWindow;
  86. var
  87.   S: String;
  88.   CS: array[0..20] of Char;
  89. begin
  90.   TDialog.SetUpWindow;
  91.   SetScrollRange(GetDlgItem(HWindow, LiveTimeSB), sb_Ctl, 1,
  92.     MaxLiveTime, False);
  93.   SetScrollRange(GetDlgItem(HWindow, PopSB), sb_Ctl, 1, MaxPop, False);
  94.   SetScrollPos(GetDlgItem(HWindow, LiveTimeSB), sb_Ctl,
  95.     MaxLiveTime + 1 - PGameWindow(Parent)^.LiveTime, True);
  96.   SetScrollPos(GetDlgItem(HWindow, PopSB), sb_Ctl,
  97.     MaxPop + 6 - PGameWindow(Parent)^.Frequence, True);
  98.   Str(PGameWindow(Parent)^.GameTime div 10, S);
  99.   StrPCopy(CS, S);
  100.   SetDlgItemText(HWindow, InputEditBox, CS);
  101. end;
  102.  
  103. procedure TOptionDialog.WMHScroll(var Message: TMessage);
  104. const
  105.   PageStep = 10;
  106. var
  107.   Pos: Integer;
  108.   Scroll: HWnd;
  109. begin
  110.   Scroll := HiWord(Message.lParam);
  111.   Pos := GetScrollPos(Scroll, SB_Ctl);
  112.   case Message.wParam of
  113.     sb_LineUp: Dec(Pos);
  114.     sb_LineDown: Inc(Pos);
  115.     sb_PageUp: Dec(Pos, PageStep);
  116.     sb_PageDown: Inc(Pos, PageStep);
  117.     sb_ThumbPosition: Pos := LoWord(Message.lParam);
  118.     sb_ThumbTrack: Pos := LoWord(Message.lParam);
  119.   end;
  120.   SetScrollPos(Scroll, sb_Ctl, Pos, True);
  121. end;
  122.  
  123. procedure TOptionDialog.OK(var Message: TMessage);
  124. var
  125.   NoError: Bool;
  126.   Time: Integer;
  127. begin
  128.   PGameWindow(Parent)^.LiveTime := MaxLiveTime + 1 - GetScrollPos(
  129.     GetDlgItem(HWindow, LiveTimeSB), sb_Ctl);
  130.   PGameWindow(Parent)^.Frequence := MaxPop + 1 - GetScrollPos(
  131.     GetDlgItem(HWindow, PopSB), sb_Ctl) + 5;
  132.   Time := GetDlgItemInt(HWindow, InputEditBox, @NoError, False) * 10;
  133.   if (NoError) and (Time > 0) then
  134.   begin
  135.     PGameWindow(Parent)^.GameTime := Time;
  136.     EndDlg(id_Ok);
  137.   end
  138.   else
  139.     MessageBox(HWindow, 'Game Time must be a number greater than 0!',
  140.       'Error', mb_Ok)
  141. end;
  142.  
  143. {--------------- TGameWindow -----------------}
  144.  
  145. constructor TGameWindow.Init(AParent: PWindowsObject; Title: PChar);
  146. begin
  147.   TWindow.Init(AParent, Title);
  148.   Attr.W := 282;
  149.   Attr.H := 400;
  150.   Attr.Style := WS_Caption or WS_SysMenu or WS_MinimizeBox;
  151.   Randomize;
  152. end;
  153.  
  154. procedure TGameWindow.About(var Message: TMessage);
  155. var
  156.   Dialog: TDialog;
  157. begin
  158.   Dialog.Init(@Self, 'About');
  159.   Dialog.Execute;
  160.   Dialog.Done;
  161. end;
  162.  
  163. procedure TGameWindow.DrawBMP(DC: HDC; X, Y, BitMap: HBitMap);
  164. var
  165.   MemDC: HDC;
  166.   bm: TBitMap;
  167.   MadeDC: Boolean;
  168. begin
  169.   if DC = 0 then
  170.   begin
  171.     DC := GetDC(HWindow);
  172.     MadeDC := True;
  173.   end
  174.   else
  175.     MadeDC := False;
  176.   MemDC := CreateCompatibleDC(DC);
  177.   SelectObject(MemDC, BitMap);
  178.   GetObject(GameOver, SizeOf(bm), @bm);
  179.   BitBlt(DC, X, Y, bm.bmWidth, bm.bmHeight, MemDC, 0, 0, SRCCopy);
  180.   DeleteDC(MemDC);
  181.   if MadeDC then ReleaseDC(HWindow, DC);
  182. end;
  183.  
  184. procedure TGameWindow.DrawGameOver(DC: HDC);
  185. begin
  186.   DrawBMP(DC, 10, 70, GameOver);
  187. end;
  188.  
  189. procedure TGameWindow.DrawCritter(DC: HDC; CritterNumber: Byte);
  190. var
  191.   MadeDC: Boolean;
  192.   MemDC: HDC;
  193. begin
  194.   if DC = 0 then
  195.   begin
  196.     DC := GetDC(HWindow);
  197.     MadeDC := True;
  198.   end
  199.   else MadeDC := False;
  200.  
  201.   if HoleInfo[CritterNumber].Time <> 0 then
  202.   begin
  203.     MemDC := CreateCompatibleDC(DC);
  204.     if HoleInfo[CritterNumber].Dead then SelectObject(MemDC, Dead)
  205.     else SelectObject(MemDC, Live);
  206.     BitBlt(DC, Holes[CritterNumber].X, Holes[CritterNumber].Y,
  207.       CritterSize, CritterSize, MemDC, 0, 0, SRCCopy);
  208.     DeleteDC(MemDC);
  209.   end
  210.   else
  211.   begin
  212.     SelectObject(DC, GetStockObject(White_Brush));
  213.     SelectObject(DC, GetStockObject(Null_Pen));
  214.     Rectangle(DC, Holes[CritterNumber].X, Holes[CritterNumber].Y,
  215.       Holes[CritterNumber].X + CritterSize + 1,
  216.       Holes[CritterNumber].Y + CritterSize + 1);
  217.   end;
  218.   if MadeDC then ReleaseDC(HWindow, DC);
  219. end;
  220.  
  221. procedure TGameWindow.DrawScoreBoard(DC: HDC);
  222. begin
  223.   DrawBMP(DC, 11, 214, ScoreBoard);
  224. end;
  225.  
  226. procedure TGameWindow.GetWindowClass(var WndClass: TWndClass);
  227. begin
  228.   TWindow.GetWindowClass(WndClass);
  229.   CursorUp := LoadCursor(hInstance, 'Malet');
  230.   WndClass.Style := 0;
  231.   WndClass.hCursor := CursorUp;
  232.   WndClass.hbrBackGround := GetStockObject(White_Brush);
  233.   WndClass.lpszMenuName := 'Menu';
  234.   WndClass.hIcon := LoadIcon(hInstance, 'Critter');
  235. end;
  236.  
  237. procedure TGameWindow.Options(var Message: TMessage);
  238. var
  239.   D: TOptionDialog;
  240. begin
  241.   D.Init(@Self, 'OptionDlg');
  242.   D.Execute;
  243.   D.Done;
  244. end;
  245.  
  246. procedure TGameWindow.Paint(PaintDC: HDC;var PaintInfo: TPaintStruct);
  247. var
  248.   I: integer;
  249. begin
  250.   DrawScoreBoard(PaintDC);
  251.   WriteScore(PaintDC);
  252.   if IsGameOver then
  253.     DrawGameOver(PaintDC)
  254.   else
  255.     for I := 1 to 5 do
  256.       DrawCritter(PaintDC, I);
  257. end;
  258.  
  259. procedure TGameWindow.Pause(var Message: TMessage);
  260. begin
  261.   if IsGameOver then Exit;
  262.   if IsPause then
  263.   begin
  264.     IsPause := False;
  265.     ModifyMenu(GetMenu(HWindow), idm_Pause, mf_ByCommand,
  266.       idm_Pause, '&Pause');
  267.     DrawMenuBar(hWindow);
  268.     if SetTimer(HWindow, 1, 100, nil) = 0 then
  269.     begin
  270.       MessageBox(HWindow, 'No Timers Left', 'Error', mb_Ok);
  271.       Halt(1);
  272.     end;
  273.   end
  274.   else
  275.   begin
  276.     IsPause := True;
  277.     KillTimer(HWindow, 1);
  278.     ModifyMenu(GetMenu(HWindow), idm_Pause, mf_ByCommand,
  279.       idm_Pause, '&Continue');
  280.     DrawMenuBar(hWindow);
  281.   end;
  282. end;
  283.  
  284. procedure TGameWindow.ResetGame(var Message: TMessage);
  285. begin
  286.   ModifyMenu(GetMenu(HWindow), idm_Option, mf_ByCommand or mf_Grayed,
  287.     idm_Option, '&Options');
  288.   ModifyMenu(GetMenu(HWindow), idm_Pause, mf_ByCommand,
  289.     idm_Pause, '&Pause');
  290.   ModifyMenu(GetMenu(HWindow), idm_Stop, mf_ByCommand,
  291.     idm_Stop, '&Stop');
  292.   DrawMenuBar(HWindow);
  293.   InValidateRect(HWindow, nil, True);
  294.   if SetTimer(HWindow, 1, 100, nil) = 0 then
  295.   begin
  296.     MessageBox(HWindow, 'No Timers Left', 'Error', mb_Ok);
  297.     Halt(1);
  298.   end;
  299.   FillChar(HoleInfo, SizeOf(HoleInfo), 0);
  300.   Counter := 0;
  301.   Score := 0;
  302.   Hits := 0;
  303.   Miss := 0;
  304.   Escaped := 0;
  305.   IsGameOver := False;
  306.   if IsPause then
  307.   begin
  308.     IsPause := False;
  309.     ModifyMenu(GetMenu(HWindow), idm_Pause, mf_ByCommand,
  310.       idm_Pause, '&Pause');
  311.     DrawMenuBar(hWindow);
  312.   end;
  313. end;
  314.  
  315. procedure TGameWindow.SetUpWindow;
  316. begin
  317.   CursorDown := LoadCursor(hInstance, 'MaletDown');
  318.   Live := LoadBitMap(hInstance, 'Live');
  319.   Dead := LoadBitMap(hInstance, 'Dead');
  320.   GameOver := LoadBitMap(hInstance, 'GameOver');
  321.   ScoreBoard := LoadBitMap(hInstance, 'Board');
  322.   IsGameOver := True;
  323.   IsPause := False;
  324.   LiveTime := 10;
  325.   Frequence := 20;
  326.   Counter := 0;
  327.   Score := 0;
  328.   Hits := 0;
  329.   Miss := 0;
  330.   Escaped := 0;
  331.   GameTime := 150 {fifteen seconds}
  332. end;
  333.  
  334. procedure TGameWindow.Stop(var Message: TMessage);
  335. begin
  336.   StopGame;
  337. end;
  338.  
  339. procedure TGameWindow.StopGame;
  340. begin
  341.   KillTimer(HWindow, 1);
  342.   ModifyMenu(GetMenu(HWindow), idm_Option, mf_ByCommand,
  343.     idm_Option, '&Options');
  344.   ModifyMenu(GetMenu(HWindow), idm_Pause, mf_ByCommand or mf_Grayed,
  345.     idm_Pause, '&Pause');
  346.   ModifyMenu(GetMenu(HWindow), idm_Stop, mf_ByCommand or mf_Grayed,
  347.     idm_Stop, '&Stop');
  348.   IsPause := False;
  349.   DrawMenuBar(HWindow);
  350.   IsGameOver := True;
  351.   InValidateRect(HWindow, nil, True);
  352.   Counter := GameTime;
  353. end;
  354.  
  355. procedure TGameWindow.WMDestroy(var Message: TMessage);
  356. begin
  357.   DeleteObject(Live);
  358.   DeleteObject(Dead);
  359.   DeleteObject(GameOver);
  360.   DeleteObject(ScoreBoard);
  361.   KillTimer(HWindow, 1);
  362.   TWindow.WMDestroy(Message);
  363. end;
  364.  
  365. procedure TGameWindow.WMLButtonDown(var Message: TMessage);
  366. var
  367.   Point: TPoint;
  368.   R: TRect;
  369.   I: Integer;
  370.   Hit: Boolean;
  371. begin
  372.   SetClassWord(HWindow, GCW_hCursor, CursorDown);
  373.   GetCursorPos(Point);
  374.   SetCursorPos(Point.X, Point.Y);
  375.   if IsGameOver or IsPause then Exit;
  376.   Hit := False;
  377.   for I := 1 to 5 do
  378.     if not ((HoleInfo[I].Dead) or (HoleInfo[I].Time = 0)) then
  379.     begin
  380.       R.Top := Holes[I].X;
  381.       R.Left := Holes[I].Y;
  382.       R.Bottom := R.Top + CritterSize;
  383.       R.Right := R.Left + CritterSize;
  384.       Point.X := HiWord(Message.lParam);
  385.       Point.Y := LoWord(Message.lParam);
  386.       if PtInRect(R, Point) then
  387.       begin
  388.     Inc(Score, HitPoints);
  389.     HoleInfo[I].Dead := True;
  390.     HoleInfo[I].Time := Counter + 2 * LiveTime;
  391.     Inc(Hits);
  392.     Hit := True;
  393.     DrawCritter(0, I);
  394.       end;
  395.     end;
  396.   if not Hit then
  397.   begin
  398.     Inc(Score, MissedPoints);
  399.     Inc(Miss);
  400.   end;
  401.   WriteScore(0);
  402. end;
  403.  
  404. procedure TGameWindow.WMLButtonUp(var Message: TMessage);
  405. var
  406.   Point: TPoint;
  407. begin
  408.   SetClassWord(HWindow, gcw_hCursor, CursorUp);
  409.   GetCursorPos(Point);
  410.   SetCursorPos(Point.X, Point.Y);
  411. end;
  412.  
  413. procedure TGameWindow.WMTimer(var Message: TMessage);
  414. var
  415.   I: Integer;
  416. begin
  417.   Inc(Counter);
  418.   I := Random(Frequence) + 1;
  419.   if I < 6 then
  420.     if HoleInfo[I].Time = 0 then
  421.     begin
  422.       HoleInfo[I].Time := Counter + LiveTime;
  423.       HoleInfo[I].Dead := False;
  424.       DrawCritter(0, I);
  425.     end;
  426.   for I := 1 to 5 do
  427.     if (Counter > HoleInfo[I].Time) and (HoleInfo[I].Time <> 0) then
  428.     begin
  429.       HoleInfo[I].Time := 0;
  430.       if not HoleInfo[I].Dead then
  431.       begin
  432.     Inc(Score, MissedCritter);
  433.     Inc(Escaped);
  434.       end;
  435.       DrawCritter(0, I);
  436.     end;
  437.   WriteScore(0);
  438.   if Counter >= GameTime then StopGame;
  439. end;
  440.  
  441. procedure TGameWindow.WMSize(var Message: TMessage);
  442. begin
  443.   if IsGameOver then Exit;
  444.   if IsIconic(HWindow) then KillTimer(HWindow, 1)
  445.   else
  446.     if not IsPause then
  447.       if SetTimer(HWindow, 1, 100, nil) = 0 then
  448.       begin
  449.     MessageBox(HWindow, 'No Timers Left', 'Error', mb_Ok);
  450.     Halt(1);
  451.       end;
  452. end;
  453.  
  454. procedure TGameWindow.WriteScore(DC: HDC);
  455. var
  456.   S: array[0..20] of Char;
  457.   MadeDC: Boolean;
  458. begin
  459.  if DC = 0 then
  460.  begin
  461.    MadeDC := True;
  462.    DC := GetDC(HWindow);
  463.  end
  464.  else MadeDC := False;
  465.  SelectObject(DC, CreateSolidBrush($8080));
  466.  SelectObject(DC, GetStockObject(Null_Pen));
  467.  SetBKMode(DC, TransParent);
  468.  
  469.  {Timer}
  470.  Rectangle(DC, 130, 252, 163, 275);
  471.  Str((GameTime-Counter):3, S);
  472.  S[3] :=S[2];
  473.  S[2]:='.';
  474.  TextOut(DC, 130, 252, S, 4);
  475.  
  476.  {Hits}
  477.  Rectangle(DC, 40, 310, 71, 329);
  478.  Str(Hits:3, S);
  479.  TextOut(DC, 40, 310, S, StrLen(S));
  480.  
  481.  {Misses}
  482.  Rectangle(DC, 77, 310, 117, 329);
  483.  Str(Miss:3, S);
  484.  TextOut(DC, 77, 310, S, StrLen(S));
  485.  
  486.  {Escaped}
  487.  Rectangle(DC, 133, 310, 174, 329);
  488.  Str(Escaped:3, S);
  489.  TextOut(DC, 133, 310, S, StrLen(S));
  490.  
  491.  {Total}
  492.  Rectangle(DC, 203, 310, 239, 328);
  493.  Str(Score:3, S);
  494.  TextOut(DC, 203, 310, S, StrLen(S));
  495.  
  496.  DeleteObject(SelectObject(DC, GetStockObject(White_Brush)));
  497.  SelectObject(DC, GetStockObject(Null_Pen));
  498.  if MadeDC then ReleaseDC(HWindow, DC);
  499. end;
  500.  
  501. {--------------- TApp ------------------------}
  502.  
  503. procedure TApp.InitMainWindow;
  504. begin
  505.   MainWindow := New(PGameWindow, Init(nil, 'Swat!'));
  506. end;
  507.  
  508. {-------------Main Program--------------------}
  509.  
  510. var
  511.   App: TApp;
  512. begin
  513.   App.Init('SwatGame');
  514.   App.Run;
  515.   App.Done;
  516. end.
  517.