Power-Programmierung/CD1.mdf/pascal/library/dos/tp6goodi/hlpctx/radio.pas

Pascal/Delphi Source File | 1991-02-04 | 5.7 KB | 225 lines

{$X+}

program Hints;

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

const
  CancelButton      = 500;
  OkButton          = 501;
  cmNewDialog       = 102;
  hcInputLine       = 2999;
  hcHvarti          = 3000;
  hcTileSet         = hcHvarti + 1;
  hcJarlsBerg       = hcTileSet + 1;
  hcSolid           = hcJarlsBerg + 1;
  hcRunny           = hcSolid + 1;
  hcMelted          = hcRunny  + 1;

type
  PMyRadioButtons = ^TMyRadioButtons;
  TMyRadioButtons = object(TRadioButtons)
   function GetHelpCtx:Word;virtual;
  end;

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

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

  PDemoDialog = ^TDemoDialog;
  TDemoDialog = object(TDialog)
   MyStatusLine : PMyStatusLine;
   procedure HandleEvent(var Event : TEvent);virtual;
  end;

procedure TDemoDialog.HandleEvent(var Event : TEvent);
begin
  TDialog.HandleEvent(Event);
  Case event.what of
  evCommand :  case event.command of
               cmDefault : MessageBox('Default button is pressed',nil, mfError or mfOkButton);
               CancelButton : MessageBox('Cancel button is pressed', nil, mfError or mfOkButton);
               OkButton : MessageBox('Ok button is pressed', nil, mfError or mfOkButton);

               end;
  else
      exit;
  ClearEvent(Event);
  end;
end;


function TMyRadioButtons.GetHelpCtx:Word;
begin
   TRadioButtons.GetHelpCtx;
   if State and sfDragging <> 0 then
    GetHelpCtx := hcDragging else
    GetHelpCtx := HelpCtx + Sel;
end;

function TMyStatusLine.Hint(AHelpCtx : Word):String;
begin
 case AHelpCtx of
   hcHvarti  : Hint := 'Hvarti is checked';
   hcTileSet : Hint := 'TileSet is checked';
   hcJarlsberg : Hint := 'Jarlsberg is checked';
   hcSolid : Hint := 'Button zero is presssed';
   hcRunny : Hint := 'Button one is pressed';
   hcMelted : Hint := 'Button two is pressed';
   hcInputLine     : Hint := 'InputLine is activated';
 else
  Hint := '';
 end;
end;

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

procedure TMyApp.Idle;
begin
 TApplication.Idle;
 HeapViewer^.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;
  HeapViewer := New(PHeapView,Init(R));
  Insert(HeapViewer);
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(
      NewLine(
      NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
      nil))),
    NewSubMenu('~W~indow', hcNoContext, NewMenu(
      NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
      NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
      NewItem('~D~ialog', 'F2', kbF2, cmNewDialog, hcNoContext,
      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(1,1,
     NewStatusKey('~No-Key~ Testing -hcDragging',kbNoKey,cmResize,
     nil),
    NewStatusDef(hcInputLine,hcInputLine,
     NewStatusKey('~F3~ Close',kbNoKey,cmResize,
     nil),
    NewStatusDef(hcHvarti, hcMelted,
      NewStatusKey('~F3~ Close',kbAltF3,cmClose,
      nil),nil))))));
end;

procedure TMyApp.NewDialog;
var
  CheckBoxes: PCheckBoxes;
  RadioButtons : PRadioButtons;
  InputLine : PInputLine;
  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, 6);
    CheckBoxes := New(PCheckBoxes, Init(R,
      NewSItem('~H~varti',
      NewSItem('~T~ilset',
      NewSItem('~J~arlsberg',
      nil)))
    ));
    CheckBoxes^.HelpCtx := hcHvarti;
    Insert(CheckBoxes);
    R.Assign(2, 2, 10, 3);
    Insert(New(PLabel, Init(R, 'Cheeses', CheckBoxes)));
    R.Assign(22, 3, 34, 6);
    RadioButtons := New(PMyRadioButtons, Init(R,
      NewSItem('~S~olid',
      NewSItem('~R~unny',
      NewSItem('~M~elted',
      nil)))));
    RadioButtons^.HelpCtx := hcSolid;
    Insert(RadioButtons);
    R.Assign(21, 2, 33, 3);
    Insert(New(PLabel, Init(R, 'Consistency', RadioButtons)));
    R.Assign(15, 10, 25, 12);
    Insert(New(PButton, Init(R, '~O~k', OkButton,bfDefault)));
    R.Assign(28, 10, 38, 12);
    Insert(New(PButton, Init(R, 'Cancel', CancelButton, bfNormal)));
    R.Assign(3, 8, 37, 9);
    InputLine := New(PInputLine, Init(R, 34));
    InputLine ^.HelpCtx := hcInputLine;
    Insert(InputLine);
    R.Assign(2, 7, 24, 8);
    Insert(New(PLabel, Init(R, 'Delivery instructions', InputLine)));
   end;
  DeskTop^.ExecView(Dialog);
  Dispose(Dialog, Done);
end;

var
  MyApp: TMyApp;

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