home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 11.ddi / WDOCDEMO.ZIP / GRAFLINE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  2.9 KB  |  135 lines
  1. {************************************************}
  2. {                                                }
  3. {   ObjectWindows Demo                           }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. {$R-} { Turn off range check because Windows message parameters
  9.         don't distinguish between Integer and Word. }
  10.  
  11. unit GrafLine;
  12.  
  13. interface
  14.  
  15. uses WinTypes, Objects, OWindows, Pen;
  16.  
  17. type
  18.   PLinePoint = ^TLinePoint;
  19.   TLinePoint = object(TObject)
  20.     X, Y: Integer;
  21.     constructor Init(AX, AY: Integer);
  22.     constructor Load(var S: TStream);
  23.     procedure Store(var S: TStream);
  24.   end;
  25.  
  26.   PLine = ^TLine;
  27.   TLine = object(TObject)
  28.     Points: PCollection;
  29.     LinePen: PPen;
  30.     constructor Init(APen: PPen);
  31.     constructor Load(var S: TStream);
  32.     destructor Done; virtual;
  33.     procedure AddPoint(AX, AY: Word);
  34.     procedure Draw(ADC: HDC);
  35.     procedure Store(var S: TStream);
  36.   end;
  37.  
  38. const
  39.   RLinePoint: TStreamRec = (
  40.     ObjType: 200;
  41.     VmtLink: Ofs(TypeOf(TLinePoint)^);
  42.     Load: @TLinePoint.Load;
  43.     Store: @TLinePoint.Store);
  44.  
  45.   RLine: TStreamRec = (
  46.     ObjType: 201;
  47.     VmtLink: Ofs(TypeOf(TLine)^);
  48.     Load: @TLine.Load;
  49.     Store: @TLine.Store);
  50.  
  51. implementation
  52.  
  53. uses WinProcs, OMemory;
  54.  
  55. {--------------------------------------------------}
  56. { TDPoints's method implementations:               }
  57. {--------------------------------------------------}
  58.  
  59. constructor TLinePoint.Init(AX, AY: Integer);
  60. begin
  61.   X := AX;
  62.   Y := AY;
  63. end;
  64.  
  65. constructor TLinePoint.Load(var S: TStream);
  66. begin
  67.   S.Read(X, SizeOf(X));
  68.   S.Read(Y, SizeOf(Y));
  69. end;
  70.  
  71. procedure TLinePoint.Store(var S: TStream);
  72. begin
  73.   S.Write(X, SizeOf(X));
  74.   S.Write(Y, SizeOf(Y));
  75. end;
  76.  
  77. constructor TLine.Init(APen: PPen);
  78. begin
  79.   inherited Init;
  80.   Points := New(PCollection, Init(50, 50));
  81.   LinePen := New(PPen, InitLike(APen));
  82. end;
  83.  
  84. constructor TLine.Load(var S: TStream);
  85. begin
  86.   Points := PCollection(S.Get);
  87.   LinePen := PPen(S.Get);
  88. end;
  89.  
  90. destructor TLine.Done;
  91. begin
  92.   Dispose(LinePen, Done);
  93.   Dispose(Points, Done);
  94.   inherited Done;
  95. end;
  96.  
  97. procedure TLine.AddPoint(AX, AY: Word);
  98. begin
  99.   Points^.Insert(New(PLinePoint, Init(AX, AY)));
  100. end;
  101.  
  102. procedure TLine.Draw(ADC: HDC);
  103. type
  104.   PtArray = array[0..0] of TPoint;
  105. var
  106.   Pts: ^PtArray;
  107.   PtCount: Integer;
  108.  
  109.   procedure DrawTheLine(P: PLinePoint); far;
  110.   begin
  111.     Pts^[PtCount].X := P^.X;
  112.     Pts^[PtCount].Y := P^.Y;
  113.     Inc(PtCount);
  114.   end;
  115.  
  116. begin
  117.   LinePen^.Select(ADC);
  118.   Pts := MemAlloc(Points^.Count * SizeOf(TPoint));
  119.   PtCount := 0;
  120.   Points^.ForEach(@DrawTheLine);
  121.   Polyline(ADC, Pts^, Points^.Count);
  122.   FreeMem(Pts, Points^.Count * SizeOf(TPoint)); 
  123.   LinePen^.Delete;
  124. end;
  125.  
  126. procedure TLine.Store(var S: TStream);
  127. begin
  128.   S.Put(Points);
  129.   S.Put(LinePen);
  130. end;
  131.  
  132. begin
  133.   RegisterType(RLinePoint);
  134.   RegisterType(RLine);
  135. end.