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

    {************************************************}
    {                                                }
    {   UNIT TVMovie  A "Movie" view object          }
    {   Copyright (c) 1993-97 by Tom Wellige         }
    {   Donated as FREEWARE                          }
    {                                                }
    {   Ortsmuehle 4, 44227 Dortmund, GERMANY        }
    {   E-Mail: wellige@itk.de                       }
    {                                                }
    {************************************************}

    unit TVMovie;

    {$O+,F+,P+}

    interface

    uses Dos, Drivers, Objects, App, Views, Dialogs;

    type
      { holding each line of the Movie }
      PMovieCollection = ^TMovieCollection;
      TMovieCollection = object(TCollection)
        procedure FreeItem(Item: Pointer); virtual;
        procedure AddLine(s: string);
      end;

      { Movie - Object }
      PMovie = ^TMovie;
      TMovie = object(TView)
          List: PMovieCollection;
          Pos, Ticks: integer;
          OldS, OldM: word;
        constructor Init(var Bounds: TRect; AList: PMovieCollection);
        procedure Draw; virtual;
        procedure AddTick;
      private
        function  GetLine(Line: integer): string;
      end;

      { About-Dialog which starts movie by user's pressing "ALT-I" }
      PMovieAbout = ^TMovieAbout;
      TMovieAbout = object(TDialog)
          MovieList: PMovieCollection;
          MovieR: TRect;
        constructor Init(var Bounds: TRect; ATitle: string;
                         AList: PMovieCollection; AMovieR: TRect);
        destructor Done; virtual;
        procedure HandleEvent(var Event: TEvent); virtual;
      end;

    const
      cmInfo         = 2000;
      cmMovieReady   = 2001;
      Movie : PMovie = nil;

    implementation

    (***********************************************************************)
    (*                          TMovieAbout                                 *)
    (***********************************************************************)

    constructor TMovieAbout.Init(var Bounds: TRect; ATitle: string;
                     AList: PMovieCollection; AMovieR: TRect);
    begin
      inherited Init(Bounds, ATitle);
      Options := Options or ofCentered;
      MovieList:= AList;
      MovieR   := AMovieR;
      Movie    := nil;
    end;

    destructor TMovieAbout.Done;
    begin
      if Assigned(Movie) then
      begin
        Delete(Movie);
        Dispose(Movie, Done);
        Movie:= nil;
      end;
      inherited Done;
    end;

    procedure TMovieAbout.HandleEvent(var Event: TEvent);
    begin
      inherited HandleEvent(Event);
      { switch Movie on }
      if ((Event.What = evKeyDown) and (Event.KeyCode = kbAltI)) or
         ((Event.What = evCommand) and (Event.Command = cmInfo)) then
      begin
        if Movie <> nil then
        begin
          ClearEvent(Event);
          Delete(Movie);
          Dispose(Movie, Done);
          Movie:= New(PMovie, Init(MovieR, MovieList));
          Insert(Movie);
        end else
        begin
          ClearEvent(Event);
          Movie:= New(PMovie, Init(MovieR, MovieList));
          Insert(Movie);
        end;
      end;
      { Movie ready, relaese view }
      if (Event.What = evBroadcast) and (Event.Command = cmMovieReady) then
      begin
        ClearEvent(Event);
        Delete(Movie);
        Dispose(Movie, Done);
        Movie:= nil;
      end;
    end;

    (***********************************************************************)
    (*                                 TMovie                               *)
    (***********************************************************************)

    constructor TMovie.Init(var Bounds: TRect; AList: PMovieCollection);
    var h, m: word;
    begin
      inherited Init(Bounds);
      Ticks:= 0;
      Pos  := 1;
      List := AList;
      GetTime(h, m, OldM, OldS);
    end;

    procedure TMovie.AddTick;
    var
      i, e: integer;
      h, m, s, hs: word;
    begin
      GetTime(h, m, s, hs);
      if s <> OldM then hs:= hs + 100;
      if hs > OldS + 50 then
      begin
        if s <> OldM then hs:= hs - 100;
        OldM:= s;
        OldS:= hs;
        inc(Pos);
        Draw;
      end;
      if Pos = List^.Count-1 then
        Message(Owner, evBroadCast, cmMovieReady, nil);
    end;

    procedure TMovie.Draw;
    var
      R: TRect;
      i: integer;
      Buf: TDrawBuffer;
      Color: word;
    begin
      GetExtent(R);
      Color:= GetColor(1);
      for i:= 0 to R.B.Y-1 do
      begin
        MoveChar(Buf, ' ', Color, Size.X);
        MoveCStr(Buf, GetLine(Pos+i), $7271);
        WriteLine(0, i, Size.X, 1, Buf);
      end;
    end;

    function TMovie.GetLine(Line: integer): string;
    var
      s: string;
      i, e: integer;
    begin
      if Line >= List^.Count then GetLine:= '' else
        GetLine:= PString(List^.At(Line))^;
    end;

    procedure TMovieCollection.FreeItem(Item: Pointer);
    begin
      if assigned(Item) then DisposeStr(Item);
    end;

    procedure TMovieCollection.AddLine(s: string);
    begin
      Insert(NewStr(s));
    end;

    end.

    { ----------------  DEMO -------------  CUT HERE ----------- }
    {************************************************}
    {                                                }
    {   PROGRAM MOVIETST  Usage of TVMOVIE Unit      }
    {   Copyright (c) 1993-97 by Tom Wellige         }
    {   Donated as FREEWARE                          }
    {                                                }
    {   Ortsmuehle 4, 44227 Dortmund, GERMANY        }
    {   E-Mail: wellige@itk.de                       }
    {                                                }
    {************************************************}

    program MovieTst;

    uses dos, drivers, objects, app, views, dialogs, menus, tvmovie;

    type
      TApp = object(TApplication)
        procedure About;
        procedure Idle; virtual;
        procedure InitMenuBar; virtual;
        procedure HandleEvent(var Event: TEvent); virtual;
      end;

    const
      cmAbout = 1000;

    procedure TApp.About;
    var
      R, F: TRect;
      D   : PMovieAbout;
      C   : PMovieCollection;
    begin

      C:= New(PMovieCollection, Init(50, 5));
      with C^ do
      begin
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('                                        '  );
        AddLine('ÚÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄ¿'  );
        AddLine('³ ³                                  ³ ³'  );
        AddLine('³þ³                                  ³þ³'  );
        AddLine('³ ³     ÛÜ ÜÛ ÛßßÛ Û   Û Û Ûßßß      ³ ³');
        AddLine('³þ³     Û ß Û Û  Û ßÜ Üß Û ÛÜÜ       ³þ³');
        AddLine('³ ³     Û   Û Û  Û  Û Û  Û Û         ³ ³');
        AddLine('³þ³     Û   Û ÛÜÜÛ  ßÜß  Û ÛÜÜÜ      ³þ³');
        AddLine('³ ³                                  ³ ³'  );
        AddLine('³þ³                                  ³þ³'  );
        AddLine('³ ³          ~by Tom Wellige~          ³ ³');
        AddLine('³þ³                                  ³þ³'  );
        AddLine('³ ³                                  ³ ³'  );
        AddLine('³þ³  Well, this is a pretty good     ³þ³'  );
        AddLine('³ ³  place to make some statements   ³ ³'  );
        AddLine('³þ³  about your program.             ³þ³'  );
        AddLine('³ ³                                  ³ ³'  );
        AddLine('³þ³  I always use this Movie to tell ³þ³'  );
        AddLine('³ ³  the user about the beta-        ³ ³'  );
        AddLine('³þ³  testers, the translators or     ³þ³'  );
        AddLine('³ ³  things like that. You want to   ³ ³'  );
        AddLine('³þ³  take a look on my Turbo Vision  ³þ³'  );
        AddLine('³ ³  programs ? No problem. Check    ³ ³'  );
        AddLine('³þ³                                  ³þ³'  );
        AddLine('³ ³      ~www.kst.dit.ie/people/~      ³ ³'  );
        AddLine('³þ³        ~twellige/hps.html~         ³þ³'  );
        AddLine('³ ³                                  ³ ³'  );
        AddLine('³þ³                                  ³þ³'  );
        AddLine('³ ³  And just to make this film a    ³ ³'  );
        AddLine('³þ³  little bit longer:              ³þ³'  );
        AddLine('³ ³                                  ³ ³'  );
        AddLine('³þ³  1                               ³þ³'  );
        AddLine('³ ³   2                              ³ ³'  );
        AddLine('³þ³    3                             ³þ³'  );
        AddLine('³ ³     4                            ³ ³'  );
        AddLine('³þ³      5                           ³þ³'  );
        AddLine('³ ³       6                          ³ ³'  );
        AddLine('³þ³        7                         ³þ³'  );
        AddLine('³ ³         8                        ³ ³'  );
        AddLine('³þ³          9                       ³þ³'  );
        AddLine('³ ³           0                      ³ ³'  );
        AddLine('³þ³            1                     ³þ³'  );
        AddLine('³ ³             2                    ³ ³'  );
        AddLine('³þ³              3                   ³þ³'  );
        AddLine('³ ³               4                  ³ ³'  );
        AddLine('³þ³                5                 ³þ³'  );
        AddLine('³ ³                 6                ³ ³'  );
        AddLine('³þ³                  7               ³þ³'  );
        AddLine('³ ³                   8              ³ ³'  );
        AddLine('³þ³                    9             ³þ³'  );
        AddLine('³ ³                     0            ³ ³'  );
        AddLine('³þ³                      1           ³þ³'  );
        AddLine('³ ³                       2          ³ ³'  );
        AddLine('³þ³                        3         ³þ³'  );
        AddLine('³ ³                         4        ³ ³'  );
        AddLine('³þ³                          5       ³þ³'  );
        AddLine('³ ³                           6      ³ ³'  );
        AddLine('³þ³                            7     ³þ³'  );
        AddLine('³ ³                             8    ³ ³'  );
        AddLine('³þ³                              9   ³þ³'  );
        AddLine('³ ³                               0  ³ ³'  );
        AddLine('³þ³                                  ³þ³'  );
        AddLine('ÀÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÙ'  );
        AddLine('                                        '  );
        AddLine('                                        '  );
      end;

      R.Assign(0,0,48,21);
      F.Assign(4,2,44,15);
      D := New(PMovieAbout, Init(R, 'About' , C, F));
      with D^ do
      begin
        R.Assign(5,2,43,12);
        Insert(New(PStaticText, Init(R,
            #3'MovieTst v1.0'+#13+
            #13+
            #3'Copyright (c) 1993-97 by Tom Wellige'+#13+
            #13+
            #3'Donated as Freeware'+#13+
            #13+
            #13+
            #13+
            #3'This is not only a simple'+#13+
            #3'about box !')));

        R.Assign(24, 18, 34, 20);
        Insert(New(PButton, Init(R, '~O~k',   cmCancel, bfDefault)));

        dec(R.A.X, 11); dec(R.B.X, 11);
        Insert(New(PButton, Init(R, '~I~nfo', cmInfo,   bfNormal)));

        SelectNext(false);
      end;

      if Assigned(D) then Application^.ExecuteDialog(D, nil);

      Dispose(C, Done);
    end;

    procedure TApp.Idle;
    begin
      inherited Idle;
      if assigned(Movie) then Movie^.AddTick;
    end;

    procedure TApp.InitMenuBar;
    var
      R: TRect;
    begin
      GetExtent(R);
      R.B.Y:= R.A.Y + 1;
      MenuBar := New(PMenuBar, Init(R, NewMenu(
        NewSubMenu('~'#240'~', 0, NewMenu(
          NewItem('~A~bout', 'Shift-F1', kbShiftF1, cmAbout, 0,
          NewLine(
          NewItem('E~x~it',  'Alt-X',    kbAltX,    cmQuit,  0,
        nil)))),
      nil))));
    end;

    procedure TApp.HandleEvent(var Event: TEvent);
    begin
      inherited HandleEvent(Event);
      if Event.What = evCommand then
        if Event.Command = cmAbout then About;
    end;

    var
      A: TApp;

    begin
      A.Init;
      A.Run;
      A.Done;
    end.

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