
{*******************************************************}
{                                                       }
{       Graphics Vision Example program                 }
{                                                       }
{       Copyright (c) 1996 Stefan Milius                }
{                                                       }
{*******************************************************}

(* To run this program you'll have to build EXAM.GVL by:

   GVLC exam.gvl english.gvs englishx.gvs exam.gvs

   Hint: If you want another than the English language just translate all
   the texts in the GVS files into this language and then rebuild EXAM.GVL!
   (Germans only have to translate exam.gvs)


This application shows:

   - how to use the old TV object in graphics mode

*)

{$ifdef Windows}
This will not run under Windows.
{$else}
Uses Dos, Objects, Drivers, KeyNames, Views, GVViews, GVMenus, GVApp, GVTexts,
     GVTV, Dialogs, GVDialog, StdDlg;
{$endif}

const

{ Commands }

  cmNew = 100; cmNewG = 101; cmNewDialog = 102;

{ HelpCtx }

  hcWindow = 3000;

type

{ TDemoApp object }

  TDemoApp = object(TApplication)
               procedure HandleEvent(var Event: TEvent); virtual;
               procedure InitStatusLine; virtual;
               function LanguageResource: String; virtual;
             end;

(******************************** TDemoApp object ***************************)

procedure TDemoApp.HandleEvent(var Event: TEvent);
var Num: Byte;

  procedure NewWindow(TVScrollBar: Boolean);
  var R: TRect;
      D: PDialog;
      TV: PView;
      Gate: PGGate;
      SB: PScrollBar;
      VSB: Views.PScrollBar;
      Entries: PCollection;
  Begin
    R.Assign(0, 0, 400, 220);
    D := New(PDialog, Init(R, GetStr(762)));
    With D^ do Begin
      Options := Options or ofCentered;

      If TVScrollBar then Begin
        { create a TV scrollbar for the listbox }
        R.Assign(3, 10, 45, 11);
        VSB := New(views.PScrollbar, Init(R));
        Insert(NewGGate(VSB));
      End
      Else Begin
        { Create a GV scrollbar, and associate an 'up scrollbar' with it }
        R.Assign(45 * CharSize.X, 3 * CharSize.Y, 45 * CharSize.X + 18,
          10 * CharSize.Y);
        SB := New(PScrollbar, Init(R));
        Insert(SB);
        VSB := New(PUpScrollbar, Init(SB));
      End;

      { create a TV listbox ... }
      R.Assign(3, 3, 45, 10);
      TV := New(Dialogs.PListBox, Init(R, 1, VSB));
      { ... and its data }
      Entries := New(PStringCollection, Init(8, 8));
      With Entries^ do begin
        AtInsert(0, NewStr(GetStr(759)));
        AtInsert(1, NewStr(GetStr(760)));
        AtInsert(2, NewStr(GetStr(761)));
      End;
      Dialogs.PListBox(TV)^.NewList(Entries);
      { wrap the TV object into a GGate and insert it }
      Gate := NewGGate(TV);
      If not TVScrollBar then Gate^.TGate^.InsertBefore(VSB, nil);
      Insert(Gate);

      { and twice again }
      R.Assign(3, 12, 13, 14);
      TV := New(Dialogs.PButton, Init(R, GetStr(739), cmOK, bfDefault));
      Insert(NewGGate(TV));
      R.Assign(15, 12, 25, 14);
      TV := New(Dialogs.PButton, Init(R, GetStr(740), cmCancel, bfNormal));
      Insert(NewGGate(TV));
      SelectNext(false);
    End;
    ExecuteDialog(D, nil);
    Dispose(Entries, Done);
  End;

  procedure NewDialog;
  var TV: PView;
  Begin
    TV := New(StdDlg.PChDirDialog, Init(cdNormal, 0));

    app.Desktop^.ExecView(TV);
  End;

Begin
  inherited HandleEvent(Event);
  If Event.What = evCommand then
    Case Event.Command Of
      cmNew: NewWindow(true);
      cmNewG: NewWindow(false);
      cmNewDialog: NewDialog;
    End
End;

procedure TDemoApp.InitStatusLine;
var R: TRect;
Begin
  GetExtent(R);
  R.A.Y := R.B.Y - 21;
  StatusLine := New(PStatusLine, Init(R,
    StdDraggingStatusDef(
    NewStatusDef(0, $FFFF,
      NewStatusKeyKN(GetStr(600), kbAltX, cmQuit,
      NewStatusKeyKN(GetStr(625), kbF3, cmNewDialog,
      NewStatusKeyKN(GetStr(613), kbF4, cmNew,
      NewStatusKeyKN(GetStr(624), kbAltF4, cmNewG,
      NewStatusKey('', kbAltF3, cmClose,
      NewStatusKey('', kbCtrlF5, cmResize, nil)))))),
    nil))));
End;

function TDemoApp.LanguageResource: String;
Begin
  LanguageResource := 'EXAM.GVL';
End;

var App: TDemoApp;

Begin
  Language := lfEnglish;
  App.Init;
  App.Run;
  App.Done;
End.
