[Back to OOP SWAG index] [Back to Main SWAG index] [Original]

    UNIT ScrSaver;

    {
      ScreenSaver Object based on the ScreenSaver by
      Stefan Boether in the TurboVision Forum of CompuServe

      (C) M.Fiel 1993 Vienna - Austria
      CompuServe ID : 100041,2007

      Initialize it with a string (wich is printed on the screen) and the time
      in seconds when it should start.

      To see how it works start the menupoint 'ScreenSave' in the
      demo.exe

      to see how to initialisze the saver watch the demo source.

      to increase or decrease the speed of the printed string use the
      '+' and '-' key (the gray ones);

      Use freely if you find it useful.

    }

    INTERFACE

    USES  Dos, Objects, Drivers, Views, App ;

    TYPE

      PScreenSaver = ^TScreenSaver;
      TScreenSaver = object( TView )

        Activ       : Boolean;
        Seconds     : Integer;

        constructor Init(FName:String;StartSeconds:Integer);
        procedure   GetEvent(var Event : TEvent); virtual;
        function    itsTimeToAct : Boolean;

        PRIVATE

        LastPos     : Integer;
        Factory     : PString;
        DelayTime   : Integer;
        IdleTime    : LongInt;

        procedure   Action; virtual;
        procedure   SetIdleTime; virtual;

      END;

    IMPLEMENTATION

      USES
        Crt;

      constructor TScreenSaver.Init(FName:String;StartSeconds:Integer);
        var
          R : TRect;
        begin

          R.Assign(ScreenWidth-1,0,ScreenWidth,1);
          inherited Init(R);

          LastPos:=(ScreenWidth DIV 2);
          Factory:=NewStr(FName);
          DelayTime:=100;
          Seconds :=StartSeconds;
          SetIdleTime;

        end;

      procedure TScreenSaver.GetEvent(var Event:TEvent);
        begin

          if (Event.What=evNothing) then begin

            if not Activ then begin

              if itsTimeToAct then begin
                Activ := True;
                DoneVideo;
              end;

            end else Action;

          end else if Activ then begin

            if ((Event.What=evKeyDown) and ((Event.KeyCode=kbGrayPlus) or
                                            (Event.KeyCode=kbGrayMinus)) ) then begin
              case Event.KeyCode of
                kbGrayPlus:if DelayTime>0 then dec(DelayTime);
                kbGrayMinus:if DelayTime<4000 then inc(DelayTime);
              end;

              ClearEvent(Event);

            end else begin
              Activ := False;
              InitVideo;
              Application^.ReDraw;
              SetIdleTime;
            end;
          end else
            SetIdleTime;
        end;

      procedure TScreenSaver.SetIdleTime;
        var
          h,m,s,mm: word;
        begin
          GetTime(h,m,s,mm);
          IdleTime:=(h*3600)+(m*60)+s;
        end;

      function TScreenSaver.itsTimeToAct : Boolean;
        var
          h,m,s,mm: word;
        begin
          GetTime(h,m,s,mm);
          itsTimeToAct:=( ((h*3600)+(m*60)+s) > (IdleTime+Seconds) )
        end;

      procedure TScreenSaver.Action;
        var
          Reg:Registers;
          PrStr : String;
        begin
          Dec(LastPos);

          if LastPos>0 then begin

           if LastPos<=ScreenWidth then begin
             if LastPos=ScreenWidth then LastPos:=ScreenWidth-length(Factory^);
             Reg.DL:=LastPos;
             PrStr:=Factory^+' ';
           end else begin
             PrStr:=(Copy(Factory^,1,ScreenWidth+length(Factory^)-LastPos));
             Reg.DL:=ScreenWidth-length(PrStr);
           end;

         end else begin

           if length(Factory^)+LastPos=0 then begin
             PrStr:=' ';
             Reg.DL:=0;
             LastPos:=ScreenWidth+length(Factory^);
           end else begin
             Reg.DL := $00;
             PrStr:=Copy(Factory^,Abs(LastPos)+1,80)+' ';
           end;

         end;

         with Reg do begin
           AH := $02;
           BH := $00;
           DH := (ScreenHeight DIV 2) + (ScreenHeight DIV 4);
         end;
         Intr($10,Reg); (* Set Cursor Position *)

         PrintStr(PrStr);

         with Reg do begin
           AH:=$02;
           BH:=$00;
           DH:=(ScreenHeight+1);
           DL:=$00;
         end;
         Intr($10,Reg); (* Set Cursor Position outside -> Cursor not visible *)

         Delay(DelayTime);

       end;

    END.

[Back to OOP SWAG index] [Back to Main SWAG index] [Original]