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