home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP_ADV.ZIP / LIST1004.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-31  |  6.7 KB  |  165 lines
  1. Unit GrafRead;
  2. {--------------------------------------------------------------}
  3. { This unit will provide a user with a routine to input any    }
  4. { type of information regradless of the currently active video }
  5. { display mode.  This unit interfaces a typed constant that    }
  6. { must be set to indicate which mode is active.                }
  7. {--------------------------------------------------------------}
  8.  
  9. Interface
  10.  
  11. Uses Crt, Graph;        { Include the standard library units   }
  12.  
  13. Const
  14.   GraphicsMode : Boolean = False;
  15.  
  16. Procedure ReadString( Var S : String );
  17.  
  18. Implementation
  19.  
  20. Procedure DrawCursor( On : Boolean );
  21. { This procedure will turn on and off a cursor for graphics    }
  22. { mode.  The boolean parameter determines whether the cursor   }
  23. { will be drawn (TRUE) and when it will be deleted (FALSE).    }
  24.  
  25. Var
  26.   CursorHeight,         { Value for the height of the cursor   }
  27.   CursorWidth : Word;   { Value for the width of the cursor    }
  28.   F : FillSettingsType; { Variable to store the current fill   }
  29.                         { settings, as we will modify them in  }
  30.                         { this procedure.                      }
  31.   XStart,               { Beginning X coordinate for cursor    }
  32.   XEnd,                 { Ending X coordinate for the cursor   }
  33.   YStart,               { Beginning Y coordinate for cursor    }
  34.   YEnd : Word;          { Ending Y coordinate for the cursor   }
  35.  
  36. Begin
  37.   CursorHeight := ( TextHeight( 'W' ) Div 8 );
  38.                       { This calculation creates an underscore }
  39.   CursorWidth := TextWidth( 'H' );
  40.                       { Calculation to create width of cursor  }
  41.   XStart := GetX;     { Set Beginning as current X screen pos. }
  42.   XEnd := XStart + CursorWidth;
  43.                       { Define end location for cursor width   }
  44.   YStart := GetY + TextHeight( 'W' );
  45.                       { Define start location for cursor height}
  46.   YEnd := YStart + CursorHeight;
  47.                       { Define end location for cursor height  }
  48.   GetFillSettings( F );{ Store current fill settings           }
  49.   If( On ) Then
  50.     SetFillStyle( SolidFill, GetColor )
  51.                        { Set the fill style with drawing color }
  52.   Else
  53.     SetFillStyle( SolidFill, GetBKColor );
  54.                        { Set the fill style with backgnd color }
  55.   Bar( XStart, YStart, XEnd, YEnd );
  56.                        { Draws the cursor using the bar proc   }
  57.   SetFillStyle( F.Pattern, F.Color );
  58.                        { Restore the saved fill information    }
  59. End;
  60.  
  61. Procedure EchoIt( Ch : Char );
  62. { This procedure will echo the charachter CH to the currently  }
  63. { active screen type with either OutText or Write              }
  64. Begin
  65.   If( GraphicsMode ) Then
  66.   Begin
  67.     DrawCursor( False );{ Erase the cursor from current loc    }
  68.     OutText( Ch );      { Draw the new character               }
  69.     DrawCursor( True ); { Replace the cursor on current loc    }
  70.   End
  71.   Else
  72.     Write( Ch );        { Simply write the char as its text    }
  73. End;
  74.  
  75. Procedure BlankIt( Ch : Char );
  76. { This procedure will erase the last character in the input    }
  77. { string by redrawing the character in the current background  }
  78. { color.                                                       }
  79. Var
  80.   XPos,                 { Value of current X screen position   }
  81.   YPos : Word;          { Value of current Y screen position   }
  82.   OrigDrawingColor : Byte;{ Temporary storage for active       }
  83.                         { drawing color                        }
  84.  
  85. Begin
  86.   If( GraphicsMode ) Then
  87.   Begin
  88.     DrawCursor( False );{ Erase the cursor                     }
  89.     XPos := GetX;       { Store the current X position         }
  90.     XPos := XPos - TextWidth( Ch );
  91.                         { Calculate the previous characters    }
  92.                         { starting X position                  }
  93.     YPos := GetY;       { Store the current Y Position         }
  94.     OrigDrawingColor := GetColor;
  95.                         { Save the previous drawing color      }
  96.     SetColor( GetBKColor );{ Set color to the background color }
  97.     MoveTo( XPos,YPos );{ Update the current pointer           }
  98.     OutText( Ch );      { Erase the character from the screen  }
  99.     SetColor( OrigDrawingColor );
  100.                         { Restore the drawing color            }
  101.     MoveTo( XPos,YPos );{ Restore the current pointer          }
  102.   End
  103.   Else
  104.   Begin
  105.     XPos := WhereX;     { Store current X position             }
  106.     XPos := XPos - 1;   { Backup position on character         }
  107.     YPos := WhereY;     { Store current Y position             }
  108.     GotoXY( XPos,Ypos );{ Update the current screen position   }
  109.     Write( ' ' );       { Erase the character from the screen  }
  110.     GotoXY( XPos,YPos );{ Update current screen position       }
  111.   End;
  112. End;
  113.  
  114. Procedure ReadChar( Var Ch : Char );
  115. { This procedure is necessary so we can place a cursor on the  }
  116. { screen if we are in graphics mode.                           }
  117. Begin
  118.   If( GraphicsMode ) Then
  119.     DrawCursor( True ); { Place the cursor on the screen       }
  120.   Ch := Readkey;        { Get a keypress from the user         }
  121. End;
  122.  
  123. Procedure ReadString( Var S : String );
  124. { This is the driving procedure for this unit.  If the enter   }
  125. { key is pressed in response to the prompt, or if the user     }
  126. { deletes all the inputted characters from the string, then    }
  127. { the procedure will not assign a value to this parameter.     }
  128. Var
  129.   Ch : Char;            { Inputted character from Readkey FN   }
  130.   TempString : String;  { Input string that will be built      }
  131.  
  132. Begin
  133.   FillChar( TempString, SizeOf( TempString ), #0 );
  134.                         { Initialize the temporary string      }
  135.   ReadChar( Ch );       { Get user input from the keyboard     }
  136.   While( Ch <> #13 ) Do { Loop until the ENTER key is hit      }
  137.   Begin
  138.     If( Ch = #8 ) Then  { Was the delete key hit?              }
  139.     Begin
  140.       If( TempString[0] > #0 ) Then
  141.                         { Check if there is a deletable char   }
  142.       Begin
  143.         Blankit( TempString[Length( TempString )] );
  144.                         { Remove the char from the screen      }
  145.         Dec( TempString[0] );
  146.                         { Update the length of the string      }
  147.       End
  148.     End
  149.     Else
  150.     Begin
  151.       EchoIt( Ch );     { Echo character to active display     }
  152.       TempString := TempString + Ch;
  153.                         { Add character to temporary string    }
  154.     End;
  155.     ReadChar( Ch );     { Get next input character             }
  156.   End;
  157.   If( Length( TempString) > 0 ) Then
  158.                         { To determine if anything was entered }
  159.     S := TempString;    { If so, return the result to caller   }
  160.   If( GraphicsMode ) Then
  161.     DrawCursor( False );{ Erase the graphics cursor.           }
  162. End;
  163.  
  164. End.
  165.