Category : Pascal Source Code
Archive   : SHAZAM2.ZIP
Filename : GUNSORT.IMP

{*******************************************************************

GUNSORT.IMP

*******************************************************************}
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

METHODS - UNSORTED STRING COLLECTION

|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================

FREE ITEM

===================================================================}
procedure TUnsortedCollection.FreeItem ( Item : pointer ) ;
begin
DisposeStr ( Item ) ;
end ;
{===================================================================

PUT ITEM

===================================================================}
procedure TUnsortedCollection.PutItem ( VAR S : TStream ; Item : Pointer ) ;
begin
S.WriteStr ( Item ) ;
end ;
{===================================================================

GET ITEM

===================================================================}
function TUnsortedCollection.GetItem ( VAR S : TStream ) : Pointer ;
begin
GetItem := S.ReadStr ;
end ;
{===================================================================

LOAD

===================================================================}
constructor TUnsortedCollection.Load ( VAR S : TStream ) ;
begin
TCollection.Load ( S ) ;
end ;
{===================================================================

STORE

===================================================================}
procedure TUnsortedCollection.Store ( VAR S : TStream ) ;
begin
TCollection.Store ( S ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

EMPTY

|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================

MENUBAR

===================================================================}
function EmptyMenuBar : PMenuBar ;
var
R : TRect ;
begin
Application^.GetExtent ( R ) ;
R.B.Y := R.A.Y + 1 ;
EmptyMenuBar := New ( PMenuBar , Init ( R , NIL ) ) ;
end ;
{===================================================================

STATUSLINE

===================================================================}
function EmptyStatusLine : PStatusLine ;
var
R : TRect ;
begin
Application^.GetExtent ( R ) ;
R.A.Y := R.B.Y - 1 ;
EmptyStatusLine := New ( PStatusLine , Init ( R , NIL ) ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

PSTRING

|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================

SET - "PString" should always start out NIL.

===================================================================}
procedure SetPStr ( VAR P : PString ; S : string ) ;
begin
if P <> NIL then
begin
DisposeStr ( P ) ;
P := NIL ;
end ;
if S = '' then EXIT ;
P := NewStr ( S ) ;
end ;
{===================================================================

GET

===================================================================}
function GetPStr ( P : PString ) : string ;
begin
if P = NIL then
GetPStr := ''
else
GetPStr := P^ ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

DISPOSE - release memory & set pointer to NIL

|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================

COLLECTION

===================================================================}
procedure DisposeCollection ( VAR C ) ;
var
PtrRef : PCollection absolute C ;
begin
if PtrRef = NIL then EXIT ;
Dispose ( PtrRef , Done ) ;
PtrRef := NIL ;
end ;
{===================================================================

VIEW

===================================================================}
procedure DisposeView ( VAR P ) ;
var
AView : PView ABSOLUTE P ;
begin
if AView = NIL then EXIT ;
if AView^.Owner <> NIL then
AView^.Owner^.Delete ( AView ) ;
Dispose ( AView , Done ) ;
AView := NIL ;
end ;
{===================================================================

MENUBOX

===================================================================}
procedure DisposeMenuBox ( VAR Box : PMenuBox ) ;
begin
if Box = NIL then EXIT ;
if Box^.Owner <> NIL then
Box^.Owner^.Delete ( Box ) ;
DisposeMenu ( Box^.Menu ) ;
Dispose ( Box , Done ) ;
Box := NIL ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

MENUBOX

|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================

EXEC - Insert, get command and dispose.

===================================================================}
procedure ExecMenu ( G : PGroup ; Box : PMenuBox ; VAR Event : TEvent ) ;
begin
if Box = NIL then EXIT ;
if Box^.Owner = NIL then
G^.Insert ( Box ) ;
G^.ClearEvent ( Event ) ;
Event.Command := G^.ExecView ( Box ) ;
DisposeMenuBox ( Box ) ;
if Event.Command = 0 then EXIT ;
Event.What := evCommand ;
G^.PutEvent ( Event ) ;
end ;