home *** CD-ROM | disk | FTP | other *** search
/ Freesoft 1997 June / Freesoft_1997-06_cd.bin / nerecenz / programmers / C32 / CRT32.INT next >
Text File  |  1997-09-29  |  13KB  |  356 lines
  1. Unit crt32;
  2.  
  3. {
  4.  
  5.         (C) 1996-97 By ZieglerSoft / Claus & Nina Ziegler
  6.                       All rights reserved
  7.  
  8.                       CRT32 version 1.15
  9.  
  10.  History:
  11.  
  12.  Version 0.90  - First version, only released in limited number
  13.  Version 1.00  - First public available version
  14.                  Oktober 1996 - version
  15.  Version 1.10  - Added a lot of stuff and fixed some errors
  16.                  November 1996 - version
  17.  Version 1.15  - Oktober 1997 - version
  18.                  New in this version:
  19.                     * Changes: Small changes in varius places
  20.                     * New Function/procedure/variable: NormVideo
  21.                     * New Function/procedure/variable: LowVideo
  22.                     * New Function/procedure/variable: HighVideo
  23.                     * New Function/procedure/variable: WindMin
  24.                     * New Function/procedure/variable: WindMax
  25.                     * New Function/procedure/variable: SingleFrame
  26.                     * New Function/procedure/variable: DoubleFrame
  27.                     * New Function/procedure/variable: Sound        (Not on NT)
  28.                     * New Function/procedure/variable: NoSound      (Not on NT)
  29.                     * New Function/procedure/variable: IsNT
  30.                     * New Function/procedure/variable: ConsoleWindowHandle
  31.                     * New Function/procedure/variable: MinimizeConsole
  32.                     * New Function/procedure/variable: MaximizeConsole
  33.                     * New Function/procedure/variable: NormalizeConsole
  34.  
  35.  
  36.  
  37.   Not to be copied without written permisson from ZieglerSoft
  38.  
  39.   Console-mode-helping-unit for 32-bit Delphi programming
  40.  
  41.   Makes the Console-applications work a bit like old Borland CRT-app-
  42.   lications (Not a complete drop-in for CRT/WinCRT/Win32CRT, but a help
  43.   for developing Console-applications in an easy way)
  44.   It has some enhancements too, like SmartInput, ScreenInput and
  45.   fast screenwrites
  46.  
  47.   Sugestions and comments must be send to crt32@zieglersoft.dk.
  48.   For information about ZieglerSoft look at: http://www.zieglersoft.dk
  49.  
  50. }
  51.  
  52. interface
  53.  
  54. Uses
  55.   Messages,
  56.   Windows;
  57.  
  58. Const {Color constants}
  59.   Black       = 0;
  60.   Blue        = 1;
  61.   Green       = 2;
  62.   Cyan        = 3;
  63.   Red         = 4;
  64.   Magenta     = 5;
  65.   Brown       = 6;
  66.   LightGray   = 7;
  67.   DarkGray    = 8;
  68.   LightBlue   = 9;
  69.   LightGreen  = 10;
  70.   LightCyan   = 11;
  71.   LightRed    = 12;
  72.   LightMagenta= 13;
  73.   Yellow      = 14;
  74.   White       = 15;
  75.  
  76. Var
  77.  ConsoleInput  : tHandle = 0;  {The handle of input}
  78.  ConsoleOutput : tHandle = 0;  {The handle of output}
  79.  ConsoleError  : tHandle = 0;  {The handle of Error}
  80.  
  81. Type
  82.   Colors = Black..White; {Used anywhere we need a color input}
  83.  
  84. Type
  85.   ShiftCodes=(skRightAlt,skLeftAlt,skAlt,skRightCtrl,skLeftCtrl,
  86.               skCtrl,skShift,skNum,skScroll,skCaps,skEnhanced);
  87.   ShiftKeys = Set of ShiftCodes;
  88.  
  89. Type
  90.   Keyset = Set of Char; {Used to tell what keys we would allow in input
  91.                          This is used by SmartInput / ScreenInput}
  92. Var
  93.   AllKeys   : KeySet = [#000..#255]; {Allow all keys in input
  94.                                       used by SmartInput / ScreenInput}
  95. Type
  96.   InputJobs = Record    {Used by ScreenInput in an array where we have
  97.                          one of theese records for each line we want to
  98.                          input}
  99.     X : Integer;        {Where must the input-string start?}
  100.     Y : Integer;
  101.     X1: Integer;        {Where must the 'Prompt' start?}
  102.     Y1: Integer;
  103.     L : Integer;        {Length of string we want to edit}
  104.     Front,Back: Colors; {The color of the input on screen}
  105.     Front1,Back1:Colors;{Colors of the 'prompt'}
  106.     S : AnsiString;     {The string we want to edit}
  107.     P : AnsiString;     {The 'prompt'}
  108.     AK: keySet;         {Accepted keys in this input. If not set,
  109.                          then all keys can be used}
  110.   End;
  111.  
  112. Type
  113.   MouseEvent=(MouseButton,MouseMove,MouseDblClick);
  114.     {What happend with the mouse?}
  115.  
  116. Type
  117.   MouseFunction=
  118.     Procedure(LeftBut,RightBut:Boolean;X,Y:Integer;Event:MouseEvent);
  119.     {Assign a procedure of this type to MouseProcedure to use mouse
  120.      in ReadKey}
  121. Var
  122.   MouseProcedure : MouseFunction = Nil; {Used if mouseinput in Readkey}
  123.  
  124. Var
  125.   MouseInput    : Boolean = False;{Mouseevents in Readkey?}
  126.   ShiftKeysDown : ShiftKeys =[];  {What shift-keys was down, when last
  127.                                    Readkey was done?}
  128.   FillVideoChar : Char = ' ';     {Used to fill the screen when ClrScr,
  129.                                    DelLine, InsLine and ClrEOL. remeber
  130.                                    to use the OEM-charset}
  131.  
  132. Function SmartInput(X,Y:Integer;             {Where do we start}
  133.                     Len:Integer;             {How long}
  134.                     TextCol,BackCol:Colors;  {Colors}
  135.                     Var Value:AnsiString;    {In- and output}
  136.                     OkKeys : KeySet;         {What keys are allowed}
  137.                     TabAdvance:Boolean;      {True=tab returns up/down}
  138.                     AutoAdvance:Boolean      {True=returns down when len}
  139.                     ):Integer;               {0=Enter,-1=esc,-2=mouse
  140.                                               else key}
  141.   {This function reads a string from the keyboard, but will return
  142.    the key used to exit the procedure, as in a normal ReadKey where
  143.    this is the second char returned (the first was #0) i.e. this is
  144.    the extended char i.e. for PgUp, PgDn, Up and down.
  145.    If TabAdvance is true, then a tab-char will return the same char
  146.    as Down, and Shift+Tab will return the same code as Up.
  147.    If Autoadvance is true, then if the char just entered was the last
  148.    that could fit into the string, then the function returns the same
  149.    code as Down}
  150.  
  151. Function ScreenInput(Var TheJob:Array of InputJobs):boolean;
  152.   {A function, that can be used to input a complete screen-full of
  153.    information in one go. You make an array of InputJobs, that is
  154.    filled with the wanted information, then calls this function to
  155.    get the data read from the screen.
  156.    If False, then user exited by pressing ESC, else ENTER}
  157.  
  158. Procedure MinimizeConsole;
  159.   {Minimize the console-window (if posible)}
  160.  
  161. Procedure MaximizeConsole;
  162.   {Maximize the console-window (if posible)}
  163.  
  164. Procedure NormalizeConsole;
  165.   {Normalize the console-window (if posible)}
  166.  
  167. Procedure CursorOff;
  168.   {Turns off the cursor}
  169.  
  170. Procedure CursorOn;
  171.   {Turns on the cursor, in the state it was last time it was turned off}
  172.  
  173. Procedure BlockCursor;
  174.   {Set the cursor to Block-state. If off, then it is set to blockstate
  175.    next time the cursor is turned on}
  176.  
  177. Procedure NormalCursor;
  178.   {Set the cursor to normal. If off, then it is set to normal
  179.    next time the cursor is turned on}
  180.  
  181. Procedure FatCursor;
  182.   {Set the cursor to Fat-state. If off, then it is set to Fat-state
  183.    next time the cursor is turned on}
  184.  
  185. Procedure FlushInput;
  186.   {Empties the inputbuffer for pending keys ect.}
  187.  
  188. Function SetScreenSize(Rows,Cols:Word):Boolean;
  189.   {Set a new size for the screen. If it can't be done, then it returns
  190.    false, else it returns true. Not all wanted sizes can be set.
  191.    You can't allways make the screen smaller.
  192.    If you run in fullscreen-mode, then only sizes that your system
  193.    normaly can do will be done. The font used plays a role too}
  194.  
  195. Procedure SetTitle(Ind:AnsiString);
  196.   {Set a title at the console-window}
  197.  
  198. Procedure FastWrite(X,Y:integer;Front,Back:Colors;S:AnsiString);
  199.   {Writes directely to the Console-buffer, and thereby saves time.
  200.    X and Y is the place where we start writing.
  201.    Front and Back is the color we want to use when writing
  202.    S is the string we want to write.}
  203.  
  204. Procedure FastTextOut(X,Y:Integer;S:AnsiString);
  205.   {As FastWrite, but you can't set the colors, so what's there before
  206.    will be used}
  207.  
  208. Function GetScreenText(X,Y,Length:Integer):AnsiString;
  209.   {Read the string from the screen, starting from X,Y and continuing
  210.    for Length chars}
  211.  
  212. Function GetChr(X,Y:Integer):Char;
  213.   {Read a char from the screen in position X,Y}
  214.  
  215. Procedure FastColorOut(X,Y:Integer;Front,Back:Colors;Length:Integer);
  216.   {As Fastwrite, but this will only fill the colors, whitout changing
  217.    the text at the place.
  218.    Length is the number of character cells you want to fill}
  219.  
  220. Procedure FillScreenChar
  221.            (X,Y:Integer;front,Back:Colors;Length:Integer;C:Char);
  222.   {Fill the screen from X,Y and length chars forward with the char C
  223.    in the colors Back,Front.
  224.    The Char (C) must be in the OEM-charset}
  225.  
  226. Procedure SetBreakHandler(Enable:boolean);
  227.   {Set the system to handle Ctrl+Break in the same way as ^C
  228.    If Enable is false then Ctrl+Break will terminate the application.
  229.    If Enable is True then if SetCheckCtrlC is set true the appliaction
  230.    terminates, but if SetCheckCtrlC is set false nothing happens}
  231.  
  232. Procedure SetCheckCtrlC(Enable:Boolean);
  233.   {Set the check for ^C (and ^Break if SetBreakHandler is set true)}
  234.  
  235. Function CheckCtrlC:Boolean;
  236.   {Do we check for ^C? (and ^Break if SetBreakHandler is set true)}
  237.  
  238. Function ReadKey:Char;
  239.   {Like the normal ReadKey-function
  240.    Returns the same codes as the normal Crt-unit, not Windows VK_X codes}
  241.  
  242. Function KeyPressed:Boolean;
  243.   {As the normal KeyPressed function}
  244.  
  245. Procedure GotoXY(X,Y:Integer);
  246.   {Moves the cursor to a position at X,Y}
  247.  
  248. Function WhereX:Integer;
  249.   {Where is the cursor, X-direction}
  250.  
  251. Function WhereY:Integer;
  252.   {Where is the cursor, Y-direction}
  253.  
  254. Procedure TextColor(Color:Colors);
  255.   {Set the textcolor}
  256.  
  257. Procedure Inverse;
  258.   {Reverses TextColor and TextBackGround}
  259.  
  260. Procedure TextBackground(Color:Colors);
  261.   {Set the Backgroundcolor}
  262.  
  263. Function GetTextBackGround:Colors;
  264.   {Returns with the color (one of the constants) that TextBackGround
  265.    is using right now}
  266.  
  267. Function GetTextColor:Colors;
  268.   {Returns with color (one of the constants) that TextColor is
  269.    using right now}
  270.  
  271. Procedure SetTextAttr(Color:Word);
  272.   {Set the colors, both Background and Textcolor. Use it with TextAttr
  273.    to set a value. Save TextAttr, do some colorchanges, and restore the
  274.    colors by setting this to the saved value}
  275.  
  276. Function GetScreenAttr(X,Y:Integer):Word;
  277.   {Returns the complete attribute for the screenposition}
  278.  
  279. Function GetScreenTextColor(X,Y:Integer):Colors;
  280.   {Returns the textcolor, used in screenposition X,Y}
  281.  
  282. Function GetScreenBackGround(X,Y:integer):Colors;
  283.   {Returns then TextBackGround for the position X,Y}
  284.  
  285. Function TextAttr:Word;
  286.   {Get both Background and Textcolor in one word}
  287.  
  288. Procedure NormVideo;
  289.   {Selects normal characters}
  290.  
  291. Procedure LowVideo;
  292.   {Selects low-intensity characters}
  293.  
  294. Procedure HighVideo;
  295.   {Selects high-intensity characters}
  296.  
  297. Procedure ClrEol;
  298.   {Clear from cursor to end of line}
  299.  
  300. Procedure ClrScr;
  301.   {Clear the screen, and return cursor to 0,0}
  302.  
  303. Procedure InsLine;
  304.   {Insert an empty line at the cursor-position}
  305.  
  306. Procedure DelLine;
  307.   {Delete the line where the cursor is, and moves the lines below up}
  308.  
  309. Function CurrentCols:Integer;
  310.   {How many cols are the screen right now?}
  311.  
  312. Function CurrentRows:Integer;
  313.   {How many rows are the screen right now}
  314.  
  315. Function WindMin:Word;
  316.   {Screen coordinates of the current (and only) Window}
  317.  
  318. Function WindMax:Word;
  319.   {Screen coordinates of the current (and only) Window}
  320.  
  321. Function AnsiOEMstr(Ind:AnsiString):AnsiString;
  322.   {A very simple version of Ansi-OEM, needed when writing strings}
  323.  
  324. Function OEMAnsiStr(Ind:AnsiString):AnsiString;
  325.   {A very simple version of OEM-Ansi, needed when reading strings}
  326.  
  327. Procedure Delay(Msec:Word);
  328.   {A delay-function that waits for at least Msec milliseconds}
  329.  
  330. Procedure SingleFrame(Front,Back:Colors;X1,Y1,X2,Y2:Integer);
  331.   {Draws a single-frame from X1,Y1 to X2,Y2 in the colors Front,Back}
  332.  
  333. Procedure DoubleFrame(Front,Back:Colors;X1,Y1,X2,Y2:Integer);
  334.   {Draws a double-frame from X1,Y1 to X2,Y2 in the colors Front,Back}
  335.  
  336. Function IsNt:Boolean;
  337.   {Helper function for testing if we are running on a NT-Box}
  338.  
  339. Function ConsoleWindowHandle:Hwnd;
  340.   {Helper function to get windows-handle for consolewindow}
  341.  
  342. Procedure Sound(Hz:Word);
  343.   {On Win95, this will Start the internal speaker, at Hz Hertz}
  344.  
  345. Procedure NoSound;
  346.   {On Win95, stops the internal speaker again}
  347.  
  348. {The following don't do anything, they are just here for comaptibility}
  349. Var
  350.   CheckSnow     : Boolean = true; {Dummy, for compatibility}
  351.   CheckEOF      : Boolean = False;{Dummy, for compatibility}
  352.   DirectVideo   : Boolean = False;{Dummy, for compatibility}
  353.  
  354. implementation
  355.  
  356.