community.borland.com

Article #15223: Associating Help Features with Context Hints

 Technical Information Database

TI223D.txt   Associating Help Features with Context Hints
Category   :TVISION
Platform    :All
Product    :Pascal  All

Description:

{

This program has context help associated with the
WINDOW selection in the main menu. The context help
for the radio buttons in the dialog is supported as
well.

}
{$X+}

program Hints;

uses Objects, Drivers, Views, Menus, Dialogs, App, Gadgets;

const
  cmNewDialog     = 100;
  hcMyDialog      = 300;
  hcCheck1        = 100;          {Declare help context handles}
  hcCheck2        = hcCheck1 + 1;
  hcRunny         = 200;
  hcMelted        = hcRunny + 1;

type
  PMyStatusLine = ^TMyStatusLine;
  TMyStatusLine = object(TStatusLine)
    function Hint(AHelpCtx : Word) : String; virtual; {Help   }
                                                      {context}
    procedure HandleEvent(var Event : TEvent); virtual;
  end;

  TMyApp = object(TApplication)
    constructor Init;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
    procedure NewDialog;
  end;

  PDemoDialog = ^TDemoDialog;
  TDemoDialog = object(TDialog)
    MyStatusLine : PMyStatusLine;
  end;

function TMyStatusLine.Hint(AHelpCtx : Word):String;
begin     { Load Hint with corresponding menu string}
          { in insertion order                      }
  case AHelpCtx of
    hcCheck1   : Hint := 'Tilset Cheese Selection';
    hcCheck2   : Hint := 'Jarlsberg Cheese Selection';
    hcmyDialog : Hint := 'DIALOG selection now pressed';
    hcMelted   : Hint := 'Melted Radio Button';
    hcRunny    : Hint := 'Runny Radio pressed';
  else
    Hint := '';
  end;
end;

procedure TMyStatusLine.HandleEvent(var Event : TEvent);
begin
  TStatusLine.HandleEvent(Event);
  Update;
end;

constructor TMyApp.Init;
var
  R : TRect;
begin
  TApplication.Init;
  GetExtent(R);
  Dec(R.B.X);
  R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
end;
{ TMyApp }

procedure TMyApp.HandleEvent(var Event: TEvent);
begin
  TApplication.HandleEvent(Event);
  if Event.What = evCommand then
  begin
    case Event.Command of
      cmNewDialog: NewDialog;
    else
      Exit;
    end;
    ClearEvent(Event);
  end;
end;

procedure TMyApp.InitMenuBar;
var
  R: TRect;
begin
  GetExtent(R);
  R.B.Y := R.A.Y + 1;
  MenuBar := New(PMenuBar, Init(R, NewMenu(
    NewSubMenu('~F~ile', hcNoContext, NewMenu(
      NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
      nil)),
    NewSubMenu('~W~indow', hcNoContext, NewMenu(
       NewItem('~D~ialog','F2', kbF2, cmNewDialog, hcmyDialog,
      nil)),
    nil))
  )));
end;

procedure TMyApp.InitStatusLine;
var
  R: TRect;
begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine := New(PMyStatusLine, Init(R,
    NewStatusDef(0,0,
      NewStatusKey('', kbF10, cmMenu,
      NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
      NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
      nil))),
    NewStatusDef(10,10,
      nil,nil))));
end;

procedure TMyApp.NewDialog;
var
  Borland: PView;
  Dialog: PDemoDialog;
  R: TRect;
  C: Word;
begin
  R.Assign(20, 6, 60, 19);
  Dialog := New(PDemoDialog, Init(R, 'Demo Dialog'));
  with Dialog^ do
  begin
    R.Assign(3, 3, 18, 5);
    Borland := New(PCheckBoxes, Init(R,
      NewSItem('~T~ilset',
      NewSItem('~J~arlsberg',
      nil)))
    );
    Borland^.HelpCtx :=hcCheck1;
    Insert(Borland);
    R.Assign(2, 2, 10, 3);
    Insert(New(PLabel, Init(R, 'Cheeses', Borland)));
    R.Assign(22, 3, 34, 5);
    Borland := New(PRadioButtons, Init(R,
      NewSItem('~R~unny',
      NewSItem('~M~elted',
      nil)))
    );
    Borland^.HelpCtx := hcRunny;
    Insert(Borland);
    R.Assign(21, 2, 33, 3);
    Insert(New(PLabel, Init(R, 'Consistency', Borland)));
    R.Assign(15, 8, 25, 10);
    Insert(New(PButton, Init(R, '~O~k', cmOK, bfDefault)));
    R.Assign(28, 8, 38, 10);
    Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  end;
  DeskTop^.ExecView(Dialog);
  Dispose(Dialog, Done);
end;
var
  MyApp: TMyApp;

begin
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
end.


Reference:


7/16/98 4:33:39 PM
 

Last Modified: 01-SEP-99