home *** CD-ROM | disk | FTP | other *** search
- { The following code fragments are a series of procedures and
- functions that I commonly include in Turbo Pascal programs.
-
- The Type definitions I've found to be especially useful. }
-
-
- Type
-
- Regs8088 = record
- Case Integer of
- 0: (ax, bx, cx, dx, bp, si, di, ds, es, Flags : Integer );
- 1: (al, ah, bl, bh, cl, ch, dl, dh : Byte );
- End;
-
- DOSRegs = record
- Case Integer of
- 0: (ax, bx, cx, dx, bp, si, di, ds, es, Flags : Integer);
- 1: (al, ah, bl, bh, cl, ch, dl, dh : Byte );
- End;
-
- Str3 = String[03];
- Str8 = String[08];
- Str10 = String[10];
- Str14 = String[14];
- Str80 = String[80];
- Str255 = String[255];
- AnyString = String[255];
-
- DateTp = record
- Yr : Byte;
- Mo : Byte;
- Day : Byte;
- End;
-
- ScreenCharacter = Record
- DisplayByte : Char;
- DisplayAttr : Char;
- End;
-
- ScreenImage = array [1..25, 1..80] of ScreenCharacter;
-
-
- {***************************************************************}
-
- Function LoggedDisk : Char;
- Var
- Registers : DOSRegs; {record for MsDos call}
- Begin
- With Registers do
- Begin
- LoggedDisk := 'A'; {set up default}
- ah := $19;
- MSDOS(Registers);
- Case al of
- 0 : LoggedDisk := 'A';
- 1 : LoggedDisk := 'B';
- 2 : LoggedDisk := 'C';
- End;
-
- End;
- End;
-
-
-
-
- Procedure GetDate (Var DtRec : DateTp; Var StrDt : Str10 );
- Var
- Registers : DOSRegs; {record for MsDos call}
- TheMonth : string[2];
- TheDay : string[2];
- TheYear : string[4];
-
- Begin
- with Registers do
- begin
- ah := $2a;
- MsDos(Registers); { call function }
- cx := cx - 1900;
- DtRec.Yr := cx;
- DtRec.Mo := dh;
- DtRec.Day:= dl;
- str(cx : 2, TheYear); {convert to string}
- str(dl : 2, TheDay); { " }
- str(dh : 2, TheMonth); { " }
- End;
-
- StrDt := TheMonth + '/' + TheDay + '/' + TheYear;
-
- End;
-
-
- Procedure Beep; { for invalid keypresses, etc. }
- Begin
- NoSound;
- Sound(440); Delay(100); NoSound;
- End;
-
-
- Procedure BigCursor;
- Var
- Regs : Regs8088;
- Begin
- Regs.ah := 1; { set cursor type }
- Regs.ch := 00;
- Regs.cl := 07;
- Intr ($10, Regs);
- End;
-
-
- Procedure SmallCursor;
- Var
- Regs : Regs8088;
- Begin
- Regs.ah := 1; { set cursor type }
- Regs.ch := 07;
- Regs.cl := 07;
-
- Intr ($10, Regs);
- End;
-