[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]

{
The following example will demonstrate how to create a listbox
of file items and enable the user to double click on any item and
produce a Message Box with the listbox item selected.
}
{$X+}
Program Simple_ListBox;

Uses
  Objects, Drivers, Views, Menus, Dialogs, App, Crt, Dos, MsgBox;

Const
 cmNewCollect = 102;
 DisableNewcollect: TCommandSet = [102];

Type

 Tmyapp = object(Tapplication)
     Constructor Init;
     Procedure Initstatusline; Virtual;
     Procedure Initmenubar; Virtual;
     Procedure NewCollect; Virtual;
     Procedure HandleEvent(var Event: TEvent); Virtual;
   End;

  PListBox = ^RListBox;
  RListBox = object(TlistBox)
    Constructor Init(var Bounds:TRect; ANumCols:Word; AScrollBar:
                         PScrollBar);
    Procedure Process;
    Destructor Done; Virtual;
  End;

  PMyDialog = ^MyDialog;
  Mydialog = object(Tdialog)
    Constructor Init(var bounds:trect; MyTitle:ttitlestr);
    Destructor done; Virtual;
    Procedure HandleEvent(var Event: TEvent); Virtual;
  End;

Var
  NameList: PstringCollection;
  Plist: ^Rlistbox;
  MyApp: Tmyapp;

Constructor Mydialog.Init(var Bounds:TRect; MyTitle: TTitleStr);
Begin
  TDialog.Init(Bounds, MyTitle);
End;

Destructor Mydialog.Done;
Begin
  TDialog.done;
  Dispose(NameList, Done);
  EnableCommands(DisableNewCollect);
End;

Procedure MyDialog.HandleEvent(var Event:TEvent);
var
  Index: integer;
Begin
  TDialog.HandleEvent(Event);
  if (Event.Double = true) and (Event.What = evNothing) then
    begin
      sound(100);
      delay(100);
      nosound;
      Index:=(Plist^.Focused);
      Messagebox(Plist^.GetText(Index,20) ,nil,mfOkButton);
    end;
  ClearEvent(Event);
End;

Constructor TMyapp.Init;
Begin
  TApplication.Init;
End;

Constructor RListBox.Init(var Bounds:TRect; ANumCols:Word;AScrollBar:
                          PScrollBar);
Begin
  TListBox.Init(Bounds, ANumCols, AScrollBar);
End;

Destructor RListBox.Done;
Begin
  Tlistbox.Done;
End;

Procedure TMyApp.InitStatusLine;
Var
  R:Trect;
Begin
  GetExtent(R);
  R.A.Y := R.B.Y -1;
  Statusline :=new(Pstatusline, init(R,
  NewStatusDef(0,$FFFF,
  NewStatusKey('~Alt-X~ Exit',kbAltX, cmQuit,
  NewStatusKey('~F10~ Menu',kbF10,cmMenu,
  Nil)),Nil)
  ));
End;

Procedure Rlistbox.Process;
var
  DirInfo: SearchRec;
Begin
  NameList:=New(Pstringcollection,Init(50,10));
  With NameList^ do
  Begin
    FindFirst('*.*', Archive, DirInfo);
    while DosError = 0 do
      Begin
        Insert(Newstr(Dirinfo.Name));
        FindNext(DirInfo);
      End;
  End;
End;

Procedure TMyApp.NewCollect;
Var
  MyBox: PMyDialog;
  R : TRect;
  pBor : ^TScrollBar;
  Col: word;
Begin
  Plist^.Process;
  R.Assign(10,10,60,20);
  MyBox := New(PmyDialog, Init(R, 'Scroll Collection'));
  Col:=1;
  R.Assign(40, 1, 41, 9);
  PBor:= New(Pscrollbar, Init(R));
  R.Assign(9, 1, 40, 9);
  Plist:=New(PListbox, Init(R,Col,PBor));
  Plist^.Newlist(Namelist);
  MyBox^.Insert(PBor);
  MyBox^.Insert(PList);
  Desktop^.insert(myBox);
End;

Procedure TMyApp.HandleEvent(var Event: TEvent);
Begin
  TApplication.HandleEvent(Event);
  if Event.What = evCommand then
    Begin
      case Event.Command of
        cmNewCollect: Begin
                        DisableCommands(DisableNewCollect);
                        Newcollect;
                      End
      else
        ClearEvent(Event);
        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('~L~istbox Menu',hcnocontext, Newmenu(
  NewItem('~B~ox','',kbF9,cmnewcollect,hcnocontext,
  NewLine(
  NewItem('~E~xit','',kbf10,cmquit,hcnocontext,
  Nil)))), Nil))));
End;

Begin
  MyApp.Init;
  MyApp.Run;
  MyApp.Done;
End.

[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]