{************************************************}
{                                                }
{   Turbo Vision File Manager Demo               }
{   Copyright (c) 1992 by Borland International  }
{                                                }
{************************************************}

{ This file has been modified by Matthias Koeppe for Graphics Vision.
  The original file is \BP\EXAMPLES\DOS\TVFM\TVFM.PAS.
}

{$M 16384,8192,655360}
{$X+,V-}

program GVFM;

{ Link the resource into the executable;
  this will work only if compiled for DPMI or Windows. }

{$R gvfm.res}

uses
  { Standard units }
  Dos, Objects, Strings,
  { Turbo Vision units }
  Drivers, Views, HistList, Memory,
  { Graphics and support units }
{$ifdef Windows}
{$else}
  Misc, Vesa, Gr, MetaGr, VgaMem, Bitmap, ExtGraph, MyMouse, MyFonts,
{$endif}
  WinRes,
  { Graphics Vision standard units }
  GvDriver, GvViews, GvDialog, GvMenus, GvStdDlg, GvApp, GvMsgBox,
  GVTexts, GvEdit, GvBitmap, GvWinDlg, GvGadget, GvClock, GvEyes,
  GvFonts, GvFiler, GvTable, GvWList, GvWinNum, KeyNames, GvBWCC,
  GvValid, GvTerm, GvVirt, GvHint, GvColor,
  { new GVFM units }
  GvFmEqu, GvFmGlob, GvFmTool, GvFmTree;

type
  TMyApp = object(TApplication)
    {TrashCan: PTrashCan;}
    ExitDir: String;
    constructor Init;
    destructor Done; virtual;
    procedure Idle; virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure OutOfMemory; virtual;
  end;

constructor TMyApp.Init;
var
  R: TRect;
  H: Word;
  CurDir: PathStr;
  TopWin: PTreeWindow;
begin
  Res := OpenResource('');
  If Res^.Status <> 0
  then begin
    PrintStr('Resource error.'^M^J);
    Halt(1)
  end;
  { Start up the Windows dialog class management.
  }
  InitClasses;
  { Register standard Windows dialog classes and controls.
  }
  RegisterGvWinDlg;
  { Open the BWCC.DLL resource. It will be searched for in the
    PATH and in the Windows system directory.
  }
  InitBWCC;

  inherited Init;
  {InitAssociations;}

  { These commands aren't enabled by default in Graphics Vision.
    So we need to enable them explicitly.
  }
  EnableCommands([cmTile, cmCascade]);

{  ReadConfig;}

  { Open two windows }
  GetDir(0, CurDir);
  InsertTreeWindow(CurDir[1]);
  TopWin := Message(Desktop, evBroadcast, cmTopWindow, nil);
  if TopWin <> nil
  then begin
    TopWin^.Flags := TopWin^.Flags and not (wfMove + wfZoom + wfGrow);
    TopWin^.SetMode(2);
  end;
  InsertTreeWindow(CurDir[1]);
  TopWin := Message(Desktop, evBroadcast, cmTopWindow, nil);
  if TopWin <> nil
  then begin
    TopWin^.Flags := TopWin^.Flags and not (wfMove + wfZoom + wfGrow);
    TopWin^.SetMode(2);
  end;
  Tile;
end;

destructor TMyApp.Done;
begin
  {DoneAssociations;}
  {Dispose(TrashCan, Done);}
{$I-}
  if ExitDir <> '' then
  begin
    if ExitDir[Length(ExitDir)] = ':' then ExitDir := ExitDir + '\';
    ChDir(ExitDir);
  end;
{$I+}
  inherited Done;
  { Shut down the Windows dialog class management.
  }
  DoneClasses;
  { Close the BWCC resource
  }
  DoneBWCC;
  { Close the resource
  }
  Dispose(Res, Done);

{  DoneMemory;}
end;

procedure TMyApp.Idle;
const
  FileListCmds : TCommandSet =
    [{cmExecute, cmViewAsHex, cmViewAsText, cmViewCustom, cmCopy, cmDelete,
     cmRename, cmChangeAttr, cmReverseTags, cmClearTags, cmTagPerCard,
     cmAssociate}];
var
  TopWindow: PWindow;
begin
  inherited Idle;

  TopWindow := Message(Desktop, evBroadcast, cmTopWindow, nil);
  if TopWindow = nil then
  begin
    DisableCommands(FileListCmds);
    DisableCommands([{cmExitHere}]);
  end
  else
  begin
    EnableCommands([{cmExitHere}]);
    if Message(TopWindow, evBroadcast, cmFileListFocused, nil) <> nil then
      EnableCommands(FileListCmds)
    else
      DisableCommands(FileListCmds);
  end;
end;

procedure TMyApp.InitMenuBar;
var
  R: TRect;
begin
  Main^.GetExtent(R);
  R.B.Y := 21;
  MenuBar := New(PMenuBar, Init(R,
    LoadMenu(Res^, 'FMMenu', mo_GraphicsVision)));
end;

procedure TMyApp.InitStatusLine;
var
  R: TRect;
begin
  Main^.GetExtent(R);
  R.A.Y := R.B.Y - 21;
  StatusLine := New(PStatusLine, Init(R,
    NewStatusDef(hcFileView, hcDirView,
      NewStatusKeyKn('Tag per wildcard', kbGrayPlus, cmTagPerCard,
      NewStatusKeyKn('Untag per wildcard', kbGrayMinus, cmUntagPerCard,
      StdStatusKeys(nil))),
    NewStatusDef(0, $FFFF,
      NewStatusKeyKn('Exit', kbAltX, cmQuit,
      StdStatusKeys(nil)),
    nil))))
end;

procedure TMyApp.HandleEvent(var Event: TEvent);
var
  NewDrive: Char;
  CurDir: DirStr;
begin
  inherited HandleEvent(Event);
  if Event.What = evCommand then
  begin
    case Event.Command of
      cmNewWindow:
	begin
	  {NewDrive := SelectDrive;
	  if NewDrive <> ' ' then InsertTreeWindow(NewDrive);}
	  GetDir(0, CurDir);
	  InsertTreeWindow(CurDir[1]);
	  ClearEvent(Event);
	end;
      {cmBeginSearch: BeginSearch;
      cmInstallViewer : InstallViewer;}
      cmDisplayOptions : SetDisplayPrefs;
      cmSaveConfig : SaveConfig;
      cmTile : Tile;
      cmCascade : Cascade;
      cmCloseAll: Message(Desktop, evBroadcast, cmCloseAll, nil);
      cmDosShell : DosShell;
      cmRun : RunDosCommand('');
      cmExitHere:
	begin
	  Message(Desktop, evBroadcast, cmGetCurrentDir, @ExitDir);
	  EndModal(cmQuit);
	  ClearEvent(Event);
	end;
{      cmColorChange: SelectNewColors;}
    end;
  end;
end;

procedure TMyApp.OutOfMemory;
begin
  MessageBox('There is not enough memory to complete this operation.',
    nil, mfError+mfOKButton);
end;

var
  MyApp : TMyApp;

begin
  {$ifndef Windows}
  StdGrMode := gr800x600x16;
  {$endif}
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
end.
