
{*******************************************************}
{                                                       }
{       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 GVDEMO21.DLL must be accessible through the DOS path or be present
   in the current directory


This application shows:

   - how to use CheckItems and RadioItems in the menu
   - how to use bitmapped items in the menu
   - how to set a different mouse cursor

*)

{$ifdef Windows}
Uses WinTypes, WinProcs, Dos, Objects, Drivers, GVDriver, KeyNames, GVMenus, GVApp,
     GVTexts, WinRes, Bitmap, VgaMem, WinGr;
{$else}
Uses CRT, Dos, Objects, Drivers, GVDriver, KeyNames, GVMenus, GVApp,
     GVTexts, WinRes, MyMouse, Bitmap, VGAMem;
{$endif}

const

{ Commands }

  cmEnableMusic = 100; cmNormalTune = 101; cmIndyTune = 102;
  cmPlay = 103;


{ Application's data }

  Tune: Word = 101;
  TuneEnabled: Boolean = true;

var
  Res: PStream;

type

{ TDemoApp object }

  TDemoApp = object(TApplication)
               constructor Init;
               destructor Done; virtual;
               procedure HandleEvent(var Event: TEvent); virtual;
               procedure InitMenuBar; virtual;
               function LanguageResource: String; virtual;
             private
               Bitmap: Pointer;
             end;

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

constructor TDemoApp.Init;
Begin
  Res := OpenResource('GVDEMO21.DLL');
  inherited Init;
End;

destructor TDemoApp.Done;
Begin
  { free the Bitmap since NewBitmap copies the bitmap's data }
  FreeImage(Bitmap);
  Dispose(Res, Done);
  inherited Done;
End;

{$IFDEF WINDOWS}
  Procedure Delay(ms : LongInt);
  Begin
  End;

  procedure Sound(X: Word);
  begin
  end;

  procedure NoSound;
  begin
  end;
{$ENDIF}

procedure TDemoApp.HandleEvent(var Event: TEvent);

 procedure Play;
 var I, J: Integer;
 Begin
   If Tune = cmIndyTune then Begin
     SetCurrentCursor(mcHourGlass);
     Sound (659 {Round (164.810*4)});
     Delay (220);
     NoSound;
     Delay (30);

     Sound (698 {Round (174.610*4)});
     Delay (150);
     NoSound;

     Sound (784 {Round (196.000*4)});
     Delay (100);
     NoSound;
     Delay (200);

     Sound (1047 {Round (261.630*4)});
     Delay (600);
     NoSound;
     SetCurrentCursor(mcNoCursor);
   End else If Tune = cmNormalTune then Begin
     SetCurrentCursor(mcHourGlass);
     For J := 1 to 3 do
       For I := 50 to 1000 do Begin
         Sound(I);
         Delay(1);
        End;
     NoSound;
     SetCurrentCursor(mcNoCursor);
   End;
 End;

Begin
  inherited HandleEvent(Event);
  If Event.What = evCommand then
    Case Event.Command Of
      cmEnableMusic : TuneEnabled := not TuneEnabled;
      cmIndyTune,
      cmNormalTune  : Tune := Event.Command;
      cmPlay        : If TuneEnabled then Play;
    End
End;

procedure TDemoApp.InitMenuBar;
var R: TRect;
Begin
  { Load a bitmap from the resource }
  Bitmap := LoadBitmapImg(Res^, 'Melody');

  Main^.GetExtent(R); R.B.Y := R.A.Y + 21;
  MenuBar := New(PMenuBar, Init(R, NewMenu(
    NewSubMenu(GetStr(513), 0, NewMenu (
      NewCheckItem(GetStr(510), kn(kbShiftF8), kbShiftF8, cmEnableMusic, 0,
        dfMenuCheck + dfCheckState,
      NewLine(
      NewCheckItem(GetStr(511), '', kbNoKey, cmNormalTune, 0,
        dfMenuCheck + dfRadio + dfCheckState,
      NewCheckItem(GetStr(512), '', kbNoKey, cmIndyTune, 0,
        dfMenuCheck + dfRadio,
      NewLine(
      NewBitmap(Bitmap, kbF8, cmPlay, 0, 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.
