Power-Programmierung/CD1.mdf/pascal/library/dos/tvision/tvgraph7/tvgdemo1.pas

Pascal/Delphi Source File | 1994-01-04 | 55.8 KB | 1,684 lines

{***************************************}
{                                       }
{     TVGraphic Library Demo1           }
{                                       }
{        COPYRIGHT (C) 1993,1994        }
{        RICHARD P. ANDRESEN            }
{                                       }
{***************************************}

{This demo program provides source code that illustrates the
 use of the TVGraphic library. It is part of the documentation
 of TVGraphic.
 Things to Study:
   Both very simple and complex commented Draw methods.
   TDemoApp.GetEvent to see how to generate evTimerTick events.
     Also how to modify/respond
     to events no matter what view is modal.
   The process of initializing and shutting down a TVGraphic
     application is completely shown.
   Setting up Menu, StatusLine, MessageBar and DeskTop.
   Saving the DeskTop
     Note: The code used here to reload the DeskTop from disk is not
     safe in Borland's Turbo Vision. View by View LowMemory checking
     in TVGraphic's TGroup.Load makes it safe here.
   DOS shell and critical error handling in graphic mode are illustrated.
   Examples of setting the mouse cursor grid.
   Examples of using evTimerTick event.
   Setting up TScroller for text and/or graphics.
   Loading a .BMP bitmap file.
   Building a ToolBar.
   The Help window now is non-modal (acts like a regular window) if called
     while the Application is modal, otherwise Help is modal.
   Examples of running Dialogs using both DeskTop^.ExecView() from TV1.0
     and ExecuteDialog() as used in TV2.0 are shown.
   Example of how to set up and use TVGraphic's TPanWindow with TSubWindows.

Users of TVGraphic may incorporate sections of this source code
into their own programs.

----------------------------------
Significant changes in TVDemo1 (ver 1.5) from earlier TVGraphic versions.
1. TCircles.HandleEvent changed so it doesn't overwrite menus
     and other modal views.
2. Help window
     now both modal and non-modal
     added menu redraw if Help is modal
3. TScroller
     show how to change scroller step sizes
     better description in complex TScroller.Draw
     example of incremental background drawing
     example of writing highlighted strings with WriteCStr
4. Bitmaps
     load and draw .BMP file in TDemoApp.LoadBMP .
     Bitmapped buttons and Toolbar - see InitToolBar.
5. note on forcing screen to color mode in TDemoApp.Init .
6. Mouse cursor
   let you set speed. Restore settings after DOS shell.
7. TDemoApp.GetEvent
   A. evTimerTick events are now generated and sent to all views
      automatically in TProgram.GetEvent. The code that generated them
      in earlier versions should be commented out.
   B. the updating of the mouse cursor position has been moved to
      TProgram.GetEvent. The call in earlier versions to
      MCur.Move(Event.Where) should be deleted.
}

program TVGDemo1;

{$F+,X+}    {+X - use Extended syntax so can call a function as if
                  it were a procedure.}

uses CRT, DOS, Memory, MyGraph3, GObjects, GDrivers,
     MCursor2, GMENU6,
     GViews,  GDialogs, GMsgBox, GStdDlg,
     GApp, GColors, GWindow,
     BMPDrvr, GBut;

{causes compiler to link in Bitmap to this unit}
procedure BAR1_BMP; external;
{$L BAR1.OBJ}
procedure BAR2_BMP; external;
{$L BAR2.OBJ}
procedure BAR3_BMP; external;
{$L BAR3.OBJ}
procedure BAR4_BMP; external;
{$L BAR4.OBJ}
procedure BAR7_BMP; external;
{$L BAR7.OBJ}
procedure BAR8_BMP; external;
{$L BAR8.OBJ}


const
  ProgName = 'TVGDemo1';
  Ver      = '1.50';

const
  dpTV1Dialog = 3;
  WinNum : integer = 0;
  hcMouseGrid   = 1000;
  hcColorSel    = 1001;
  cmBMPlikebuttons   = 254;
  cmTVlikeButtons    = 255;
  cmSetColors        = 1100;
  cmDosCriticalError = 1101;
  cmCircleWindow     = 1102;
  cmScrollerWindow   = 1103;
  cmShowMessageBar   = 1104;
  cmAbout            = 1105;
  cmOptionsSave      = 1106;
  cmOptionsLoad      = 1107;
  cmTools            = 1108;
  cmBMP              = 1109;
  cmBitBut           = 1110;
  cmTEdit            = 1111;
  cmHourGlass        = 1112;
  cmDeskTopStyle     = 1114;
  cmDeskTopOptions   = 1115;
  cmVersion          = 1116;
  cmMouseGrids       = 1117;

  AString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';

var
  OldExitProc : Pointer;  { Saves exit procedure address }
  Graphic  : boolean;     { true if screen is in graphic mode }


procedure GExitProc; far;     {must be Far}
  {Exit procedure - restore screen to text mode if program halts}
begin
  ExitProc := OldExitProc; { Restore exit procedure address }
  CloseGraph;              { Shut down the graphics system }
end;


function GSystemError(ErrorCode: integer; Drive: byte): Integer; far;
                                                        {must be Far}
  {GSystemError handles DOS Critical Errors while in graphics mode.
       Not an example of drawing Views in TVGraphics
       - see .Draw methods instead for that.
   Note the saving and restoring of the Viewport (vital). Also of
   TextSettings which may not be necessary in every program.}
   {Caution - BOMBS unless you use FarSelectKey to get user input.}
const
  SRetryOrCancel:  string[30] = '~Enter~: Retry  ~Esc~: Cancel';
var
  P: Pointer;
  S: string[63];
  X,YOff : integer;
  SS : string;
  VPort : ViewPortType;
  SaveText : TextSettingsType;
begin
  P := Pointer(Drive + Ord('A'));
  FormatStr(S, GetCritErrorStr(ErrorCode), P);
  SS := S + '      ' + SRetryOrCancel;
  X := (GetMaxX - (Length(SS))*Charlen) div 2;

  GetViewSettings(VPort);                  {save current viewport}
  SetViewPort(0,0,GetMaxX,GetMaxY,ClipOn); {set to full screen}

  GetTextSettings(SaveText);                 {save current font, style}
  SetTextStyle(font8x8,HorizDir,1);
  YOff := CalcVertTextOffset(MenuBar^.Size.y);

  SetColor(lightcyan);
  SetFillStyle(solidfill, red);
      {draw over menu bar so can erase by calling MenuBar^.Draw}
  Bar3d(0, 0, GetMaxX, MenuBar^.Size.y, 0, false);
  WriteCStrXY(X, YOff, SS, white, yellow);
  SetColor(white);
  OutTextXY(Charlen,YOff, Chr($10));
  OutTextXY(GetMaxX-2*Charlen,YOff, Chr($11));

  GSystemError := FarSelectKey;        {get retry/cancel user input}
  MenuBar^.Draw;                        {erase error message}

  with SaveText do
    SetTextStyle(Font, Direction, CharSize);
  with VPort do
    SetViewPort(X1, Y1, X2, Y2, Clip);
end;


{------ Heap View object ----------}
{displays available heap space, updates using timer tick}

type
  PHeapView = ^THeapView;
  THeapView = object(TView)
    OldMem : LongInt;
    constructor Init(var Bounds: TRect);
    procedure Draw; virtual;
    procedure HandleEvent(var Event : TEvent); virtual;
  end;

constructor THeapView.Init(var Bounds: TRect);
begin
  TView.Init(Bounds);
  OldMem := 0;
  EventMask := evTimerTick;
  VFont := font8x8;
end;

procedure THeapView.Draw;
  {Because the HeapView is outside of the default viewport in this
   program, the viewport is changed and restored in this Draw routine.}
var
  S: string;
  C: word;
  VPort : ViewPortType;
  YOff : integer;
  Glob : TRect;
begin
  MCur.Hide;                                       {hide mouse cursor}
  GetViewSettings(VPort);                          {save current viewport}

  GetScreenCoords(Glob);      {set viewport to outline of this view}
  SetViewPort(Glob.A.x, Glob.A.y, Glob.B.x, Glob.B.y,ClipOn);

  GetVPRelCoords(Glob);       {get view outline in viewport relative coords}

  OldMem := MemAvail;
  Str(OldMem, S);
  C := GetColor(2);           {get normal menu text color pair from palette}

  SetColor(ForeColor(C));                      {set text color}
  SetFillStyle(solidfill,BackColor(C));        {set background color}
  Bar(Glob.A.x, Glob.A.y, Glob.B.x, Glob.B.y); {draw background}

  S := 'HEAP: ' + S;
  SetTextStyle(VFont,HorizDir,1);                  {set text font}
    {must set font Before calling CalcVertTextOffset}
  YOff := CalcVertTextOffset(Size.y); {center text vertically in view}

  OutTextXY(Glob.A.x+BXOffset,Glob.A.y+YOff,S);    {write text}

  with VPort do                                    {restore viewport}
    SetViewPort(X1, Y1, X2, Y2, Clip);
  MCur.Show;                                       {show mouse cursor}
end;

procedure THeapView.HandleEvent(var Event : TEvent);
begin
  if (Event.What = evTimerTick) and (OldMem <> MemAvail) then DrawView;
end;

{-----------------------------------}
const
  SArraySize = 34;
  SArray : array[0..SArraySize] of Str80 = (
    '',
    '         TVGraphic is a compiled library',
    'written in Borland''s Turbo Vision and extending it',
    'into DOS graphic mode by using the EGA/VGA driver.',
    'TVGraphic requires Turbo Vision and the Graph unit.',
    '',
    'Currently based on TV 1.0, it includes fixes and',
    'many upgrades from TV 2.0 plus other enhancements',
    'aimed at pure graphics applications.',
    '',
    'A new partial screen redraw mechanism provides',
    'automatic sizing of the viewport and the Clip variable.',
    '',
    'TView methods are included that calculate the',
    'global coordinates needed for graphic drawing calls.',
    '',
    'Two FAST, clippable bit mapped fonts are included.',
    'Optional user settable grid for mouse cursor.',
    'Hooks are present for user modifications.',
    '',
    'A Window (or any TGroup descendent) may have an',
    'interior larger than the screen which contains',
    'SubWindows and TView descendants.',
    '',
    'Units are available for Pascal versions 6 and 7.',
    'Full TV2.0 functionality, more links to the visual',
    'design tool, Protected mode and VESA 800x600 are',
    'likely for 1994.',
    '',
    'For information, comments, wish items, bugs, etc.',
    '       or software consulting/development',
    '',
    '   Richard P Andresen     CompuServe# 71222,1200',
    '   RR2 Box 900',
    '   Hinesburg,Vermont 05461');


const
  TestStr : string =
    'A GOOD LONG PIECE OF LENGTHY, MONOTONOUS, BORING, REPETITIVE TEXT.';

type
  {A basic text oriented scrolling view with graphics too}

  PMyScroller = ^TMyScroller;
  TMyScroller = object (TScroller)
    constructor Init(var Bounds: TRect;
                         AHScrollBar,AVScrollBar: PScrollBar);
    procedure Draw; virtual;
    procedure PartOfSetLimit(X, Y: Integer); virtual; {new with version 1.5}
  end;

const     {change constants here to set TMyScroller step sizes}
          {also see discussion of changing vertical text offset in .Draw}
  HSpacing = Charlen;
  VSpacing = Boxheight;

constructor TMyScroller.Init(var Bounds: TRect;
                                 AHScrollBar, AVScrollBar: PScrollBar);
begin
  TScroller.Init(Bounds, AHScrollBar, AVScrollBar);
  GrowMode := gfGrowHiX + gfGrowHiY;
  SetLimit((3*Size.x div 2) div HSpacing, 2*Size.y div VSpacing);
end;

procedure TMyScroller.Draw;
const
  Triangle: array[1..4] of TPoint = ((X: 200; Y: 70), (X: 400; Y:70),
   (X: 300; Y: 170), (X:  200; Y: 70));
var
  VPort : ViewPortType;
  R,C : TRect;
  HColor,Color,I,Err : integer;
  Glob : TRect;
begin
  MCur.Hide;                       {hide mouse cursor}
  GetViewSettings(VPort);          {save current viewport settings}
  Move(VPort,C, Sizeof(C));        {copy viewport outline to C}
  GetScreenCoords(R);              {get outline of this view in screen coords}
  R.Intersect(C);        {find outline of view contained within the viewport}
                         {reset viewport to clip at this outline}
     {Note that the viewport's size is set automatically by TVGraphic
      whenever it redraws only a portion of the screen (a common occurance).
      Thus the viewport may be larger than, smaller than
      or cover only a part of this view when this Draw is called.

      General discussion:
      BECAUSE SCROLLERS HAVE A DRAWABLE INTERIOR LARGER THEN
      THEIR SIZE, we must prevent drawing outside the View. If we drew
      only text, we could alter the text strings that show to just fit
      in the size of the window and not draw the rest. This is how
      Turbo Vision works.
      But since we are also drawing diagonal lines, not just text, and the
      view and the viewport can be any size, we will limit drawing by
      resetting the viewport for the duration of this Draw method.
      To do this, we re-size (shrink) the viewport to match the rectangle
      of this View that falls within the current viewport (as shown above).

      VITAL - Because there may be other views to redraw, ALWAYS restore
      a re-sized viewport to the values saved in VPort at the end of
      a .Draw !! }

      {Debugging note: When calling a view's Draw via it's DrawView method,
       DrawView first checks the view's Exposed function. Exposed will
       prevent Draw from being called if no part of the view overlaps
       the Clip variable.
       At the start of a partial redraw, the viewport is set to match
       (cover) the Clip area.}

  SetViewPort(R.A.x,R.A.y,R.B.x,R.B.y,ClipOn);

  GetVPRelCoords(Glob);   {get view's outline in Viewport Relative coords}
                          {Must call after setting viewport!}

  Color := GetColor(1);   {call palette for normal text color}
                          {note that GetColor returns both foreground
                           and background colors in single word}
              {color for text       - use ForeColor for foreground color}
              {color for background - use BackColor}
  HColor := GetColor(2);  {call palette for Highlight text color}

  SetFillStyle(solidfill,BackColor(Color));
  Bar(Glob.A.x,Glob.A.y,Glob.B.x,Glob.B.y);   {draw background}

  SetColor(ForeColor(Color));
  SetTextStyle(font8x14,HorizDir,1);

     {draw scrolling text using scroller offset "Delta"}
   {Note: we are assuming text is HSpacing wide by VSpacing tall.
    These are the scroll step sizes this scroller was set to with
    these constants in TMyScroller.PartOfSetLimit.}

  {kludge for demo program - text varies with window title}
if PWindow(Owner)^.Title^[1] <> 'A' then begin
  SetTextStyle(font8x14,HorizDir,1);
  OutTextXY(Glob.A.x+HSpacing - (Delta.x*HSpacing),
            Glob.A.y + (10-Delta.y)*VSpacing, TestStr);

   {Draw some text that doesn't move as view scrolls}
  SetTextStyle(font8x8,HorizDir,1);
     {Can write text the usual way}
(*  OutTextXY(Glob.A.x,Glob.A.y+200,'This line doesn''t scroll.');*)
     {or write strings with imbedded highlights using the ~ delimiter.}
  WriteCStrXY(Glob.A.x, Glob.A.y+200, 'This line ~doesn''t~ scroll.',
                 ForeColor(Color), ForeColor(HColor));

  {Now for something Graphic:
   Note that since we have set TScroller up as a text scroller, we
   have to multiply Delta.x by HSpacing and Delta.y by VSpacing to
   get graphic coords.
   By changing the constants used in PartOfSetLimits and in the SetLimit
   call in Init, and using these same constants in this Draw method,
   you can get any scroll step size you want.

   For a scroller of your own that is single pixel oriented
   (rather than text spacing), you don't need to override
   TScroller.PartOfSetLimit. You will probably want to set
   GrowMode the same as in TMyScroller.Init.

   Related subject:
   TVGraphic's TView.VOffset field can be used in any view similarly
   to how Delta is used by TScroller to offset/scroll the interior.
   GetVPRelCoords automatically includes all VOffset's in its calculation.
   TVGraphic expects VOffset to be maintained in pixel units.
   TVGraphic's TPanWindow is an example of this. It does not have a
   separate scroller view. This allows drawing to go all the way
   to window edges.}

  SetColor(red);
  for I := 1 to 3 do    {lines scroll since using Delta}
    Line(Glob.A.x+Triangle[I].x-(Delta.x*HSpacing),Glob.A.y+Triangle[I].y-(Delta.y*VSpacing),
      Glob.A.x+Triangle[I+1].x-(Delta.x*HSpacing),Glob.A.y+Triangle[I+1].y-(Delta.y*VSpacing));
  SetColor(Yellow);
  Circle(Glob.A.x+300 -(Delta.x*HSpacing),
         Glob.A.y+120 -(Delta.y*VSpacing),
         100);
end
else         {normal scroller code}
    {Optional - for speed improvement on large files, call OutTextXY
                  only when it is within the current viewport.}
    {Remember - GetVPRelCoords(Glob) is viewport relative.}
    {ByOffset
      is automatically set in TVGraphic. It is a font dependent
      value used to center text vertically in the standard Boxheight.
      If you make VSpacing other than Boxheight, don't use ByOffset.
      Use function CalcVertTextOffset -
        YOffset := CalcVertTextOffset(VSpacing) to find the offset to
      center text in arbitrary vertical spacing.}

      {TVGraphic Version 1.0 code, works but I should now start at 0.}
(*  for I := 1 to SArraySize do
    if ((Glob.A.y + (I+1-Delta.y)*VSpacing) > 0)
     and ((Glob.A.y + (I-2-Delta.y)*VSpacing) < Glob.B.y) then
       OutTextXY(Glob.A.x+HSpacing - (Delta.x*HSpacing) +1,
           Glob.A.y + (I-Delta.y)*VSpacing + BYOffset, SArray[I]);*)

   for I := 0 to (Size.y+1) div VSpacing +1 do begin
     {If you want to draw the background incrementally, use the
     following line instead of the earlier call to Bar.}
     (* Bar(Glob.A.x, Glob.A.y + (I)*VSpacing,
            Glob.B.x, Glob.A.y + (I+1)*VSpacing-1); *)
    if (I+Delta.y <= SArraySize) then
    OutTextXY(Glob.A.x+HSpacing - (Delta.x*HSpacing) +1,
           Glob.A.y + I*VSpacing + BYOffset, SArray[I+Delta.y]);
  end;

  with VPort do       {restore viewport}
    SetViewPort(X1,Y1,X2,Y2,Clip);

  MCur.Show;          {show mouse cursor}
end;

   {ADDED Version 1.5}
procedure TMyScroller.PartOfSetLimit(X, Y : integer);
var
  YSize,XSize : integer;
begin
  XSize := (Size.x+1) div HSpacing;
  YSize := (Size.y+1) div VSpacing;
  Limit.X := X;
  Limit.Y := Y;
  if HScrollBar <> nil then
    HScrollBar^.SetParams(HScrollBar^.Value, 0, X - XSize, XSize - 1,
      HScrollBar^.ArStep);
  if VScrollBar <> nil then
    VScrollBar^.SetParams(VScrollBar^.Value, 0, Y - YSize, YSize - 1,
      VScrollBar^.ArStep);
end;


type

  {demonstrates very simple Draw method and using TimerTick events}

  PCircles = ^TCircles;
  TCircles = object(TWinBackground)
    Count : integer;
    Speed : integer;
    constructor Init(var Bounds: TRect);
    procedure Draw; virtual;
    procedure DrawCircle;
    procedure HandleEvent(var Event : TEvent); virtual;
  end;

  constructor TCircles.Init(var Bounds: TRect);
  begin
    TWinBackground.Init(Bounds);
    EventMask := evTimerTick;
    VColor := black;               {store drawing color}
  end;

  procedure TCircles.Draw;
  var   Glob : TRect;
  begin
    MCur.Hide;              {hide cursor}
    GetVPRelCoords(Glob);   {get view's outline in viewport relative coords}

    SetFillStyle(solidfill,VColor);            {set background color}
    Bar(Glob.A.x,Glob.A.y,Glob.B.x,Glob.B.y);  {draw background}

    DrawCircle;

    MCur.Show;
  end;

  procedure TCircles.DrawCircle;
  var
    Radius : word;
    Glob : TRect;
    Color : integer;
  begin
    MCur.Hide;              {hide cursor}
    GetVPRelCoords(Glob);   {get view's outline in viewport relative coords}

    if (Count = 0) or (Count =8) then Color := 14
      else Color := Count;
    SetColor(Color);               {set circle Color based on Count}

                                   {compute radius based on view's size}
    if Size.x < Size.y then Radius := Size.x
    else Radius := Size.y;
    Radius := Radius div 3;
                                   {draw circle}
    Circle(Glob.A.x+Size.x div 2, Glob.A.y+Size.y div 2, Radius);
    MCur.Show;               {show the mouse cursor}
  end;

  procedure TCircles.HandleEvent(var Event : TEvent);
  begin
    if Event.What = evTimerTick then begin
         { if you want to avoid overwriting menus and modal dialog boxes,
           must exit if the Application (Desktop's Owner) is not the
           modal view.}
      if TopView <> PView(DeskTop^.Owner) then Exit;

      Inc(Speed);
      if Speed > 1023 then Speed := 0;
      if (Speed mod 8 = 0) then begin
        Inc(Count);
        if Count > 15 then Count := 0;   {limit to highest color}
        if GetState(sfActive) then DrawCircle;
      end;
    end;
  end;

{RegisterTypes}
const
  RMyScroller: TStreamRec = (
     ObjType: 3000;
     VmtLink: Ofs(TypeOf(TMyScroller)^);
     Load:    @TMyScroller.Load;
     Store:   @TMyScroller.Store
  );
  RCircles: TStreamRec = (
     ObjType: 3001;
     VmtLink: Ofs(TypeOf(TCircles)^);
     Load:    @TCircles.Load;
     Store:   @TCircles.Store
  );

  procedure RegisterLocals;
  begin
    RegisterType(RMyScroller);
    RegisterType(RCircles);
  end;
{--------------------------------}
type
  TDemoApp = object(TProgram)
    DeskTopStyle : word;            {style currently in use}
    ThePanWindow : PPanWindow;      {pointer to panning window if it exists}
    constructor Init;
    procedure GetEvent(var Event : TEvent); virtual;
    procedure DoAboutBox;
    procedure DosShell;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure InsertCircleWin;
    procedure InsertScrollerWin(ATitle : string);
    procedure InitHeapViewer;
    procedure InitMenuBar; virtual;
    procedure InitShiftView;
    procedure InitMessageBar;       {message that covers over the MenuBar}
    procedure InitStatusLine; virtual;
    procedure InitToolBar;
    procedure IntroScreen;
    procedure LoadBMP;
    procedure NewWindow;
    procedure SaveDeskTop;
    procedure SelectDeskTopStyle;
    procedure LoadDeskTop;
    procedure ShowHelp;
    procedure ShowMouseBox;
    destructor Done; virtual;
    destructor HaltDone;
  end;

destructor TDemoApp.Done;
  {called for normal program termination}
begin
  TProgram.Done;
  MCur.Done;            {releases mouse cursor memory}
  CloseGraph;
  Graphic := false;

  {DoneHistory;}
  DoneSysError;
  DoneEvents;
  DoneVideo;
  DoneMemory;
end;

destructor TDemoApp.HaltDone;
  {used if program halts while trying to initilize graphic mode}
begin
  {DoneHistory;}
  DoneSysError;
  DoneEvents;
  DoneVideo;
  DoneMemory;
end;

constructor TDemoApp.Init;
  procedure DoStreamRegistration;
    {register objects and views for stream I/O}
    {vary contents to match your program}
  begin
    RegisterObjects;
    RegisterViews;
    RegisterDialogs;
    RegisterMenus;
    RegisterApp;
    RegisterStdDlg;
    RegisterWindows;
    RegisterLocals;
    RegisterBitMaps;
  end;
var
  GraphDriver,GraphMode,ErrorCode : integer;
begin
  Graphic := false;

  InitMemory;
  InitVideo;
  InitEvents;
  InitSysError;
  {InitHistory;}

     {register screen driver}
  if RegisterBGIdriver(@EGAVGADriverProc) < 0 then begin
    HaltDone;
    Writeln('Internal EGA/VGA driver not linked.');
    Halt(1);
  end;
     {verify graphics mode}
  DetectGraph(GraphDriver, GraphMode);
  if not ((GraphDriver = VGA) or (GraphDriver = EGA)) then begin
    HaltDone;
    Writeln('Error - system does not support EGA or VGA graphics.');
    Halt(1);
  end;

(*  {Optional -forces color display mode if in B&W mode. This can
               cause a problem with B&W LCD laptops which can
               drive an external VGA color monitor. They end up in
               color mode and so Turbo Vision selects the color
               palette instead of B&W palette.}
  SetVideoMode(smCO80);*)

    {enter graphics mode}
  if GraphDriver = VGA then GraphMode := VGAHi
    else GraphMode := EGAHi;
  InitGraph(GraphDriver,GraphMode,'');
  ErrorCode := GraphResult;
  if ErrorCode <> grOK then begin
    HaltDone;
    Writeln('Graphics Error: ',GraphErrorMsg(ErrorCode));
    Halt(1);
  end
  else begin
          {install exit proc to Close graphics}
    OldExitProc := ExitProc;                { save previous exit proc }
    ExitProc := @GExitProc;                { insert our exit proc in chain }
    Graphic := true;
          {install graphic mode DOS critical error handler}
    SysErrorFunc := GSystemError;
          {improves look of dark gray and brown on VGA monitors,
           no effect in EGA}
    ImprovePaletteColors;
  end;

  MCur.Init;             {mouse cursor object}
  MCur.SetSpeed(12,12);  {how fast cursor moves, "normal" is 8,8}

  InitShiftView;     {must do before TProgram.Init if calling
                      ShiftView.HandleEvent from TDemoApp.HandleEvent.
                      ShiftView is needed for Panning windows only.}
  TProgram.Init;


      {following items may be different for your program}
  DoStreamRegistration;

  InitMessageBar;

  DoubleDelay := 6;   {time between mouse button presses for double press}
                      {TV uses 8 - very slow}

    {set default Viewport to just cover the DeskTop. The MainMenu,MessageBar
       and StatusLine temporarily reset viewport when they draw themselves.}
  with DeskTop^ do
    SetViewPort(Origin.x, Origin.y,
           Origin.x + Size.x, Origin.y + Size.y, ClipOn);

    {set mouse grids to off}
  MCur.SetGrid(1,1,0,0);
  MouseSnapToMenuGrid := false;
  MouseSnapToDialogGrid := false;

  InitHeapViewer;

  InitToolBar;

  IntroScreen;      {optional}

  DisableCommands([cmTVlikeButtons]);  { for demo program only! }
end;

procedure TDemoApp.DosShell;
  {Must override method TApplication.DosShell for graphics.}
begin
   {USE TurboVision 2.0 MEMORY Unit if compiling with TP 7.0,
      use MEMORY ver 1.0 with TP.6.0}
  RestoreCrtMode;          {back to text mode}

  DoneSysError;
  DoneEvents;
  DoneVideo;

  {$IFDEF VER60}
    SetMemTop(HeapPtr);      {reduce reserved memory size}
  {$ELSE}
    DoneDosMem;
  {$ENDIF}
  Writeln('Type EXIT to return to '+ ProgName + '...');
  SwapVectors;
  Exec(GetEnv('COMSPEC'), '');
  SwapVectors;
  {$IFDEF VER60}
    SetMemTop(HeapEnd);      {reserve all of memory}
  {$ELSE}
    InitDosMem;
  {$ENDIF}

  InitVideo;
  InitEvents;
  InitSysError;

  SetGraphMode(GetGraphMode);
  ImprovePaletteColors;

        {Other programs can change mouse settings. Restore here.}
  MCur.RestoreSettings;

  Redraw;                          {Use Redraw here, not Draw.}
  if DosError <> 0 then DOSErrorMessageBox(DosError, 'Running DOS shell');
end;


procedure TDemoApp.GetEvent(var Event : TEvent);
const
  HelpInUse : boolean = false;
  LastPressDouble : boolean = false;
begin
  TProgram.GetEvent(Event);    {usual call}

   {Timer Tick events for v1.5 and above
     are now handled automatically in TProgram.GetEvent}

     {Optional - Mouse button behavior}
  if (Event.What and evMouse <> 0) and (Graphic = true) then begin
  (* next line moved to TProgram.GetEvent
      MCur.Move(Event.Where);    {move cursor to mouse location}*)
    if (Event.What = evMouseDown) then begin
          {OPTIONAL - remap middle button of 3 button mouse}
      if (Event.Buttons > mbRightButton) then Event.Buttons := mbLeftButton;
         {eliminate sequential double press events}
      if (Event.Double) then
        if not LastPressDouble then LastPressDouble := true  {remember this double press}
        else begin
          Event.Double := false;         {reset the double flag}
          LastPressDouble := false;
        end
      else LastPressDouble := false;     {clear flag if non-double press}
    end;
  end;

    {Hook in HELP screens here in GetEvent to cover
     situation when another view is Modal}
  if (Event.What = evCommand) and (Event.Command = cmHelp)
   and not HelpInUse then begin
    HelpInUse := true;
    ShowHelp;
    ClearEvent(Event);
    HelpInUse := false;
  end;

end;

procedure TDemoApp.ShowHelp;
  var
    HWin : PDialog;
    S : string;
    Control : integer;
    HCtx : word;
    PS : PGStaticText;
    B : PButton;
    R : TRect;
    Event : TEvent;
    P : PMenuView;
  begin
    HCtx := GetHelpCtx;
    Str(HCtx,S);
    case HCtx of
      hcMouseGrid:
        S := 'TVGraphic allows the mouse cursor to be snapped to any user specified grid for the screen in general.'+
         ' Grid Off (uses every pixel) and two other choices are provided here.';
      hcColorSel:
        S := ^C'Use Background color selector for all items listed after a "/".'+^M^M+
             ^C'Only Items showing "bkgnd" have a changable background.';
      else
        S := ^C'THIS IS NO HELP AT ALL'^M^M^M+
         ^C+ 'Help Context = ' + S;
    end;
    R.A.x := 0;  R.B.x := R.A.x + 49*Charlen;
    R.A.Y := 0;  R.B.y := R.A.y + (11+3)*Boxheight;

    HWin := New(PDialog,Init(R,'HELP'));
    HWin^.Options := HWin^.Options or OfCentered;  {autocenter}

    Inc(R.A.x, 4*Charlen);
    Dec(R.B.x, 4*Charlen);
    Inc(R.A.y, 4*Boxheight);
    R.B.y := R.A.y + 5*Boxheight;
    PS := New(PGStaticText, Init(R,S,DefaultOpts));
    HWin^.Insert(PS);

    if TopView = @Self then
             {if no other view is modal, insert dialog
              as non-modal (persistant) view}
      if ThePanWindow <> nil then ThePanWindow^.Insert(HWin)
      else DeskTop^.Insert(HWin)
    else begin         {some other view is already modal, make dialog modal}
      R.A.x := HWin^.Size.x - 11*Charlen;
      R.A.y := HWin^.Size.y - 2*Boxheight;
      B := New(PCancelButton, Init(R.A));
      HWin^.Insert(B);                      {add Cancel button}

      Control := DeskTop^.ExecView(HWin);
      Dispose(HWin,Done);
                   {TVGraphics partial redraw scheme isn't aware of open
                   submenu(s) extending over the DeskTop. If you create a
                   overlapping modal view while these menus are open,
                   you must manually call the menu chain to redraw
                   themselves as shown here.}
        P := MenuBar^.Target;     {first submenu in the chain}
        while P <> nil do begin   {redraw all open submenus}
          P^.DrawView;
          P := P^.Target;
        end;
    end;
  end;

procedure TDemoApp.DoAboutBox;
begin
  InsertScrollerWin('ABOUT TVGRAPHIC');
end;


procedure TDemoApp.HandleEvent(var Event: TEvent);

  procedure Colors;
  var
    D: PColorDialog;
  begin
    D := New(PColorDialog, Init('',
      ColorGroup('Desktop',       DesktopColorItems(nil),
      ColorGroup('Menus',         MenuColorItems(nil),
      ColorGroup('Dialogs',  DialogColorItems(dpTV1Dialog, nil),
      ColorGroup('Windows',  WindowColorItems(wpBlueWindow, nil),
      {ColorGroup('Help',     WindowColorItems(wpCyanWindow, nil),}
        nil)))))){)};
    D^.HelpCtx := hcColorSel;

    if ExecuteDialog(D, Application^.GetPalette) <> cmCancel then
    begin
      ReDraw;        { Redraw application with new palette }
    end;
  end;

  procedure DosErr;
  var
    F: Text;
    Cmd : integer;
  begin
    Cmd := MessageBox(^C'Testing DOS Critical Error'+
          ^M^M^C'Remove any disk in drive A:',nil,mfWarning+mfOKCancel);
    if Cmd <> cmOK then exit;

    Assign(F, 'a:\8anyfile.7Z3');
  {$I-}
    Reset(F);
    Close(F);
    Cmd := IOResult;   {added 5/17/93}
  {$I+}
  end;

  procedure ShowVersion;
  var Cmd : integer;
  begin
    Cmd := MessageBox(^C'TVGraphic Demo1 ver '+Ver,
      nil, mfInformation+mfOKButton);
  end;
  procedure ShowHourGlass;
  begin
    Mcur.SelectHourGlass;
    Delay(500);
    MCur.SelectStdCursor;
  end;

  procedure DeskTopOptionsInfo;
  begin
    MessageBox(^C'The heights and fonts of the Menubar and the '
                     +'StatusLine are adjustable in the code.',
      nil, mfInformation+mfOKButton);
  end;
  procedure ToolsInfo;
  begin
    MessageBox(^C'TVGraphic now works with David Baldwin''s visual '+
                        'design tool, Dialog Design v4.0.',
      nil, mfInformation+mfOKButton);
  end;
  procedure TEditInfo;
  begin
    MessageBox(^C'The Editors unit for TVGraphic is in progress.',
      nil, mfInformation+mfOKButton);
  end;
  procedure ToolBarInfo;
  begin
    MessageBox(^C'Bitmapped buttons may be used in Dialogs or in'+
                        ' a ToolBar.',
      nil, mfInformation+mfOKButton);
  end;
  procedure MakeSound;
  begin
    Sound(1000);
    Delay(10);
    NoSound;
  end;

var
  R: TRect;
  PDir,FInputBox : PView;
  Cmd : integer;
begin
  if (ShiftViewPtr <> Nil) then ShiftViewPtr^.HandleEvent(Event);
      {ShiftViewPtr will be nil unless InitShiftView has been
      called. A ShiftView is needed if using TPanWindow type. Call to
      ShiftViewPtr^.HandleEvent must come before call to
      TProgram.HandleEvent.}

  TProgram.HandleEvent(Event);    {usual call to ancestor method}

  if Event.What = evCommand then
  begin
    case Event.Command of
      cmNew: NewWindow;
      cmShowMessageBar:
        begin
          MessageBar^.ShowText('~T~HIS IS THE MESSAGE BAR.');
          Delay(1000);
          MessageBar^.Hide;
        end;
      cmAbout: DoAboutBox;
      cmOpen:
        begin
          FInputBox := New(PFileDialog, Init('*.*', 'OPEN A FILE', '~N~ame', fdOpenButton,0));
          Cmd := DeskTop^.ExecView(FInputBox);
          Dispose(FInputBox, Done);
        end;
      cmChangeDir:
        begin
          PDir := New(PChDirDialog, Init(cdNormal {+ cdHelpButton},0));
          Cmd := DeskTop^.ExecView(PDir);
          Dispose(PDir, Done);
        end;
      cmSetColors: Colors;
      cmDOSshell : DOSShell;
      cmDosCriticalError : DosErr;
      cmOptionsSave : SaveDeskTop;
      cmOptionsLoad : LoadDeskTop;
      cmCircleWindow : InsertCircleWin;
      cmScrollerWindow : InsertScrollerWin('WINDOW WITH SCROLLER');
      cmMouseGrids   : ShowMouseBox;
      cmDeskTopStyle : SelectDeskTopStyle;
      cmDeskTopOptions : DeskTopOptionsInfo;
      cmVersion       : ShowVersion;
      cmTools        : ToolsInfo;
      cmTEdit        : TEditInfo;
      cmBMP          : LoadBMP;
      cmBitBut       : ToolBarInfo;
      cmHourGlass    : ShowHourGlass;
      cmTVlikeButtons : begin
            TextButtonsMatchBitMapButtons := false;
            DisableCommands([cmTVlikeButtons]);
            EnableCommands([cmBMPlikeButtons]);
                        end;
      cmBMPlikeButtons :begin
            TextButtonsMatchBitMapButtons := true;
            DisableCommands([cmBMPlikeButtons]);
            EnableCommands([cmTVlikeButtons]);
                        end;
    end;
  end;
end;

procedure TDemoApp.InsertCircleWin;
var
  P : PView;
  W : PWindow;
  R : TRect;
begin
  R.Assign((WinNum+20)*Grid, (WinNum+20)*Grid,
           (WinNum+40)*Grid, (WinNum+40)*Grid);

   {use a TSubWindow here rather than TWindow since window may be
   inserted into another window instead of the DeskTop}
  W := New(PSubWindow, Init(R,'CIRCLES',wnNoNumber));

  W^.GetMaxSubViewSize(R);
  P := New(PCircles, Init(R));
  W^.Insert(P);
  if ThePanWindow <> nil then ThePanWindow^.Insert(W)
   else DeskTop^.Insert(W);
end;

procedure TDemoApp.InsertScrollerWin(Atitle : string);
var
  WinTitle : string;
  TheWindow : PSubWindow;
  PScrollH,PScrollV : PScrollBar;
  PS : PView;
  R : TRect;
begin
  Inc(WinNum);
  R.Assign((WinNum+4)*Charlen, (WinNum+4)*Boxheight,
           (WinNum+64)*Charlen,(WinNum+24)*Boxheight);
  WinTitle := ATitle;
  TheWindow := New(PSubWindow, Init(R, WinTitle, WinNum{wnNoNumber}));

  PScrollH := TheWindow^.StandardScrollBar(sbHorizontal + sbHandleKeyboard);
  PScrollV := TheWindow^.StandardScrollBar(sbVertical + sbHandleKeyboard);

  TheWindow^.GetMaxSubViewSize(R);
     {GetMaxSubViewSize returns the rectangle that needs to be filled
     with views - here fill it with the scroller}
  PS := New(PMyScroller, Init(R,PScrollH,PScrollV));
  TheWindow^.Insert(PS);

  if ThePanWindow <> nil then ThePanWindow^.Insert(TheWindow)
  else DeskTop^.Insert(TheWindow);
end;

procedure TDemoApp.InitHeapViewer;
var
  P : PView;
  R : TRect;
begin
  R.Assign(Size.x - 14*Charlen, StatusLine^.Origin.y, Size.x, Size.y);
  P := New(PHeapView, Init(R));
  Insert(P);
end;

procedure TDemoApp.InitMessageBar;  {message that covers over the MenuBar}
begin
  MessageBar := New(PGMessageBar,Init);
  Insert(MessageBar);
end;

procedure TDemoApp.InitShiftView;
 {Used with full desktop panning window(s).
  Zero or One ShiftView per application.
  The shape of ShiftView is the top row of pixels on the screen.}
var
  R : TRect;
begin
  R.A.x := 0;  R.B.x := GetMaxX;
  R.A.y := 0;  R.B.y := 0{1};           {shape = slit above menubar}
  ShiftViewPtr := New(PShiftView,Init(R));
end;

procedure TDemoApp.InitMenuBar;
var
  R: TRect;
begin
  MenuBarHeight := {15}20;   {user choice}
  GetExtent(R);
  MenuBar := New(PGMenuBar, Init(R, NewMenu(
    NewSubMenu('~F~ile', hcNoContext, NewMenu(
      NewItem('~N~ew', '', kbNoKey, cmNew, hcNew,
      NewItem('~O~pen...', 'F3', kbF3, cmOpen, hcOpen,
      NewLine(
      NewItem('~C~hange dir...', '', kbNoKey, cmChangeDir, hcChangeDir,
      NewItem('~D~OS shell', '', kbNoKey, cmDosShell, hcDosShell,
      NewItem('E~x~it', 'Alt+X', kbAltX, cmQuit, hcExit,
      nil))))))),
    NewSubMenu('~D~eskTop', hcNoContext, NewMenu(
      NewItem('~S~et Style...', '', kbNoKey, cmDeskTopStyle, hcNoContext,
      NewItem('~O~ptions...', '', kbNoKey, cmDeskTopOptions, hcNoContext,
      NewLine(
      NewItem('S~a~ve desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
      NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
      nil)))))),
    NewSubMenu('~W~indows', hcNoContext, NewMenu(
      NewItem('~C~ircleWindow', '', kbNoKey, cmCircleWindow , hcNoContext,
      NewItem('~S~crollerWindow1', '', kbNoKey, cmScrollerWindow , hcNoContext,
      NewItem('~S~crollerWindow2', '', kbNoKey, cmAbout, hcNoContext,
      NewLine(
      NewItem('~S~ize/Move','Ctrl+F5', kbCtrlF5, cmResize, hcResize,
      NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcZoom,
      NewItem('~N~ext', 'F6', kbF6, cmNext, hcNext,
      NewItem('~P~revious', 'Shift+F6', kbShiftF6, cmPrev, hcPrev,
      NewItem('~C~lose', 'Alt+F3', kbAltF3, cmClose, hcClose,
      nil)))))))))),
    NewSubMenu('~M~ouse', hcNoContext, NewMenu(
      NewItem('~S~et Cursor grids...', '', kbNoKey, cmMouseGrids, hcNoContext,
      NewItem('~H~ourglass Cursor', '', kbNoKey, cmHourGlass, hcNoContext,
      nil))),
    NewSubMenu('O~p~tions', hcNoContext, NewMenu(
      NewItem('~S~how MessageBar', '', kbNoKey, cmShowMessageBar, hcNoContext,
      NewItem('~D~os Crit Error', '', kbNoKey, cmDosCriticalError, hcNoContext,
      NewItem('Set ~C~olors...', '', kbNoKey, cmSetColors, hcNoContext,
      NewLine(
      NewItem('~T~V style text buttons', '', kbNoKey, cmTVlikeButtons, hcNoContext,
      NewItem('~B~MP like text buttons', '', kbNoKey, cmBMPlikeButtons, hcNoContext,
      nil))))))),
    NewSubMenu('~I~nfo', hcNoContext, NewMenu(
      NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
      NewItem('~V~ersion #', '', kbNoKey, cmVersion, hcNoContext,
      nil))),
    NewSubMenu('The Future', hcNoContext, NewMenu(
      NewSubMenu('~H~ere now', hcNoContext, NewMenu(
        NewItem('~T~ools', '', kbNoKey, cmTools, hcNoContext,
        NewItem('~B~itMaps', '', kbNoKey, cmBMP, hcNoContext,
        nil))),
      NewItem('~E~ditors Unit', '', kbNoKey, cmTEdit, hcNoContext,
      nil))),
    nil)))))))
  )));
end;

procedure TDemoApp.InitStatusLine;
  function  HiddenStatusKeys(Next : PStatusItem) : PStatusItem;
  begin
    HiddenStatusKeys :=
        NewStatusKey('', kbF10, cmMenu,
        NewStatusKey('', kbAltF3, cmClose,
        NewStatusKey('', kbF5, cmZoom,
        NewStatusKey('', kbCtrlF5, cmResize,
        NewStatusKey('', kbF6, cmNext,
        Next)))));
  end;
var
  R: TRect;
begin
  GetExtent(R);
  R.B.x := R.B.x - 14*Charlen;           {leave space for heap viewer}
  R.A.Y := R.B.Y - 9 {Boxheight};    {this gives a 10 pixel tall StatusLine}
StatusLine :=   New(PGStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('~F1~ Help', kbF1, cmHelp,
      NewStatusKey('~F6~ Next', kbF6, cmNext,
      NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmPrev,
      NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
      HiddenStatusKeys(nil))))),
       nil)));

StatusLine^.VFont := font8x8;
   {use for 10 pixel tall StatusLine - default font is Font8x14}
end;

procedure TDemoApp.InitToolBar;
  {NOTE: this is a toolbar that is inserted into the DeskTop,
   just like a window. It can be any size. Windows can cover it.
   As an alternative, you could make a toolbar which is inserted into
   the application like a menu and reduces the size of the DeskTop.
   See Bitmap documentation.}
const
  BWidth = 28;
  BHeight = 28;
var
  PBar : PToolBar;
  PBut : PIconButton;
  R : TRect;
begin
  R.Assign(0, 0, 5 +BWidth, 2+Boxheight +6*BHeight);
  PBar := New(PToolBar, Init(R, ''));

{ Buttons have ofSelectable set by default.  If so, the Selected
  button will have a dotted line drawn around it. Setting bfGrabFocus
  in the Opts field of the constructor will cause a button to Select
  itself when clicked with mouse. So the dotted line will be on the last
  clicked button.
    If you don't want the dotted line , clear the ofSelectable flag
  in the button's Options field after construction. bfGrabFocus is
  not needed in this case but doesn't hurt.
    Note that buttons will respond to HotKeys, if you have set them,
  but Turbo Vision does not cause such a button to select itself.}

  R.A.x := 3;  R.A.y := 14;        {HotKey = "N"}
  PBut := New(PIconButton, Init(R, '~N~',cmNext,
      tbDrawDisabled+bfGrabFocus+tbDrawFrame+tbAutoSize, @Bar8_BMP));
PBut^.Options := PBut^.Options and not ofSelectable;
  PBar^.Insert(PBut);
  Inc(R.A.y, BHeight);
  PBut := New(PIconButton, Init(R, '',cmBitBut,
              bfGrabFocus+tbDrawFrame+tbAutoSize, @Bar2_BMP));
PBut^.Options := PBut^.Options and not ofSelectable;
  PBar^.Insert(PBut);
  Inc(R.A.y, BHeight);
  PBut := New(PIconButton, Init(R, '',cmBitBut,
              bfGrabFocus+tbDrawFrame+tbAutoSize, @Bar3_BMP));
PBut^.Options := PBut^.Options and not ofSelectable;
  PBar^.Insert(PBut);
  Inc(R.A.y, BHeight);
  PBut := New(PIconButton, Init(R, '',cmBitBut,
              bfGrabFocus+tbDrawFrame+tbAutoSize, @Bar4_BMP));
PBut^.Options := PBut^.Options and not ofSelectable;
  PBar^.Insert(PBut);
  Inc(R.A.y, BHeight);
  PBut := New(PIconButton, Init(R, '',cmBitBut,
              bfGrabFocus+tbDrawFrame+tbAutoSize, @Bar7_BMP));
PBut^.Options := PBut^.Options and not ofSelectable;
  PBar^.Insert(PBut);
  Inc(R.A.y, BHeight);
  PBut := New(PIconButton, Init(R, '',cmBitBut,
              bfGrabFocus+tbDrawFrame+tbAutoSize, @Bar1_BMP));
PBut^.Options := PBut^.Options and not ofSelectable;
  PBar^.Insert(PBut);

  PBar^.SelectNext(false);

  DeskTop^.Insert(PBar);
end;

procedure TDemoApp.IntroScreen;
var
  R : TRect;
  I,J : integer;
  Msg : string;
  XPt,YPt : integer;
begin
  DeskTop^.GetExtent(R);
  SetTextStyle(defaultfont,HorizDir,2);
  SetColor(white);
  for I := 1 to 22 do begin
    if I > 10 then SetTextStyle(font8x14,HorizDir,1);
    if I > 18 then SetTextStyle(font8x8,HorizDir,1);
    OutTextXY(I*20,I*20{R.A.y}, 'TVGraphic');
  end;
  Delay(500);
  R.B.x := 52*Charlen;
  R.B.y := 14*Boxheight;
  Msg := ^C'WELCOME TO TVGraphic Demo1'^M^M^C+
          'TVGraphic is written in Borland Turbo Vision.'+
          ^M^M^C'Make your TV application look like this one with TVGraphic(tm).'
          +^M^M^C+
          'CopyRight 1993,1994 Richard P Andresen';

  MessageBoxRect(R, Msg, nil, mfInformation+mfOKButton);
  DeskTop^.Draw;
end;

procedure TDemoApp.LoadBMP;
var
  R : TRect;
  BitPtr : PBitMap;
  Cmd : integer;
  FInputBox : PFileDialog;
  FName : PathStr;
  InFile : file;
  Result : word;
  Buf : array[0..Sizeof(TBitMapInfoHeader)-1] of byte;
  TotalBytes : LONGint; {!!!}
  ErrStr : string;
begin
  BitPtr := nil;
  Inc(WinNum);
  R.A.x := 100; R.A.y := 100;
  FInputBox := New(PFileDialog, Init('*.BMP', 'LOAD AND DRAW A BITMAP', '~N~ame', fdOpenButton,0));
  Cmd := DeskTop^.ExecView(FInputBox);

  if (Cmd = cmFileOpen) or (Cmd = cmOK) then FInputBox^.GetFileName(FName)
      else FName := '';
  Dispose(FInputBox, Done);
  if FName <> '' then begin
    Assign(InFile, FName);
    Reset(InFile,1);   {reads 1 byte blocks}

      {read just the InfoHeader}
    BlockRead(InFile, Buf, Sizeof(TBitMapInfoHeader), Result);

        {remember - the Infoheader is in Buf, not yet in BitPtr^.}
    ErrStr := BMPFormatOKStr(PBitMap(@Buf), FName);
    If ErrStr = '' then begin
      BitPtr := AllocateBMPmem(PBitMap(@Buf)); {allocate mem,use special call}
      if BitPtr <> nil then begin
        TotalBytes := GetBitImageSize(PBitMap(@Buf));

        Reset(InFile,1);   {start again at beginning of file, read all}
        BlockRead(InFile, BitPtr^, TotalBytes, Result);

        WinToTVColor(BitPtr);
        MCur.Hide;
        PutBitMap(100,100, BitPtr, 0, NormalPut);
        MCur.Show;
      end;
    end
    else
      Cmd := MessageBox(ErrStr, nil, mfError+mfOKButton);

    System.Close(InFile);

  {! WARNING ! - following line disposes of memory used by this bitmap -
    fine here since just want to draw bitmap once on screen but disaster
    if you assign BitPtr to a View or Button in your own code!}

    if BitPtr <> nil then FreeMem(BitPtr, TotalBytes); {do here for demo}
  end;
end;


procedure TDemoApp.SaveDeskTop;
const
  FName = 'TVGDEMO.DSK';
var
  SaveFile : TBufStream;
  FStatus,Cmd : integer;
  Pal : PString;
begin
    SaveFile.Init(FName, stCreate, 1048);          {create a save file}
    Pal := PString(GetPalette);   {get pointer to palette}
    SaveFile.WriteStr(Pal);          {save palette}
    SaveFile.Put(DeskTop);           {save DeskTop}
    SaveFile.Flush;
    FStatus := SaveFile.Status;
    SaveFile.Done;          {flushes buffer}
    if FStatus <> stOK then
      if FStatus = stPutError then
        Cmd := MessageBox('Put of unregistered object.',nil, mfError + mfOkButton)
      else if SaveFile.ErrorInfo <> 0 then
           DOSErrorMessageBox(SaveFile.ErrorInfo, FName)
           else
             Cmd := MessageBox('Error saving file.',nil, mfError + mfOkButton);
end;

procedure TDemoApp.LoadDeskTop;
  procedure CloseView(P: PView); far;
  begin
    Message(P, evCommand, cmClose, nil);
  end;
  procedure ReadFile(var S : TBufStream);
  var
    Pal : PString;
  begin
    if Desktop^.Valid(cmClose) then
    begin
      Pal := S.ReadStr;
      if Pal <> nil then
      begin
        GetPalette^ := Pal^;
        DisposeStr(Pal);
      end;
      Delete(DeskTop);
      Dispose(DeskTop,Done);
      DeskTop := PDeskTop(ValidView(PDeskTop(S.Get)));
                   {May overflow memory in TV, safe in TVGraphic}
                   {note pointer type conversion to PDeskTop}

      Insert(DeskTop);
    end;
  end;
const
  FName = 'TVGDEMO.DSK';
var
  SaveFile : TBufStream;
  FStatus,Cmd : integer;
begin
  SaveFile.Init(FName, stOpenRead, 1048);
  if (SaveFile.Status = stOK) then begin      {found file}
    ReadFile(SaveFile);
    FStatus := SaveFile.Status;
    SaveFile.Done;          {flushes buffer}
    if FStatus <> stOK then
      if FStatus = stGetError then
        Cmd := MessageBox('Get of unregistered object.',nil, mfError + mfOkButton)
      else if SaveFile.ErrorInfo <> 0 then
           DOSErrorMessageBox(SaveFile.ErrorInfo, FName)
           else
             Cmd := MessageBox('Error reading file.',nil, mfError + mfOkButton);
  end;
end;

procedure TDemoApp.NewWindow;
var
  Cmd : integer;
begin
  Cmd := MessageBox(^C'Use the Windows Menu to open Windows',nil,
                       mfInformation+mfOKButton);
end;

procedure TDemoApp.ShowMouseBox;
type
  Temptype = record
    RW : word;
    CW : word;
  end;
var
  Win : PDialog;
  WinTitle : PGStaticText;
  OKButton,CancelButton : PButton;
  StyleStr  : string;
  Control,SaveStyle : integer;
  R     : TRect;
  Org   : TPoint;
  Lab   : PGLabel;
  Radio : PRadioButtons;
  Check : PCheckBoxes;
  Temp : Temptype;
  MGridSize : MGridRec;
begin
        R.A.x := 0;  R.B.x := R.A.x + 42 * Charlen;
        R.A.y := 0;  R.B.y := R.A.y + 19 * Boxheight;
        Win := New(PDialog,Init(R,'MOUSE GRIDS'));
        Win^.Options := Win^.Options or ofCentered;
        {Win^.HelpCtx := hcMouseGrid;}

        {add note}
        StyleStr:= ^C'The mouse Cursor can be continuous or snapped to an invisible grid.'+
        ^M^M^C'BoxMenus and Dialogs use the desktop grid if their own grid is not enabled.';
        R.Assign(Charlen{0},2*Boxheight, Win^.Size.x-Charlen, 7*Boxheight);
        WinTitle := New(PGStaticText,Init(R,StyleStr,DefaultOpts));
        Win^.Insert(WinTitle);

        {create buttons}
        Org.x := 3{2}*Charlen; Org.y := Win^.Size.y - 2*Boxheight;
        OkButton := New(POKButton,Init(Org, true));
        Win^.Insert(OKButton);

        Org.x := Win^.Size.x - 13{10}{9} * Charlen;
        Org.y := Win^.Size.y - 2*Boxheight;
        CancelButton := New(PCancelButton,Init(Org));
        Win^.Insert(CancelButton);

        {create RadioButtons}
        R.A.x := 4*Charlen;
        R.B.x := Win^.Size.x - 4*Charlen;
        R.A.y := R.B.y + 2*Boxheight;
        R.B.y := R.A.y + 3*Boxheight;
        Radio := New(PRadioButtons, Init(R,
          NewSItem('Desktop Grid off',
          NewSItem('10x10 grid for desktop',
          NewSItem('8x14 Text grid for desktop',
          nil)))));
        Radio^.HelpCtx := hcMouseGrid;
        Win^.Insert(Radio);

        Dec(R.A.y, Boxheight);
          {note use of txAdjustSize to avoid specifying exact size}
        Lab := New(PGLabel, Init(R,'~D~esktop',Radio,txAdjustSize));
        Win^.Insert(Lab);
        Inc(R.A.y, Boxheight);

        {create CheckBoxes}
        R.A.y := R.B.y + 2*Boxheight;
        R.B.y := R.A.y + 2*Boxheight;
        Check := New(PCheckBoxes, Init(R,
          NewSItem('8x14 Grid for Box Menus',
          NewSItem('8x14 Grid for Dialog Boxes',
          nil))));
        Win^.Insert(Check);

        Dec(R.A.y, Boxheight);
          {note use of txAdjustSize to avoid specifying exact size}
        Lab := New(PGLabel, Init(R,'Use ~S~pecialty grids',Check,txAdjustSize));
        Win^.Insert(Lab);
        Inc(R.A.y, Boxheight);

        {set Temp variable}
          {Desktop mouse grid: 0 = 1x1, 1=10x10, 2=8x14}
        MCur.GetGrid(MGridSize);   {added 11/11/93}
        case MGridSize.X of
          1  : Temp.RW := 0;
          10 : Temp.RW := 1;
          8  : Temp.RW := 2;
        end;

        Temp.CW := 0;
        if MouseSnapToMenuGrid then Temp.CW := Temp.CW or $01;
        if MouseSnapToDialogGrid then Temp.CW := Temp.CW or $02;

        Radio^.Select;
        Win^.SetData(Temp);
        Control := DeskTop^.ExecView(Win);   {MODAL, owner is DeskTop}
        Win^.GetData(Temp);

        if (Control <> cmCancel) then begin
         {Setting the mouse grid with MCur.SetGrid .
          The third and fourth parameters are an Xoffset and
          YOffset of the grid from the screen's upper left corner.
          Note that MCur.SetGrid(1,1,0,0) causes the mouse coords to
          be used as they come from the mouse driver.
          Unit MCursor also provides functions to limit the area
          of the screen the mouse cursor can move in.}

          case byte(Temp.RW) of
            0 : MCur.SetGrid(1,1,0,0);
            1 : MCur.SetGrid(10,10,0,0);
            2 : MCur.SetGrid(Charlen,Boxheight,0,0);
          end;

          if (Temp.CW and $01 <> 0) then MouseSnapToMenuGrid := true
            else MouseSnapToMenuGrid := false;
          if (Temp.CW and $02 <> 0) then MouseSnapToDialogGrid := true
            else MouseSnapToDialogGrid := false;
        end;

        Dispose(Win,Done);
end;

procedure TDemoApp.SelectDeskTopStyle;
  {While you probably won't switch Desktop styles in a real application,
   it does show two different ways you can set up a program.
   You could also change the heights and fonts of the MenuBar
   and the StatusLine. Or eliminate the StatusLine if you wish.}

   {Example of changing entire Application palette and also
    color pairs within the palette.}

  procedure SetDeskTopStyle;
  var
    R : TRect;
    PanStep,IntSize : TPoint;
    TheWindow: PWindow;
    PScrollH,PSCrollV : PScrollbar;
    PS : PScroller;
    P,PBak : PView;
    WinTitle,TestStr : string;
    Pal : PPalette;
  begin
    Delete(DeskTop);
    Dispose(DeskTop, Done);      {dispose old desktop and everything in it}
    InitDeskTop;
    Insert(DeskTop);             {insert the new one}
    ThePanWindow := nil;          {tested for nil elsewhere in program}
    Dispose(ShiftViewPtr, Done);    {dispose to reset Shiftview}
    InitShiftView;

    if DeskTopStyle = 1 then begin       {Panning window}
      Inc(WinNum);
      R.Assign(0, 0, 60*Charlen, 20*Boxheight);
      WinNum := 1;
      DeskTop^.GetExtent(R);
      IntSize.x := GetMaxX+200;
      IntSize.y := GetMaxY+100;
      PanStep.x := ScrnShiftX;
      PanStep.y := ScrnShiftY;
        {The pan window should be a even multiple of the mouse grid size}
      ThePanWindow := New(PPanWindow, Init(R,
        'Larger Than Screen Panning Window', wnNoNumber, IntSize, PanStep));

      with ThePanWindow^ do begin
        Flags := 0;        {prevent from closing}
        VOffset.y := 50;   {shift the window's Interior by 50 pixels so
                            it starts above the top of the window.}
        R.Assign(Charlen,200,InteriorSize.x-Charlen,200+4*Boxheight);
        P := New(PGStaticText, Init(R,AString+AString+AString,txAuto+font8x14));
        P^.VOptions := P^.VOptions or txDrawBackground;
        Insert(P);
      end;
      DeskTop^.Insert(ThePanWindow);
      Pal := GetPalette;
      Pal^[2] := Chr($30);    {change menu background color to cyan}
    end
    else begin
      Pal := GetPalette;
      Pal^[2] := Chr($70);    {change menu background color to light gray}
    end;
    MenuBar^.Draw;            {since changed color}
    StatusLine^.Draw;
  end;

type
  Temptype = record
    W : word;
  end;
var
  Win : PDialog;
  WinTitle : PGStaticText;
  OKButton,CancelButton : PButton;
  StyleStr  : Str80;
  Control : integer;
  R     : TRect;
  Org   : TPoint;
  Radio : PRadioButtons;
  Temp : Temptype;
begin
        R.A.x := 0;  R.B.x := R.A.x + 42 * Charlen;
        R.A.y := 0;  R.B.y := R.A.y + 10 * Boxheight;
        Win := New(PDialog,Init(R,'SELECT STYLE'));
        Win^.Options := Win^.Options or ofCentered;
        {SizeWin^.HelpCtx := hcSizeWin;}

                      {add note}
        StyleStr:= ^C'Changing Style clears the DeskTop.';
        R.Assign(0,2*Boxheight, Win^.Size.x, 3*Boxheight);
        WinTitle := New(PGStaticText,Init(R,StyleStr,DefaultOpts));
        Win^.Insert(WinTitle);

        {create buttons}
        Org.x := 3{2}*Charlen; Org.y := Win^.Size.y - 2*Boxheight;
        OkButton := New(POKButton,Init(Org, true));
        Win^.Insert(OKButton);

        Org.x := Win^.Size.x - 13{10}{9} * Charlen;
        Org.y := Win^.Size.y - 2*Boxheight;
        CancelButton := New(PCancelButton,Init(Org));
        Win^.Insert(CancelButton);

        {create RadioButtons}
        R.A.x := 4*Charlen;
        R.B.x := Win^.Size.x - 4*Charlen;
        Inc(R.A.y, 2*Boxheight);
        R.B.y := R.A.y + 2*Boxheight;
        Radio := New(PRadioButtons, Init(R,
          NewSItem('Multiple Non-Panning Windows',
          NewSItem('Full Screen Panning Window',
          nil))));
        Win^.Insert(Radio);

          {DeskTopStyle: 0 = non-panning, 1=panning}
        Temp.W := DeskTopStyle;

        Win^.SetData(Temp.W);
        Control := DeskTop^.ExecView(Win);   {MODAL, owner is DeskTop}
        Win^.GetData(Temp.W);

        if (Control <> cmCancel) and (Temp.W <> DeskTopStyle) then begin
          DeskTopStyle := Temp.W;
          SetDeskTopStyle;
        end;

        Dispose(Win,Done);
end;


var
  DemoApp: TDemoApp;
begin
  DemoApp.Init;
  DemoApp.Run;
  DemoApp.Done;
end.