
{*******************************************************}
{                                                       }
{       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:

   - usage of different languages
   - statusline with hints
   - advantages of NewItemKN, StatusItemKN and NewItemKNhc functions
   - WindowCmds set usage
*)

Uses Objects, Drivers, KeyNames, GVViews, GVMenus, GVApp, GVTexts;

const

{ Commands }

  cmOpenText = 100; cmOpenBitmap = 101; cmChDir = 102; cmDos = 103;
  cmWinList = 104; cmDesktopImage = 105;

{ Help contexts }

  hcFile = 2000; hcWindow = 3000; hcAction = 4000;

type

  PDemoStat = ^TDemoStat;
  TDemoStat = object(TStatusLine)
                function Hint (AHelpCtx: Word): String; virtual;
              end;

  TDemoApp = object(TApplication)
               constructor Init;
               procedure InitMenuBar; virtual;
               procedure InitStatusLine; virtual;
               function LanguageResource: String; virtual;
             end;

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

constructor TDemoApp.Init;
Begin
  inherited Init;
  { insert cmCloseAll into the WindowCmds set }
  WindowCmds := WindowCmds + [Byte(cmCloseAll)];
  DisableCommands([Byte(cmCloseAll)]);
End;

procedure TDemoApp.InitMenuBar;
var R: TRect;
Begin
  Main^.GetExtent(R);
  R.B.Y := 21;
  MenuBar := New(PMenuBar, Init(R, NewMenu(
    NewSubMenu(GetStr(500), hcFile, NewMenu(
        { this is NewItemKN... }
      NewItemKN(GetStr(501), kbF3, cmOpenText, hc + cmOpenText,
        { ... and NewItemKNhc is even better. }
        { Note the help-context convention in Graphics Vision:
          The help context for a command is the constant `hc' added to
          the command cmXXXX.
        }
      NewItemKNhc(GetStr(502), kbF4, cmOpenBitmap,
      NewLine(
      NewItemKNhc(GetStr(503), kbNoKey, cmChDir,
      NewLine(
      NewItemKNhc(GetStr(504), kbNoKey, cmDos,
      NewItemKNhc(GetStr(505), kbAltX, cmQuit, nil)))))))),
    NewSubMenu(GetStr(507), hcWindow, NewMenu(
      StdWindowMenuItems(
      NewLine(
      NewItemKNhc(GetStr(508), kbAlt0, cmWinList,
      NewItemKNhc(GetStr(509), kbAltMinus, cmDesktopImage, nil))))),
    nil)))));
End;

procedure TDemoApp.InitStatusLine;
var R: TRect;
Begin
  Main^.GetExtent(R);
  R.A.Y := R.B.Y - 21;
  StatusLine:=New (PDemoStat, Init (R,
    NewStatusDef (0,0,
      NewStatusKeyKN (GetStr(600),kbAltX,cmQuit,
      NewStatusKeyKN (GetStr(601),kbF10,cmMenu,
      NewStatusKey ('',kbCtrlF5,cmResize,nil))),
    NewStatusDef (2, 499,
      NewStatusKeyKN (GetStr(606),kbAltF3,cmClose,
      NewStatusKeyKN (GetStr(607),kbCtrlF5,cmResize,
      NewStatusKeyKN (GetStr(608),kbAltF10, 0, nil))),
    NewStatusDef (500, 699,
      NewStatusKeyKN (GetStr(609), kbEsc, cmCancel,
      NewStatusKeyKN (GetStr(610), kbEnter, cmOk,
      NewStatusKeyKN (GetStr(611),kbCtrlF5, cmResize, nil))),
    { Note that a standard dragging statusline definition
      is now available. }
    {NewStatusDef (1000,1000,
      NewStatusKey (#2'~'+Chr(27)+Chr(26)+Chr(25)+Chr(24)+'~' + GetStr(602),kbNoKey,cmError,
      NewStatusKey (#2'~Shift-'+ Chr(27)+Chr(26)+Chr(25)+Chr(24)+'~' + GetStr(603),kbNoKey,cmError,
      NewStatusKey (#2'~'+Chr(17)+'ΔΩ~' + GetStr(604),kbNoKey,cmError,
      NewStatusKey (#2'~Esc~' + GetStr(605),kbNoKey,cmError,nil)))),}
    StdDraggingStatusDef(
    NewStatusDef (1001,$FFFF,
      NewStatusKeyKN (GetStr(600),kbAltX,cmQuit,nil),
    nil)))))));
End;


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

(***************************** TDemoStat object *****************************)

function TDemoStat.Hint(AHelpCtx: Word): String;
Begin
  If AHelpCtx >= 1000 then Hint := GetStr(AHelpCtx)
                      else Hint := '';
End;


var App: TDemoApp;

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