
{*******************************************************}
{                                                       }
{       Graphics Vision Example program                 }
{                                                       }
{       Copyright (c) 1996 Matthias K”ppe               }
{                                                       }
{*******************************************************}

(* This example shows:
   - how to hook the Graphics Vision message box functions for BWCC style
   - how to use a bitmap viewer that gets its bitmap from a resource

   We get our Windows resource from the GVSH.EXE program.
   This executable includes a resource which has been built from
   the GVSH.RC script.
*)

uses
  { Turbo Vision units }
  Objects, Drivers, Memory,
  { Graphics Vision units }
  GVViews, GVMenus, GVApp, GvMsgBox, WinRes, KeyNames, GvWinDlg, GvBWCC,
  GvDialog, GvValid, GvTexts,
  { Graphics Vision bitmap controls }
  GvBitmap,
  { Following is the symbol unit, which has been created with
    Resource Workshop. It includes identifiers for commands,
    help contexts and strings. }
  GvShCmd;

{ The resource we access
}
const
  ResourcePath = 'exam.dll';
var
  Res: PStream;

function LoadWinDialog(Name: PChar): PWinDialog;
var
  Dlg: PWinDialog;
begin
  Dlg := PWinDialog(Application^.ValidView(LoadDialog(Res^, Name)));
  If Dlg <> nil
  then Dlg^.Options := Dlg^.Options or ofCentered;
  LoadWinDialog := Dlg
end;

function BorMessageBox(Res: PStream; Name: PChar;
  BitmapRes: PStream; BitmapName: PChar; Text: string): PWinDialog;
{ This function retrieves a BWCC message box from a resource
  and puts a bitmap and a text into it.
}
var
  Dlg: PWinDialog;
  Bounds: TRect;
  P: PGView;
begin
  Dlg := LoadDialog(Res^, Name);
  If Dlg <> nil
  then begin
    { Control 33 is supposed to be a static template for a bitmap viewer.
      We insert a real bitmap viewer before the template. Then we kill the
      template.
    }
    P := Dlg^.GetControl(33);
    If P <> nil then
    with P^ do
    begin
      GetBounds(Bounds);
      Dlg^.InsertBefore(
	New(PBmpView, Init(Bounds, BitmapRes, BitmapName, 0)),
	P);
      Free
    end;
    { Control 34 is supposed to be an empty static text.
      We fill it with text.
    }
    P := Dlg^.GetControl(34);
    If P <> nil then
    PStaticText(P)^.Text := NewStr(Text);
    Dlg^.Options := Dlg^.Options or ofCentered;
  end;
  BorMessageBox := Dlg
end;

function BorCreateMessageBox(var Bounds: TRect;
  ATitle, AText: string; AOptions: Word): PDialog; {$ifndef FPK}far;{$endif}
{ This is our implementation of the CreateMessageBox hook function,
  using the above function to create a message box.
}
var
  DlgName, BmpName: PChar;
  Dialog: PDialog;
begin
  { On low memory, loading our message box could fail.
  }
  If LowMemory
  then begin
    BorCreateMessageBox := StdCreateMessageBox(Bounds, ATitle, AText, AOptions);
    Exit
  end;
  { Parse the options
  }
  case AOptions and $0F00 of
    mfOKButton:
      DlgName := bwcc_dialog_Ok;
    mfOKButton + mfCancelButton:
      DlgName := bwcc_dialog_OkCancel;
    mfYesButton + mfNoButton + mfCancelButton:
      DlgName := bwcc_dialog_YesNoCancel;
    mfYesButton + mfNoButton:
      DlgName := bwcc_dialog_YesNo;
    else
      DlgName := bwcc_dialog_AbortRetryIgnore;
  end;
  case AOptions and $000F of
    mfWarning:
      BmpName := bwcc_bitmap_Exclamation;
    mfError:
      BmpName := bwcc_bitmap_Hand;
    mfInformation:
      BmpName := bwcc_bitmap_Information;
    mfConfirmation:
      BmpName := bwcc_bitmap_Question;
    else
      BmpName := nil;
  end;
  { Load the dialog template
  }
  Dialog := BorMessageBox(BWCC, DlgName, BWCC, BmpName, AText);
  Dialog^.Title := NewStr(ATitle);
  If Bounds.B.X = -1
  then Dialog^.Options := Dialog^.Options or ofCentered
  else Dialog^.MoveTo(Bounds.A.X, Bounds.A.Y);
  BorCreateMessageBox := Dialog
end;

type
{ The application
}
  TDemoApp = object(TApplication)
    constructor Init;
    destructor Done; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure InitMenuBar; virtual;
    procedure InitTexts; virtual;
  end;

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

constructor TDemoApp.Init;
begin
  Res := OpenResource(ResourcePath);
  If Res^.Status <> 0
  then begin
    PrintStr('Resource error.'^M^J);
    Halt(1)
  end;
  InitClasses;
  RegisterGvWinDlg;
  BWCC := Res;
  { Hook the CreateMessageBox function
  }
  CreateMessageBox := BorCreateMessageBox;
  inherited Init;
end;

destructor TDemoApp.Done;
begin
  inherited Done;
  DoneClasses;
  Dispose(Res, Done);
end;

procedure TDemoApp.HandleEvent(var Event: TEvent);

	procedure BPMemory;
	var
	  D: PWinDialog;
	  Data: record
	    RealStack: LongInt;
	    RealMinHeap: LongInt;
	    RealMaxHeap: LongInt;
	    ProtStack: LongInt;
	    WinStack: LongInt;
	    WinHeap: LongInt
	  end;

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

	begin
	  with Data do
	  begin
	    RealStack := 16384;
	    RealMinHeap := 0;
	    RealMaxHeap := 655360;
	    ProtStack := 16384;
	    WinStack := 8192;
	    WinHeap := 8192
	  end;
	  D := LoadWinDialog('bpc_memory');
	  Rangify(hiBPCRealStack, 1024, 65520);
	  Rangify(hiBPCRealMinHeap, 0, 655360);
	  Rangify(hiBPCRealMaxHeap, 0, 655360);
	  Rangify(hiBPCProtStack, 1024, 65520);
	  Rangify(hiBPCWinStack, 1024, 65536);
	  Rangify(hiBPCWinHeap, 1024, 65536);
	  ExecuteDialog(D, @Data);
	end;

begin
  inherited HandleEvent(Event);
  If Event.What = evCommand
  then begin
    case Event.Command of
      cmAbout:
	MessageBox(GetStr(sCopyright), nil, mfInformation + mfOkButton);
      cmGREP:
	ExecuteDialog(LoadWinDialog('grep'), nil);
      cmDirs:
	ExecuteDialog(LoadWinDialog('dirs'), nil);
      cmBPOptions:
	ExecuteDialog(LoadWinDialog('bpc_compiler'), nil);
      cmBPLinker:
	ExecuteDialog(LoadWinDialog('bpc_linker'), nil);
      cmBPTarget:
	ExecuteDialog(LoadWinDialog('bpc_target'), nil);
      cmTASMWarnings:
	ExecuteDialog(LoadWinDialog('tasm_warn'), nil);
      cmBPMemory:
	BPMemory;
      else Exit;
    end;
    ClearEvent(Event)
  end
end;

procedure TDemoApp.InitMenubar;
var
  R: TRect;
  Menu: PMenu;
  Acc: PAccelerators;
Begin
  Menu := LoadMenu(Res^, 'Menu', mo_GraphicsVision);
  Acc := LoadAccelerators(Res^, 'GV');
  AddAccelerators(Menu, Acc);
  FreeAccelerators(Acc);
  Main^.GetExtent(R);
  R.B.Y := 21;
  MenuBar := New(PMenuBar, Init(R, Menu));
End;

procedure TDemoApp.InitTexts;
begin
  SetTextResource(Res)
end;

var
  App: TDemoApp;

Begin
  App.Init;
  MessageBox('This app has installed a MessageBox hook for BWCC style.',
    nil, mfInformation + mfOKButton);
  App.Run;
  App.Done
End.
