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

{
672: How to Create a Listbox and Get a Double Click
   Pascal   All       TI-09/30/94

Demonstrates handling double click on a
listbox.

  PRODUCT  :  Pascal                                 NUMBER  :  672
  VERSION  :  All
       OS  :  DOS
     DATE  :  September 30, 1994                       PAGE  :  1/1

    TITLE  :  How to Create a Listbox and Get a Double Click
{

The following example demonstrates how to create a listbox
of file items and enable the user to double click on any item.
This produces a Message Box containing the listbox selected

item.

}
{$X+}
Program Simple_ListBox;

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

Const
 cmNewCollect = 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);
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;
  PBorland: ^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);
  PBorland:= New(PScrollBar, Init(R));
  R.Assign(9, 1, 40, 9);
  Plist:=New(PListbox, Init(R,Col,PBorland));
  Plist^.Newlist(Namelist);
  MyBox^.Insert(PBorland);
  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: Newcollect;
      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;








PRODUCT  :  Turbo Pascal                           NUMBER  :  672
VERSION  :  6.0
     OS  :  MS/PC DOS
   DATE  :  June 23, 1994                            PAGE  :  2/5

  TITLE  :  How to Create a Listbox and Get a Double Click




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


DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that

you received with the Borland product to which this information
pertains.
PACHXA296:PACHXA296

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