home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / pastrick / apps.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-06-02  |  3.3 KB  |  136 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      APPS.PAS                          *)
  3. (*            Bildschirmschoner für Turbo Vision          *)
  4. (*         (c) 1993 Andres Cvitkovich & DMV-Verlag        *)
  5. (* ------------------------------------------------------ *)
  6. UNIT AppS;
  7.  
  8. {$F+,O+,S-,X+,D-}
  9.  
  10. INTERFACE
  11.  
  12. USES App, Objects, Drivers, Views;
  13.  
  14. CONST
  15.   cSavColor      = #$07#$00#$00#$00;
  16.   cSavBlackWhite = #$07#$00#$00#$00;
  17.   cSavMonochrome = #$07#$00#$00#$00;
  18.   cSColor        = cColor      + cSavColor;
  19.   cSBlackWhite   = cBlackWhite + cSavBlackWhite;
  20.   cSMonochrome   = cMonochrome + cSavMonochrome;
  21.  
  22. TYPE
  23.   pDarkView = ^tDarkView;
  24.   tDarkView = OBJECT (tView)
  25.     FUNCTION  GetPalette : pPalette;  VIRTUAL;
  26.     PROCEDURE Draw;                   VIRTUAL;
  27.   END;
  28.  
  29.   pApplicationS = ^tApplicationS;
  30.   tApplicationS = OBJECT (tApplication)
  31.     LastInputTime : LongInt;
  32.     TimeOutTicks  : LongInt;
  33.     Dark          : BOOLEAN;
  34.     DarkenObject  : pDarkView;
  35.     LastSelected  : pView;
  36.  
  37.     CONSTRUCTOR Init(TimeOut : WORD);
  38.     FUNCTION    GetPalette : pPalette;        VIRTUAL;
  39.     PROCEDURE   GetEvent(VAR Event : tEvent); VIRTUAL;
  40.     PROCEDURE   Idle;                         VIRTUAL;
  41.     PROCEDURE   SetTimeOut(TimeOut : WORD);   VIRTUAL;
  42.   END;
  43.  
  44. IMPLEMENTATION
  45.  
  46. (* Turbo Pascal 6.0:
  47. CONST
  48.   Seg0040 = $0040;
  49. *)
  50.  
  51.   FUNCTION Timer : LongInt;
  52.   BEGIN
  53.     Timer := MemL[Seg0040:$006C];
  54.   END;
  55.  
  56.   FUNCTION tDarkView.GetPalette : pPalette;
  57.   CONST
  58.     DarkColor : STRING = #64;
  59.   BEGIN
  60.     GetPalette := @DarkColor
  61.   END;
  62.  
  63.   PROCEDURE tDarkView.Draw;
  64.   VAR
  65.     s : STRING;
  66.     i : BYTE;
  67.   BEGIN
  68.     FillChar(s[1], Size.X, ' ');
  69.     s[0] := Chr(Size.X);
  70.     FOR i := 0 TO Size.Y-1 DO
  71.       WriteStr(0, i, s, 1);
  72.   END;
  73.  
  74.   CONSTRUCTOR tApplicationS.Init(TimeOut : WORD);
  75.   BEGIN
  76.     tApplication.Init;
  77.     SetTimeOut(TimeOut);
  78.     Dark := FALSE;
  79.   END;
  80.  
  81.   FUNCTION tApplicationS.GetPalette : pPalette;
  82.   CONST
  83.     P : ARRAY [apColor..apMonochrome] OF
  84.         STRING [Length(cSColor)] =
  85.      (cSColor, cSBlackWhite, cSMonochrome);
  86.   BEGIN
  87.     GetPalette := @P[AppPalette];
  88.   END;
  89.  
  90.   PROCEDURE tApplicationS.GetEvent(VAR Event : tEvent);
  91.   BEGIN
  92.     tApplication.GetEvent(Event);
  93.     IF Event.What <> evNothing THEN BEGIN
  94.       IF Dark THEN BEGIN
  95.         ShowMouse;
  96.         Delete(DarkenObject);
  97.         Dark := FALSE;
  98.         ClearEvent(Event);
  99.         LastSelected^.Select;
  100.       END;
  101.       LastInputTime := Timer;
  102.     END;
  103.   END;
  104.  
  105.   PROCEDURE tApplicationS.Idle;
  106.   VAR
  107.     t : LongInt;
  108.     R : tRect;
  109.   BEGIN
  110.     tApplication.Idle;
  111.     IF (NOT Dark) AND (TimeOutTicks > 0) THEN BEGIN
  112.       t := Timer;
  113.       IF t < LastInputTime THEN
  114.         t := t + 1573040;
  115.       IF t > (LastInputTime + TimeOutTicks) THEN BEGIN
  116.         Dark := TRUE;
  117.         GetExtent(R);
  118.         DarkenObject := New(pDarkView, Init(R));
  119.         Insert(DarkenObject);
  120.         LastSelected := Current;
  121.         DarkenObject^.Select;
  122.         HideMouse;
  123.       END;
  124.     END;
  125.   END;
  126.  
  127.   PROCEDURE tApplicationS.SetTimeOut(TimeOut : WORD);
  128.   BEGIN
  129.     TimeOutTicks  := Round(TimeOut * 18.2);
  130.     LastInputTime := Timer;
  131.   END;
  132.  
  133. END.
  134. (* ------------------------------------------------------ *)
  135. (*                 Ende von APPS.PAS                      *)
  136.