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

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

GEVENT.IMP

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

ZOOM

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

UNZOOM - shrink

===================================================================}
procedure hdUnZoom ;
{-------------------------------------------------------------------
Shrink if full size
-------------------------------------------------------------------}
procedure Action ( P : PView ) ; FAR ;
begin
if IsZoomed ( P ) then
Message ( P , evCommand , cmZoom , NIL ) ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
Desktop^.ForEach ( @Action ) ;
end ;
{===================================================================

ZOOM - expand

===================================================================}
procedure hdZoom ;
{-------------------------------------------------------------------
Expand if not full size
-------------------------------------------------------------------}
procedure Action ( P : PView ) ; FAR ;
begin
if not IsZoomed ( P ) then
Message ( P , evCommand , cmZoom , NIL ) ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
Desktop^.ForEach ( @Action ) ;
end ;
{===================================================================

ALL ZOOMED - return FALSE if any window not zoomed

===================================================================}
function AllZoomed : boolean ;
var
w : word ;
{-------------------------------------------------------------------
Is it full size?
-------------------------------------------------------------------}
procedure Action ( P : PView ) ; FAR ;
begin
if not Zoomable ( P ) then EXIT ;
if not IsZoomed ( P ) then inc ( w ) ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
w := 0 ;
Desktop^.ForEach ( @Action ) ;
AllZoomed := w = 0 ;
end ;
{===================================================================

ZOOM ALL

===================================================================}
procedure hdZoomAll ;
begin
if AllZoomed then
hdUnZoom
else
hdZoom ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

MISC

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

TILE - VERTICAL (standard)

===================================================================}
procedure hdTile ;
var
R : TRect ;
begin
Desktop^.GetExtent ( R ) ;
Desktop^.Tile ( R ) ;
end ;
{===================================================================

CASCADE

===================================================================}
procedure hdCascade ;
var
R : TRect ;
begin
Desktop^.GetExtent ( R ) ;
Desktop^.Cascade ( R ) ;
end ;
{===================================================================

DIRECTORY

===================================================================}
procedure hdChangeDir ;
begin
ExecDialog ( New ( PChDirDialog ,
Init ( cdNormal , 0 ) ) , NIL ) ;
hdRefreshDisplay ;
end ;
{===================================================================

SHOW

===================================================================}
procedure hdShowClipboard ;
begin
ClipWindow^.Select ;
ClipWindow^.Show ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

DISPLAY

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

COPY SCREEN - copy from saved buffer to the Clipboard

===================================================================}
procedure hdCopyScreen ;
var
y : byte ;
Ch : char ;
S : string ;
begin
ClipWindow^.Hide ;
VisionOFF ;
PullScreen ; { From saved buffer }
with ClipWindow^.Editor^ do
begin
SetSelect ( 0 , BufLen , TRUE ) ; { all text }
DeleteSelect ; { dump it }
for y := 1 to BiosHeight do { ROW }
begin
S := GetLine ( y , SaveScreen ) ;
S := TrimRight ( S , #32 ) ;
InsertText ( @S[1] , length ( S ) , FALSE ) ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
AVOID CR/LF ON LAST LINE
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
if y < BiosHeight then
begin
Ch := #13 ;
InsertText ( @Ch , 1 , FALSE ) ; { add CR }
Ch := #10 ; { add LF }
InsertText ( @Ch , 1 , FALSE ) ;
end ;
end ;
end ;
VisionON ;
ClipWindow^.Select ;
ClipWindow^.Show ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Goto top line
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
Message ( ClipWindow , evKeyDown , kbCtrlPgUp , NIL ) ;
end ;
{===================================================================

REDRAW

===================================================================}
procedure hdRefreshDisplay ;
begin
DoneMemory ; { Dump cache buffers }
Application^.Redraw ; { Redisplay all }
end ;
{===================================================================

USER SCREEN

===================================================================}
procedure hdUserScreen ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
procedure Hide ( P : PView ) ; FAR ;
begin
P^.Hide ;
end ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
procedure Show ( P : PView ) ; FAR ;
begin
P^.Show ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
var
Event : TEvent ;
begin
if SaveScreen = NIL then EXIT ;
HideMouse ;
Application^.ForEach ( @Hide ) ;
Application^.Hide ;
Message ( Application ,
evBroadcast ,
cmCommandSetChanged ,
NIL ) ;
VisionOFF ;
InitEvents ;
PullScreen ; { From saved buffer }
Application^.ClearEvent ( Event ) ;
while Event.What = evNothing do
begin
Application^.GetEvent ( Event ) ;
case Event.What of
evCommand : ;
evBroadCast : ;
evKeyDown : ;
evMouseDown : ;
else
Application^.ClearEvent ( Event ) ;
end ;
end ;
DoneEvents ;
VisionON ;
Application^.ClearEvent ( Event ) ;
Application^.ForEach ( @Show ) ;
Application^.Show ;
ShowMouse ;
hdRefreshDisplay ; { redraw screen }
Message ( Application ,
evBroadcast ,
cmCommandSetChanged ,
NIL ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

PALETTE & COLOR

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

COLOR

===================================================================}
procedure hdColor ;
begin
AppPalette := apColor ;
hdRefreshDisplay ;
end ;
{===================================================================

BW

===================================================================}
procedure hdBlackWhite ;
begin
AppPalette := apBlackWhite ;
hdRefreshDisplay ;
end ;
{===================================================================

MONO

===================================================================}
procedure hdMonochrome ;
begin
AppPalette := apMonochrome ;
hdRefreshDisplay ;
end ;
{===================================================================

RESET

===================================================================}
procedure hdResetColors ;
var
SaveAppPalette : integer ;
S : string ;
begin
SaveAppPalette := AppPalette ;
AppPalette := apColor ;
S := CColor ;
Move ( S [1] , Application^.GetPalette^[1] , length ( CColor ) ) ;

AppPalette := apBlackWhite ;
S := CBlackWhite ;
Move ( S [1] , Application^.GetPalette^[1] , length ( CBlackWhite ) ) ;

AppPalette := apMonochrome ;
S := CMonochrome ;
Move ( S [1] , Application^.GetPalette^[1] , length ( CMonochrome ) ) ;

AppPalette := SaveAppPalette ;
hdRefreshDisplay ;
end ;
{===================================================================

EGA/VGA

===================================================================}
procedure hdVideoMode ;
var
NewMode : Word ;
begin
NewMode := ScreenMode xor smFont8x8;
if NewMode and smFont8x8 <> 0 then
ShadowSize.X := 1 { EGA/VGA }
else
ShadowSize.X := 2 ; { 25-line }
Application^.SetScreenMode ( NewMode ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

DESKTOP

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

CLEAR - prompt first

===================================================================}
function hdClearDesktop : boolean ;
begin
hdClearDesktop := FALSE ;
if not Desktop^.Valid ( cmClose ) then EXIT ; { prompt for save }
CloseAll ; { dump'em }
ClearHistory ; { free heap }
hdClearDesktop := TRUE ;
end ;
{===================================================================

SAVE DESKTOP

===================================================================}
procedure hdSaveDesktop ;
begin
if not Desktop^.Valid ( cmClose ) then EXIT ; { prompt for save }
SaveDesktopTo ( DesktopName , 'Desktop File' ) ;
end ;
{===================================================================

LOAD DESKTOP

===================================================================}
procedure hdLoadDesktop ;
begin
if not Desktop^.Valid ( cmClose ) then EXIT ; { prompt for save }
LoadDesktopFrom ( DesktopName ) ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

EXEC

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

EXEC - normal or Turbo Vision

===================================================================}
function VisionExec ( Path , CmdLine : string ) : word ;
var
DosScreen : boolean ;
{-------------------------------------------------------------------
MSG
-------------------------------------------------------------------}
procedure ShellMsg ;
begin
PrintStr ( #13#10 ) ;
PrintStr ( ' ÞßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÝ'#13#10 ) ;
PrintStr ( ' Þ Type EXIT to return to the program... Ý'#13#10 ) ;
PrintStr ( ' ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÝ'#13#10 ) ;
end ;
{-------------------------------------------------------------------
OFF
-------------------------------------------------------------------}
function AppOFF : boolean ;
begin
AppOFF := FALSE ;
if DesktopName = '' then
VisionOFF
else
begin
if not Desktop^.Valid ( cmClose ) then EXIT ;
SaveDesktopTo ( DesktopName , 'Temporary EXEC - Desktop file' ) ;
CloseAll ;
DisposeClipboard ;
ClearHistory ;
DoneHistory ;
VisionOFF ;
if BufHeapSize > 0 then
DoneBuffers ; { restore heap }
end ;
if DosScreen then
PopScreen ;
AppOFF := TRUE ;
end ;
{-------------------------------------------------------------------
ON
-------------------------------------------------------------------}
procedure AppON ;
begin
if DosScreen then
PushScreen ;
if DesktopName = '' then
VisionON
else
begin
if BufHeapSize > 0 then
InitBuffers ;
VisionON ;
InitHistory ;
LoadDesktopFrom ( DesktopName ) ;
CreateClipboard ;
end ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
VisionExec := $FFFF ;
DosScreen := SaveScreen <> NIL ;
if Application <> NIL then
if not AppOFF then EXIT ;
if ( Path = GetEnv ( 'COMSPEC' ) ) and ( CmdLine = '' ) then
ShellMsg ;
VisionExec := EXECPROC.Exec ( Path , CmdLine ) ;
if Application <> NIL then
AppON ;
end ;
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

SHELL - "VisionExec" saves desktop & takes care of "house cleaning"

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

LITTLE - Available memory only. "DesktopName" blanked so
Desktop is not saved/loaded (avoid disk/diskette access).

===================================================================}
procedure hdLittleDOS ;
var
Temp : PathStr ;
begin
EXECPROC.UseExecSwap := FALSE ;
Temp := DesktopName ;
DesktopName := '' ;
VisionExec ( GetEnv ( 'COMSPEC' ) , '' ) ;
DesktopName := Temp ;
end ;
{===================================================================

MEDIUM - Desktop is saved, then cleared. Reloaded on return.

===================================================================}
procedure hdMediumDOS ;
begin
EXECPROC.UseExecSwap := FALSE ;
VisionExec ( GetEnv ( 'COMSPEC' ) , '' ) ;
end ;
{===================================================================

BIG - Does Swap-to-Disk/EMS. Desktop is saved & cleared, so
swap file is as small as possible.

===================================================================}
procedure hdBigDOS ;
begin
EXECPROC.UseExecSwap := TRUE ;
VisionExec ( GetEnv ( 'COMSPEC' ) , '' ) ;
end ;
{===================================================================

DOS SHELL - for simpler applications. If EXECSWAP is not used,
then "BigDOS" is the same as "MediumDOS".

===================================================================}
procedure hdDosShell ;
begin
hdBigDOS ;
end ;