home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / vrac / bugslay.zip / CRASHME.PAS < prev    next >
Pascal/Delphi Source File  |  1994-09-29  |  3KB  |  156 lines
  1.  
  2. {A simple program that crashes in it's paint method. Used to demonstrate
  3. BugSlay.
  4.  
  5. This will leave a window allocated on termination.
  6.  
  7. Rex K. Perkins, 11th July 1994
  8.  
  9. ⌐ Copyright Apsley-Bolton Computers, Inc.}
  10.  
  11.  
  12. Program CrashMe;
  13.  
  14. {$C PRELOAD}
  15.  
  16. Uses BugSlay,WinTypes, WinProcs,
  17.   {$IfDef Ver15}
  18.     WObjects;    {WObjects for TPW1.5... or}
  19.   {$Else}
  20.     OWindows;    {OWindows for BPW7}
  21.   {$EndIf}
  22.  
  23. {$D CrashMe!}
  24. {$R+}    {We will be causing a 201:Range Check Error, so we need range checking on!}
  25. {$W-}    {BugSlay does not support Windows stack frames, so turn them off}
  26.  
  27. Const
  28.   BoxSize=16;    {Size of each box}
  29.   NumColors=4096;{Max X+Y of window size}
  30.  
  31. Type
  32.  
  33.   TCrashMeApplication=Object(TApplication)
  34.     Procedure InitMainWindow; Virtual;
  35.   End;
  36.  
  37.  
  38.   PCrashMeWindow=^TCrashMeWindow;
  39.   TCrashMeWindow=Object(TWindow)
  40.     Procedure Paint(PaintDC:HDC; Var PaintInfo:TPaintStruct); Virtual;
  41.   End;
  42.  
  43.  
  44.   PColorTable=^TColorTable;
  45.   TColorTable=Array[1..NumColors] Of TColorRef;
  46.  
  47.  
  48.  
  49. Procedure TCrashMeApplication.InitMainWindow;
  50.  
  51. Begin
  52.   MainWindow:=New(PCrashMeWindow,Init(Nil,'CrashMe!'))
  53. End;
  54.  
  55.  
  56. {--------Main Window----------}
  57.  
  58.  
  59. Procedure TCrashMeWindow.Paint(PaintDC:HDC; Var PaintInfo:TPaintStruct);
  60.  
  61. {Draw a series of boxes on the screen. Will crash with a range check error}
  62.  
  63. Var ColorTable:PColorTable;
  64.  
  65.   Procedure CreateColorArray;
  66.  
  67.   {Create a big table of random colors}
  68.  
  69.   Var BrushColor:TColorRef;
  70.       ColorIndex:Word;
  71.  
  72.   Begin
  73.     For ColorIndex:=1 To NumColors Do
  74.       ColorTable^[ColorIndex]:=RGB(Random($100),Random($100),Random($100))
  75.   End;
  76.  
  77.  
  78.  
  79.   Procedure DrawBoxes;
  80.  
  81.   {Fill the window with boxes}
  82.  
  83.   Var WindowSize:TRect;
  84.       Line:Integer;
  85.  
  86.     Procedure DrawLine(Line:Integer);
  87.  
  88.     {Draw a line of boxes on Line}
  89.  
  90.     Var Col:Integer;
  91.  
  92.       Procedure DrawBox(Col,Line:Integer);
  93.  
  94.       {Draw one box at Col,Line in a random color}
  95.  
  96.       Var BoxToDraw:TRect;
  97.           ColoredBrush:HBrush;
  98.  
  99.       Begin
  100.         ColoredBrush:=CreateSolidBrush(ColorTable^[Col+Line]);
  101.  
  102.         With BoxToDraw Do  {Build the Rect record}
  103.           Begin
  104.             Top:=(Line*BoxSize)+1;
  105.             Bottom:=(Line+1)*BoxSize;
  106.             Left:=(Col*BoxSize)+1;
  107.             Right:=(Col+1)*BoxSize
  108.           End;
  109.  
  110.         FillRect(PaintDC,BoxToDraw,ColoredBrush);  {Draw the rectangle}
  111.  
  112.         DeleteObject(ColoredBrush)    {Tidy up}
  113.       End;
  114.  
  115.     Begin
  116.       Col:=WindowSize.Right DIV BoxSize;  {Calculate number of boxes in a column}
  117.       While Col>=0 Do
  118.         Begin
  119.           DrawBox(Col,Line);
  120.           DEC(Col)
  121.         End
  122.     End;
  123.  
  124.   Begin
  125.     GetClientRect(HWindow,WindowSize);
  126.     Line:=WindowSize.Bottom DIV BoxSize;  {Calculate number of boxes on a line}
  127.     While Line>=0 Do
  128.       Begin
  129.         DrawLine(Line);
  130.         DEC(Line)
  131.       End
  132.   End;
  133.  
  134. Begin
  135.   New(ColorTable);    {Allocate the color table on the heap}
  136.   If ColorTable<>Nil Then
  137.     Begin
  138.       CreateColorArray; {Fill color table with random colors}
  139.       DrawBoxes         {Draw the boxes}
  140.     End;
  141.   Dispose(ColorTable) {Free the color table}
  142. End;
  143.  
  144.  
  145.  
  146. Var
  147.   CrashMeApp:TCrashMeApplication;
  148.  
  149. Begin
  150.   CrashMeApp.Init('CrashMe');
  151.   CrashMeApp.Run;
  152.   CrashMeApp.Done
  153. End.
  154.  
  155.  
  156.