
{*******************************************************}
{                                                       }
{       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 flying hints
   - how to use window numbers

Note that we need different graphics units for Windows.
*)

Uses 
  {$ifdef Windows} WinGr, {$else} MetaGr, MyFonts, MyMouse, {$endif}
  Dos, Objects, Drivers, ExtGraph, KeyNames,
  Views, GVViews, GVMenus, GVApp, GVTexts, GVWinNum, GVHint;

const

{ Commands }

  cmNew = 100;

{ HelpCtx }

  hcUpLeft = 10000; hcUp = 10001; hcUpRight = 10002; hcRight = 10003;
  hcDownRight = 10004; hcDown = 10005; hcDownLeft = 10006; hcLeft = 10007;

  hcInterior = 10008; hcClosefield = 10009; hcZoomfield = 10010;
  hcWinNum = 10011; hcTitle = 10012;
  hcIntSpace = 10013; hcCloseSpace = 10014; hcZoomSpace = 10015;
  hcNumSpace = 10016;

  hcIntText = 10017;

const
  HintDelay: Word = 10;

type

{ TDemoWindow object }

  PDemoWindow = ^TDemoWindow;
  TDemoWindow = object(TWindow)
    constructor Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
    procedure ChMCursor; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

{ TInterior object }

  PInterior = ^TInterior;
  TInterior = object(TGView)
    constructor Init(var Bounds: TRect);
    procedure Draw; virtual;
  end;

{ TDemoApp object }

  TDemoApp = object(TApplication)
               procedure GetEvent(var Event: TEvent); virtual;
               procedure HandleEvent(var Event: TEvent); virtual;
               procedure InitStatusLine; virtual;
               function LanguageResource: String; virtual;
               procedure Timer(var Event: TEvent); virtual;
             private
               LastEvent: Word;
             end;

(***************************** TInterior object *****************************)

constructor TInterior.Init(var Bounds: TRect);
begin
  TGView.Init(Bounds);
  GrowMode := gfGrowHiX + gfGrowHiY;
end;

const
  Greeting: string = 'Hello, World!';

procedure TInterior.Draw;
begin
  SetFillStyle (SolidFill, GetColor(21));
  Bar (0,0, Size.X-1, Size.Y-1);
  SetTextParams(ftSansSerif, 0, GetColor(19), false);
  SetTextJustify(LeftText, TopText);
  OutTextXY(20, 35, Greeting);
end;

(*************************** TDemoWindow object *****************************)

constructor TDemoWindow.Init(Bounds: TRect; WinTitle: String; WindowNo: Word);
var
  Interior: PInterior;
begin
  TWindow.Init(Bounds, WinTitle, WindowNo);
  Flags := Flags and not wfBackground;
  GetExtent(Bounds);
  GetClientRect(Bounds);
  Interior := New(PInterior, Init(Bounds));
  Insert(Interior);
end;

function Ranges (x, Lx, Hx: Integer): Boolean; Assembler;
Asm
	MOV	AX, X
	CMP	AX, Lx
        JL	@@1
        CMP	AX, Hx
        JG	@@1
        MOV	AX, 1
        JMP	@@2
@@1:	XOR	AX, AX
@@2:
End;

procedure TDemoWindow.ChMCursor;
var P: TPoint;
    R: TRect;
Begin
  { call the old mouse cursor change routine }
  inherited ChMCursor;
  { an now the extensions for hints }
  If Exposed then Begin
    HelpCtx := hcNoContext;
    MakeLocal(MouseWhere, P);
    If Ranges(P.Y, 0, 3) then
      If Ranges(P.X, 0, 22) then HelpCtx := hcUpLeft
      Else If Ranges(P.X, Size.X - 23, Size.X - 1) then HelpCtx := hcUpRight
           Else HelpCtx := hcUp
    Else If Ranges(P.Y, Size.Y - 4, Size.Y - 1) then
           If Ranges(P.X, 0, 22) then HelpCtx := hcDownLeft
           Else If Ranges(P.X, Size.X - 23, Size.X - 1) then HelpCtx := hcDownRight
                Else HelpCtx := hcDown;
    If HelpCtx = hcNoContext then
      If Ranges(P.X, 0, 3) then
        If Ranges(P.Y, 0, 22) then HelpCtx := hcUpLeft
        Else If Ranges(P.Y, Size.Y - 23, Size.Y - 1) then HelpCtx := hcDownLeft
             Else HelpCtx := hcLeft
      Else If Ranges(P.X, Size.X - 4, Size.X - 1) then
             If Ranges(P.Y, 0, 22) then HelpCtx := hcUpRight
             Else If Ranges(P.Y, Size.Y - 23, Size.Y - 1) then HelpCtx := hcDownRight
                  Else HelpCtx := hcRight;
    If HelpCtx = hcNoContext then Begin
      GetClientRect(R);
      If R.Contains(P) then Begin
        Inc(R.A.X, 20); Inc(R.A.Y, 35);
        SetTextParams(ftSansSerif, 0, 0, false);
        R.B.X := R.A.X + TextWidth(Greeting);
        R.B.Y := R.A.Y + TextHeight(Greeting);
        If R.Contains(P) then HelpCtx := hcIntText
        Else HelpCtx := hcInterior
      End
      Else Begin
        If P.Y = 22 then HelpCtx := hcIntSpace
        Else
          If P.X = 22 then HelpCtx := hcCloseSpace
          Else
            If P.X < 22 then HelpCtx := hcClosefield
            Else
              If P.X = Size.X - 23 then HelpCtx := hcZoomSpace
              Else
                If P.X > Size.X - 23 then HelpCtx := hcZoomfield
                Else
                  If P.X = Size.X - 42 then HelpCtx := hcNumSpace
                  Else
                    If P.X > Size.X - 42 then HelpCtx := hcWinNum
                    Else HelpCtx := hcTitle;
      End
    End
  End
End;

procedure TDemoWindow.HandleEvent(var Event: TEvent);
Begin
  If (Event.What = evPositionalCtx) then Begin
    ClearEvent(Event);
    Event.InfoLong := HelpCtx;
  End
  Else inherited HandleEvent(Event)
End;

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

procedure TDemoApp.GetEvent(var Event: TEvent);
{ keep the time when the last user-input event occured
}
begin
  inherited GetEvent(Event);
  If Event.What and (evMouse + evKeyboard) <> 0
  then LastEvent := GetTimerTicks
end;

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

  procedure NewWindow;
  var R: TRect;
  Begin
    R.Assign(0, 0, GMinWinSize.X + Random(200), GMinWinSize.Y + Random(200));
    R.Move(Random(200), Random(200));
    InsertWindow(New(PDemoWindow, Init(R, GetStr(705), wnJustANumber)));
  End;

Begin
  inherited HandleEvent(Event);
  If Event.What = evCommand then
    Case Event.Command Of
      cmNew: NewWindow;
    End;
  { this shows how to use Alt-<Num> keys to select windows }
  Num := GetNumberFromEvent(Event, etNumberKeys);
  If Num <> wnNoNumber then
    Message(@Self, evBroadCast, cmSelectWindowNum, Ptr(0, Num))
End;

procedure TDemoApp.InitStatusLine;
var R: TRect;
Begin
  Main^.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(613), kbF3, cmNew,
      NewStatusKey('', kbAltF3, cmClose,
      NewStatusKey('', kbCtrlF5, cmResize,
      NewStatusKey('', kbF5, cmZoom, nil))))),
    nil))));
End;

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

procedure TDemoApp.Timer(var Event: TEvent);
{ need to overwrite the Timer method to use flying hints }
const
  HintActive: Boolean = false;
var
  P: PString;
  s: string;
  Wh: TPoint;
  Hint: PGView;
  R: TRect;
begin
  inherited Timer(Event);
  If (Event.InfoWord > LastEvent + HintDelay) and not HintActive
  then begin
    Wh := MouseWhere;
    P := Message(Application, evPositionalCtx, 0, pointer(Wh));
    If P <> nil
    then begin
      If Seg(P^) = 0
      then begin
	If Ofs(P^) < HelpCtxMinimum then Exit;
	s := GetStr(Ofs(P^));
	If s = '' then Exit;
      end
      else s := P^;
      GetExtent(R);
      R.A.X := Wh.x + 15;
      R.A.Y := Wh.y;
      Hint := New(PFlyingHint, Init(R, s));
      HintActive := true;
      ExecView(Hint);
      HintActive := false;
      Dispose(Hint, Done)
    end;
  end;
end;


var App: TDemoApp;

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