home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / pctchnqs / 1991 / number2 / slow.pas < prev    next >
Pascal/Delphi Source File  |  1991-03-27  |  3KB  |  122 lines
  1. { slow.pas -- Draw polygon using conventional paint method }
  2.  
  3. program Slow;
  4.  
  5. {$R test.res}   { Attach binary resources to .EXE file }
  6.  
  7. uses WinTypes, WinProcs, WObjects, Poly;
  8.  
  9. const
  10.  
  11.   id_Menu     = 100;    { Menu resource ID }
  12.   cm_NewShape = 101;    { Menu New Shape command ID }
  13.   cm_Quit     = 102;    { Menu Quit command ID }
  14.   numShapes   = 5;      { Number of polygons to display }
  15.  
  16. type
  17.  
  18.   TestApplication = object(TApplication)
  19.     procedure InitMainWindow; virtual;
  20.   end;
  21.  
  22.   PTestWindow = ^TestWindow;
  23.   TestWindow = object(TWindow)
  24.     PolyShapes: PCollection;  { Collection of shapes }
  25.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  26.     destructor Done; virtual;
  27.     procedure CMNewShape(var Msg: TMessage);
  28.       virtual cm_First + cm_NewShape;
  29.     procedure CMQuit(var Msg: TMessage);
  30.       virtual cm_First + cm_Quit;
  31.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  32.       virtual;
  33.   end;
  34.  
  35.  
  36. {----- TestApplication methods -----}
  37.  
  38. {- Initialize TestApplication object's window }
  39. procedure TestApplication.InitMainWindow;
  40. begin
  41.   MainWindow := New(PTestWindow, Init(nil, 'Slow Paint Demo'));
  42.   Randomize
  43. end;
  44.  
  45.  
  46. {----- TestWindow methods -----}
  47.  
  48. {- Construct TestWindow object }
  49. constructor TestWindow.Init(AParent: PWindowsObject;
  50.  ATitle: PChar);
  51. var
  52.   I: Integer;
  53. begin
  54.   TWindow.Init(AParent, ATitle);
  55.   PolyShapes := New(PCollection, Init(numShapes, 0));
  56.   if PolyShapes = nil then
  57.   begin
  58.     MessageBox(0, 'Not enough memory available',
  59.      'Fata Error', mb_SystemModal);
  60.     PostQuitMessage(0)
  61.   end;
  62.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu))
  63. end;
  64.  
  65. {- Dispose of TestWindow object }
  66. destructor TestWindow.Done;
  67. begin
  68.   if PolyShapes <> nil then Dispose(PolyShapes, Done);
  69.   TWindow.Done
  70. end;
  71.  
  72. {- Execute Menu:New Shape command }
  73. procedure TestWindow.CMNewShape(var Msg: TMessage);
  74. var
  75.   P: PPolygon;
  76.   I: Integer;
  77.   R: TRect;
  78. begin
  79.   PolyShapes^.Freeall;
  80.   GetClientRect(HWindow, R);
  81.   for I := 0 to numShapes - 1 do
  82.   begin
  83.     P := New(PPolygon, Init(50, R.Right, R.Bottom));
  84.     if P <> nil then
  85.       PolyShapes^.Insert(P)
  86.   end;
  87.   InvalidateRect(HWindow, nil, true)
  88. end;
  89.  
  90. {- Execute Menu:Exit command }
  91. procedure TestWindow.CMQuit(var Msg: TMessage);
  92. begin
  93.   CloseWindow
  94. end;
  95.  
  96. {- Paint window's client area, showing current polygons }
  97. procedure TestWindow.Paint(PaintDC: HDC;
  98.  var PaintInfo: TPaintStruct);
  99.   procedure DrawShape(P: PPolygon); far;
  100.   begin
  101.     P^.Draw(PaintDC)
  102.   end;
  103. begin
  104.   PolyShapes^.ForEach(@DrawShape)
  105. end;
  106.  
  107. var
  108.  
  109.   SlowApp: TestApplication;
  110.  
  111. begin
  112.   SlowApp.Init('SlowApp');
  113.   SlowApp.Run;
  114.   SlowApp.Done
  115. end.
  116.  
  117.  
  118. {--------------------------------------------------------------
  119.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  120.   Revision 1.00    Date: 3/26/1991
  121. ---------------------------------------------------------------}
  122.