[comp.lang.pascal] ListBox Dialog example

TOMJ@csdserver3.csd.scarolina.edu (Thomas E. Jenkins, Jr.) (06/05/91)

Hi,

  Someone requested an example listBox dialog box and here's one.  I decided
to do this as a learning exercise; and boy was it.  In the code you'll see
that I used TCollection as my base for the list displayed in the listbox.
Since I didn't want the list sorted, I used TCollection and not
TStringCollection.  TCollection worked fine EXCEPT I ended up losing around
132 bytes EACH time I used the listbox!  Upon careful experimentation ( and
reading the manual closer ) I discovered a couple of things.  One, I had to
replace FreeItem with my own.  FreeItem defaults to calling TObject.Done (
or any decedant's Done ).  Since I was using PStrings, this had non-
desireable effects ;-).  Some of these were error messages such as
208:Overlay manager not loaded - Hmmmm.  Very helpful error message that one
:-(.  Two, the write-ups for TSortedCollection and TStringCollection are
reversed.  Plus there are several bogas items in the general descriptions.
Basicly just look at TSortedCollection for TStringCollection's methods and
visa-a-versa.

PROGRAM ListDialog ;


USES
       App ,
       Objects ,
       Dialogs ,
       StdDlg ,
       Menus ,
       Drivers ,
       Views ,
       Memory ,
       MsgBox ,
       HistList ,
       DOS ;




CONST

       cmTestList                                = 2000 ;
       cmAbout                                   = 2001 ;








TYPE
       TListDialog                               = OBJECT ( TApplication )

         PROCEDURE   InitMenuBar ;
           VIRTUAL ;

         PROCEDURE   InitStatusLine ;
           VIRTUAL ;

         PROCEDURE   HandleEvent ( VAR event     : TEvent ) ;
           VIRTUAL ;

         END ;  {  TListDialog  }



       PMyCollection                             = ^TMyCollection ;
       TMyCollection                             = OBJECT ( TCollection )

         PROCEDURE   FreeItem (     item         : POINTER ) ;
           VIRTUAL ;

         END ;  {  TMyCollection  }




VAR
       item                                      : STRING ;
       mem                                       : LONGINT ;
       memStr                                    : STRING ;
       collection                                : PMyCollection ;





 PROCEDURE   About ;

  VAR
       dialog                                    : PDialog ;
       r                                         : TRect ;
       control                                   : WORD ;

   BEGIN  {  About  }

     r.Assign ( 20 , 5 , 60 , 14 ) ;

     dialog := New ( PDialog ,
                     Init ( r ,
                            'About ... ' ) ) ;

     WITH dialog^
      DO
       BEGIN

         r.Assign ( 9 , 2 , 36 , 3 ) ;

         Insert ( New ( PStaticText ,
                        Init ( r ,
                               'Dialog ListBox Example' ) ) ) ;

         r.Assign ( 10 , 4 , 35 , 5 ) ;

         Insert ( New ( PStaticText ,
                        Init ( r ,
                               'By Thomas E. Jenkins' ) ) ) ;

         r.Assign ( 15 , 6 , 25 , 8 ) ;

         Insert ( New ( PButton ,
                        Init ( r ,
                               '~O~k',
                               cmOk ,
                               bfDefault ) ) ) ;


         END ;  {  WITH  }

     control := deskTop^.ExecView ( dialog ) ;

     Dispose ( dialog , Done ) ;

     END ;  {  About  }




 FUNCTION    ListDlg                             : STRING ;

  VAR
       dialog                                    : PDialog ;
       scrollBar                                 : PScrollBar ;
       lBox                                      : PListBox ;
       r                                         : TRect ;
       control                                   : WORD ;


   BEGIN  {  ListDlg  }

     New ( collection ,                          {  Allocate memory for the }
           Init ( 10 ,                           {  collection here.  Init  }
                  1 ) ) ;                        {  size 20, grow by 10     }

     WITH collection^
      DO
       BEGIN

         Insert ( NewStr ( 'One' ) ) ;
         Insert ( NewStr ( 'Two' ) ) ;
         Insert ( NewStr ( 'Three' ) ) ;
         Insert ( NewStr ( 'Four' ) ) ;
         Insert ( NewStr ( 'Five' ) ) ;
         Insert ( NewStr ( 'Six' ) ) ;
         Insert ( NewStr ( 'Seven' ) ) ;
         Insert ( NewStr ( 'Eight' ) ) ;
         Insert ( NewStr ( 'Nine' ) ) ;
         Insert ( NewStr ( 'Ten' ) ) ;

         END ;  {  WITH collection^  }

     r.Assign ( 20 , 5 , 60 , 19 ) ;

     dialog := New ( PDialog ,
                     Init ( r ,
                            'List Box ... ' ) ) ;

     WITH dialog^
      DO
       BEGIN

         r.Assign ( 17 , 9 , 27 , 11 ) ;

         Insert ( New ( PButton ,
                        Init ( r ,
                               '~C~ancel',
                               cmCancel ,
                               bfNormal ) ) ) ;

         r.Assign ( 5 , 9 , 15 , 11 ) ;

         Insert ( New ( PButton ,
                        Init ( r ,
                               '~O~k',
                               cmOk ,
                               bfDefault ) ) ) ;

         r.Assign ( 23 , 3 , 24 , 7 ) ;

         scrollBar := New ( PScrollBar ,
                            Init ( r ) ) ;

         Insert ( scrollBar ) ;

         r.Assign ( 3 , 3 , 23 , 7 ) ;

         lBox := New ( PListBox ,
                       Init ( r ,
                              1 ,
                              scrollBar ) ) ;

         lBox^.NewList ( collection ) ;

         Insert ( lBox ) ;

         r.Assign ( 3 , 2 , 11 , 3 ) ;

         Insert ( New ( PLabel ,
                        Init ( r ,
                               'Options' ,
                               lBox ) ) ) ;

         END ;  {  WITH  }

     control := deskTop^.ExecView ( dialog ) ;

     IF ( control <> cmCancel )
      THEN
         ListDlg := PString ( lBox^.list^.At ( lBox^.focused ) )^

      ELSE
         ListDlg := '' ;

     Dispose ( dialog , Done ) ;

     Dispose ( collection , Done ) ;

     END ;  {  ListDlg  }



 PROCEDURE   DisplayItem (     item              : STRING ) ;

  VAR
       dialog                                    : PDialog ;
       r                                         : TRect ;
       control                                   : WORD ;

   BEGIN  {  DisplayItem  }

     IF ( item = '' )
      THEN
         Exit ;

     r.Assign ( 20 , 5 , 60 , 14 ) ;

     dialog := New ( PDialog ,
                     Init ( r ,
                            'You selected' ) ) ;

     WITH dialog^
      DO
       BEGIN

         r.Assign ( 9 , 2 , 36 , 3 ) ;

         Insert ( New ( PStaticText ,
                        Init ( r ,
                               item ) ) ) ;

         r.Assign ( 15 , 6 , 25 , 8 ) ;

         Insert ( New ( PButton ,
                        Init ( r ,
                               '~O~k',
                               cmOk ,
                               bfDefault ) ) ) ;


         END ;  {  WITH  }

     control := deskTop^.ExecView ( dialog ) ;

     Dispose ( dialog , Done ) ;

     END ;  {  DisplayItem  }





 PROCEDURE   TMyCollection.FreeItem (     item   : POINTER ) ;

   BEGIN  {  TMyCollection.FreeItem  }

     IF ( item <> NIL )
      THEN
         DisposeStr ( item ) ;

     END ;  {  TMyCollection.FreeItem  }





 PROCEDURE   TListDialog.InitMenuBar ;

  VAR
       r                                         : TRect ;

   BEGIN  {  TListDialog.InitMenuBar  }

     GetExtent ( r ) ;                 {  Get current screen size          }

     r.b.y := ( r.a.y + 1 ) ;          {  Set to one line from top         }

     MenuBar := New ( PMenuBar , Init ( r , NewMenu (
       NewSubMenu ( '~' + #240 + '~' , hcNoContext , NewMenu (
         NewItem ( '~A~bout...' , 'Alt-A' , kbAltA , cmAbout , hcNoContext ,
         NIL ) ) ,
       NewSubMenu ( '~T~est' , hcNoContext , NewMenu (
         NewItem ( '~L~ist dialog...' , 'F3' , kbF3 , cmTestList ,
hcNoContext ,
         NewLine (
         NewItem ( 'E~x~it' , 'ALT-X' , kbAltX , cmQuit , hcNoContext ,
         NIL ) ) ) ) ,
       NIL )
     ) ) ) ) ;

     END ;  {  TListDialog.InitMenuBar  }




 PROCEDURE   TListDialog.InitStatusLine ;

  VAR
       r                                         : TRect ;

   BEGIN  {  TListDialog.InitStatusLine  }

     GetExtent ( r ) ;                           {  Get screen size        }

     r.a.y := r.b.y - 1 ;                        {  Set to one line from   }
                                                 {  Screen size            }
     statusLine := New ( PStatusLine , Init ( r ,
       NewStatusDef ( 0 , $FFFF ,                {  Set context help ranges}
         NewStatusKey ( '~Alt-X~ Exit' , kbAltX , cmQuit ,
         NewStatusKey ( '~F10~ Menu' , kbF10 , cmMenu ,
         NIL ) ) ,
       NIL ) ) ) ;

     END ;  {  TListDialog.InitStatusLine  }




 PROCEDURE   TListDialog.HandleEvent ( VAR event : TEvent ) ;

  VAR
       r                                         : TRect ;

   BEGIN  {  TListDialog.HandleEvent  }

     TApplication.HandleEvent ( event ) ;

     IF ( event.what = evcommand )
      THEN
       BEGIN

         CASE event.command
          OF

            cmTestList :
              BEGIN  {  cmTestList  }

                mem := MemAvail ;

                item := ListDlg ;

                DisplayItem ( item ) ;

                IF ( mem <> MemAvail )
                 THEN
                  BEGIN

                    mem := mem - MemAvail ;

                    Str ( mem , memStr ) ;

                    DisplayItem ( memStr ) ;

                    END ;  {  IF  }

                END ;  {  cmTestList  }

            cmAbout :
              About ;

          ELSE

          END ;  {  CASE  }

         ClearEvent ( event ) ;

         END ;  {  THEN  }

     END ;  {  TListDialog.HandleEvent  }




VAR
       ld                                        : TListDialog ;
       mem1                                      : LONGINT ;




BEGIN

   mem1 := MemAvail ;

  ld.Init ;
  ld.Run ;
  ld.Done ;

  WriteLn ( mem1 , ' - ' , MemAvail ) ;  {  sanity check ;-)  }

END .

tom
+--------------------------------------------------------------------------+
|  Thomas E. Jenkins, Jr.   Programmer, University of South Carolina CSD   |
+--------------------------------------------------------------------------+
| BITNET         :  C0361@UNIVSCVM.BITNET  |  CSDNET  :  tomj/csdserver3   |
| INTERNET       :  TOMJ@csdserver3.csd.scarolina.EDU          {PREFERRED} |
|                :  C0361@univscvm.csd.scarolina.EDU  |  129.252.43.30     |
+--------------------------------------------------------------------------+