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 | +--------------------------------------------------------------------------+