
{*******************************************************}
{                                                       }
{       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 EXAM0005.PAS this application shows:

   - usage of a virtual desktop
   - usage of Graphics Vision's window number management
   - screenmodes

*)

{$ifdef Windows}
This will not run under Windows.
{$else}
Uses Dos, Misc, Gr, Objects, Drivers, KeyNames, GVViews, GVBitmap, GVDialog,
     GVMenus, GVApp, GVStdDlg, GVTexts, GVWinNum, GVMsgBox, GVValid, GVVirt;
{$endif}

const
  cmOpen = 100; cmNew = 101; cmOptions = 102; cmDesktopImage = 103;

var
  BackBitmap: PathStr;
  IsVirtual: Boolean;
  VirtualFactor: TPoint;

type

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

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

constructor TDemoApp.Init;
Begin
  VirtualFactor.X := 3;
  VirtualFactor.Y := 3;
  BackBitmap := GetWinDir + 'BLAETTER.BMP';
  IsVirtual := false;

  inherited Init;
  Insert(ImageWindow)
End;

procedure TDemoApp.HandleEvent(var Event: TEvent);

  procedure LoadDesktop;
  var D: PFileDialog;
  Begin
    D := New(PFileDialog, Init('*.bmp', GetStr(704), GetStr(702),
      fdOpenButton, 42));
    If ExecuteDialog(D, @BackBitmap) <> cmCancel then
      PNewDesktop(Desktop)^.NewBitmap(BackBitmap);
  End;

  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(PWindow, Init(R, GetStr(705), wnJustANumber)));
  End;

  procedure ScreenMode;
  const
    Modes: array[0..5] of Word =
      (gr640x480x16, gr720x480x16, gr800x600x16,
       gr640x480x256, gr800x600x256, gr1024x768x256);

    Min = 1; Max = 5;
  var
    Data: record
      Mode: Word;
      Stat: Word;
      Virt: Word;
      X, Y: LongInt;
    end;

    D: PDialog;
    R: TRect;
    Control: PGView;
    Val: PValidator;

    procedure Rangify(P: Pointer; Min, Max: LongInt);
    var Val: PValidator;
    begin
      Val := New(PRangeValidator, Init(Min, Max));
      Val^.Options := Val^.Options or voTransfer;
      PInputLine(P)^.SetValidator(Val)
    end;

  Begin
    R.Assign(0, 0, 450, 260);
    D := New(PDialog, Init(R, GetStr(746)));
    With D^ do Begin
      Options := Options or ofCentered;
      R.Assign(30, 65, 250, 160);
      Control := PGView(Insert(New(PRadioButtons, Init(R,
        NewSItem(GetStr(751),
        NewSItem(GetStr(752),
        NewSItem(GetStr(753),
        NewSItem(GetStr(754),
        NewSItem(GetStr(755),
        NewSItem(GetStr(756), nil))))))))));
      {$IFNDEF metagr_bgi}
      PCluster(Control)^.SetButtonState($00000078, false);
      {$ENDIF}
      R.Assign(30, 40, 130, 60);
      Insert(New(PLabel, Init(R, GetStr(747), Control)));

      R.Assign(270, 65, 410, 85);
      Control := PGView(Insert(New(PCheckBoxes, Init(R,
        NewSItem(GetStr(750), nil)))));
      R.Assign(270, 40, 370, 60);
      Insert(New(PLabel, Init(R, GetStr(749), Control)));

      R.Assign(270, 130, 380, 150);
      Control := PGView(Insert(New(PCheckBoxes, Init(R,
        NewSItem(GetStr(758), nil)))));
      R.Assign(270, 105, 370, 125);
      Insert(New(PLabel, Init(R, GetStr(757), Control)));

      R.Assign(280, 163, 300, 183);
      Insert(New(PStatictext, Init(R, 'X')));
      R.Assign(300, 160, 330, 180);
      Rangify(Insert(New(PInputLine, Init(R, 5))), 1, 5);

      R.Assign(350, 163, 370, 183);
      Insert(New(PStatictext, Init(R, 'Y')));
      R.Assign(370, 160, 400, 180);
      Rangify(Insert(New(PInputLine, Init(R, 5))), 1, 5);

      R.Assign(130, 200, 230, 230);
      Insert(New(PButton, Init(R, GetStr(739), cmOK, bfDefault)));
      R.Move(120, 0);
      Insert(New(PButton, Init(R, GetStr(740), cmCancel, bfNormal)));
      SelectNext(false);
    End;
    For Data.Mode := 5 downto 0 do
      If Modes[Data.Mode] = GrMode then Break;
    Data.Stat := Byte(StatusLine^.GetState(sfVisible));
    Data.Virt := Byte(IsVirtual);
    Data.X := VirtualFactor.X;
    Data.Y := VirtualFactor.Y;

    If ExecuteDialog(D, @Data) <> cmCancel then Begin
      IsVirtual := Data.Virt = 1;
      VirtualFactor.X := Data.X;
      VirtualFactor.Y := Data.Y;
      Lock;
      If Modes[Data.Mode] <> GrMode then Begin
	PNewDesktop(Desktop)^.NewBitmap('');
	SetScreenMode(Modes[Data.Mode]);
	PNewDesktop(Desktop)^.NewBitmap(BackBitmap)
      End;

      GetExtent(R);
      R.A.Y := Menubar^.Origin.Y + Menubar^.Size.Y;

      If Data.Stat = 0 then StatusLine^.Hide
      Else Begin
	R.B.Y := StatusLine^.Origin.Y;
	StatusLine^.Show;
      End;
      Desktop^.Locate(R);
      If IsVirtual then
        PVirtualDesktop(Desktop)^.SetFactor(VirtualFactor.X, VirtualFactor.Y)
      Else PVirtualDesktop(Desktop)^.SetFactor(1, 1);
      Unlock;
      If GrMode <> Modes[Data.Mode] then
        MessageBox(GetStr(748), nil, mfError + mfOkButton);
    End;
  End;


Begin
  inherited HandleEvent(Event);
  If Event.What = evCommand then
    Case Event.Command Of
      cmOpen: LoadDesktop;
      cmNew: NewWindow;
      cmOptions: ScreenMode;
      cmDesktopImage:
        with ImageWindow^ do
	begin
	  SetState(sfVisible, not GetState(sfVisible));
	end;
    End
End;

procedure TDemoApp.InitDesktop;
var R: TRect;
Begin
  Main^.GetExtent(R);
  R.Grow(0, -21);
  If IsVirtual then Desktop := New(PVirtualDesktop, Init(R, BackBitmap,
    VirtualFactor.X, VirtualFactor.Y))
  Else Desktop := New(PVirtualDesktop,Init(R, BackBitmap, 1, 1));
  R.Assign(0, 0, 128, 96);
  R.Move(400, 200);
  ImageWindow := New(PDesktopImageWindow, Init(R, 'Desktop'));
  with ImageWindow^ do
  begin
    Flags := Flags or wfHideClose;
    Hide
  end
End;

procedure TDemoApp.InitStatusLine;
var R: TRect;
Begin
  GetExtent(R);
  R.A.Y := R.B.Y - 21;
  StatusLine := New(PStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKeyKN(GetStr(600), kbAltX, cmQuit,
      NewStatusKeyKN(GetStr(612), kbF3, cmOpen,
      NewStatusKeyKN(GetStr(613), kbF4, cmNew,
      NewStatusKeyKN(GetStr(614), kbAltF4, cmOptions,
      NewStatusKeyKN(GetStr(615), kbF9, cmDesktopImage,
      NewStatusKey('', kbAltF3, cmClose,
      NewStatusKey('', kbCtrlF5, cmResize,
      NewStatusKey('', kbF5, cmZoom,
      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.
