home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / tpw / docdemos / stream1.pas < prev    next >
Pascal/Delphi Source File  |  1991-05-20  |  7KB  |  276 lines

  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Demo program                                 }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9.  
  10. { Create and display a collection of graphical objects:
  11.   ellipses, rectangles and pie slices. Then put them on a stream
  12.   to be read by another program (STREAM2.PAS). }
  13.  
  14. program Stream1;
  15.  
  16. uses
  17.   WObjects, WinTypes, WinProcs, Strings;
  18.  
  19. const
  20.   NumToDraw = 10;
  21.   em_Stream = 100;
  22.  
  23. { ********************************** }
  24. { ******  Graphical Objects  ******* }
  25. { ********************************** }
  26.  
  27. type
  28.   PGraphObject = ^TGraphObject;
  29.   TGraphObject = object(TObject)
  30.     Rect: TRect;
  31.     constructor Init(Bounds: TRect);
  32.     procedure Draw(DC: HDC); virtual;
  33.     procedure Store(var S: TStream); virtual;
  34.   end;
  35.  
  36.   PGraphEllipse = ^TGraphEllipse;
  37.   TGraphEllipse = object(TGraphObject)
  38.     procedure Draw(DC: HDC); virtual;
  39.   end;
  40.  
  41.   PGraphRect = ^TGraphRect;
  42.   TGraphRect = object(TGraphObject)
  43.     procedure Draw(DC: HDC); virtual;
  44.   end;
  45.  
  46.   PGraphPie = ^TGraphPie;
  47.   TGraphPie = object(TGraphObject)
  48.     ArcStart, ArcEnd: TPoint;
  49.     constructor Init(Bounds: TRect);
  50.     procedure Draw(DC: HDC); virtual;
  51.     procedure Store(var S: TStream); virtual;
  52.   end;
  53.  
  54. { TGraphObject }
  55. constructor TGraphObject.Init(Bounds: TRect);
  56. var
  57.   Height, Width: Word;
  58. begin
  59.   TObject.Init;
  60.   with Bounds do
  61.   begin
  62.     Height := Random(Bottom - Top) div 2 + 10;
  63.     Width := Random(Right - Left) div 3 + 15;
  64.   end;
  65.   with Rect do
  66.   begin
  67.     Left := Random(Bounds.Right - Bounds.Left - Width);
  68.     Right := Left + Width;
  69.     Top := Random(Bounds.Bottom - Bounds.Top - Height);
  70.     Bottom := Top + Height;
  71.   end;
  72. end;
  73.  
  74. procedure TGraphObject.Draw(DC: HDC);
  75. begin
  76.   Abstract;
  77. end;
  78.  
  79. procedure TGraphObject.Store(var S: TStream);
  80. begin
  81.   S.Write(Rect, SizeOf(Rect));
  82. end;
  83.  
  84. { TGraphEllipse }
  85. procedure TGraphEllipse.Draw(DC: HDC);
  86. begin
  87.   with Rect do
  88.     Ellipse(DC, Left, Top, Right, Bottom);
  89. end;
  90.  
  91. { TGraphRect }
  92. procedure TGraphRect.Draw(DC: HDC);
  93. begin
  94.   with Rect do
  95.     Rectangle(DC, Left, Top, Right, Bottom);
  96. end;
  97.  
  98. { TGraphPie }
  99. constructor TGraphPie.Init(Bounds: TRect);
  100. var Height, Width: Word;
  101. begin
  102.   TGraphObject.Init(Bounds);
  103.   with Bounds do
  104.   begin
  105.     Height := Random(Bottom - Top);
  106.     Width := Random(Right - Left);
  107.  
  108.     ArcStart.X := Random(Right - Left - Width);
  109.     ArcEnd.X := ArcStart.X + Width;
  110.     ArcStart.Y := Random(Bottom - Top - Height);
  111.     ArcEnd.Y := ArcStart.Y + Height;
  112.   end;
  113. end;
  114.  
  115. procedure TGraphPie.Draw;
  116. begin
  117.   with Rect do
  118.     Pie(DC, Left, Top, Right, Bottom,
  119.       ArcStart.X, ArcStart.Y, ArcEnd.X, ArcEnd.Y);
  120. end;
  121.  
  122. procedure TGraphPie.Store(var S: TStream);
  123. begin
  124.   TGraphObject.Store(S);
  125.   S.Write(ArcStart, SizeOf(ArcStart));
  126.   S.Write(ArcEnd, SizeOf(ArcEnd));
  127. end;
  128.  
  129.  
  130. { ********************************** }
  131. { **  Stream Registration Records ** }
  132. { ********************************** }
  133.  
  134. const
  135.   RGraphEllipse: TStreamRec = (
  136.     ObjType: 150;
  137.     VmtLink: Ofs(TypeOf(TGraphEllipse)^);
  138.     Load: nil;                             { No load method yet }
  139.     Store: @TGraphEllipse.Store);
  140.  
  141.   RGraphRect: TStreamRec = (
  142.     ObjType: 151;
  143.     VmtLink: Ofs(TypeOf(TGraphRect)^);
  144.     Load: nil;                             { No load method yet }
  145.     Store: @TGraphRect.Store);
  146.  
  147.   RGraphPie: TStreamRec = (
  148.     ObjType: 152;
  149.     VmtLink: Ofs(TypeOf(TGraphPie)^);
  150.     Load: nil;                             { No load method yet }
  151.     Store: @TGraphPie.Store);
  152.  
  153. procedure StreamRegistration;
  154. begin
  155.   RegisterType(RCollection);
  156.   RegisterType(RGraphEllipse);
  157.   RegisterType(RGraphRect);
  158.   RegisterType(RGraphPie);
  159. end;
  160.  
  161. { ********************************** }
  162. { *********  Graph Window  ********* }
  163. { ********************************** }
  164. type
  165.   { Define a TApplication descendant }
  166.   TGraphApp = object(TApplication)
  167.     procedure InitMainWindow; virtual;
  168.     procedure Error(ErrorCode: Integer); virtual;
  169.   end;
  170.  
  171.   PGraphWindow = ^TGraphWindow;
  172.   TGraphWindow = object(TWindow)
  173.     GraphicsList: PCollection;
  174.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  175.     destructor Done; virtual;
  176.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  177.     procedure SetupWindow; virtual;
  178.   end;
  179.  
  180.  
  181. { TGraphApp }
  182. procedure TGraphApp.InitMainWindow;
  183. begin
  184.   MainWindow := New(PGraphWindow,
  185.     Init(nil, 'Collection of Graphical Objects'));
  186. end;
  187.  
  188. procedure TGraphApp.Error(ErrorCode: Integer);
  189. var
  190.   ErrorString: array[0..25] of Char;
  191. begin
  192.   case ErrorCode of
  193.     em_Stream:
  194.       MessageBox(0, 'Error creating GRAPHICS.STM.',
  195.         'Application Error', mb_Ok);
  196.   else
  197.     WVSPrintF(ErrorString, 'Error code = %d', ErrorCode);
  198.     MessageBox(0, ErrorString, 'Application Error', mb_Ok);
  199.   end;
  200. end;
  201.  
  202.  
  203. { TGraphWindow }
  204. constructor TGraphWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  205. begin
  206.   TWindow.Init(AParent, ATitle);
  207.   GraphicsList := nil;
  208. end;
  209.  
  210. procedure TGraphWindow.SetupWindow;
  211. var
  212.   Bounds: TRect;
  213.   I: Integer;
  214.   P: PGraphObject;
  215.   GraphicsStream: TBufStream;
  216. begin
  217.   TWindow.SetupWindow;
  218.   GetClientRect(HWindow, Bounds);
  219.  
  220.   { Instantiate a collection of objects }
  221.  
  222.   { Initialize collection to hold 10 elements first, then grow by 5's }
  223.   GraphicsList := New(PCollection, Init(10, 5));
  224.  
  225.   for I := 1 to NumToDraw do
  226.   begin
  227.     case I mod 3 of                      { Create it }
  228.       0: P := New(PGraphRect, Init(Bounds));
  229.       1: P := New(PGraphEllipse, Init(Bounds));
  230.       0..2: P := New(PGraphPie, Init(Bounds));
  231.     end;
  232.     GraphicsList^.Insert(P);                     { Add it to collection }
  233.   end;
  234.  
  235.   { Put the collection in a stream on disk }
  236.   StreamRegistration;                   { Register all streamed objects }
  237.   GraphicsStream.Init('GRAPH.STM', stCreate, 1024);
  238.   GraphicsStream.Put(GraphicsList);     { Output collection }
  239.   if GraphicsStream.Status <> 0 then
  240.     Status := em_Stream;
  241.   GraphicsStream.Done;                  { Shut down stream }
  242. end;
  243.  
  244. destructor TGraphWindow.Done;
  245. begin
  246.   Dispose(GraphicsList, Done);         { Delete collection }
  247.   TWindow.Done;
  248. end;
  249.  
  250. procedure TGraphWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  251. const
  252.   Msg: PChar = 'Figures stored. Run STREAM2.PAS to load and see them.';
  253. var
  254.   Bounds: TRect;
  255. begin
  256.   GetClientRect(HWindow, Bounds);
  257.   DrawText(PaintDC, Msg, StrLen(Msg), Bounds, DT_WordBreak);
  258. end;
  259.  
  260.  
  261. { ********************************** }
  262. { **********  Main Program ********* }
  263. { ********************************** }
  264.  
  265. { Declare a variable of type TGraphApp }
  266. var
  267.   GraphApp: TGraphApp;
  268.  
  269. { Run the GraphApp }
  270. begin
  271.   GraphApp.Init('GraphApp');
  272.   GraphApp.Run;
  273.   GraphApp.Done;
  274. end.
  275.  
  276.