home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l044 / 2.ddi / TVDEMOS.ZIP / GADGETS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-23  |  2.5 KB  |  127 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Demo                            }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit Gadgets;
  10.  
  11. {$F+,O+,S-,D-}
  12.  
  13. { Useful gadgets: clock and heap available viewer }
  14.  
  15. interface
  16.  
  17. uses Dos, Objects, Views, App;
  18.  
  19. type
  20.   PHeapView = ^THeapView;
  21.   THeapView = object(TView)
  22.     OldMem : LongInt;
  23.     constructor Init(var Bounds: TRect);
  24.     procedure Draw; virtual;
  25.     procedure Update;
  26.   end;
  27.  
  28.   PClockView = ^TClockView;
  29.   TClockView = object(TView)
  30.     Refresh: Byte;
  31.     LastTime: DateTime;
  32.     TimeStr: string[10];
  33.     constructor Init(var Bounds: TRect);
  34.     procedure Draw; virtual;
  35.     function FormatTimeStr(H, M, S: Word): String; virtual;
  36.     procedure Update; virtual;
  37.   end;
  38.  
  39.  
  40. implementation
  41.  
  42. uses Drivers;
  43.  
  44. {------ Heap Window object ----------}
  45.  
  46. constructor THeapView.Init(var Bounds: TRect);
  47. begin
  48.   TView.Init(Bounds);
  49.   OldMem := 0;
  50. end;
  51.  
  52. procedure THeapView.Draw;
  53. var
  54.   S: String;
  55.   B: TDrawBuffer;
  56.   C: Byte;
  57. begin
  58.   OldMem := MemAvail;
  59.   Str(OldMem:Size.X, S);
  60.   C := GetColor(2);
  61.   MoveChar(B, ' ', C, Size.X);
  62.   MoveStr(B, S, C);
  63.   WriteLine(0, 0, Size.X, 1, B);
  64. end;
  65.  
  66.  
  67. procedure THeapView.Update;
  68. begin
  69.   if (OldMem <> MemAvail) then DrawView;
  70. end;
  71.  
  72. {-------- ClockView Object --------}
  73.  
  74. function LeadingZero(w: Word): String;
  75. var s: String;
  76. begin
  77.   Str(w:0, s);
  78.   LeadingZero := Copy('00', 1, 2 - Length(s)) + s;
  79. end;
  80.  
  81. constructor TClockView.Init(var Bounds: TRect);
  82. begin
  83.   TView.Init(Bounds);
  84.   FillChar(LastTime, SizeOf(LastTime), #$FF);
  85.   TimeStr := '';
  86.   Refresh := 1;
  87. end;
  88.  
  89.  
  90. procedure TClockView.Draw;
  91. var
  92.   B: TDrawBuffer;
  93.   C: Byte;
  94. begin
  95.   C := GetColor(2);
  96.   MoveChar(B, ' ', C, Size.X);
  97.   MoveStr(B, TimeStr, C);
  98.   WriteLine(0, 0, Size.X, 1, B);
  99. end;
  100.  
  101.  
  102. procedure TClockView.Update;
  103. var
  104.   h,m,s,hund: word;
  105. begin
  106.   GetTime(h,m,s,hund);
  107.   if Abs(s - LastTime.sec) >= Refresh then
  108.   begin
  109.     with LastTime do
  110.     begin
  111.       Hour := h;
  112.       Min := m;
  113.       Sec := s;
  114.     end;
  115.     TimeStr := FormatTimeStr(h, m, s);
  116.     DrawView;
  117.   end;
  118. end;
  119.  
  120. function TClockView.FormatTimeStr(H, M, S: Word): String;
  121. begin
  122.   FormatTimeStr := LeadingZero(h)+ ':'+ LeadingZero(m) +
  123.     ':' + LeadingZero(s);
  124. end;
  125.  
  126. end.
  127.