Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TVTOOL.ZIP/SCROLL.PAS

Pascal/Delphi Source File | 1992-09-15 | 10.5 KB | 405 lines

program TV_SCROLL_TEST;
{$X+}

USES
  TvScroll,
  Objects, Drivers, Views, Menus, Dialogs, App;


CONST
  cmTestW  = 100;
  cmTestD  = 101;

            {         1         2         3         4         5         6         7         8         9         0}
            {1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890}
  Line1   = '┌─ These () are Dragable and Resizable, farther down are some input lines. ────┬────┬────┬────┬────┐';
  Line2   = '│    │    │    │    │    │    │    │    │    │    │    │    │    │    │    │    │    │    │    │    │';
  Line3   = '├────┼────┼────┼────┼────┼────┼────┼────┼────┼────┼────┼────┼────┼────┼────┼────┼────┼────┼────┼────┤';


TYPE
  TMyApp = object(TApplication)
    Constructor Init;
    Procedure   HandleEvent(var Event: TEvent); virtual;
    Procedure   InitMenuBar; virtual;
    Procedure   InitStatusLine; virtual;
    Procedure   TestWindow;
    Procedure   TestDialog;
  end;


  PMyView1 = ^TMyView1;
  TMyView1 = Object(TView)
    Procedure   Draw;                                               Virtual;
  end;


  PMyView2 = ^TMyView2;
  TMyView2 = Object(TView)
    Procedure   Draw;                                               Virtual;
  end;


  PMyView3 = ^TMyView3;
  TMyView3 = Object(TScrollView)
    Procedure   Draw;                                               Virtual;
    Procedure   SizeLimits(var Min, Max : TPoint);                  Virtual;
  end;


{ TMyView3 }
{ Scrolling, selectable views }
Procedure TMyView3.Draw;

  var
    B : TDrawBuffer;
    C : Word;

  begin
    { set colors for the various modes. }
    if (State AND sfDragging <> 0) and (State AND sfSelected <> 0) then
      C := 3
    else if (State AND sfFocused <> 0) then
      C := 2
    else
      C := 1;

    MoveChar(B, 'X', GetColor(C), Size.X);
    WriteLine(0, 0, Size.X, Size.Y, B);
  end;

Procedure TMyView3.SizeLimits(var Min, Max : TPoint);
  begin
    { only grow in X dimension }
    Min.X := 1;
    Min.Y := 1;
    Max.X := Owner^.Size.X;
    Max.Y := 1;
  end;


{ TMyView2 }
{ Scrolling background }
Procedure TMyView2.Draw;

  var
    C : Word;
    Y : Word;
    X : Word;
    I : Integer;
    T : String[5];
    S : String;

  begin
    if State and sfFocused <> 0 then
      C := $0002
    else
      C := $0001;

    { Display the currently visible portion of the background }
    Y := PScrollGroup(Owner)^.VScrollBar^.Value;
    X := PScrollGroup(Owner)^.HScrollBar^.Value + 1;

    for I := 0 to Size.Y - 1 do
    begin
      if (Y = 0) then
        S := Copy(Line1, X, Size.X)
      else if (Y MOD 3 = 0) then
        S := Copy(Line3, X, Size.X)
      else
        S := Copy(Line2, X, Size.X);

      Inc(Y);
      Str(Y:3, T);
      S[Length(S) - 1] := T[3];
      S[Length(S) - 2] := T[2];
      S[Length(S) - 3] := T[1];

      WriteStr(0, I, S, C);
    end;
  end;


{ TMyView1 }
{ Scrolling non-selectable views }
Procedure TMyView1.Draw;

  var
    B : TDrawBuffer;
    C : Word;

  begin
    if State and sfFocused <> 0 then
    begin
      C := $0002;
    end
    else
    begin
      C := $0001;
    end;

    MoveChar(B, '*', GetColor(C), Size.X);
    WriteLine(0, 0, Size.X, Size.Y, B);
  end;


{ TMyApp }
Procedure TMyApp.HandleEvent(var Event: TEvent);
  begin
    TApplication.HandleEvent(Event);

    if Event.What = evCommand then
    begin
      case Event.Command of
        cmTestW : TestWindow;
        cmTestD : TestDialog;
      else
        Exit;
      end;

      ClearEvent(Event);
    end;
  end;

Procedure TMyApp.InitMenuBar;

  var
    R: TRect;

  begin
    GetExtent(R);
    R.B.Y := R.A.Y + 1;
    MenuBar := New(PMenuBar, Init(R, NewMenu(
      NewSubMenu('~T~est', hcNoContext, NewMenu(
        NewItem('Test ~W~indow', 'F4', kbF4, cmTestW, hcNoContext,
        NewItem('Test ~D~ialog', 'F5', kbF4, cmTestD, hcNoContext,
        NewLine(
        NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
        nil))))),
      nil))
    ));
  end;

Procedure TMyApp.InitStatusLine;

  var
    R: TRect;

  begin
    GetExtent(R);
    R.A.Y := R.B.Y - 1;
    StatusLine := New(PStatusLine, Init(R,
      NewStatusDef(0, $FFFF,
        NewStatusKey('', kbF10, cmMenu,
        NewStatusKey('~Alt-X~ Exit',      kbAltX, cmQuit,
        NewStatusKey('~F2~ Resize Window',kbF2,   cmResize,
        NewStatusKey('~F3~ Resize Field', kbF3,   cmDragView,
        NewStatusKey('~F4~ New Window',   kbF4,   cmTestW,
        NewStatusKey('~F5~ New Dialog',   kbF5,   cmTestD,
        NewStatusKey('~F6~ Next Window',  kbF6,   cmNext,
        nil))))))),
      nil)
    ));
  end;

Procedure TMyApp.TestDialog;

  var
    Dlg : PScrollDialog;
    R   : TRect;
    P   : PView;
    i   : Integer;

  begin
    R.Assign(0,0,44,19);
    New(Dlg, Init(R, 'Test Dialog'));

    with Dlg^ do
    begin
      Options := Options OR ofCentered;
      { Make sure to set the size limits so the scrolling can be controlled. }
      SetLimit(60, 30);

      { There should always be some view that will in all situations
        cover the entire window interior in the scrolling group. In general
        this will be the first view, and will probably be all blank. Here,
        we add a standard TView.
      }
      Interior^.GetExtent(R);
      P := New(PView, Init(R));
      { This view should be disabled and non-selectable, and should
        grow with the window.
      }
      P^.SetState(sfDisabled, True);
      P^.Options    := P^.Options AND not ofSelectable;
      InsertToScroll(P);

      { add a label }
      { any view can be inserted to scroll, just set the scroll flag }
      R.Assign(10,0,30,1);
      P := New(PStaticText, Init(R, 'Scrolling Data Entry'));
      P^.GrowMode := P^.GrowMode OR gfGrowXYRel;
      InsertToScroll(P);

      { add some input lines }
      for i := 1 to 12 do
      begin
        R.Assign(5,i + 1, 20, i + 2);
        P := New(PInputLine, Init(R, 12));
        P^.GrowMode := P^.GrowMode OR gfGrowXYRel;
        InsertToScroll(P);
      end;

      { add check boxes }
      R.Assign(23,2,34,6);
      P := New(PCheckBoxes, Init(R,
        NewSItem('~O~ne',
        NewSItem('~T~wo',
        NewSItem('Th~r~ee',
        NewSItem('~F~our',Nil))))));
      P^.GrowMode := P^.GrowMode OR gfGrowXYRel;
      PCluster(P)^.Value := 0;
      InsertToScroll(P);

      { add radio buttons }
      R.Assign(23,8,34,12);
      P := New(PRadioButtons, Init(R,
        NewSItem('~O~ne',
        NewSItem('~T~wo',
        NewSItem('Th~r~ee',
        NewSItem('~F~our',Nil))))));
      P^.GrowMode := P^.GrowMode OR gfGrowXYRel;
      PCluster(P)^.Value := 0;
      InsertToScroll(P);

      { add some more input lines }
      for i := 1 to 12 do
      begin
        R.Assign(38,i + 1, 53, i + 2);
        P := New(PInputLine, Init(R, 12));
        P^.GrowMode := P^.GrowMode OR gfGrowXYRel;
        InsertToScroll(P);
      end;

      { add more radio buttons }
      R.Assign(23,13,34,17);
      P := New(PRadioButtons, Init(R,
        NewSItem('~O~ne',
        NewSItem('~T~wo',
        NewSItem('Th~r~ee',
        NewSItem('~F~our',Nil))))));
      P^.GrowMode := P^.GrowMode OR gfGrowXYRel;
      PCluster(P)^.Value := 0;
      InsertToScroll(P);

      { Add some buttons, these can scroll too, as you see fit.
        It kind of depends on how your dialog box is layed out.
        But make sure to insert them into the scrolling group, not
        directly into the dialog box. If buttons are inserted into
        the dialog and not the scrolling group, the tab order gets
        messed up.
      }
      R.Assign(6,20,14,22);
      P := New(PButton, Init(R, 'O~K~', cmOK, bfDefault));
      P^.GrowMode := P^.GrowMode OR gfGrowXYRel;
      InsertToScroll(P);

      R.Assign(26,20,38,22);
      P := New(PButton, Init(R, '~C~ancel', cmCancel, bfNormal));
      P^.GrowMode := P^.GrowMode OR gfGrowXYRel;
      InsertToScroll(P);

      Interior^.SelectNext(False);
    end;

    Desktop^.ExecView(Dlg);
    Dispose(Dlg, Done);
  end;

Procedure TMyApp.TestWindow;


  var
    Win : PScrollWindow;
    i   : Integer;
    P   : PView;
    R   : TRect;
    S   : PScroller;

  begin
    R.Assign(0, 0, 40, 15);
    Win := New(PScrollWindow, Init(R, 'Demo Window', wnNoNumber));
    { Make sure to set the size limits so the scrolling can be controlled. }
    Win^.SetLimit(100,30);

    { There should always be some view that will in all situations
      cover the entire window interior in the scrolling group. In general
      this will be the first view, and will probably be all blank. Here,
      we add a special view that will display a background that scrolls
      with the other views. This view could just as well be a standard TView,
      that would by default be empty.
    }
    Win^.Interior^.GetExtent(R);
    P := New(PMyView2, Init(R));
    { This view should be disabled and non-selectable, and should
      grow with the window.
    }
    P^.SetState(sfDisabled, True);
    P^.Options    := P^.Options AND not ofSelectable;
    P^.GrowMode   := P^.GrowMode OR gfGrowHiX OR gfGrowHiY;
    Win^.InsertToScroll(P);


    { Add some views that scroll, and can be resized and dragged. }
    for i := 1 to 7 do
    begin
      R.Assign(i,i, i + i * 2, i + 1);
      P := New(PMyView3, Init(R));
      Win^.InsertToScroll(P);
    end;

    { Add some views that scroll, but cannot be resized or dragged.
      You could also add views that do not scroll at all, just by
      cleared the gfGrowXYRel bit in the GrowMode.
    }
    for i := 1 to 7 do
    begin
      R.Assign(1,i + 9, i * i + 1, i + 10);
      P := New(PMyView1, Init(R));
      P^.GrowMode  := P^.GrowMode OR gfGrowXYRel;
      Win^.InsertToScroll(P);
    end;

    { add some scrolling input lines }
    for i := 1 to 2 do
    begin
      R.Assign(1,i + 18, 9, i + 19);
      P := New(PScrollInputLine, Init(R, 6));
      Win^.InsertToScroll(P);
    end;

    R.Assign(1,i + 20, 9, i + 21);
    P := New(PScrollInputLine, Init(R, 15));
    Win^.InsertToScroll(P);

    { Always insert the window after it is setup, (after first view
      has been inserted) this will avoid some unsightly screen displays on
      slower machines.
    }
    DeskTop^.Insert(Win);
  end;

Constructor TMyApp.Init;
  begin
    TApplication.Init;
  end;


VAR
  MyApp : TMyApp;

BEGIN
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
END.