From ts@uwasa.fi Wed Feb 5 00:00:00 1997
Subject: FAQPAS5.TXT contents

                               Copyright (c) 1993-1997 by Timo Salmi
                                                 All rights reserved

FAQPAS5.TXT The fifth set of frequently (and not so frequently)
asked Turbo Pascal questions with Timo's answers. The items are in
no particular order.

You are free to quote brief passages from this file provided you
clearly indicate the source with a proper acknowledgment.

Comments and corrections are solicited. But if you wish to have
individual Turbo Pascal consultation, please post your questions to
a suitable Usenet newsgroup like news:comp.lang.pascal.borland. It
is much more efficient than asking me by email. I'd like to help,
but I am very pressed for time. I prefer to pick the questions I
answer from the Usenet news. Thus I can answer publicly at one go if
I happen to have an answer. Besides, newsgroups have a number of
readers who might know a better or an alternative answer. Don't be
discouraged, though, if you get a reply like this from me. I am
always glad to hear from fellow Turbo Pascal users.

....................................................................
Prof. Timo Salmi   Co-moderator of news:comp.archives.msdos.announce
Moderating at ftp:// & http://garbo.uwasa.fi archives  193.166.120.5
Department of Accounting and Business Finance  ; University of Vaasa
mailto:ts@uwasa.fi  <URL:http://uwasa.fi/~ts>  ; FIN-65101,  Finland

--------------------------------------------------------------------
101) How do I detect if mouse hardware/driver is installed?
102) How can I read absolute sectors directly from a floppy?
103) How can I move a file to another directory in Turbo Pascal?
104) How can I get/set a disk volume label?
105) Is there a function to chop off the leading zero from 0.322?
106) How can I print a text file (and conclude sending a formfeed)?
107) How can I round 4.1256455 to two decimal places to give 4.13?
108) How can I list with paths all the files on a drive?
109) What are the formulas for ArcSin and ArcTan?
110) How can I determine how many bytes are allocated to a file?
111) How can I modify the colors of the VGA graphics palette?
112) How can I check if SMARTDRV has been installed? Which version?
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:41 1997
Subject: Detecting mouse

101. *****
 Q: How do I detect if mouse hardware/driver is installed?

 A: The source code is given below. For more mouse related functions
please see ftp://garbo.uwasa.fi/pc/programming/inter52c.zip for
interrupt $33 functions.
  uses Dos;
  (* Detect if mouse hardware/driver is installed; initializes driver *)
  function MOUSDRFN : boolean;
  var regs : registers;
  begin
    FillChar (regs, SizeOf(regs), 0);  { Just to make sure }
    regs.ax := $0000;                  { Interrupt function number }
    Intr ($33, regs);                  { Call interrupt $33 }
    if regs.ax = $FFFF then
      mousdrfn := true
      else mousdrfn := false;
  end;  (* mousedrfn *)
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:42 1997
Subject: Reading absolute sectors

102. *****
 Q: How can I read absolute sectors directly from a floppy?

 A: Here is the source code for reading directly from a floppy disk.
For directly reading data from hard disk, please study the
information for interrupt $13 function $02 in Ralf Brown's list of
interrupts ftp://garbo.uwasa.fi/pc/programming/inter52a.zip.
  uses Dos;
  type readBufferType = array [1..1024] of byte;
  procedure READFLPY (drive  : char;
                      side   : byte;
                      track  : byte;
                      sector : byte;
                      var rb : readBufferType;
                      var ok : boolean);
  var regs : registers;
       i : byte;
  begin
    ok := false;
    for i := 1 to 3 do begin
      FillChar (regs, SizeOf(regs), 0);  { Just to make sure }
      regs.ah := $02;                    { Function }
      regs.al := 2;                      { Number of sectors to read }
      regs.dl := ord(Upcase(drive))-ord('A');
      if (regs.dl < 0) or (regs.dl > 1) then exit;   { For floppies only }
      regs.dh := side;
      regs.ch := track;
      regs.cl := sector;
      regs.es := Seg(rb);
      regs.bx := Ofs(rb);
      Intr ($13, regs);                  { Call interrupt $13 }
      if regs.flags and FCarry = 0 then begin   { Was it ok? }
        ok := true; exit;
      end; {if}
      { reset and try again a maximum of three times }
      FillChar (regs, SizeOf(regs), 0);  { Just to make sure }
      regs.ah := $00;                    { Function }
      regs.dl := ord(Upcase(drive))-ord('A');
    end; {for i}
  end;  (* readflpy *)
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:43 1997
Subject: Moving files

103. *****
 Q: How can I move a file to another directory in Turbo Pascal?

 A: If the file and the target directory are on the same disk you
can use Turbo Pascal's rename command for the purpose. If they are
on separate disks you'll first have to copy the file as explained in
the item "How can I copy a file in a Turbo Pascal program?" and then
erase the original as explained in the item "Can you tell a beginner
how to delete files with Turbo Pascal?"
  var f : file;
  begin
    Assign (f, 'r:\faq.pas');
    {$I-} Rename (f, 'r:\cmand\faq.pas'); {$I+}
    if IOResult = 0 then
      writeln ('File moved') else writeln ('File not moved');
  end.
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:44 1997
Subject: Getting/setting volume label

104. *****
 Q: How can I get/set a disk volume label?

 A: Getting the volume label can be done in alternative ways. Below
is one of them
  Uses Dos;
  (* Get a disk's volume label *)
  function GETLABFN (device : char) : string;
  var FileInfo : SearchRec;
      fsplit_dir  : DirStr;
      fsplit_name : NameStr;
      fsplit_ext  : ExtStr;
      stash       : byte;
  begin
    getlabfn := '';
    device := UpCase (device);
    if (device < 'A') or (device > 'Z') then exit;
    {}
    stash := fileMode;
    FileMode := $40;
    FindFirst (device + ':\*.*', AnyFile, FileInfo);
    while DosError = 0 do
      begin
        if ((FileInfo.Attr and VolumeId) > 0) then
          begin
            FSplit (FExpand(FileInfo.Name),
                    fsplit_dir, fsplit_name, fsplit_ext);
            Delete (fsplit_ext, 1, 1);
            getlabfn := fsplit_name + fsplit_ext;
            FileMode := stash;
            exit;
          end;
        FindNext (FileInfo);
      end; {while}
    FileMode := stash;
  end; (* getlabfn *)

As for setting a disk volume label with Turbo Pascal that is a much
more complicated task. You'll need to manipulate the File Control
Block (FCB). This alternative is not taken further in here. If you
need the procedure it is available without the source code as
  "SETLABEL Set a disk's volume label"
  in TSUNTL.TPU in ftp://garbo.uwasa.fi/pc/ts/tspa3570.zip.
An alternative is shelling to Dos to call its own LABEL.EXE program
as follows
  {$M 2048, 0, 0}   (* <-- Important. Adjust if out of memory. *)
  Uses Dos;
  begin
    SwapVectors;
    Exec (GetEnv('comspec'), '/c label A:');  (* Execution *)
    SwapVectors;
  end.
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:45 1997
Subject: Omitting leading zero

105. *****
 Q: Is there a function to chop off the leading zero from 0.322?

 A: If you wish to output a real without the leading zero you can
use the following function
  function CHOPFN (x : real; dd : byte) : string;
  var s : string;
  begin
    Str (x:0:dd, s);
    if x >= 0 then
      chopfn := Copy (s,2,255)
    else
      chopfn := '-' + Copy (s,3,255);
  end;  (* chopfn *)
There are other options. What is below is more cumbersome than
CHOPFN, but it demonstrates the usage of the Move command rather
nicely.
  function CHOP2FN (x : real; dd : byte) : string;
  var s : string;
  begin
    Str (x:0:dd, s);
    if x >= 0 then begin
      Move (s[2],s[1],Length(s)-1);
      Dec(s[0]);
      chop2fn := s;
      end
    else begin
      Move (s[3],s[1],Length(s)-2);
      Dec(s[0],2);
      chop2fn := '-' + s;
    end;
  end;  (* chop2fn *)
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:46 1997
Subject: Printing a file and a formfeed

106. *****
 Q: How can I print a text file (and conclude sending a formfeed)?

 A: We can turn this beginner's question into some instructive
source code. Study carefully the many details included. For printer
handling you might also wish to see in my FAQ the separate item
number 15 "How can I test that the printer is ready?"
  Uses Printer;             { Associates lst with the LPT1 device }
  const formfeed = #12;     { The formfeed character }
  var s : string;           { A string for a single line }
      filename : string;    { A variable for the file name }
      f : text;             { Text-file variable }
      fmsave : byte;        { For storing the original filemode }
  begin
    if ParamCount > 0 then  { If there are parameters on the command line }
      filename := ParamStr(1)                     { get the first of them }
    else begin
      writeln ('Usage: ', ParamStr(0), ' [Filename]');
      halt(1);              { Sets errorlevel to 1 for batches }
    end;
    fmSave := FileMode;     { Save the current filemode }
    FileMode := $40;        { To handle also read-only and network files }
    Assign (f, filename);   { Associate file variable with file name }
    {$I-}                   { Input/Output-Checking temporarily off }
    Reset (f);              { Open the file }
    {$I+}
    if IOResult <> 0 then begin    { Check failure of opening the file }
      writeln ('Error opening ', filename);
      FileMode := fmSave;   { Restore original filemode }
      halt(2);              { Sets errorlevel to 2 for batches }
    end; {if}
    while not eof(f) do begin
      readln (f, s);        { Read a line, maximum length 255 characters }
      writeln (lst, s);     { Write the line to the printer }
    end; {while}
    Close (f);              { Close the file }
    FileMode := fmSave;     { Restore the original filemode }
    write (lst, formfeed);  { Eject the page from the printer }
  end.
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:47 1997
Subject: Rounding a value

107. *****
 Q: How can I round 4.1256455 to two decimal places to give 4.13?

 A: Here is the source code. Note the two alternatives. The trivial
one of just formulating the output, and the more complicated of
actually rounding the value of a variable.
  var x, y : real;
  {}
  (* Sign function, needed to round negative values correctly *)
  function SignFn (a : real) : real;
  begin
    if a > 0.0 then signfn := 1.0
      else if a < 0.0 then signfn := -1.0
        else signfn := 0.0;
  end; (* sgnfn *)
  {}
  (* Round a real variable to d decimal places *)
  function RoundRealFn (x : real; d : byte) : real;
  var a : real;
      i : byte;
  begin
    a := 1.0;
    for i := 1 to d do a := a*10.0;
    RoundRealFn := Int (a*x + SignFn(x)*0.5) / a;
  end;  (* RoundRealFn *)
  {}
  (* Test *)
  begin
    x := 4.1256455;
    {}
    { ... The case of actually rounding a variable ...}
    y := RoundRealFn (x, 2);
    writeln (x, ' ', y);
    {}
    {... The more common case case of rounding the output only ...}
    writeln (x:0:2);
  end.
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:48 1997
Subject: Recursing directories

108. *****
 Q: How can I list with paths all the files on a drive?

 A: Here is the example source code
  {$M 16384,0,0}
  Uses Dos;
  {... the top directory ...}
  procedure FindFiles (Path, FileSpec : string);
  var FileInfo : SearchRec;
  begin
    FindFirst (Path + FileSpec, AnyFile, FileInfo);
    while DosError = 0 do begin
      if ((FileInfo.Attr and Directory) = 0) and
         ((FileInfo.Attr and VolumeId) = 0) then begin
        writeln (Path+FileInfo.Name);
      end; {if}
      FindNext (FileInfo);
    end; {while}
    {}
    {... subdirectories ...}
    FindFirst (Path + '*.*', Directory, FileInfo);
    while DosError = 0 do
      begin
        if ((FileInfo.Attr and Directory) > 0) and
            (FileInfo.Name <> '.') and
            (FileInfo.Name <> '..') then
              FindFiles (Path + FileInfo.Name + '\', FileSpec);
        FindNext (FileInfo);
      end; {while}
  end;  (* findfiles *)
  {}
  begin
    FindFiles ('C:\', '*.*');  { Note the trailing \ }
  end.
For starting below the root, use e.g. FindFiles ('C:\DOS\', '*.*');
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:49 1997
Subject: Arcsin and ArcCos

109. *****
 Q: What are the formulas for ArcSin and ArcCos?

 A: Arcsin is the inverse function of the sine. Hence y = acrsin(x)
implies x = sin(y). The values of x range from -1 and to 1. The
square root of (1-x^2) will become zero at -1 and 1 which will cause
an error if those special cases are not taken into account. Thus
define
  function ArcSin (x : real) : real;
  const halfPi = pi/2.0;
  begin
    if (x < -1.0) or (x > 1.0) then begin
      writeln ('ArcSin argument ', x, ' out of range [-1,1]');
      halt;
    end;
    if x = 1.0 then arcsin := halfPi
    else if x = -1.0 then arcsin := -halfPi
    else arcsin := ArcTan(x/Sqrt(1.0-Sqr(x)));
  end; (* arcsin *)

For ArcCos we can use
  function ArcCos (x : real) : real;
  const halfPi = pi/2.0;
  begin
    arccos := halfPi - ArcSin(x);
  end; (* arccos *)
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:50 1997
Subject: File size allocation

110. *****
 Q: How can I determine how many bytes are allocated to a file?

 A: Disk space is allocated to files by clusters, not by individual
bytes. Therefore, (except when exact multiples of cluster size)
files take up more space than is shown on the MS-DOS dir command
file size. To find out the true number of bytes a file takes up
you'll find have to find out what is the cluster size for the device
where the file is located. The following function does that.
  (* Allocation of bytes per cluster for the files on a drive *)
  function CLUSIZFN (device : char) : longint;
  var regs : registers;
  begin
    FillChar (regs, SizeOf(regs), 0);  { Just a precaution }
    with regs do begin
      ax := $3600;    { Get drive allocation information }
      dx := ord (UpCase(device)) - 64;  { Default=0, A=1, B=2,.. }
      MsDos (regs);   { Call interrrupt $21 }
      if (ax = $FFFF) then           { $FFFF if drive is invalid }
         clusizfn := -1              { To indicate an error }
       else
         clusizfn := cx * ax; { bytes per sector * sectors per cluster }
    end; {with}
  end;  (* clusizfn *)

Next, the following function can be used to find out the number of
bytes a file takes up.
  (* The file's total allocated bytes. Don't apply on an open file *)
  function ALLSIZFN (filename : string) : longint;
  var SizeOfCluster : longint;
      fmSave : byte;
      fpoint : file of byte;
  begin
    filename := FExpand (filename); { Make sure the drive is first }
    SizeOfCluster := CLUSIZFN (filename[1]);
    if SizeOfCluster = -1 then
      allsizfn := -1                { In case of error }
    else
      begin
        fmSave := FileMode;  { Store the FileMode value }
        FileMode := $40;     { Also read-only and network files }
        Assign (fpoint, filename);
        {$I-} Reset (fpoint); {$I+}
        if IOResult <> 0 then
          allsizfn := -1            { In case of error }
        else begin
          allsizfn := ((FileSize(fpoint) + SizeOfCluster - 1) div
                        SizeOfCluster) * SizeOfCluster;
          Close (fpoint);
        end;
        FileMode := fmSave;  { Restore the original FileMode status }
      end;
  end;  (* allsizfn *)
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:51 1997
Subject: Modifying VGA palette

111. *****
 Q: How can I modify the colors of the VGA graphics palette?

 A: Below is a demo source code how to do it. Solving this problem
is not trivial, but it is not overly complicated either.
   The related task of selecting the RGB (Red Green Blue) color
values to your liking is, in fact, the most laborious task. The
color values for each color component for the adapter run from 0 to
255, but in Turbo Pascal only only the 6 most-significant bits of
the color byte are loaded in the palette. Thus the TP color
components run from 0 to 63 only. The correspondence between the 0
to 255 and the 0 to 63 items can be found using the formula
  ReducedColorItem := Full8bitColorItem shr 2;
The reduction to 6 significant bits means that TP will unfortunately
not be able to utilize all the color combinations your VGA adapter
should be capable of.

  uses Crt, Graph;

  type RGBRecordType = record
                         c       : byte;
                         r, g, b : byte;
                       end;

  type RGBArrayRecordType = array[0..MaxColors] of RGBRecordType;

  const
    DefaultPalette : RGBArrayRecordType = (
     (c:  0; r: 0; g: 0; b: 0),   { Black; }
     (c:  1; r: 0; g: 0; b:40),   { Blue; }
     (c:  2; r: 0; g:40; b: 0),   { Green; }
     (c:  3; r: 0; g:40; b:40),   { Cyan; }
     (c:  4; r:40; g: 7; b: 7),   { Red; }
     (c:  5; r:40; g: 0; b:40),   { Magenta; }
     (c: 20; r:40; g:30; b: 0),   { Brown; }
     (c:  7; r:49; g:49; b:49),   { LightGray; }
     (c: 56; r:26; g:26; b:26),   { DarkGray; }
     (c: 57; r: 0; g: 0; b:63),   { LightBlue; }
     (c: 58; r: 9; g:63; b: 9),   { LightGreen; }
     (c: 59; r: 0; g:63; b:63),   { LightCyan; }
     (c: 60; r:63; g:10; b:10),   { LightRed; }
     (c: 61; r:44; g: 0; b:63),   { LightMagenta; }
     (c: 62; r:63; g:63; b:18),   { Yellow; }
     (c: 63; r:63; g:63; b:63) ); { White; }

  const
    MyPalette : RGBArrayRecordType = (
     (c:  0; r: 0; g: 0; b: 0),   { Black; }
     (c:  1; r: 0; g: 0; b:32),   { Blue; }
     (c:  2; r: 0; g:32; b: 0),   { Green; }
     (c:  3; r: 0; g:48; b:48),   { Cyan; }
     (c:  4; r:32; g: 0; b: 0),   { Red; }
     (c:  5; r:32; g: 0; b:32),   { Magenta; }
     (c: 20; r:43; g:21; b: 0),   { Brown; }
     (c:  7; r:48; g:48; b:48),   { LightGray; }
     (c: 56; r:32; g:32; b:32),   { DarkGray; }
     (c: 57; r: 0; g: 0; b:63),   { LightBlue; }
     (c: 58; r: 0; g:63; b: 0),   { LightGreen; }
     (c: 59; r: 0; g:63; b:63),   { LightCyan; }
     (c: 60; r:63; g: 0; b: 0),   { LightRed; }
     (c: 61; r:63; g: 0; b:63),   { LightMagenta; }
     (c: 62; r:63; g:63; b: 0),   { Yellow; }
     (c: 63; r:63; g:63; b:63) ); { White; }

  const
    BlackPalette : RGBArrayRecordType = (
     (c:  0; r: 0; g: 0; b: 0),   { Black; }
     (c:  1; r: 0; g: 0; b: 0),   { Blue; }
     (c:  2; r: 0; g: 0; b: 0),   { Green; }
     (c:  3; r: 0; g: 0; b: 0),   { Cyan; }
     (c:  4; r: 0; g: 0; b: 0),   { Red; }
     (c:  5; r: 0; g: 0; b: 0),   { Magenta; }
     (c: 20; r: 0; g: 0; b: 0),   { Brown; }
     (c:  7; r:48; g:48; b:48),   { LightGray; }
     (c: 56; r: 0; g: 0; b: 0),   { DarkGray; }
     (c: 57; r: 0; g: 0; b: 0),   { LightBlue; }
     (c: 58; r: 0; g: 0; b: 0),   { LightGreen; }
     (c: 59; r: 0; g: 0; b: 0),   { LightCyan; }
     (c: 60; r: 0; g: 0; b: 0),   { LightRed; }
     (c: 61; r: 0; g: 0; b: 0),   { LightMagenta; }
     (c: 62; r: 0; g: 0; b: 0),   { Yellow; }
     (c: 63; r: 0; g: 0; b: 0) ); { White; }

  procedure UsePalette (palette : RGBArrayRecordType);
  var i : byte;
  begin
    for i := 0 to MaxColors do
      SetRGBPalette (palette[i].c,
                     palette[i].r, palette[i].g, palette[i].b);
  end; (* UsePalette *)

  procedure DisplayPalette (x0, y0 : integer);
  const hight = 20; width = 30; separation = 10;
  var i, j, k : integer;
  begin
    k := 0;
    for j := 0 to 1 do begin
      for i := 0 to 7 do begin
        SetFillStyle (SolidFill, k);
        Bar (x0+i*(width+separation), y0+j*(hight+separation),
             x0+i*(width+separation)+width, y0+j*(hight+separation)+hight);
        Inc(k);
      end; {for i}
    end; {for j}
  end;  (* DisplayPalette *)

  var grDriver        : integer;
      grMode          : integer;
      ErrCode         : integer;
  begin
    grDriver := VGA;
    grMode := VGAHi;
    InitGraph (grDriver, grMode, ' ');
    ErrCode := GraphResult;
    if ErrCode <> grOk then begin
      Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
    ClearDevice;  { Clears and homes the current pointer }
    {}
    SetFillStyle (SolidFill, LightGray);
    Bar (0, 0, GetMaxX, GetMaxy);
    DisplayPalette (50, 50);
    repeat until KeyPressed;
    while KeyPressed do ReadKey;
    {}
    UsePalette (MyPalette);
    DisplayPalette (50, 150);
    repeat until KeyPressed;
    while KeyPressed do ReadKey;
    {}
    UsePalette (BlackPalette);
    DisplayPalette (50, 250);
    repeat until KeyPressed;
    while KeyPressed do ReadKey;
    {}
    UsePalette (DefaultPalette);
    DisplayPalette (50, 350);
    repeat until KeyPressed;
    {}
    RestoreCrtMode;
    CloseGraph;
  end.
--------------------------------------------------------------------

From ts@uwasa.fi Wed Feb 5 00:01:52 1997
Subject: Detecting SMARTDRV

112. *****
 Q: How can I check if SMARTDRV has been installed? Which version?

 A: Below is the source code

  Uses Dos;

  (* Has SMARTDRV been installed *)
  function SMARTFN : boolean;  { For SMARTDRV v4.00+ }
  var regs : registers;
  begin
    FillChar (regs, SizeOf(regs), 0);
    regs.ah := $4A;   { function }
    regs.al := $10;   { subfunction }
    regs.bx := $0000; { See $0003 for cache status }
    regs.cx := $EBAB;
    Intr ($2F, regs);
    smartfn := regs.ax = $BABE;   { A sense of humor ? }
  end; (* smartfn *)

  (* Get the SMARTDRV version *)
  function SMRVERFN : string;  { For SMARTDRV v4.00+ }
    function HEXFN (decimal : word) : string;
    const hexDigit : array [0..15] of char = '0123456789ABCDEF';
    begin
      hexfn := hexDigit[(decimal shr 12)]
            + hexDigit[(decimal shr 8) and $0F]
            + hexDigit[(decimal shr 4) and $0F]
            + hexDigit[(decimal and $0F)];
    end;  (* hexfn *)
  var regs : registers;
  begin
    FillChar (regs, SizeOf(regs), 0);
    regs.ah := $4A;   { function }
    regs.al := $10;   { subfunction }
    regs.bx := $0000; { See $0003 for cache status }
    regs.cx := $EBAB;
    Intr ($2F, regs);
    if regs.ax = $BABE then
      smrverfn := HEXFN(regs.bp)
    else
      smrverfn := 'Error';
  end; (* smrverfn *)
--------------------------------------------------------------------