home *** CD-ROM | disk | FTP | other *** search
Text File | 1986-03-03 | 47.2 KB | 1,018 lines |
- { SCREEN.INC }
-
- { *************************************************************************** }
- { * * }
- { * TURBO SCREEN INPUT PRE-PROCESSOR TOOLKIT * }
- { * * }
- { * SCREEN FUNCTION SUBPROGRAM INCLUDE FILE * }
- { * * }
- { * Version 1.07 * }
- { * * }
- { * * }
- { * This subprogram contains various functions and procedures to * }
- { * manipulate the monitor screen, get date and time, etc. * }
- { * The following functions and procedures are contained in * }
- { * this subprogram: * }
- { * * }
- { * MonitorType ( IBM Specific ) * }
- { * SpeedPrint ( IBM Specific ) * }
- { * SpeedWrite ( IBM Specific ) * }
- { * SpeedPrint2 ( IBM Specific ) * }
- { * DrawWindow1 * }
- { * DrawWindow2 * }
- { * ZoomWindow1 * }
- { * ZoomWindow2 * }
- { * DrawHorizWindowLine1 * }
- { * DrawHorizWindowLine2 * }
- { * WriteCenterText * }
- { * SetCursorSize ( IBM Specific ) * }
- { * HideBlinkingCursor ( IBM Specific ) * }
- { * ShowBlinkingCursor ( IBM Specific ) * }
- { * InitTextScreenPointers ( IBM Specific ) * }
- { * StoreTextScreen ( IBM Specific ) * }
- { * RecallTextScreen ( IBM Specific ) * }
- { * WriteScreenPageToFile ( IBM Specific ) * }
- { * ReadScreenPagesFromFile ( IBM Specific ) * }
- { * DisplayScreenPage ( IBM Specific ) * }
- { * SoundError * }
- { * SoundAttention * }
- { * WaitUntilKeypressed * }
- { * Date1 ( IBM Specific ) * }
- { * Date2 ( IBM Specific ) * }
- { * Time ( IBM Specific ) * }
- { * * }
- { * Note to reduce the size of your compiled code, remove those * }
- { * procedures within this subprogram that you are not using. * }
- { * * }
- { *************************************************************************** }
-
-
-
- Function MonitorType:Integer;
-
- { This function returns an integer value corresponding to the current display
- mode of the video monitor. IBM specific. Typical values follow:
-
- VALUE MODE SIZE ADAPTER MONITOR COLORS
-
- 0 Text 40 x 25 CGA,EGA,PCjr Monochrome 16 (grey)
- 1 Text 40 x 25 CGA,EGA,PCjr Color 16 foreground, 8 background
- 2 Text 80 x 25 CGA,EGA,PCjr Monochrome 16 (grey)
- 3 Text 80 x 25 CGA,EGA,PCjr Color 16 foreground, 8 background
- 4 Graphics 320 x 200 CGA,EGA,PCjr Color 4
- 5 Graphics 320 x 200 CGA,EGA,PCjr Monochrome 4 (grey)
- 6 Graphics 640 x 200 CGA,EGA,PCjr Color 2
- 7 Text 80 x 25 EGA,Monochrome Monochrome b/w
- 8 Graphics 160 x 200 PCjr Color 16
- 9 Graphics 320 x 200 PCjr Color 16
- 10 Graphics 640 x 200 PCjr Color 4
- 11 EGA Internal
- 12 EGA Internal
- 13 Graphics 320 x 200 EGA Color 16
- 14 Graphics 640 x 200 EGA Color 16
- 15 Graphics 640 x 350 EGA Monochrome b/w
- 16 Graphics 640 x 350 EGA Color 64 }
-
- Begin { MonitorType }
- MonitorType:=Mem[$0040:$0049]; { Get the current video mode value }
- End; { MonitorType }
-
-
-
- Procedure SpeedPrint( Text:WorkString;
- Col,
- Row :Integer);
-
- { This procedure writes the passed text directly to the video memory.
- This allows for ultra-fast screen output.
-
- Text = any literal string up to 80 characters long to be printed
- Col = screen column location ( 1 to 80 )
- Row = screen row location ( 1 to 25 )
-
-
- Note that this procedure does not clip the passed text if it extends beyond
- the edge of the screen, rather it will wrap the text around to the next
- line. IBM specific. This routine does cause some colored snow on the
- IBM standard color monitor, but not on the monochrome or enhanced monitors.
-
- I would like to note that I have encountered some erratic behavior from this
- procedure after doing a complex windowing call on an enhanced color monitor
- and adapter. Typically this procedure will not work immediately after
- displaying a window or zoom window. I think it is because the video buffer
- resides at a different location than specified below. }
-
-
- Var
- ColorMonitorImage:Array[1..25,1..80,1..2] Of Char Absolute $B800:0000;
- { an overlayed map of the color video memory addresses }
- MonoMonitorImage:Array[1..25,1..80,1..2] Of Char Absolute $B000:0000;
- { an overlayed map of the monochrome video memory addresses }
- ScreenCol:Integer; { an index used to help write out the passed character string }
-
- Begin { SpeedPrint }
- If MonitorType=7 Then { monochrome monitor and monochrome adapter }
- For ScreenCol:=1 To Length(Text) Do
- MonoMonitorImage[Row,Col+ScreenCol-1,1]:=Text[ScreenCol]
- Else { color or monochrome monitor and color adapter }
- For ScreenCol:=1 To Length(Text) Do
- ColorMonitorImage[Row,Col+ScreenCol-1,1]:=Text[ScreenCol];
- End; { SpeedPrint }
-
-
-
- Procedure SpeedWrite( Text:WorkString);
-
- { This procedure writes the passed text directly to the video memory wherever
- the cursor is located. This allows for ultra-fast screen output. Note that
- this procedure does not clip the passed text if it extends beyond the edge
- of the screen, rather it will wrap the text around to the next line. IBM
- specific. This routine does cause some colored snow on the IBM standard
- color monitor, but not on the monochrome or enhanced monitors.
-
- I would like to note that I have encountered some erratic behavior from this
- procedure after doing a complex windowing call on an enhanced color monitor
- and adapter. Typically this procedure will not work immediately after
- displaying a window or zoom window. I think it is because the video buffer
- resides at a different location than specified below. }
-
- Var
- ColorMonitorImage:Array[1..25,1..80,1..2] Of Char Absolute $B800:0000;
- { an overlayed map of the color video memory addresses }
- MonoMonitorImage:Array[1..25,1..80,1..2] Of Char Absolute $B000:0000;
- { an overlayed map of the monochrome video memory addresses }
- CurrentCursorCol:Integer; { a variable used in incrementing the cursor position as each character is written }
- CurrentCursorRow:Integer; { a variable used in incrementing the cursor position as each character is written }
- ScreenCol:Integer; { an index used to help write out the passed character string }
-
- Begin { SpeedWrite }
- CurrentCursorCol:=WhereX;
- CurrentCursorRow:=WhereY;
- If MonitorType=7 Then { monochrome monitor and monochrome adapter }
- For ScreenCol:=1 To Length(Text) Do
- MonoMonitorImage[CurrentCursorRow,CurrentCursorCol+ScreenCol-1,1]:=Text[ScreenCol]
- Else { color or monochrome monitor and color adapter }
- For ScreenCol:=1 To Length(Text) Do
- ColorMonitorImage[CurrentCursorRow,CurrentCursorCol+ScreenCol-1,1]:=Text[ScreenCol];
- CurrentCursorCol:=CurrentCursorCol+Length(Text); { increment cursor position }
- GotoXY(CurrentCursorCol,CurrentCursorRow);
- End; { SpeedWrite }
-
-
-
- Procedure SpeedPrint2(Var Text:WorkString;
- Var Col,
- Row :Integer);
-
- { This procedure writes text directly to video memory. This allows for
- ultra-fast screen output. IBM specific.
-
- Text = any literal string up to 80 sharacters long to be printed
- Col = screen col location ( 1 to 80 )
- Row = screen row location ( 1 to 25 )
-
- Note that this procedure does not clip the literal string if it extends
- beyond the screen edge, it will wrap to the next line. Also, WorkString
- can be dimensioned larger than 80 if desired.
-
- This procedure is nicer than SpeedPrint since this procedure does not
- produce colored snow on the standard IBM color monitor when it is called.
- This is because this procedure waits for the horizontal retrace check.
- I should note that colored snow only occurs on the standard color monitor,
- not the monochrome or enhanced color monitors. Both routines are fairly
- equal in speed.
-
- I would like to note that I have encountered some erratic behavior from this
- procedure after doing a complex windowing call on an enhanced color monitor
- and adapter. Typically this procedure will not work immediately after
- displaying a window or zoom window. I think it is because the video buffer
- resides at a different location than specified below. }
-
-
- Begin { SpeedPrint2 }
- InLine($8B/$5E/$08/ { mov bx,[bp+8] ; address of col var }
- $8B/$3F/ { mov di,[bx] ; get the col value }
- $4F/ { dec di }
- $8B/$5E/$04/ { mov bx,[bp+4] ; address of row var }
- $8B/$07/ { mov ax,[bx] ; get the row value }
- $48/ { dec ax }
- $8B/$5E/$0C/ { mov bx,[bp+12] ; address of string }
- $32/$ED/ { xor ch,ch }
- $8A/$0F/ { mov cl,[bx] ; get string length }
- $80/$F9/$00/ { cmp cl,0 ; test for null string }
- $74/$40/ { je exit }
- $C4/$76/$0C/ { les si,[bp+12] ; point to string }
- $46/ { inc si ; point to first char }
- $BB/$40/$00/ { mov bx,40h ; check video card type }
- $8E/$C3/ { mov es,bx ; current column setting }
- $26/$F7/$26/$4A/$00/ { mul es:4Ah ; set card mode }
- $03/$F8/ { add di,ax }
- $D1/$E7/ { shl di,1 ; attribute byte }
- $26/$8B/$16/$63/$00/ { mov dx,es:63h }
- $83/$C2/$06/ { add dx,6 ; point to status port }
- $B8/$00/$B8/ { mov ax,0B800H ; first try color card }
- $26/$8B/$1E/$10/$00/ { mov bx,es:10h ; check for card type }
- $81/$E3/$30/$00/ { and bx,30H }
- $83/$FB/$30/ { cmp bx,30H ; test for mono card }
- $75/$03/ { jne setcard }
- $B8/$00/$B0/ { mov ax,0B000H ; else is a mono card }
- $8E/$C0/ { setcard: mov es,ax ; point es to video }
- $EC/ { testlow: in al,dx ; get status }
- $A8/$01/ { test al,1 ; is it low ? }
- $75/$FB/ { jnz testlow ; no, keep checking }
- $FA/ { cli ; turn off interrupts }
- $EC/ { testhi: in al,dx ; get status }
- $A8/$01/ { test al,1 ; is it high ? }
- $74/$FB/ { jz testhi ; no, keep checking }
- $A4/ { movsb ; proper time to display }
- $47/ { inc di ; skip attribute byte }
- $E2/$F1/ { loop testlow ; end of string ? }
- $FB); { sti ; turn interrupts on }
- End; { SpeedPrint2 }
-
-
-
- Procedure DrawWindow1( BeginCol,
- BeginRow,
- EndCol,
- EndRow:Integer);
-
- { This procedure draws a rectangular window with a single line border at the
- location specified.
-
- ( BeginCol,BeginRow ) __________________________
- | |
- | |
- | Window |
- | |
- | _________________________|
- ( EndCol,EndRow) }
-
- Var
- I:Integer; { variable used to help build the horizontal borderline }
- BorderLine:String[77]; { string variable used in storing the top and bottom borderline }
-
- Begin { DrawWindow1 }
- Window(BeginCol,BeginRow,EndCol,EndRow);
- ClrScr;
- BorderLine:='';
- For I:=BeginCol+2 To EndCol-2 Do
- BorderLine:=BorderLine+Chr(196);
- GotoXY(2,1);
- Write(Chr(218),BorderLIne,Chr(191));
- For I:=2 To EndRow-BeginRow Do
- Begin
- GotoXY(2,I);
- Write(Chr(179));
- GotoXY(EndCol-BeginCol,I);
- Write(Chr(179));
- End; { For I }
- GotoXY(2,EndRow-BeginRow+1);
- Write(Chr(192),BorderLine,Chr(217));
- Window(1,1,80,25);
- End; { DrawWindow1 }
-
-
-
- Procedure DrawWindow2( BeginCol,
- BeginRow,
- EndCol,
- EndRow:Integer);
-
- { This procedure draws a rectangular window with a double line border at the
- location specified.
-
- ( BeginCol,BeginRow ) ==========================
- || ||
- || ||
- || Window ||
- || ||
- || ||
- ========================== ( EndCol,EndRow) }
-
- Var
- I:Integer; { variable used to help build the horizontal borderline }
- BorderLine:String[77]; { string variable used in storing the top and bottom borderline }
-
- Begin { DrawWindow2 }
- Window(BeginCol,BeginRow,EndCol,EndRow);
- ClrScr;
- BorderLine:='';
- For I:=BeginCol+2 To EndCol-2 Do
- BorderLine:=BorderLine+Chr(205);
- GotoXY(2,1);
- Write(Chr(201),BorderLIne,Chr(187));
- For I:=2 To EndRow-BeginRow Do
- Begin
- GotoXY(2,I);
- Write(Chr(186));
- GotoXY(EndCol-BeginCol,I);
- Write(Chr(186));
- End; { For I }
- GotoXY(2,EndRow-BeginRow+1);
- Write(Chr(200),BorderLine,Chr(188));
- Window(1,1,80,25);
- End; { DrawWindow2 }
-
-
-
- Procedure ZoomWindow1( BeginCol,
- BeginRow,
- EndCol,
- EndRow:Integer);
-
- { This procedure zooms horizontally a window with a single line border onto
- the monitor screen. A similar procedure could be written for a pull-down
- menu like is used on the Apple MacIntosh. }
-
- Var
- Row:Integer; { index to a screen row for displaying the vertical borders of the window }
- BeginStepCol:Integer; { variable denoting the left edge of the temporary zoom portion of the window }
- EndStepCol:Integer; { variable denoting the right edge of the temporary zoom portion of the window }
-
- Begin { ZoomWindow1 }
- BeginStepCol:=((BeginCol+EndCol) Div 2)-1;
- EndStepCol:=(BeginCol+EndCol) Div 2;
- Window(BeginStepCol,BeginRow,EndStepCol,EndRow);
- ClrScr;
- Window(1,1,80,25);
- GotoXY(BeginStepCol,BeginRow);
- Write(Chr(196),Chr(196));
- GotoXY(BeginStepCol,EndRow);
- Write(Chr(196),Chr(196));
- Repeat
- BeginStepCol:=BeginStepCol-2;
- EndStepCol:=EndStepCol+2;
- Window(BeginStepCol,BeginRow,BeginStepCol+1,EndRow);
- ClrScr;
- Window(1,1,80,25);
- GotoXY(BeginStepCol,BeginRow);
- Write(Chr(196),Chr(196));
- GotoXY(BeginStepCol,EndRow);
- Write(Chr(196),Chr(196));
- Window(EndStepCol-1,BeginRow,EndStepCol,EndRow);
- ClrScr;
- Window(1,1,80,25);
- GotoXY(EndStepCol-1,BeginRow);
- Write(Chr(196),Chr(196));
- GotoXY(EndStepCol-1,EndRow);
- Write(Chr(196),Chr(196));
- Until (BeginStepCol-3<=BeginCol) Or (EndStepCol+3>=EndCol);
- Window(BeginCol,BeginRow,BeginStepCol-1,EndRow);
- ClrScr;
- Window(1,1,80,25);
- GotoXY(BeginCol+1,BeginRow);
- Write(Chr(218),Chr(196),Chr(196),Chr(196));
- GotoXY(BeginCol+1,EndRow);
- Write(Chr(192),Chr(196),Chr(196),Chr(196));
- For Row:=BeginRow+1 To EndRow-1 Do
- Begin
- GotoXY(BeginCol+1,Row);
- Write(Chr(179));
- End; { For Row }
- Window(EndStepCol+1,BeginRow,EndCol,EndRow);
- ClrScr;
- Window(1,1,80,25);
- GotoXY(EndCol-4,BeginRow);
- Write(Chr(196),Chr(196),Chr(196),Chr(191));
- GotoXY(EndCol-4,EndRow);
- Write(Chr(196),Chr(196),Chr(196),Chr(217));
- For Row:=BeginRow+1 To EndRow-1 Do
- Begin
- GotoXY(EndCol-1,Row);
- Write(Chr(179));
- End; { For Row }
- End; { ZoomWindow1 }
-
-
-
- Procedure ZoomWindow2( BeginCol,
- BeginRow,
- EndCol,
- EndRow:Integer);
-
- { This procedure zooms horizontally a window with a double line border onto
- the monitor screen. A similar procedure could be written for a pull-down
- menu like is used on the Apple MacIntosh. }
-
- Var
- Row:Integer; { index to a screen row for displaying the vertical borders of the window }
- BeginStepCol:Integer; { variable denoting the left edge of the temporary zoom portion of the window }
- EndStepCol:Integer; { variable denoting the right edge of the temporary zoom portion of the window }
-
- Begin { ZoomWindow2 }
- BeginStepCol:=((BeginCol+EndCol) Div 2)-1;
- EndStepCol:=(BeginCol+EndCol) Div 2;
- Window(BeginStepCol,BeginRow,EndStepCol,EndRow);
- ClrScr;
- Window(1,1,80,25);
- GotoXY(BeginStepCol,BeginRow);
- Write(Chr(205),Chr(205));
- GotoXY(BeginStepCol,EndRow);
- Write(Chr(205),Chr(205));
- Repeat
- BeginStepCol:=BeginStepCol-2;
- EndStepCol:=EndStepCol+2;
- Window(BeginStepCol,BeginRow,BeginStepCol+1,EndRow);
- ClrScr;
- Window(1,1,80,25);
- GotoXY(BeginStepCol,BeginRow);
- Write(Chr(205),Chr(205));
- GotoXY(BeginStepCol,EndRow);
- Write(Chr(205),Chr(205));
- Window(EndStepCol-1,BeginRow,EndStepCol,EndRow);
- ClrScr;
- Window(1,1,80,25);
- GotoXY(EndStepCol-1,BeginRow);
- Write(Chr(205),Chr(205));
- GotoXY(EndStepCol-1,EndRow);
- Write(Chr(205),Chr(205));
- Until (BeginStepCol-3<=BeginCol) Or (EndStepCol+3>=EndCol);
- Window(BeginCol,BeginRow,BeginStepCol-1,EndRow);
- ClrScr;
- Window(1,1,80,25);
- GotoXY(BeginCol+1,BeginRow);
- Write(Chr(201),Chr(205),Chr(205),Chr(205));
- GotoXY(BeginCol+1,EndRow);
- Write(Chr(200),Chr(205),Chr(205),Chr(205));
- For Row:=BeginRow+1 To EndRow-1 Do
- Begin
- GotoXY(BeginCol+1,Row);
- Write(Chr(186));
- End; { For Row }
- Window(EndStepCol+1,BeginRow,EndCol,EndRow);
- ClrScr;
- Window(1,1,80,25);
- GotoXY(EndCol-4,BeginRow);
- Write(Chr(205),Chr(205),Chr(205),Chr(187));
- GotoXY(EndCol-4,EndRow);
- Write(Chr(205),Chr(205),Chr(205),Chr(188));
- For Row:=BeginRow+1 To EndRow-1 Do
- Begin
- GotoXY(EndCol-1,Row);
- Write(Chr(186));
- End; { For Row }
- End; { ZoomWindow2 }
-
-
-
- Procedure DrawHorizWindowLine1( BeginCol,
- BeginRow,
- EndCol:Integer);
-
- { This procedure draws a singular horizontal line in the interior of a
- rectangular window which has a single line border.
-
- ( BeginCol,BeginRow )
- |--------------------------|
- ( EndCol ) }
-
- Begin { DrawHorizWindowLine1 }
- GotoXY(BeginCol,BeginRow);
- Write(' ',Chr(195));
- While WhereX<EndCol-1 Do
- Write(Chr(196));
- Write(Chr(180),' ');
- End; { DrawHorizWindowLine1 }
-
-
-
- Procedure DrawHorizWindowLine2( BeginCol,
- BeginRow,
- EndCol:Integer);
-
- { This procedure draws a singular horizontal line in the interior of a
- rectangular window which has a double line border.
-
- ( BeginCol,BeginRow )
- ||------------------------||
- ( EndCol ) }
-
- Begin { DrawHorizWindowLine2 }
- GotoXY(BeginCol,BeginRow);
- Write(' ',Chr(199));
- While WhereX<EndCol-1 Do
- Write(Chr(196));
- Write(Chr(182),' ');
- End; { DrawHorizWindowLine2 }
-
-
-
- Procedure WriteCenterText( Row :Integer;
- TextString:WorkString);
-
- { This procedure centers and writes a string of text at a given row on the
- monitor screen. }
-
- Begin { WriteCenterText }
- GotoXY(40-((Length(TextString)) div 2),Row);
- Write(TextString);
- End; { WriteCenterText }
-
-
-
- Procedure SetCursorSize( Top,
- Bottom:Integer);
-
- { This procedure is used to change the current cursor size. Top corresponds to
- the top of the cursor block. Bottom corresponds to the bottom of the cursor
- block. IBM specific.
-
- Typical IBM visible cursor blocks follow:
-
- MONOCHROME COLOR ENHANCED COLOR
-
- Top 0-|||| 0-|||| 0-||||
- |||| |||| ||||
- |||| |||| ||||
- Bottom 13-|||| 7-|||| 8-|||| }
-
- Begin { SetCursorSize }
- InLine($8A/$6E/$06/ { mov ch,[bp+06] }
- $8A/$4E/$04/ { mov cl,[bp+04] }
- $B4/$1F/ { mov ah,1F }
- $22/$EC/ { and ch,ah }
- $22/$CC/ { and cl,ah }
- $B4/$01/ { mov ah,01 }
- $CD/$10); { int 10 }
- End; { SetCursorSize }
-
-
-
- Procedure HideBlinkingCursor;
-
- { This procedure hides the blinking cursor. IBM specific. }
-
- Begin { HideBlinkingCursor }
- InLine($B9/$0F00/ { mov cx,0F00 ; turn cursor off }
- $B4/$01/ { mov ah,01 ; cursor type }
- $CD/$10); { int 10 ; screen interrupt }
- End; { HideBlinkingCursor }
-
-
-
- Procedure ShowBlinkingCursor;
-
- { This procedure first determines what type of monitor is being used. It
- then sets the proper visible cursor for that monitor. IBM specific. }
-
- Begin { ShowBlinkingCursor }
- If MonitorType=7 Then { monochrome adapter }
- InLine($B9/$0C0D/ { mov cx,0C0D ; turn monochrome cursor on }
- $B4/$01/ { mov ah,01 ; cursor type }
- $CD/$10) { int 10 ; screen interrupt }
- Else { color or enhanced color adapter }
- InLine($B9/$0607/ { mov cx,0F00 ; turn color cursor on }
- $B4/$01/ { mov ah,01 ; cursor type }
- $CD/$10); { int 10 ; screen interrupt }
- End; { ShowBlinkingCursor }
-
-
-
- Procedure InitTextScreenPointers;
-
- { This procedure initializes the screen pointers to Nil that are used in the
- storing of temporary text screens in the heap. Temporary text screens are
- stored, for example, just before a help screen is displayed on the monitor
- screen. }
-
- Var
- Number:Integer; { an index for the TextScreen array }
-
- Begin { InitTextScreenPointers }
- For Number:=1 To MAX_NUM_OF_TEXT_SCREENS Do
- TextScreen[Number]:=Nil;
- End; { InitTextScreenPointers }
-
-
-
- Procedure StoreTextScreen( Number:Integer);
-
- { This procedure is called to store the currently displayed video image into
- the heap. The currently displayed screen is not affected by this storage
- process. You store the screen under a number and thus can have many screens
- stored in the heap for instant display when required. You can even animate
- the screen using this process. This is all possible due to Turbo's 'Move'
- procedure which provides a very fast way of moving a block of memory.
-
- Another example:
-
- User has entered a help command so that a help screen will
- be displayed onto the screen.
-
- 1. Store the currently displayed video image.
- 2. Write a help screen onto the currently displayed video image.
- 3. Wait until the user has read the help screen and has replied
- to return to previous work.
- 4. Restore the previously stored image.
-
- This procedure could be easily modified to recall graphic screens. Simply
- define the screen size from 4096 to 16384 in the constant declaration in the
- program header. }
-
- Var
- ColorMonitorImage:Array[1..TEXT_SCREEN_SIZE] of Byte Absolute $B800:$0000;
- { an overlayed map of the color video memory addresses }
- MonoMonitorImage:Array[1..TEXT_SCREEN_SIZE] of Byte Absolute $B000:$0000;
- { an overlayed map of the monochrome video memory addresses }
-
- Begin { StoreTextScreen }
- New(TextScreen[Number]); { allocate screen image space in the heap to }
- { store currently displayed image }
- If MonitorType=7 Then { monochrome adapter }
- Move(MonoMonitorImage,TextScreen[Number]^.Image,TEXT_SCREEN_SIZE) { store currently displayed video image into }
- { the heap as TextScreen[Number] }
- Else
- Begin { color or enhanced color adapter }
- Repeat Until ((Port[$3DA] And 8)=8); { wait for video retrace to end }
- Port[$3D8]:=1; { temporarily haly video retrace }
- Move(ColorMonitorImage,TextScreen[Number]^.Image,TEXT_SCREEN_SIZE); { store currently displayed video image into }
- { the heap as TextScreen[Number] }
- Port[$3D8]:=9; { restore video retrace }
- End; { color or enhanced color adapter }
- End; { StoreTextScreen }
-
-
-
- Procedure RecallTextScreen( Number:Integer);
-
- { This procedure is called to recall TextScreen[Number] from the heap and
- display onto the monitor. You must first store a screen under a number
- before you can recall it. Using this process you can even animate the
- screen. This is all possible due to Turbo's 'Move' procedure which provides
- a very fast way of moving a block of memory.
-
- Another example:
-
- User has entered a help command so that the program will display
- a help window onto the screen. How do you restore the previous
- screen without reconstructing the whole screen ? Do the following:
-
- 1. Store the currently displayed video image.
- 2. Write a help window onto the currently displayed video image.
- 3. Wait until the user has read the help window and has replied
- to return to previous work.
- 4. Restore the previously stored screen image.
-
- This procedure could be easily modified to recall graphic screens. Simply
- define the screen size from 4096 to 16384 in the constant declaration in the
- program header. }
-
- Var
- ColorMonitorImage:Array[1..TEXT_SCREEN_SIZE] of Byte Absolute $B800:$0000;
- { an overlayed map of the color video memory addresses }
- MonoMonitorImage:Array[1..TEXT_SCREEN_SIZE] of Byte Absolute $B000:$0000;
- { an overlayed map of the monochrome video memory addresses }
-
- Begin { RecallTextScreen }
- If MonitorType=7 Then { monochrome adapter }
- Move(TextScreen[Number]^.Image,MonoMonitorImage,TEXT_SCREEN_SIZE) { recall TextScreen[Number] from the heap }
- { and display }
- Else
- Begin { color or enhanced color adapter }
- Repeat Until ((Port[$3DA] And 8)=8); { wait for video retrace to end }
- Port[$3D8]:=1; { temporarily haly video retrace }
- Move(TextScreen[Number]^.Image,ColorMonitorImage,TEXT_SCREEN_SIZE); { recall TextScreen[Number] from the heap and }
- { display }
- Port[$3D8]:=9; { restore video retrace }
- End; { color or enhanced color adapter }
- Dispose(TextScreen[Number]); { remove previously stored screen from heap }
- { thus freeing up memory in the heap }
- TextScreen[Number]:=Nil;
- End; { RecallTextScreen }
-
-
-
- Procedure WriteScreenPageToFile( ScreenPageFileName:WorkString);
-
- { This procedure is used to write the currently displayed text screen to a
- screen file of the passed file name. The text screen pages are stored under
- screen files titled '________.COL(or MON)' where COL stands for color and
- MON stands for monochrome. The currently displayed screen is not affected by
- this process.
-
- This procedure can be used to make your program appear very professional
- looking with rapid screen page displays. There will no longer be any need
- to construct a text screen with Write statements everytime a screen is to be
- displayed. By storing the screen pages ahead of time in files and then
- having the application program read the screen pages out of their files
- and storing them in the heap, it is very easy to instantly display various
- text screen pages. In addition, your application program no longer
- requires the code to construct the screen pages since the screen pages are
- are stored in the heap. This gives you more room to write code for your
- application.
-
- You should run this procedure twice for each screen page, once on a
- monochrome machine and once again on a color machine. The reason for this
- is that the colors are different on the two machines and the video buffers
- reside at different locations, also. You can circumnavigate having to use
- two machines by simply adjusting the colors for the file you wish to write
- and making sure to copy from the right video buffer location. The function
- MonitorType is used to determine the type of monitor being used. It is
- used in the initialization module to set the proper screen colors and other
- items. You can trick it into thinking you have the other type of display
- to help set up screen colors but then rewrite this procedure so that this
- procedure copies from the proper video buffer location.
-
- This procedure is not meant to be used in the application program. It is
- meant to be used during program development once the screen pages have been
- finalized. The re-display of the stored text screens should then be
- accomplished in the application program with the two procedures
- 'ReadScreenPagesFromFiles' and 'DisplayScreenPage(PageNumber)' found below.
-
- IBM Specific. }
-
- Const
- BLOCK_SIZE=32; { the number of 128-byte blocks to be written out }
-
- Var
- ColorMonitorImage:Array[1..TEXT_SCREEN_SIZE] of Byte Absolute $B800:$0000;
- { an overlayed map of the color video memory addresses }
- MonoMonitorImage:Array[1..TEXT_SCREEN_SIZE] of Byte Absolute $B000:$0000;
- { an overlayed map of the monochrome video memory addresses }
- TextScreenFile:File; { untyped screen file }
-
- Begin { WriteScreenPageToFile }
- If MonitorType=3 Then { color adapter and color monitor }
- Begin { color text screen page }
- Assign(TextScreenFile,ScreenPageFileName+'.COL'); { assign disk file }
- Rewrite(TextScreenFile); { open the file for writing }
- BlockWrite(TextScreenFile,ColorMonitorImage,BLOCK_SIZE); { write untyped data to file }
- Close(TextScreenFile); { close the file }
- End { color text screen page }
- Else
- If MonitorType=7 Then { monochrome adapter and monochrome monitor }
- Begin { monochrome text screen page }
- Assign(TextScreenFile,ScreenPageFileName+'.MON'); { assign disk file }
- Rewrite(TextScreenFile); { open the file for writing }
- BlockWrite(TextScreenFile,MonoMonitorImage,BLOCK_SIZE); { write untyped data to file }
- Close(TextScreenFile); { close the file }
- End { monochrome text screen page }
- Else { color adapter and monochrome monitor }
- Begin { monochrome text screen page }
- Assign(TextScreenFile,ScreenPageFileName+'.MON'); { assign disk file }
- Rewrite(TextScreenFile); { open the file for writing }
- BlockWrite(TextScreenFile,ColorMonitorImage,BLOCK_SIZE); { write untyped data to file }
- Close(TextScreenFile); { close the file }
- End; { monochrome text screen page }
- End; { WriteScreenPageToFile }
-
-
-
- Procedure ReadScreenPageFromFile( ScreenPageFileName:WorkString;
- Var ScreenPageImage :TextScreenPtr);
-
- { This procedure reads the stored text screen pages from the passed file name
- (which were generated using the procedure WriteScreenPageToFile) and passes
- the ScreenPageImage back to the calling routine. The text screen pages are
- stored under screen files titled '________.COL(or MON)' where COL stands
- for color and MON stands for monochrome. The currently displayed screen is
- not affected by this process.
-
- This procedure can be used to make your program appear very professional
- looking with rapid screen page displays. There will no longer be any need
- to construct a text screen with Write statements everytime a screen is to
- be displayed. By storing the screen pages ahead of time in files and then
- having the application program read the screen pages out of their files
- and storing them in the heap, it is very easy to instantly display various
- text screen pages. In addition, your application program no longer
- requires the code to construct the screen pages since the screen pages are
- are stored in the heap. This gives you more room to write code for your
- application.
-
- The re-display of the stored text screens is accomplished in the
- application program by using this procedure and the procedure
- 'DisplayScreenPage'.
-
- IBM Specific. }
-
- Const
- BLOCK_SIZE=32; { the number of 128-byte blocks to be read in }
-
- Var
- TextScreenFile:File; { untyped screen file }
-
- Begin { ReadScreenPageFromFiles }
- New(ScreenPageImage); { allocate screen image space in the heap }
- If MonitorType=3 Then { color adapter and color monitor }
- Begin { color text screen page }
- Assign(TextScreenFile,ScreenPageFileName+'.COL'); { assign disk file }
- Reset(TextScreenFile); { open the file for reading }
- BlockRead(TextScreenFile,ScreenPageImage^.Image,BLOCK_SIZE); { read untyped data from file }
- Close(TextScreenFile); { close the file }
- End { color text screen page }
- Else { monochrome adapter or color adapter and monochrome monitor }
- Begin { monochrome text screen page }
- Assign(TextScreenFile,ScreenPageFileName+'.MON'); { assign disk file }
- Reset(TextScreenFile); { open the file for reading }
- BlockRead(TextScreenFile,ScreenPageImage^.Image,BLOCK_SIZE); { read untyped data from file }
- Close(TextScreenFile); { close the file }
- End; { monochrome text screen page }
- End; { ReadScreenPageFromFiles }
-
-
-
- Procedure DisplayScreenPage( ScreenPageImage:TextScreenPtr);
-
- { This procedure is called to recall the passed ScreenPageImage from the
- heap and display the screen page image onto the monitor. The screen page
- must have first been read into the heap by the procedure
- 'ReadScreenPagesFromFiles' before this procedure can be used. The stored
- screen page is uneffected by this process.
-
- This procedure can be used to make your program appear very professional
- looking with rapid screen page displays. There will no longer be any need
- to construct a text screen with Write statements everytime a screen is to
- be displayed. By storing the screen pages ahead of time in files and then
- having the application program read the screen pages out of their files
- and storing them in the heap, it is very easy to instantly display various
- text screen pages. In addition, your application program no longer
- requires the code to construct the screen pages since the screen pages are
- are stored in the heap. This gives you more room to write code for your
- application.
-
- IBM Specific. }
-
- Var
- ColorMonitorImage:Array[1..TEXT_SCREEN_SIZE] of Byte Absolute $B800:$0000;
- { an overlayed map of the color video memory addresses }
- MonoMonitorImage:Array[1..TEXT_SCREEN_SIZE] of Byte Absolute $B000:$0000;
- { an overlayed map of the monochrome video memory addresses }
-
- Begin { DisplayScreenPage }
- If MonitorType=7 Then { monochrome adapter and monchrome monitor }
- Move(ScreenPageImage^.Image,MonoMonitorImage,TEXT_SCREEN_SIZE) { recall ScreenPage[PageNumber] from the heap }
- { and display on monochrome monitor }
- Else
- Begin { color adapter and color monitor or monochrome monitor }
- Repeat Until ((Port[$3DA] And 8)=8); { wait for video retrace to end }
- Port[$3D8]:=1; { temporarily haly video retrace }
- Move(ScreenPageImage^.Image,ColorMonitorImage,TEXT_SCREEN_SIZE); { recall ScreenPage[PageNumber] from the heap
- { and display on color or monochrome monitor }
- Port[$3D8]:=9; { restore video retrace }
- End; { color adapter and color monitor or monochrome monitor }
- End; { DisplayScreenPage }
-
-
-
- Procedure SoundError;
-
- { This procedure makes a sound when an illegal character has been entered. }
-
- Begin { SoundError }
- Sound(230);Delay(50);NoSound;
- End; { SoundError }
-
-
-
- Procedure SoundAttention;
-
- { This procedure makes a sound to get the user's attention. }
-
- Begin { SoundAttention }
- Sound(630);Delay(30);NoSound;Delay(40);Sound(630);Delay(30);NoSound;
- End; { SoundAttention }
-
-
-
- Procedure WaitUntilKeypressed;
-
- { This procedure is called, for example, when an overlayed window is displayed
- and tha program is waiting for the user to strike any key. Then the
- overlayed window should be removed. This procedure is necessary since
- a key that the user may strike may generate a two character code. This
- procedure deals with that by recognizing that two characters were generated
- and that it should ignore both of them. }
-
- Var
- KeyboardEntry:Char; { char variable used to absorb user's keystroke }
-
- Begin { WaitUntilKeypressed }
- Read(Kbd,KeyboardEntry);
- If (KeyboardEntry=Chr(27)) And Keypressed Then
- Read(Kbd,KeyboardEntry);
- End; { WaitUntilKeypressed }
-
-
-
- Function Date1:WorkString;
-
- { This function determines the current date by making a DOS call to the
- computer's clock. This function returns a string with the current day
- of the week, the month, the date, and the year. An example date that
- might be returned follows:
-
- Thu Oct. 10, 1985
-
- This function can be easily modified so that the entire day name and
- month name is returned if so desired. IBM specific. }
-
- Const
- DaysOfTheWeek: String[21]='SunMonTueWedThuFriSat'; { string constant for week days }
- MonthsOfTheYear:String[36]='JanFebMarAprMayJunJulAugSepOctNovDec'; { string constant for calendar months }
-
- Type
- RecordOfRegisters=
- Record
- AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:Integer { Record for storing register values }
- End; { RecordOfRegisters }
-
- Var
- Register:RecordOfRegisters; { variable used in reading internal registers }
- Day:String[2]; { string used in determining calendar day from internal system clock }
- Year:String[4]; { string used in determining calendar year from internal system clock }
-
- Begin { Date1 }
- Register.AX:=$2A00; { place function number $2A (Get Date) into register AX }
- MsDos(Register); { invoke DOS interrupt $21 }
- Str(Lo(Register.DX),Day); { convert integer to string }
- Str(Register.CX,Year); { convert integer to string }
- Date1:=Copy(DaysOfTheWeek,3*Lo(Register.AX)+1,3)+' '+
- Copy(MonthsOfTheYear,3*Hi(Register.DX)-2,3)+'. '+
- Day+', '+Year;
- End; { Date1 }
-
-
-
- Function Date2:WorkString;
-
- { This function determines the current date by making a DOS call to the
- computer's clock. IBM specific. An example date that might be returned
- follows:
-
- 8/10/1985 }
-
- Type
- RecordOfRegisters=
- Record
- AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:Integer { Record for storing register values }
- End; { RecordOfRegisters }
-
- Var
- Register:RecordOfRegisters; { variable used in reading internal registers }
- Month,Day:String[2]; { string used in determining calendar day from internal system clock }
- Year:String[4]; { string used in determining calendar year from internal system clock }
-
- Begin { Date2 }
- Register.AX:=$2A00; { place function number $2A (Get Date) into register AX }
- MsDos(Register); { invoke DOS interrupt $21 }
- With Register Do
- Begin
- Str(CX,Year); { convert integer to string }
- Str(DX Mod 256,Day); { convert integer to string }
- Str(DX Shr 8,Month); { convert integer to string }
- End; { With Register }
- Date2:=Month+'/'+Day+'/'+Year;
- End; { Date2 }
-
-
-
- Function Time:WorkString;
-
- { This function determines the current time by making a DOS call to the
- computer's clock. IBM specific. An example time that might be returned
- follows:
-
- 12:05:32 PM }
-
- Type
- RecordOfRegisters=
- Record
- AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:Integer { Record for storing register values }
- End; { RecordOfRegisters }
-
- Var
- Register:RecordOfRegisters; { variable used in reading internal registers }
- Hour:String[2]; { string used in determining hours from internal system clock }
- Minutes:String[2]; { string used in determining minutes from internal system clock }
- Seconds:String[5]; { string used in determining seconds from internal system clock }
-
- Begin { Time }
- Register.AX:=$2C00; { place function number $2C (Get Time) into register AX }
- Intr($21,Register); { invoke DOS interrupt $21 }
- With Register Do
- Begin
- Str(CX Shr 8,Hour); { convert integer to string }
- Str(CX Mod 256,Minutes); { convert integer to string }
- Str(DX Shr 8,Seconds); { convert integer to string }
- If Length(Minutes)=1 Then { check if less than 10 minutes }
- Minutes:='0'+Minutes;
- If Length(Seconds)=1 Then { check if less than 10 seconds }
- Seconds:='0'+Seconds;
- If (CX Shr 8)>12 Then { check if in afternoon }
- Begin
- Str((CX Shr 8)-12,Hour); { convert to 12 hour time }
- Seconds:=Seconds+' PM';
- End { If CX }
- Else
- Begin
- If (CX Shr 8)=0 Then { check if immediately after 12:00 midnight }
- Hour:='12';
- If (CX Shr 8)=12 Then { check if immediately after 12:00 noon }
- Seconds:=Seconds+' PM'
- Else { else it's still morning }
- Seconds:=Seconds+' AM';
- End { Else }
- End; { With Register }
- Time:=Hour+':'+Minutes+':'+Seconds;
- End; { Time }