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

Besides the features of EXAM0003.PAS this application shows:

   - an application HandleEvent method that provides most of the actions
     of the menu
   - the usage of scrollers as text interiors of windows
   - the usage of scrollers as graphical interiors of windows

Note: Since the underlying graphics system is different,
      we have to `ifdef'ify the `uses' statement.
*)

Uses
  {$ifdef Windows} WinGr, {$else} {$ifdef FPC} Bgi, {$else} MetaGr, MyFonts, {$endif} {$endif}
  Dos, Objects, Drivers, ExtGraph, KeyNames, Views,
  GVViews, GVMenus, GVApp, GVTexts, GVBitmap, GVStdDlg, GVWList, GVWinNum;

const

{ Commands }

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

{ Help contexts }

  hcFile = 2000; hcWindows = 3000;
  hcWindow = 100; hcDialog = 500;

type

{ TTextInterior object }

  PTextInterior = ^TTextInterior;
  TTextInterior = object (TScroller)
    Strings: TStringCollection;
    constructor Init(var Bounds: TRect; AHScrollBar,
	AVScrollBar: PScrollBar; FileName: PathStr);
    destructor Done; virtual;
    procedure Draw; virtual;
    procedure ReadFile(FileName: PathStr); virtual;
  end;

{ TTextWindow object }

  PTextWindow = ^TTextWindow;
  TTextWindow = object (TWindow)
    constructor Init (var Bounds: TRect; WinTitle: String;
      ANumber: Integer);
  end;

{ TBitmapWindow object }

  PBitmapWindow = ^TBitmapWindow;
  TBitmapWindow = object(TWindow)
    constructor Init(Bounds: TRect; WinTitle: String;
      WindowNo: Word);
  end;

{ TDemoStat object }

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

{ TDemoApp object }

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

(*************************** TTextInterior object ***************************)

constructor TTextInterior.Init;
Begin
  TScroller.Init (Bounds, AHScrollBar, AVScrollBar);
  GrowMode:=gfGrowHiX + gfGrowHiY;
  ReadFile (FileName);
End;

destructor TTextInterior.Done;
Begin
  Strings.Done;
  TGView.Done;
End;

procedure TTextInterior.Draw;
var
  I, j: Integer;
  S, Ins: String;
Begin
  { Background  }
  SetFillStyle(SolidFill, GetColor(3));   { scroller normal background }
  Bar(0, 0, Size.X-1, Size.Y-1);
  { Text  }
  SetTextParams(ftMonoSpace, 0, GetColor(1), false);  { scroller normal text }
  SetTextJustify(LeftText, CenterText);
  Ins := '        ';
  For I := Delta.Y to Delta.Y + Size.Y div TextSize.Y do
    If I < Strings.Count
    then Begin
      S := PString(Strings.At(I))^;
      { Tab conversion
      }
      j := 1;
      while j <= Length(S) do
	if S[j] = #9
	then begin
	  Ins[0] := Chr(7 - (j - 1) mod 8);
	  Insert(Ins, S, j + 1);
	  S[j] := ' ';
	  Inc(j, Length(Ins) + 1)
	end
	else Inc(j);
      { Output the text line
      }
      OutTextXY(- Delta.X * TextSize.X,
	(I - Delta.Y) * TextSize.Y + TextSize.Y div 2, S)
    End;
End;

procedure TTextInterior.ReadFile;
var F: Text;
    S: String;
    I: Integer;
Begin
  Strings.Init (30,10);
  Strings.Duplicates:=true;
  Assign (F, FileName);
  {$I-}
  Reset (F);
  While not EOF (F) and (IOResult = 0) do Begin
    ReadLn (F, S);
    If S='' then S:=' ';
    Strings.AtInsert (Strings.Count, NewStr (S));
  End;
  Close (F);
  {$I+}
  SetLimit (100, Strings.Count);
End;

(**************************** TTextWindow object ****************************)

constructor TTextWindow.Init;
var R: TRect;
Begin
  TWindow.Init (Bounds, WinTitle, ANumber);
  Flags := Flags and not wfBackground;
  GetClientRect (R);
  Dec (R.B.X, 17); Dec (R.B.Y, 17);
  Insert (New (PTextInterior, Init (R,
    StandardScrollBar (sbHorizontal+sbHandleKeyboard),
    StandardScrollBar (sbVertical+sbHandleKeyboard),
    WinTitle)));
End;

(**************************** TBitmapWindow object **************************)

constructor TBitmapWindow.Init(Bounds: TRect; WinTitle: String;
  WindowNo: Word);
var
  HScrollBar, VScrollBar: PScrollBar;
  Interior: PGView;
begin
  TWindow.Init(Bounds, WinTitle, WindowNo);
  Flags := Flags and not wfBackground;

  VScrollBar := StandardScrollBar(sbVertical + sbHandleKeyboard);
  HScrollBar := StandardScrollBar(sbHorizontal + sbHandleKeyboard);

  GetClientRect(Bounds);
  Dec(Bounds.B.X, 17); Dec(Bounds.B.Y, 17);

  Interior := New(PBmpScroller, Init(Bounds, HScrollBar, VScrollBar, WinTitle));
  Insert(Interior);
end;


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

constructor TDemoApp.Init;
Begin
  inherited Init;
  { insert cmCloseAll into the WindowCmds set }
  WindowCmds := WindowCmds + [Byte(cmCloseAll)];
  DisableCommands([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 }
      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))),
    {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;

procedure TDemoApp.HandleEvent(var Event: TEvent);

  procedure FileOpen(FileName: PathStr);
  var
    R: TRect;
  Begin
    R.Assign(0, 0, 400, 300);
    R.Move(Random(240), Random(140));
    InsertWindow(New(PTextWindow, Init(R, Filename, wnJustANumber)))^.HelpCtx :=
      hcWindow;
  End;

  procedure OpenFileDlg;
  var
    D: PFileDialog;
    S: PathStr;
  Begin
    S := '*.txt';
    D := New(PFileDialog, Init(S, GetStr(701), GetStr(702),
      fdOpenButton, 40));
    D^.HelpCtx := hcDialog;
    If ExecuteDialog(D, @S) <> cmCancel then FileOpen(S)
  End;

  procedure BitmapOpen(FileName: PathStr);
  var
    R: TRect;
  Begin
    R.Assign(0, 0, 300, 200);
    R.Move(Random(340), Random(240));
    InsertWindow(New(PBitmapWindow, Init(R, Filename, wnJustANumber)))^.HelpCtx :=
      hcWindow;
  End;

  procedure OpenBitmapDlg;
  var
    D: PFileDialog;
    S: PathStr;
  Begin
    S := '*.bmp';
    D := New(PFileDialog, Init(S, GetStr(703), GetStr(702),
      fdOpenButton, 41));
    D^.HelpCtx := hcDialog;
    If ExecuteDialog(D, @S) <> cmCancel then BitmapOpen(S)
  End;

  procedure Close(P: PGView); {$ifndef FPK}far;{$endif}
  Begin
    If Message(P, evBroadCast, cmHeyYou, Desktop) <> nil then
      PWindow(P)^.Close;
  End;

var Num: Word;

Begin
  inherited HandleEvent(Event);
  If (Event.What = evCommand) then
    Case Event.Command Of
      cmOpentext: OpenFileDlg;
      cmOpenBitmap: OpenBitmapDlg;
      cmChDir: ExecuteDialog(New (PChDirDialog, Init(cdNormal, 30)), nil);
      cmDos: Dosshell;
      cmCloseAll: Desktop^.ForEach(@Close);
      cmWinList: ExecuteWindowList(New (PWListDialog, Init(wlNormal)));
    End;
  { this shows how to use Alt-<Num> keys to select windows }
  Num := GetNumberFromEvent(Event, etAltNumKeys);
  If Num <> wnNoNumber then
    Message(@Self, evBroadCast, cmSelectWindowNum, Ptr(0, Num));
End;

procedure TDemoApp.WriteShellMsg;
Begin
  PrintStr(GetStr(700));
End;



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

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

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


var App: TDemoApp;

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