home *** CD-ROM | disk | FTP | other *** search
- { Program Window Demo
-
- This program demonstrates the use of the procedures in jerwind.inc
- to do windows on IBM PC's and compatibles, using Turbo Pascal.
-
- Requires a color card or compatible card as long as the screen
- memory is a b8000H. If not the program will need to be modified.
- Certain procedures or functions may require Turbo Ver.3. to compile
- correctly..
-
- Ver. 1.0 ---- BY J. Lamphere }
-
- { Start of main test program }
- {$u-}
- {$I Jerwind.inc} {include the window program}
- {$I dir.inc} {include the directory procedures}
-
- Type
- Regpack = Record
- AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : Integer;
- End;
-
- Anything = String[60];
- Time_is = String[8];
- Date_is = String[10];
-
- Var
- Ch :char;
- Regs :Regpack;
-
- { Procedure to write messages saves a little in programing }
-
- Procedure Msg(X,Y:integer; say :Anything);
- { Write the string say at coords x,y }
- Begin
- GotoXY (x,y);
- Write( Say );
- end; { end of message procedure }
-
- { Function to return the date }
-
- Function Date : Date_is;
-
- Var
- Month, Day : String[2];
- Year : String[4];
-
- Begin
-
- Regs.AX := $2A Shl 8; {Shift it left so its in AH}
- Msdos(Regs); {Call the function}
- Str(Regs.CX,Year); {Convert to a string}
- Str(Regs.DX Mod 256, Day); {Convert to string}
- Str(Regs.DX Shr 8, Month); {shift right to reg DH and convert}
-
- Date := Month + '-' + Day + '-' + Year;
-
- End; { end of get date procedure }
-
-
- Function Time : Time_is;
-
- Var
- Hour, Min, Sec : String[2];
-
- Begin
- Regs.AX := $2C Shl 8; {Shift left so its put in AH}
- Msdos(Regs); {Call the function}
- Str(Regs.CX Shr 8, Hour); {Get the hour from CH}
- Str(Regs.CX Mod 256, Min);
- Str(Regs.DX Shr 8, Sec); {Get the seconds form DH}
-
- Time := Hour + ':' + Min + ':' + Sec
-
- End; { end get time and date }
-
- { main program starts here }
-
- Begin
- Clrscr;
- Msg (10,2,'Are you using a color moniter Y/N ? ');
- repeat
- Read (Kbd,Ch)
- until Upcase(ch) in ['Y','N',#27];
- if Upcase (Ch) in ['N',#27] then
- begin
- Writeln ('Sorry presently set for a color card.');
- Halt;
- end;
-
- Textcolor (2);
- Msg (10,5,' Small Window Demo program ');
- Msg (10,7,'Ver 1.1 By J. Lamphere 5/85');
- Msg (10,9,'This program will demonstrate one of the many ways to');
- Msg (10,10,'implement windows on IBM pc''s and compatibles using');
- Msg (10,11,'Turbo Pascal. None the the Demo routines are anything');
- Msg (10,12,'special but should allow you to get a feel for some of');
- Msg (10,13,'things Turbo Pascal is capable of..................');
- Msg (10,15,' You may use any or all of these routines in your');
- Msg (10,16,'Programs provided they are for your own use or for');
- Msg (10,17,'programs to be put in public domain.');
- Msg (25,19,'Copyright 1985');
- Textcolor (3);
- Msg (10,22,'Press any key when ready');
- Repeat
- Until Keypressed;
-
- { open the first window then restore it }
- Open_Window (1);
- textcolor(8);
- Dir;
- Write(#10#13#10,' Press any Key');
- textcolor(7);
- Repeat
- until keypressed;
-
- { Now open window 2 }
-
- Open_window (2);
- Clrscr;
- GotoXY(5,5);
- Write ('The Time is ',Time,' and the Date is ',Date);
- GotoXY(5,7);
- Writeln(' We''ll look at window 3 after you press a key');
- repeat
- until keypressed;
- { now try # 3}
- Open_Window (3);
- Msg (5,2,' A little window is good for warning messages');
- Msg (5,3,' incase a particular function is not allowed');
- Textcolor (8);
- Msg (5,6,' Warning file may be corrupted if you continue');
- Textcolor (7);
- Msg (8,9,'Press any key for the final window');
- Repeat
- until Keypressed;
- { ----------------- start of window 4 demo --------------}
-
- Open_Window (4); Clrscr;
-
- Msg (5,2,' This is last window in the demonstration ');
- Msg (5,3,' hopefully this will help you in managing');
- Msg (5,4,' windows for your programs.................');
- Msg (5,8,' When you press a key we will restore the');
- Msg (5,9,' opening screen then exit the program.');
- Textcolor (5); Msg (12,12,'TAKE CARE Jerry Lamphere');
- Repeat
- Until Keypressed;
- Close_Window;
- Textcolor(3);
- Write (' all done ');
- GotoXY(1,24)
- End.
-
-
- { This program and the procedures used were developed on a
- Heath HS-151 PC.
-
- HS-151 is a trademark of the Heath/Zenith corp.
- Turbo Pascal is a trademark of Borland International, Inc.
- IBM is a registered trademark of International Business Machines
- }