DP Tool Club 17/CD_ASCQ_17_101194.iso/vrac/ptgenr2.zip/BBDLG.PAS

Pascal/Delphi Source File | 1994-08-01 | 37KB | 1,280 lines

{ Created : 18-02-'91

Uses string identifiers 1920..1930
Uses object type identifiers 1920..1930

Last changes :
93-09-16  Created from PrintError a procedure type, else all of TurboVision
          would be linked in because of the Application = nil check and
          possibly subsequent call to MsgBox
93-09-22  Adapted to BBGui wrapper
93-09-24  Moved DisposeSItem from BBUtil to this unit
93-12-21  Added procedure PrintWarning
93-12-22  Enhanced TListViewer2 and TListBox2 to speed up selection by adding
          support to select an item by typed characters
          Removed cmBEditItem, cmBDeleteItem and cmBInsertItem. Their current
          use was unclear
93-12-23  Fixed bug in InputString which would input only uppercase characters
          Added procedure ShowHelpWindow which displays a given helpwindow
94-01-07  Added cmBEDitItem, cmBDeleteItem and cmBInsertItem again. These
          commands were for buttons which should not be disabeld after
          a ListBox releases its focus!
94-01-14  Added procedure ViewAsText, copied from tvfm
94-03-05  Added RegisterBBDlg procedure
}


{$IFDEF DPMI}
{$X+,S-,I-,V-}
{$ELSE}
{$X+,O+,F+,I-,R-,Q-,S-,V-,D-}
{$ENDIF}
unit BBDlg;

interface

uses Objects, Drivers, Menus, Views, Dialogs;


const

{ Message box classes }

  mfWarning      = $0000;       { Display a Warning box }
  mfError        = $0001;       { Dispaly a Error box }
  mfInformation  = $0002;       { Display an Information Box }
  mfConfirmation = $0003;       { Display a Confirmation Box }

{ Message box button flags }

  mfYesButton    = $0100;       { Put a Yes button into the dialog }
  mfNoButton     = $0200;       { Put a No button into the dialog }
  mfOKButton     = $0400;       { Put an OK button into the dialog }
  mfCancelButton = $0800;       { Put a Cancel button into the dialog }
  mfHelpButton   = $1000;       { Put a Help button into the dialog }

  mfYesNoCancel  = mfYesButton + mfNoButton + mfCancelButton;
                                { Standard Yes, No, Cancel dialog }
  mfOKCancel     = mfOKButton + mfCancelButton;
                                { Standard OK, Cancel dialog }
  mfOKCancelHelp = mfOKButton + mfCancelButton + mfHelpButton;

                                { Standard OK, Cancel, Help dialog }
const
  PassWordLen = 8;


{* allowed chars used by InputString *}
const
  Numbers = '0123456789';
  Capitals = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  LowerCase = 'abcdefghijklmnopqrstuvwxyz';
  AllChars = '';

const
  cmEditItem    = 240;       {* bind these two to *}
  cmDeleteItem  = 241;       {* the keyboard *}
  cmInsertItem  = 242;
  cmBEditItem   = 243;       {* these are for buttons which should *}
  cmBDeleteItem = 244;       {* not be disabled when a listbox releases *}
  cmBInsertItem = 245;       {* its focus *}

{* the following commands are defined so that existing code does not break *}
{* on the removal of language dependency from BBDlg *}
const
  English = 0;
  Dutch = 0;

{* the following commands are defined so that existing code does not
   break on the removal of AnswerType *}
const
  Yes = cmYes;
  No = cmNo;
  Cancel = cmCancel;

type
  PPopupMenu = ^TPopupMenu;
  TPopupMenu = object(TMenuPopup)
    destructor Done;  virtual;
  end;

  PSpinButton = ^TSpinButton;
  TSpinButton = object(TRadioButtons)
    constructor Init(var Bounds : TRect; AStrings : PSItem);
    procedure Draw;  virtual;
    procedure HandleEvent(var Event : TEvent);  virtual;
  end;

  PXInputLine = ^TXInputLine;
  TXInputLine = object(TInputLine)
    procedure HandleEvent(var Event : TEvent);  virtual;
  end;

const
  RightMouseButtonIsEdit:Boolean = TRUE;    {* when right mouse button is *}
                                            {* pressed in list box,       *}
                                            {* activate EditItem method?  *}

type
  PListViewer2 = ^TListViewer2;
  TListViewer2 = object(TListViewer)
    TypedStr : PString;
    TypedStrIndex : word;
    constructor Init(var Bounds: TRect; ANumCols: Integer; AHScrollBar, AVScrollBar: PScrollBar);
    procedure HandleEvent(var Event : TEvent);  virtual;
    procedure InsertItem;  virtual;
    procedure DeleteItem;  virtual;
    procedure EditItem;  virtual;
  end;

{* listbox record to be used by Get- or SetData *}
  TListBoxRec = record
    List: PCollection;
    Selection: Word;
  end;

  PListBox2 = ^TListBox2;
  TListBox2 = object(TListBox)
    TypedStr : PString;
    TypedStrIndex : word;
    constructor Init(var Bounds: TRect; ANumCols: Integer; AVScrollBar: PScrollBar);
    procedure HandleEvent(var Event : TEvent);  virtual;
    procedure InsertItem;  virtual;
    procedure DeleteItem;  virtual;
    procedure EditItem;  virtual;
  end;

  PParamInputBox = ^TParamInputBox;
  TParamInputBox = object(TListBox2)
    procedure InsertItem;  virtual;
    procedure DeleteItem;  virtual;
    procedure EditItem;  virtual;
  end;

  PStringInputBox = ^TStringInputBox;
  TStringInputBox = object(TListBox2)
    procedure InsertItem;  virtual;
    procedure DeleteItem;  virtual;
    procedure EditItem;  virtual;
  end;


procedure DisposeSItem(PS : PSItem);

procedure PrintError(const s : string; AHelpCtx : word);
procedure PrintWarning(const s : string; AHelpCtx : word);
function  PromptUser(const s : string; AHelpCtx : word) : word;
function  UserAnswer(const s : string; AHelpCtx : word) : word;
function  popAnswer(const s : string; AHelpCtx : word) : word;
function  InputString(Header : string; var s : string; len : word; AllowedChars : string; AHelpCtx : word) : word;
function  InputWord(Header : string; var w : word; len : word; AHelpCtx : word) : word;
procedure InfoBox(const s : string; AHelpCtx : word);
function  ExecDialog(P : PDialog; Data : pointer): word;
function  CheckExecDialog(P : PDialog; Data: pointer; DataSize : word): word;
function  PassWord(const s : string; AHelpCtx : word) : Boolean;
procedure InsertButtons(Dialog : PDialog; AOptions : word);

{ procedures to show a progress dialog box }

procedure OpenProgressDlg(const ATitle : string; ATotal : longint);
procedure CloseProgressDlg;
procedure SetProgressDlg(Position : longint);
procedure ProgressDlgNewText(const s : string);


{ procedure to popup a help window }

procedure ShowHelpWindow(const FileName : string; HelpCtx : word);


{ procedure to insert window with a text file as contents }

procedure ViewAsText(const FileName: FNameStr);


{ MessageBox displays the given string in a standard sized      }
{ dialog box. Before the dialog is displayed the Msg and Params }
{ are passed to FormatStr.  The resulting string is displayed   }
{ as a TStaticText view in the dialog.                          }

function MessageBox(const Msg: string; Params: pointer; AOptions: word;
  AHelpCtx : word): word;

{ MessageBoxRec allows the specification of a TRect for the     }
{ message box to occupy.                                        }

function MessageBoxRect(var R: TRect; const Msg: string; Params: pointer;
  AOptions: word; AHelpCtx : word): word;



procedure RegisterBBDlg;


const
  RPopupMenu: TStreamRec = (
    ObjType: 1920;
    VmtLink: Ofs(TypeOf(TPopupMenu)^);
    Load:    @TPopupMenu.Load;
    Store:   @TPopupMenu.Store
  );

const
  RSpinButton: TStreamRec = (
    ObjType: 1921;
    VmtLink: Ofs(TypeOf(TSpinButton)^);
    Load:    @TSpinButton.Load;
    Store:   @TSpinButton.Store
  );

const
  RXInputLine : TStreamRec = (
    ObjType: 1922;
    VmtLink: Ofs(TypeOf(TXInputLine)^);
    Load:    @TXInputLine.Load;
    Store:   @TXInputLine.Store
  );

const
  RListViewer2: TStreamRec = (
    ObjType: 1923;
    VmtLink: Ofs(TypeOf(TListViewer2)^);
    Load:    @TListViewer2.Load;
    Store:   @TListViewer2.Store
  );

const
  RListBox2: TStreamRec = (
    ObjType: 1924;
    VmtLink: Ofs(TypeOf(TListBox2)^);
    Load:    @TListBox2.Load;
    Store:   @TListBox2.Store
  );

const
  RParamInputBox: TStreamRec = (
    ObjType: 1925;
    VmtLink: Ofs(TypeOf(TParamInputBox)^);
    Load:    @TParamInputBox.Load;
    Store:   @TParamInputBox.Store
  );

const
  RStringInputBox: TStreamRec = (
    ObjType: 1926;
    VmtLink: Ofs(TypeOf(TStringInputBox)^);
    Load:    @TStringInputBox.Load;
    Store:   @TStringInputBox.Store
  );





implementation

uses App, HelpFile, Editors, ViewText,
     BBConst, BBGui, BBUtil, BBFile, BBError, BBStrRes;



const
  cmProgressDlg_Add = 1000;
  cmProgressDlg_Set = 1001;

type
  PMyInputLine = ^TMyInputLine;
  TMyInputLine = object(TXInputLine)
    AllowedChars : string;        {* if empty all chars are allowed *}
    constructor Init(var Bounds : TRect; AMaxLen : integer; AnAllowedChars : string);
    procedure HandleEvent(var Event : TEvent);  virtual;
  end;

  PPasswordInputLine = ^TPasswordInputLine;
  TPasswordInputLine = object(TInputLine)
    procedure Draw;  virtual;
  end;

  PPercentBar = ^TPercentBar;
  TPercentBar = object(TView)
    constructor Init(Bounds: TRect);
    procedure Draw; virtual;
    function GetPalette: PPalette; virtual;
    procedure Update(APercent : word);
    function Valid(Command: Word): Boolean; virtual;
  private
    Percent: Integer;
  end;

  PProgressDlg = ^TProgressDlg;
  TProgressDlg = object(TDialog)
    Percent : integer;       {* 0..100% *}
    Total : longint;
    PercDisplay : PStaticText;
    PercentBar : PPercentBar;
    TextDisplay : PStaticText;
    constructor Init(var Bounds : TRect; ATitle : TTitleStr; ATotal : longint);
    procedure SetPerc(Position : longint);
    procedure NewText(const s : string);
  private
    LastPosition : longint;
    Limit : longint;
  end;

const
  ProgressDlg:PProgressDlg = nil;



procedure DisposeSItem(PS : PSItem);
{ PRE - PS = nil or not nil }
begin
  if PS <> nil then  begin
    DisposeSItem(PS^.next);
    DisposeStr(PS^.value);
    Dispose(PS);
  end;
end;


function MessageBox(const Msg : string; Params: pointer; AOptions: word;
  AHelpCtx : word): word;
var
  R: TRect;
begin
  R.Assign(0, 0, 40, 9);
  R.Move((Desktop^.Size.X - R.B.X) div 2, (Desktop^.Size.Y - R.B.Y) div 2);
  MessageBox := MessageBoxRect(R, Msg, Params, AOptions, AHelpCtx);
end;


procedure InsertButtons(Dialog : PDialog; AOptions : word);
{* inserts language specific buttons in any dialog *}
const
  ButtonName: array[0..4] of string[6] =
    ('~Y~es', '~N~o', 'O~K~', 'Cancel', 'Help');
const
  Commands: array[0..4] of word =
    (cmYes, cmNo, cmOK, cmCancel, cmHelp);
var
  I, X, ButtonCount: Integer;
  Control: PView;
  R : TRect;
  ButtonList: array[0..4] of PView;
begin
  with Dialog^ do  begin
    X := -2;
    ButtonCount := 0;
    for I := 0 to 4 do
      if AOptions and ($0100 shl I) <> 0 then  begin
        R.Assign(0, 0, 10, 2);
        if I in [0, 2]
         then  begin
           if Strings = nil
            then  Control := New(PButton, Init(R, ButtonName[I], Commands[i], bfDefault))
            else  begin
              if rsGet(sButtonYes+I) = ''
               then  Control := New(PButton, Init(R, ButtonName[I], Commands[i], bfDefault))
               else  Control := New(PButton, Init(R, rsGet(sButtonYes+I), Commands[i],bfDefault));
            end;
         end
         else  begin
           if Strings = nil
            then  Control := New(PButton, Init(R, ButtonName[I], Commands[i], bfNormal))
            else  begin
              if rsGet(sButtonYes+I) = ''
               then  Control := New(PButton, Init(R, ButtonName[I], Commands[i], bfNormal))
               else  Control := New(PButton, Init(R, rsGet(sButtonYes+I), Commands[i], bfNormal));
            end;
         end;
        Inc(X, Control^.Size.X + 2);
        ButtonList[ButtonCount] := Control;
        Inc(ButtonCount);
      end;
    X := (Size.X - X) shr 1;
    for I := 0 to ButtonCount - 1 do  begin
      Control := ButtonList[I];
      Insert(Control);
      Control^.MoveTo(X, Size.Y - 3);
      Inc(X, Control^.Size.X + 2);
    end;  { of for }
    SelectNext(FALSE);
  end;  { of with }
end;


function MessageBoxRect(var R: TRect; const Msg: string; Params: pointer;
  AOptions: word; AHelpCtx : word): word;
const
  Titles: array[0..3] of string[11] =
    ('Warning','Error','Information','Confirm');
var
  Dialog: PDialog;
  Control: PView;
  S: String;
begin
  if Strings = nil
   then
     Dialog := New(PDialog,
      Init(R, Titles[AOptions and $3]))
   else
     Dialog := New(PDialog,
      Init(R, rsGet(sWarning + (AOptions and $3))));
  with Dialog^ do  begin
    R.Assign(3, 2, Size.X - 2, Size.Y - 3);
    FormatStr(S, Msg, Params^);
    Control := New(PStaticText, Init(R, S));
    Insert(Control);
    InsertButtons(Dialog, AOptions);
  end; { of with }
  Dialog^.HelpCtx := AHelpCtx;
  MessageBoxRect := DeskTop^.ExecView(Dialog);
  Dispose(Dialog, Done);
end;


procedure PrintError(const s : string; AHelpCtx : word);
var
  StackFrame : word;
begin
  asm
    mov StackFrame,bp
  end;
  if Application = nil
   then  BBGui.TextPrintError(s, AHelpCtx)
   else  begin
     Beep;
     LogError('Error: ' + s);
     MessageBox(s, nil, mfError + mfOKButton, AHelpCtx);
     if @DumpStack <> nil then  DumpStack(nil, StackFrame);
   end;
end;


procedure PrintWarning(const s : string; AHelpCtx : word);
begin
  if Application = nil
   then  BBGui.TextPrintError(s, AHelpCtx)
   else  begin
     Beep;
     MessageBox(s, nil, mfWarning + mfOKButton, AHelpCtx);
     LogError('Warning: ' + s);
   end;
end;


function PromptUser(const s : string; AHelpCtx : word) : word;
begin
  if Application = nil
   then  begin
     writeln(s);
     PromptUser := cmYes;
   end
   else
     PromptUser := MessageBox(s, nil, mfInformation + mfOKButton, AHelpCtx);
end;

function UserAnswer(const s : string; AHelpCtx : word) : word;
begin
  if Application = nil
   then  UserAnswer := TextUserAnswer(s, AHelpCtx)
   else  UserAnswer := MessageBox(s, nil, mfConfirmation + mfYesNoCancel, AHelpCtx);
end;

function popAnswer(const s : string; AHelpCtx : word) : word;
begin
  popAnswer := UserAnswer(s, AHelpCtx);
end;

constructor TMyInputLine.Init (var Bounds : TRect; AMaxLen : integer; AnAllowedChars : string);
begin
  inherited Init(Bounds, AMaxLen);
  AllowedChars := AnAllowedChars;
end;

procedure TMyInputLine.HandleEvent (var Event : TEvent);
begin
  if (AllowedChars <> '') and (Event.What and evKeyBoard <> 0) and
     (Event.CharCode in [#32..#255]) then  begin
    if Pos(Event.CharCode, AllowedChars) = 0 then  begin
      Event.CharCode := UpCase(Event.CharCode);
      if Pos(Event.CharCode, AllowedChars) = 0 then  begin
        ClearEvent(Event);
        Beep;
      end;
    end;
  end;
  inherited HandleEvent(Event);
end;

function InputString(Header : string; var s : string; len : word;
  AllowedChars : string; AHelpCtx : word) : word;
var
  R: TRect;
  Dialog : PDialog;
begin
  R.Assign(0, 0, 40, 7);
  R.Move((Desktop^.Size.X - R.B.X) div 2, (Desktop^.Size.Y - R.B.Y) div 2);
  Dialog := New(PDialog, Init(R, Header));
  Dialog^.HelpCtx := AHelpCtx;
  if len < Dialog^.Size.X-1
   then  R.Assign(2,2, 2+2+len,3)
   else  R.Assign(2,2, Dialog^.Size.X-2, 3);
  Dialog^.Insert(New(PMyInputLine, Init(R, len, AllowedChars)));
  InsertButtons(Dialog, mfOKCancelHelp);
  InputString := ExecDialog(Dialog, @s);
end;

function InputWord(Header : string; var w : word; len : word; AHelpCtx : word) : word;
var
  s : string;
begin
  s := '';
  InputWord := InputString(Header, s, len, Numbers, AHelpCtx);
  w := ValW(s);
end;

procedure InfoBox(const s : string; AHelpCtx : word);
begin
  if Application = nil
   then  BBGui.TextInfoBox(s, AHelpCtx)
   else  MessageBox(s, nil, mfInformation + mfOKButton, AHelpCtx);
end;

function ExecDialog(P : PDialog; Data : pointer): word;
var
  Result: Word;
begin
  Result := cmCancel;
  P := PDialog(Application^.ValidView(P));
  if P <> nil then
  begin
    if Data <> nil then P^.SetData(Data^);
    Result := DeskTop^.ExecView(P);
    if (Result <> cmCancel) and (Data <> nil) then P^.GetData(Data^);
    Dispose(P, Done);
  end;
  ExecDialog := Result;
end;


function CheckExecDialog(P : PDialog; Data: pointer; DataSize : word): word;
var
  Result: Word;
begin
  Result := cmCancel;
  P := PDialog(Application^.ValidView(P));
  if P <> nil then
  begin
    if Data <> nil then begin
      if P^.DataSize <> DataSize then  begin
        PrintError('Internal error. DataSize mismatch -- CheckExecDialog --', hcNoContext);
        Halt(1);
      end;
      P^.SetData(Data^);
    end;
    Result := DeskTop^.ExecView(P);
    if (Result <> cmCancel) and (Data <> nil) then P^.GetData(Data^);
    Dispose(P, Done);
  end;
  CheckExecDialog := Result;
end;



procedure TPasswordInputLine.Draw;
var
  s : string;
  i : integer;
begin
  s := Data^;
  for i := 1 to length(s) do  Data^[i] := '*';
  inherited Draw;
  Data^ := s;
end;

function PassWord(const s : string; AHelpCtx : word) : Boolean;
var
  R : TRect;
  Dialog : PDialog;
  es : string;
  p : PPalette;
  sc1,sc2 : char;
begin
  R.Assign(0, 0, 40, 9);
  R.Move((Desktop^.Size.X - R.B.X) div 2, (Desktop^.Size.Y - R.B.Y) div 2);
  Dialog := New(PDialog, Init(R, rsGet(sPassword)));
  Dialog^.HelpCtx := AHelpCtx;
  R.Assign(2,2, 39,3);
  Dialog^.Insert(New(PStaticText, Init(R, rsGet(sEnterPassword))));
  R.Assign(4,4, 4+16+2,5);
  Dialog^.Insert(New(PPasswordInputLine, Init(R, PassWordLen)));
  InsertButtons(Dialog, mfOKCancel);
  PButton(Dialog^.Current^.Prev)^.AmDefault := TRUE;
  if DeskTop^.ExecView(Dialog) = cmCancel
   then  PassWord := FALSE
   else  begin
     Dialog^.GetData(es);
     if UpStr(es) = UpStr(s)
      then  PassWord := TRUE
      else  PassWord := FALSE;
   end;
end;



{---------------------------------------------------------------------------}
{* TProgressDlg                                                            *}
{---------------------------------------------------------------------------}

constructor TPercentBar.Init(Bounds: TRect);
begin
  inherited Init(Bounds);
  Percent := 0;
end;

procedure TPercentBar.Draw;
var
  Color : byte;
  i : integer;
  B : TDrawBuffer;
  Temp : string;
  PerSize : integer;
begin
  if Percent = 100
   then  PerSize := Size.X
   else  PerSize := (longint(Percent)*Size.X) div 100;

  Temp := RepChar(#177, Size.X);

  for i := 1 to Size.X do  begin
    if i <= PerSize
     then  Color := GetColor(2)   { use #20 for completed }
     else Color := GetColor(1);   { and #19 for incomplete 'area' of bar }

    MoveChar(B[i-1], Temp[i], Color, 1); { copy temp str into buffer }
  end;  { of for i }

  WriteBuf(0, 0, Size.X, 1, B);   { write buffer into view }
end;

function TPercentBar.GetPalette: PPalette;
const P:string[2] = #19#20;
begin
  GetPalette := @P;
end;

procedure TPercentBar.Update(APercent : word);
begin
  Percent := APercent;
  DrawView;
end;

function TPercentBar.Valid(Command: Word): Boolean;
begin
  if Command = cmValid
   then  Valid := (Size.X >= 10) and (Size.Y = 1)
   else  Valid := inherited Valid(Command);
end;


constructor TProgressDlg.Init(var Bounds : TRect; ATitle : TTitleStr; ATotal : longint);
var
  R : TRect;
begin
  inherited Init(Bounds, ATitle);
  if ATotal = 0
   then  Total := 1
   else  Total := ATotal;
  Limit := Round(0.025 * Total);
  R.Assign(Size.X-4-4,3, Size.X-4,4);
  Percent := 0;
  PercDisplay := New(PStaticText, Init(R, '  0%'));
  Insert(PercDisplay);
  R.Assign(4,4, Size.X-4,5);
  PercentBar := New(PPercentBar, Init(R));
  Insert(PercentBar);
  R.Assign(3,2, Size.X-3,3);
  TextDisplay := New(PstaticText, Init(r, ''));
end;

procedure TProgressDlg.SetPerc(Position : longint);
begin
  if (Position - LastPosition) < Limit then  Exit;
  LastPosition := Position;
  Lock;
  FreeStr(PercDisplay^.Text);
  if Position >= Total
   then  begin
     PercDisplay^.Text := NewStr('100%');
     Percent := 100;
   end
   else  begin
     PercDisplay^.Text := NewStr(' '+StrW(Percent)+'%');
     Percent := (Position*100) div Total;
   end;
  PercentBar^.Update(Percent);
  Redraw;
  Unlock;
end;

procedure TProgressDlg.NewText(const s : string);
begin
  FreeStr(TextDisplay^.Text);
  TextDisplay^.Text := NewStr(s);
  TextDisplay^.Draw;
end;


procedure OpenProgressDlg(const ATitle : string; ATotal : longint);
var
  R : TRect;
begin
  if Application = nil
   then  TextOpenProgressDlg(ATitle, ATotal)
   else  begin
     R.Assign(0, 0, 40, 8);
     R.Move((Desktop^.Size.X - R.B.X) div 2, (Desktop^.Size.Y - R.B.Y) div 2);
     ProgressDlg := New(PProgressDlg, Init(R, ATitle, ATotal));
     DeskTop^.Insert(ProgressDlg);
   end;
end;

procedure CloseProgressDlg;
begin
  if Application = nil
   then  TextCloseProgressDlg
   else  begin
     if ProgressDlg <> nil then  begin
       DeskTop^.Delete(ProgressDlg);
       Discard(ProgressDlg);
     end;
   end;
end;

procedure SetProgressDlg(Position : longint);
begin
  if Application = nil
   then  TextSetProgressDlg(Position)
   else  begin
     if ProgressDlg <> nil then
       ProgressDlg^.SetPerc(Position);
   end;
end;

procedure ProgressDlgNewText(const s : string);
begin
  if ProgressDlg <> nil then
    ProgressDlg^.NewText(s);
end;


{---------------------------------------------------------------------------}
{* ShowHelpWindow                                                          *}
{---------------------------------------------------------------------------}

procedure ShowHelpWindow(const FileName : string; HelpCtx : word);
var
  W : PWindow;
  HFile : PHelpFile;
  HelpStrm : PBufStream;
begin
  HelpStrm := New(PBufStream, Init(FileName, stOpenRead, 1024));
  HFile := New(PHelpFile, Init(HelpStrm));
  if HelpStrm^.Status = stOk
   then  begin
      W := New(PHelpWindow,Init(HFile, HelpCtx));
      if Application^.ValidView(W) <> nil then  begin
        Application^.ExecView(W);
        Dispose(W, Done);
      end;
   end
   else  begin
     PrintError(rsGet1(word(HelpStrm^.Status), longint(@FileName)), hcNoContext);
     Dispose(HFile, Done);
   end;
end;


{---------------------------------------------------------------------------}
{* ViewAsText                                                              *}
{---------------------------------------------------------------------------}

procedure ViewAsText(const FileName : FNameStr);
{* copied from /bp/examples/dos/tvfm/tools.pas *}
var
  T : PTextWindow;
  R : TRect;
begin
  R.Assign(0,0,72,15);
  T := New(PTextWindow, Init(R, FileName));
  T^.Options := T^.Options or ofCentered;
  Desktop^.Insert(T);
end;


{---------------------------------------------------------------------------}
{* TPopUpMenuBox                                                           *}
{---------------------------------------------------------------------------}

destructor TPopupMenu.Done;
{ This destructor has to be defined, because TMenuPopup.Done won't dispose the
  menulist
}
begin
  DisposeMenu(Menu);
  inherited Done;
end;


{---------------------------------------------------------------------------}
{* TSpinButton                                                             *}
{---------------------------------------------------------------------------}

constructor TSpinButton.Init(var Bounds : TRect; AStrings : PSItem);
begin
  inherited Init(Bounds, AStrings);
  SetCursor(1,0);
end;

procedure TSpinButton.Draw;
var
  Buf : TDrawBuffer;
  Attrs : word;
begin
  if GetState(sfSelected)
   then  Attrs := GetColor($0402)
   else  Attrs := GetColor($0301);
  MoveChar(Buf, ' ', Lo(Attrs), Size.X);
  if Sel < Strings.Count then
    MoveCStr(Buf, #17 + LeftJustify(PString(Strings.At(Sel))^, Size.X)+#16, Attrs);
  WriteBuf(0,0, Size.X, Size.Y, Buf);
end;

procedure TSpinButton.HandleEvent(var Event : TEvent);

  procedure HandleMouse;
  var
    MouseLoc : TPoint;
  begin
    if (Event.What and (evMouseDown+evMouseAuto) <> 0) then  begin
      repeat
        MakeLocal(Event.Where, MouseLoc);
        if MouseLoc.X = 0
         then  begin
           if Sel = 0
            then  Sel := Strings.Count-1
            else  Dec(Sel);
         end
         else
           if MouseLoc.X = Size.X-1
            then  begin
              if Sel = Strings.Count-1
               then  Sel := 0
               else  Inc(Sel);
            end
            else  begin
              ClearEvent(Event);
              Exit;
            end;
        MovedTo(Sel);
        DrawView;
      until not MouseEvent(Event, evMouseAuto); {Wait for mouse up}
      ClearEvent(Event);
    end;
  end;

begin
  TView.HandleEvent(Event);
  HandleMouse;
  inherited HandleEvent(Event);
end;


{---------------------------------------------------------------------------}
{* TXInputLine                                                             *}
{---------------------------------------------------------------------------}

procedure TXInputLine.HandleEvent (var Event : TEvent);

  procedure ClipPaste(var Buf : PEditBuffer;
                      Offset, Length : word);
  var
    rec : string;
  begin
     rec := '';
     {--- Check to make sure we don't exceed field length ---}
     if Length > MaxLen then
       Length := MaxLen;

     {--- Copy contents of clipboard to input line ---}
     Move(Buf^[Offset], Rec[1], Length);

     {--- Set the length of the string ---}
     Rec[0] := Char(Length);

     {--- Set the data in the dialog ---}
     SetData(rec);
  end;

  procedure ClipCopy;
  var
    s : string;
  begin
     GetData(s);
     s := FTCopy(s, SelStart+1, SelEnd);
     ClipBoard^.InsertText(@s[1], length(s), TRUE);
  end;

const
  Boundary = '!@#$%^&*()-+=[]{};''`:"~\ ,./|<>?';
var
  s : string;
begin
  inherited HandleEvent(Event);
  case Event.What of
    evKeyBoard : begin
        case Event.KeyCode of
          kbCtrlLeft : begin
              if SelStart <> SelEnd then  SelectAll(FALSE);
              GetData(s);

            {* go left if on boundary *}
              while (CurPos > 0) and (Pos(s[CurPos], Boundary) <> 0) do  Dec(CurPos);

            {* go left, until boundary is found or edge is reached *}
              while (CurPos > 0) and (Pos(s[CurPos], Boundary) = 0) do  Dec(CurPos);

              if CurPos < FirstPos then
                Dec(FirstPos, FirstPos - CurPos);
              DrawView;
            end;
          kbCtrlRight : begin
              if SelStart <> SelEnd then  SelectAll(FALSE);
              GetData(s);

            {* go right, until boundary is found or edge is reached *}
              while (CurPos < length(s)) and (Pos(s[CurPos+1], Boundary) = 0) do  Inc(CurPos);

            {* go right if current character is a boundary *}
              while (CurPos < length(s)) and (Pos(s[CurPos+1], Boundary) <> 0) do  Inc(CurPos);

              if CurPos > FirstPos + Size.X-2 then
                Inc(FirstPos, CurPos - (Size.X - 2));
              DrawView;
            end;
          kbShiftIns : begin
              with ClipBoard^ do
                ClipPaste(Buffer, BufPtr(SelStart), SelEnd - SelStart);
            end;
          kbCtrlIns : ClipCopy;
        else  Exit;
        end;  { of case }
        ClearEvent(Event);
      end;
    evCommand : begin
        case Event.Command of
          cmPaste : with ClipBoard^ do
                      ClipPaste(Buffer, BufPtr(SelStart), SelEnd - SelStart);
          cmCopy : ClipCopy;
        else  Exit;
        end; { of case }
        ClearEvent(Event);
      end;
  end; { of case }
end;


{---------------------------------------------------------------------------}
{* TListViewer2 and TListBox2                                              *}
{---------------------------------------------------------------------------}

constructor TListViewer2.Init(var Bounds: TRect; ANumCols: Integer;
  AHScrollBar, AVScrollBar: PScrollBar);
begin
  inherited Init(Bounds, ANumCols, AHScrollBar, AVScrollBar);
  Options := Options or ofPostProcess;
  TypedStr := NewStr(Spc(Size.X div NumCols + 1));
end;

procedure TListViewer2.HandleEvent(var Event : TEvent);
var
  ColWidth : word;
  i : integer;
  P : TPoint;
begin
  i := Focused;
  if RightMouseButtonIsEdit and
     (Event.What and (evMouseDown+evMouseUp) <> 0) and (Event.Buttons = mbRightButton)
   then  begin
     if Event.What = evMouseDown then  begin
       MakeLocal(Event.Where, P);
       inherited HandleEvent(Event);
       if P.Y < Range-TopItem then
         EditItem;
     end;
   end
   else
     inherited HandleEvent(Event);
  if Focused <> i then
    TypedStrIndex := 0;
  case Event.What of
    evCommand : begin
        case Event.Command of
          cmInsertItem, cmBInsertItem : InsertItem;
          cmDeleteItem, cmBDeleteItem : if Focused < Range then  DeleteItem;
          cmEditItem, cmBEditItem : if Focused < Range then  EditItem;
        else  Exit;
        end;  { of case }
      end;
    evBroadCast : begin
        case Event.Command of
          cmReceivedFocus : if Event.InfoPtr = @Self then
                              EnableCommands([cmInsertItem, cmDeleteItem]);
          cmReleasedFocus : if Event.InfoPtr = @Self then
                              DisableCommands([cmInsertItem, cmDeleteItem]);
        else  Exit;
        end; { of case }
      end;
    evKeyboard : begin
        ColWidth := Size.X div NumCols + 1;
        if (Event.CharCode in [#32..#255]) and (TypedStrIndex < ColWidth)
         then  begin
           Inc(TypedStrIndex);
           TypedStr^[TypedStrIndex] := UpCase(Event.CharCode);
           TypedStr^[0] := Chr(TypedStrIndex);
           for i := 0 to Range-1 do  begin
             if UpStr(Copy(GetText(i, ColWidth), 1, TypedStrIndex)) = TypedStr^ then  begin
               inherited FocusItem(i);
               break;
             end;
           end;
         end
         else  begin
           case Event.KeyCode of
             kbDel, kbBack : if TypedStrIndex > 0 then  Dec(TypedStrIndex);
           else  Exit;
           end; { of case }
         end;
      end;
  else  Exit;
  end; { of case }
  if Event.What and evBroadCast = 0 then  ClearEvent(Event);
end;

procedure TListViewer2.InsertItem;
begin
  Abstract;
end;

procedure TListViewer2.DeleteItem;
begin
  Abstract;
end;

procedure TListViewer2.EditItem;
begin
  Abstract;
end;


constructor TListBox2.Init(var Bounds: TRect; ANumCols: Integer; AVScrollBar: PScrollBar);
begin
  inherited Init(Bounds, ANumCols, AVScrollBar);
  Options := Options or ofPostProcess;
  TypedStr := NewStr(Spc(Size.X div NumCols + 1));
end;

procedure TListbox2.HandleEvent(var Event : TEvent);
var
  ColWidth : word;
  i : integer;
  P : TPoint;
begin
  i := Focused;
  if RightMouseButtonIsEdit and
     (Event.What and (evMouseDown+evMouseUp) <> 0) and (Event.Buttons = mbRightButton)
   then  begin
     if Event.What = evMouseDown then  begin
       MakeLocal(Event.Where, P);
       inherited HandleEvent(Event);
       if P.Y < Range-TopItem then
         EditItem;
     end;
   end
   else
     inherited HandleEvent(Event);
  if Focused <> i then
    TypedStrIndex := 0;
  case Event.What of
    evCommand : begin
        case Event.Command of
          cmInsertItem, cmBInsertItem : begin
              if (List^.Count < List^.Limit) or (List^.Delta > 0) then
                InsertItem;
            end;
          cmDeleteItem, cmBDeleteItem : if Focused < Range then  DeleteItem;
          cmEditItem, cmBEditItem : if Focused < Range then  EditItem;
        else  Exit;
        end;  { of case }
      end;
    evBroadCast : begin
        case Event.Command of
          cmReceivedFocus : if Event.InfoPtr = @Self then
                              EnableCommands([cmInsertItem, cmDeleteItem]);
          cmReleasedFocus : if Event.InfoPtr = @Self then
                              DisableCommands([cmInsertItem, cmDeleteItem]);
        else  Exit;
        end; { of case }
      end;
    evKeyboard : begin
        ColWidth := Size.X div NumCols + 1;
        if (Event.CharCode in [#32..#255]) and (TypedStrIndex < ColWidth)
         then  begin
           Inc(TypedStrIndex);
           TypedStr^[TypedStrIndex] := UpCase(Event.CharCode);
           TypedStr^[0] := Chr(TypedStrIndex);
           for i := 0 to Range-1 do  begin
             if UpStr(Copy(GetText(i, ColWidth), 1, TypedStrIndex)) = TypedStr^ then  begin
               inherited FocusItem(i);
               break;
             end;
           end;
         end
         else  begin
           case Event.KeyCode of
             kbDel, kbBack : if TypedStrIndex > 0 then  Dec(TypedStrIndex);
           else  Exit;
           end; { of case }
         end;
      end;
  else  Exit;
  end; { of case }
  if Event.What and evBroadCast = 0 then  ClearEvent(Event);
end;

procedure TListbox2.InsertItem;
begin
  Abstract;
end;

procedure TListbox2.DeleteItem;
begin
  Abstract;
end;

procedure TListbox2.EditItem;
begin
  Abstract;
end;


{---------------------------------------------------------------------------}
{* TParamInputBox                                                          *}
{---------------------------------------------------------------------------}

procedure TParamInputBox.InsertItem;
var
  s : string;
begin
  s := '';
  if InputString('Parameter', s, 255, '', hcNoContext) = cmOK then  begin
    List^.AtInsert(Focused, NewStr(s));
    SetRange(Range+1);
    Inc(Focused);
    DrawView;
  end;
end;

procedure TParamInputBox.DeleteItem;
var
  s : string;
begin
  if Focused >= Range-1 then  Exit;
  if UserAnswer('Delete current item?', hcNoContext) = Yes then  begin
    List^.AtFree(Focused);
    SetRange(Range-1);
    DrawView;
  end;
end;

procedure TParamInputBox.EditItem;
var
  s : string;
begin
  if Focused >= Range-1 then  Exit;
  s := GetStr(PString(List^.At(Focused)));
  if InputString('Parameter', s, 255, '', hcNoContext) = cmOK then  begin
    List^.FreeItem(List^.At(Focused));
    List^.AtPut(Focused, NewStr(s));
    DrawView;
  end;
end;


{---------------------------------------------------------------------------}
{* TStringInputBox                                                         *}
{---------------------------------------------------------------------------}

procedure TStringInputBox.InsertItem;
var
  s : string;
begin
  s := '';
  if InputString('Parameter', s, 255, '', hcNoContext) = cmOK then  begin
    List^.Insert(NewStr(s));
    SetRange(Range+1);
    Inc(Focused);
    DrawView;
  end;
end;

procedure TStringInputBox.DeleteItem;
var
  s : string;
begin
  if UserAnswer('Delete current item?', hcNoContext) = Yes then  begin
    List^.AtFree(Focused);
    SetRange(Range-1);
    DrawView;
  end;
end;

procedure TStringInputBox.EditItem;
var
  s : string;
begin
  s := GetStr(PString(List^.At(Focused)));
  if InputString('Parameter', s, 255, '', hcNoContext) = cmOK then  begin
    List^.FreeItem(List^.At(Focused));
    List^.Insert(NewStr(s));
    DrawView;
  end;
end;


{---------------------------------------------------------------------------}
{* RegisterBBDlg                                                           *}
{---------------------------------------------------------------------------}

procedure RegisterBBDlg;
begin
  RegisterType(RPopupMenu);
  RegisterType(RSpinButton);
  RegisterType(RXInputLine);
  RegisterType(RListViewer2);
  RegisterType(RListBox2);
  RegisterType(RParamInputBox);
  RegisterType(RStringInputBox);
end;


begin
  BBGui.CloseProgressDlg := CloseProgressDlg;
  BBGui.InfoBox := InfoBox;
  BBGui.OpenProgressDlg := OpenProgressDlg;
  BBGui.PrintError := PrintError;
  BBGui.SetProgressDlg := SetProgressDlg;
  BBGui.UserAnswer := UserAnswer;
end.  { of unit BBDlg }