Newsgroups: comp.lang.pascal
Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!caen!news.cs.indiana.edu!noose.ecn.purdue.edu!ed.ecn.purdue.edu!binni
From: binni@ed.ecn.purdue.edu (Brynjolfur Thorsson)
Subject: Cursor On/Off Code plus ...
Message-ID: <1991Apr8.192802.27683@noose.ecn.purdue.edu>
Sender: root@noose.ecn.purdue.edu (ECN System Management)
Organization: Purdue University Engineering Computer Network
Date: Mon, 8 Apr 1991 19:28:02 GMT

Dave Sisson asked me to post this in response to previously posted article.
Pls. contact him directly if you have questions/comments.

Brynjolfur.
(binni@ecn.purdue.edu)

----------------------------------------------------------------------

From daves@vtcosy.cns.vt.edu Mon Apr  8 13:42:26 1991
Received: from vtcosy.cns.vt.edu by ed.ecn.purdue.edu (5.65/1.30jrs)
	id AA25441; Mon, 8 Apr 91 13:42:06 -0500
Received: by vtcosy.cns.vt.edu (AIX  2.1.2/4.03)
          id AA10592; Mon, 8 Apr 91 14:42:55 EDT
From: daves@vtcosy.cns.vt.edu (Dave Sisson)
Message-Id: <9104081842.AA10592@vtcosy.cns.vt.edu>
Subject: Cursor On/Off Code plus ...
To: binni@ed.ecn.purdue.edu
Date: Mon, 8 Apr 91 14:42:53 EDT
X-Mailer: ELM [version 2.3 PL0]
Status: OR

       Here's the code I use to do it.  This unit grew as I developed
       a BBS front end program.  The code contains a lot of extra functions,
       most of which you probably won't use, but enjoy!


unit Exists;

(**************************************************************************)
(*
(*  Unit Exists
(*
(*  Description:  Contains the FileExists and the ScrollLock functions
(*                in addition to ToggleScrollLock function and the Strng
(*                function with Cursor On/Off routines added in on the side
(*                Also includes string lengthening and shortening routines
(*                Includes a fancy little alarm or beeper.
(*
(*  Author: Brian Martin and David Sisson
(*
(*  Revisions: None
(*
(*  Version: 1.32
(*
(**************************************************************************)

interface
{$D-}

  function FileExists(str: string): boolean;
  function DirExists(str: string): boolean;
  function ScrollLock:boolean;
  procedure ToggleScroll;
  function Strng(num: longint): string;
  procedure CursorOn;
  procedure CursorOff;
  function Shorten(astr: string): string;
  function Lengthen(str: string; num: integer): string;
  procedure Beeper;
  function UpperString(astr: string): string;


implementation
  uses Crt, Dos;

(**************************************************************************)
(*
(*  Procedure ToggleScroll
(*
(*  Description:  Toggles the Scroll Lock key
(*
(*  Author: Brian Martin and David Sisson
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

Procedure ToggleScroll;
var kbflag: byte absolute $0040:$0017;

begin
  KbFlag:=(KbFlag XOR $10)
end;


(**************************************************************************)
(*
(*  Function Strng
(*
(*  Description:  Returns the string of a numeric value
(*
(*  Author: Brian Martin and David Sisson
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

function Strng;
  var str2: string;

  begin
    Str(num, str2);
    Strng:=str2;
  end;


(**************************************************************************)
(*
(*  Function ScrollLock
(*
(*  Description:  Returns True if Scroll Lock is enabled
(*
(*  Author: Brian Martin and David Sisson
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

function ScrollLock;

var kbflag: byte absolute $0040:$0017;

   begin
      ScrollLock:=(Kbflag and $10)>0;
   end;


(**************************************************************************)
(*
(*  Function FileExists
(*
(*  Description:  Returns True if the file exists
(*
(*  Author: David Sisson
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

  function FileExists;
    var fil:text;
    begin
      {$I-}
      Assign(fil,str);
      Reset(fil);
      if IOResult<>0 then FileExists:=False else FileExists:=True;
      {$I+}
    end;


(**************************************************************************)
(*
(*  Function DirExists
(*
(*  Description:  Returns True if the given directory exists
(*
(*  Author: David Sisson
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

  function DirExists;
    var SR: SearchRec;
    begin
      FindFirst(str, Directory, SR);
      if DosError=0 then DirExists:=True else DirExists:=False;
    end;


(**************************************************************************)
(*
(*  Procedure CursorOn
(*
(*  Description:  Turns the cursor on
(*
(*  Author: David Sisson
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

  procedure CursorOn;
    var Regs: Registers;

    begin
      Regs.AH:=1;
      Regs.CH:=11;
      Regs.CL:=13;
      Intr($10, Regs);
    end;


(**************************************************************************)
(*
(*  Procedure CursorOff
(*
(*  Description:  Turns the cursor off
(*
(*  Author: Brian Martin
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

  procedure CursorOff;
    var Regs: Registers;

    begin
      Regs.CH:=Regs.CH or $20;
      Regs.AH:=1;
      Intr($10, Regs);
    end;


(**************************************************************************)
(*
(*  Function Shorten
(*
(*  Description:  Removes trailing spaces from the end of a string
(*
(*  Author: David Sisson
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

function Shorten(astr: string): string;
  begin
    while (Length(astr)>0) and (astr[Length(astr)]=' ') do begin
      astr:=Copy(astr,1,Length(astr)-1);
    end;
    Shorten:=astr;
  end;


(**************************************************************************)
(*
(*  Function Lengthen
(*
(*  Description:  Puts trailing spaces from the end of a string to make
(*                it as long as you want
(*
(*  Author: David Sisson
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

function Lengthen(str: string; num: integer): string;
  var str2: string;

  begin
    str2:=str;
    while Length(str2)<num do str2:=str2+' ';
    Lengthen:=str2;
  end;

(**************************************************************************)
(*
(*  Procedure Beeper
(*
(*  Description:  Does a fancy little beep
(*
(*  Author: Brian Martin
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

  Procedure Beeper;

  var i:integer;

  begin
    For i:= 1 to 4 do begin
      Delay(90);
      Sound(1500);
      Delay(90);
      Sound(1600);
      Delay(90);
      Sound(1800);
      Delay(90);
      Sound(1600);
    end;
    NoSound;
  end;


(**************************************************************************)
(*
(*  Function UpperString
(*
(*  Description:  Capitalizes a string
(*
(*  Author: David Sisson
(*
(*  Revisions: None
(*
(*  Version: 1.00
(*
(**************************************************************************)

function UpperString(astr: string): string;
  var i: integer;

  begin
    if Length(astr)>0 then begin
      for i:=1 to Length(astr) do astr[i]:=UpCase(astr[i]);
      UpperString:=astr;
    end;
  end;

end.

-- 
       Dave Sisson @vtcosy.cns.vt.edu 
       Gamemaster, Graphics enthusiast, Other.