home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / oop.swg / 0056_Another Example of TV Dir Collection.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-28  |  3.9 KB  |  178 lines
  1. {
  2. The following example will demonstrate how to create a listbox
  3. of file items and enable the user to double click on any item and
  4. produce a Message Box with the listbox item selected.
  5. }
  6. {$X+}
  7. Program Simple_ListBox;
  8.  
  9. Uses
  10.   Objects, Drivers, Views, Menus, Dialogs, App, Crt, Dos, MsgBox;
  11.  
  12. Const
  13.  cmNewCollect = 102;
  14.  DisableNewcollect: TCommandSet = [102];
  15.  
  16. Type
  17.  
  18.  Tmyapp = object(Tapplication)
  19.      Constructor Init;
  20.      Procedure Initstatusline; Virtual;
  21.      Procedure Initmenubar; Virtual;
  22.      Procedure NewCollect; Virtual;
  23.      Procedure HandleEvent(var Event: TEvent); Virtual;
  24.    End;
  25.  
  26.   PListBox = ^RListBox;
  27.   RListBox = object(TlistBox)
  28.     Constructor Init(var Bounds:TRect; ANumCols:Word; AScrollBar:
  29.                          PScrollBar);
  30.     Procedure Process;
  31.     Destructor Done; Virtual;
  32.   End;
  33.  
  34.   PMyDialog = ^MyDialog;
  35.   Mydialog = object(Tdialog)
  36.     Constructor Init(var bounds:trect; MyTitle:ttitlestr);
  37.     Destructor done; Virtual;
  38.     Procedure HandleEvent(var Event: TEvent); Virtual;
  39.   End;
  40.  
  41. Var
  42.   NameList: PstringCollection;
  43.   Plist: ^Rlistbox;
  44.   MyApp: Tmyapp;
  45.  
  46. Constructor Mydialog.Init(var Bounds:TRect; MyTitle: TTitleStr);
  47. Begin
  48.   TDialog.Init(Bounds, MyTitle);
  49. End;
  50.  
  51. Destructor Mydialog.Done;
  52. Begin
  53.   TDialog.done;
  54.   Dispose(NameList, Done);
  55.   EnableCommands(DisableNewCollect);
  56. End;
  57.  
  58. Procedure MyDialog.HandleEvent(var Event:TEvent);
  59. var
  60.   Index: integer;
  61. Begin
  62.   TDialog.HandleEvent(Event);
  63.   if (Event.Double = true) and (Event.What = evNothing) then
  64.     begin
  65.       sound(100);
  66.       delay(100);
  67.       nosound;
  68.       Index:=(Plist^.Focused);
  69.       Messagebox(Plist^.GetText(Index,20) ,nil,mfOkButton);
  70.     end;
  71.   ClearEvent(Event);
  72. End;
  73.  
  74. Constructor TMyapp.Init;
  75. Begin
  76.   TApplication.Init;
  77. End;
  78.  
  79. Constructor RListBox.Init(var Bounds:TRect; ANumCols:Word;AScrollBar:
  80.                           PScrollBar);
  81. Begin
  82.   TListBox.Init(Bounds, ANumCols, AScrollBar);
  83. End;
  84.  
  85. Destructor RListBox.Done;
  86. Begin
  87.   Tlistbox.Done;
  88. End;
  89.  
  90. Procedure TMyApp.InitStatusLine;
  91. Var
  92.   R:Trect;
  93. Begin
  94.   GetExtent(R);
  95.   R.A.Y := R.B.Y -1;
  96.   Statusline :=new(Pstatusline, init(R,
  97.   NewStatusDef(0,$FFFF,
  98.   NewStatusKey('~Alt-X~ Exit',kbAltX, cmQuit,
  99.   NewStatusKey('~F10~ Menu',kbF10,cmMenu,
  100.   Nil)),Nil)
  101.   ));
  102. End;
  103.  
  104. Procedure Rlistbox.Process;
  105. var
  106.   DirInfo: SearchRec;
  107. Begin
  108.   NameList:=New(Pstringcollection,Init(50,10));
  109.   With NameList^ do
  110.   Begin
  111.     FindFirst('*.*', Archive, DirInfo);
  112.     while DosError = 0 do
  113.       Begin
  114.         Insert(Newstr(Dirinfo.Name));
  115.         FindNext(DirInfo);
  116.       End;
  117.   End;
  118. End;
  119.  
  120. Procedure TMyApp.NewCollect;
  121. Var
  122.   MyBox: PMyDialog;
  123.   R : TRect;
  124.   pBor : ^TScrollBar;
  125.   Col: word;
  126. Begin
  127.   Plist^.Process;
  128.   R.Assign(10,10,60,20);
  129.   MyBox := New(PmyDialog, Init(R, 'Scroll Collection'));
  130.   Col:=1;
  131.   R.Assign(40, 1, 41, 9);
  132.   PBor:= New(Pscrollbar, Init(R));
  133.   R.Assign(9, 1, 40, 9);
  134.   Plist:=New(PListbox, Init(R,Col,PBor));
  135.   Plist^.Newlist(Namelist);
  136.   MyBox^.Insert(PBor);
  137.   MyBox^.Insert(PList);
  138.   Desktop^.insert(myBox);
  139. End;
  140.  
  141. Procedure TMyApp.HandleEvent(var Event: TEvent);
  142. Begin
  143.   TApplication.HandleEvent(Event);
  144.   if Event.What = evCommand then
  145.     Begin
  146.       case Event.Command of
  147.         cmNewCollect: Begin
  148.                         DisableCommands(DisableNewCollect);
  149.                         Newcollect;
  150.                       End
  151.       else
  152.         ClearEvent(Event);
  153.         Exit;
  154.       End;
  155.       ClearEvent(Event);
  156.     End;
  157. End;
  158.  
  159. Procedure TMyApp.InitMenubar;
  160. var
  161.   R:Trect;
  162. Begin
  163.   GetExtent(R);
  164.   R.B.Y := R.A.Y +1;
  165.   MenuBar :=new(PMenubar, init(R, Newmenu(
  166.   NewSubMenu('~L~istbox Menu',hcnocontext, Newmenu(
  167.   NewItem('~B~ox','',kbF9,cmnewcollect,hcnocontext,
  168.   NewLine(
  169.   NewItem('~E~xit','',kbf10,cmquit,hcnocontext,
  170.   Nil)))), Nil))));
  171. End;
  172.  
  173. Begin
  174.   MyApp.Init;
  175.   MyApp.Run;
  176.   MyApp.Done;
  177. End.
  178.