
{*******************************************************}
{                                                       }
{       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 the color selection facillities
   - usage of desktop eyes

Note that we need different graphics units in Windows mode.
*)

Uses
  {$ifdef Windows} WinGr,
  {$else} {$ifdef FPK} Bgi, {$else} Metagr, MyFonts, {$endif}
  {$endif}
  Dos, Objects, Drivers, ExtGraph, KeyNames, GVViews,
  GVMenus, GVApp, GVTexts, GVEyes, GVColor, GVStdDlg;

const

{ Commands }

  cmNew = 100; cmEyes = 101; cmColor = 102; cmLoad = 103; cmSave = 104;

type

{ TDemoWindow object }

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

{ TInterior object }

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

{ TDemoApp object }

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

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

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

procedure TInterior.Draw;
const
  Greeting: string = 'Hello, World!';
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, wnNoNumber);
  Flags := Flags and not wfBackground;
  GetExtent(Bounds);
  GetClientRect(Bounds);
  Interior := New(PInterior, Init(Bounds));
  Insert(Interior);
end;

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

procedure TDemoApp.HandleEvent(var Event: TEvent);

  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), wnNoNumber)));
  End;

  procedure NewEyes;
  var
    R: TRect;
  begin
    R.Assign(0, 0, GMinWinSize.X + Random(200), GMinWinSize.Y + Random(200));
    R.Move(Random(200), Random(200));
    InsertWindow(New(PEyeWindow, Init(R)))
  end;

  procedure ShowColor;
  var D: PColorDialog;
  Begin
    D := New (PColorDialog, Init ('',
      ColorGroup (GetStr(706),
        ColorItem (GetStr(707), 1, nil),
      ColorGroup (GetStr(708),
        ColorItem (GetStr(709), 2,
        ColorItem (GetStr(710), 3,
        ColorItem (GetStr(711), 4,
        ColorItem (GetStr(712), 5,
        ColorItem (GetStr(713), 6,
        ColorItem (GetStr(714), 7,
        ColorItem (GetStr(715), 8,
        ColorItem (GetStr(716), 9, nil)))))))),
      ColorGroup (GetStr(717),
        ColorItem (GetStr(718), 28,
        ColorItem (GetStr(719), 30, nil)),
      ColorGroup (GetStr(730),
        ColorItem (GetStr(731), 144, nil), nil))))));
    If ExecuteDialog(D, Application^.GetPalette) <> cmCancel then Redraw;
  End;

  procedure LoadPalette;
  var
    D: PFileDialog;
    Path: PathStr;
    S: PStream;
  Begin
    Path := '*.pal';
    D := New(PFileDialog, Init('*.pal', GetStr(732), GetStr(702),
      fdOpenButton, 43));
    If ExecuteDialog(D, @Path) <> cmCancel then Begin
      S := New(PDosStream, Init(Path, stOpenRead));
      S^.Read(GetPalette^[1], Length(CColor));
      Dispose(S, Done);
      Redraw
    End
  End;

  procedure SavePalette;
  var
    D: PFileDialog;
    Path: PathStr;
    S: PStream;
  Begin
    Path := '*.pal';
    D := New(PFileDialog, Init('*.pal', GetStr(733), GetStr(702),
      fdOKButton, 43));
    If ExecuteDialog(D, @Path) <> cmCancel then Begin
      S := New(PDosStream, Init(Path, stCreate));
      S^.Write(GetPalette^[1], Length(GetPalette^));
      Dispose(S, Done);
    End
  End;


Begin
  inherited HandleEvent(Event);
  If Event.What = evCommand then
    Case Event.Command Of
      cmNew: NewWindow;
      cmEyes: NewEyes;
      cmColor: ShowColor;
      cmLoad: LoadPalette;
      cmSave: SavePalette;
    End
End;

procedure TDemoApp.InitStatusLine;
var R: TRect;
Begin
  Main^.GetExtent(R);
  R.A.Y := R.B.Y - 21;
  StatusLine := New(PStatusLine, Init(R,
    NewStatusDef(0, 0,
      NewStatusKeyKN(GetStr(600), kbAltX, cmQuit,
      NewStatusKeyKN(GetStr(613), kbF3, cmNew,
      NewStatusKeyKN(GetStr(617), kbF4, cmEyes,
      NewStatusKeyKN(GetStr(621), kbF6, cmColor,
      NewStatusKeyKN(GetStr(622), kbF9, cmLoad,
      NewStatusKeyKN(GetStr(623), kbAltF9, cmSave,
      NewStatusKey('', kbAltF3, cmClose,
      NewStatusKey('', kbCtrlF5, cmResize,
      NewStatusKey('', kbF5, cmZoom, nil))))))))),
    StdDraggingStatusDef(
    nil))));
End;

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

var App: TDemoApp;

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