home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / XTRADOS.ZIP / XTRADOS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-09-27  |  7.9 KB  |  451 lines
  1. Unit XtraDos;
  2.  
  3. {$F+}
  4.  
  5. Interface
  6.  
  7. Uses Dos,Crt;
  8.  
  9.      Type
  10.       CallH = Object
  11.         Procedure BoxText(Phrase : String; Row : Integer);
  12.         Procedure EraseBox(Length, Row : Integer);
  13.         Procedure DrawBox(c1,r1,c2,r2:Integer);
  14.         Procedure CenterText(Phrase : String; Row : Integer);
  15.         Procedure KeyPressLoop;
  16.         Procedure CursorOff;
  17.         Procedure CursorOn;
  18.         Procedure DisplayTime(Column, Row : Integer);
  19.         Function GetKey : Char;
  20.         Function CheckDate(Arrive:String) : Boolean;
  21.         Function Eight(Temp_Arrive:String) : String;
  22.         Function GetYear(Arrive:String):Integer;
  23.         Function LeadingZero(w: Word) : String;
  24.         Function GetSelection(Pressed : Char) : Integer;
  25.         Function GetDayOfWeek(Year:Integer):Integer;
  26.         Function DayOfYear(Arrive:String):Integer;
  27.         End;
  28.  
  29. Implementation
  30.  
  31. Procedure CallH.BoxText(Phrase : String; Row : Integer);
  32.  
  33. Var
  34.   Count,
  35.   LPhrase,
  36.   C1,C2,R1,R2,
  37.   Center : Integer;
  38.  
  39. Begin
  40.   LPhrase:=Length(Phrase);
  41.   Center:=40-(LPhrase Div 2);
  42.   C1:=Center-2;
  43.   C2:=(Center+LPhrase)+1;
  44.   R1:=Row-1;
  45.   R2:=Row+1;
  46.   For Count:=c1 to c2 Do
  47.    Begin
  48.     GotoXY(count,r1);
  49.     Write(Chr(205));
  50.     GotoXY(count,r2);
  51.     Write(Chr(205));
  52.    End;
  53.   For Count:=r1 to r2 Do
  54.    Begin
  55.     GotoXY(c1,count);
  56.     Write(Chr(186));
  57.     GotoXY(c2,count);
  58.     Write(Chr(186));
  59.    End;
  60.   GotoXY(c1,r1);
  61.   Write(Chr(201));
  62.   GotoXY(c2,r2);
  63.   Write(Chr(188));
  64.   GotoXY(c1,r2);
  65.   Write(Chr(200));
  66.   GotoXY(c2,r1);
  67.   Write(Chr(187));
  68.   GotoXY(Center,Row);
  69.   Write(Phrase);
  70. End;
  71.  
  72. Procedure CallH.EraseBox(Length, Row : Integer);
  73.  
  74. Var
  75.  C1, C2, R1, R2,
  76.  Count, Count2, Center : Integer;
  77.  
  78. Begin
  79.  Center:=40-(Length Div 2);
  80. C1:=Center-2;
  81.   C2:=(Center+Length)+1;
  82.   R1:=Row-1;
  83.   R2:=Row+1;
  84.   For Count2:=c1 to c2 Do
  85.    Begin
  86.     For Count:=r1 to r2 Do
  87.      Begin
  88.       GotoXY(Count2,Count);
  89.       Write(' ');
  90.      End;
  91.    End;
  92. End;
  93.  
  94. Procedure CallH.DrawBox(c1,r1,c2,r2:Integer);
  95.  
  96. Var
  97.   Count : Integer;
  98.  
  99. Begin
  100.  
  101.   For Count:=c1 to c2 Do
  102.    Begin
  103.     GotoXY(count,r1);
  104.     Write(Chr(205));
  105.     GotoXY(count,r2);
  106.     Write(Chr(205));
  107.    End;
  108.   For Count:=r1 to r2 Do
  109.    Begin
  110.     GotoXY(c1,count);
  111.     Write(Chr(186));
  112.     GotoXY(c2,count);
  113.     Write(Chr(186));
  114.    End;
  115.   GotoXY(c1,r1);
  116.   Write(Chr(201));
  117.   GotoXY(c2,r2);
  118.   Write(Chr(188));
  119.   GotoXY(c1,r2);
  120.   Write(Chr(200));
  121.   GotoXY(c2,r1);
  122.   Write(Chr(187));
  123. End;
  124.  
  125. Procedure CallH.CenterText(Phrase : String; Row : Integer);
  126.  
  127. Var
  128.   Count,
  129.   LPhrase,
  130.   Center : Integer;
  131.  
  132. Begin
  133.   LPhrase:=Length(Phrase);
  134.   Center:=40-(LPhrase Div 2);
  135.   GotoXY(Center,Row);
  136.   Write(Phrase);
  137. End;
  138.  
  139.  
  140.  
  141. Procedure CallH.KeyPressLoop;
  142.  
  143. Var
  144.  K : Char;
  145.  
  146. Begin
  147.   Repeat
  148.   K := ReadKey;
  149.   Until K<>''
  150. End;
  151.  
  152. Procedure CallH.CursorOff;
  153.  
  154. Var
  155.   Regs : Registers;
  156.  
  157. Begin
  158. Regs.AH:=$01;
  159. Regs.CH:=$20;
  160. Regs.CL:=$20;
  161. Intr($10,Regs);
  162. End;
  163.  
  164. Procedure CallH.CursorOn;
  165.  
  166. Var
  167.   Regs : Registers;
  168.  
  169. Begin
  170. Regs.AH:=$01;
  171. Regs.CH:=$0;
  172. Regs.CL:=$7;
  173. Intr($10,Regs);
  174. End;
  175.  
  176. Procedure CallH.DisplayTime(Column, Row : Integer);
  177.  
  178. Const
  179.  
  180. WMTH : Array[1..12] Of String[10] =('January','February','March','April','May',
  181.                                   'June','July','August','September','October',
  182.                                   'November','December');
  183.  
  184. DayOWs : array [0..6] of String[9] = ('Sunday','Monday','Tuesday', 'Wednesday',
  185.                                       'Thursday','Friday','Saturday');
  186.  
  187.  
  188. var
  189.   T, C, d2, y2,
  190.   Z,x,y : String[20];
  191.   d : String[40];
  192.   A : string[2];
  193.   yr,mth,dy,dow,
  194.   h, m, s, hund : Word;
  195.  
  196. begin
  197.   GetTime(h,m,s,hund);
  198.   If h>12 then
  199.     begin
  200.      h:=h-12;
  201.      A:='pm';
  202.     end
  203.     else
  204.      a:='am';
  205.   z:=LeadingZero(m);
  206.   c:=LeadingZero(s);
  207.   str(h,x);
  208.    If h<10 Then
  209.      T:=' '+x+':'
  210.    Else
  211.      t:=x+':';
  212.   Y:=t+z+':'+c+a;
  213.   GotoXY(58,24);
  214.   Write(y);
  215.   GetDate(yr,mth,dy,dow);
  216.   str(dy,d2);
  217.   str(yr,y2);
  218.   d:=DayOWS[Dow]+', '+WMTH[mth]+' '+d2+', '+y2;
  219.   GotoXY(Column, Row);
  220.   Write(d);
  221. end;
  222.  
  223. Function CallH.GetKey : Char;
  224.  
  225. Var
  226.  K : Char;
  227.  
  228. Begin
  229.   Repeat
  230.   K := ReadKey;
  231.   Until K<>'';
  232.   GetKey:=K;
  233. End;
  234.  
  235. Function CallH.CheckDate(Arrive:String) : Boolean;
  236.  
  237. Type
  238.  
  239.   DaysPerMonth = Array[1..12] Of Integer;
  240.  
  241. Var
  242.   Leap : Boolean;
  243.   DPM : DaysPerMonth;
  244.   L,
  245.   D,
  246.   Code,
  247.   Wm,
  248.   Wd,
  249.   Month,
  250.   Day,
  251.   Year : Integer;
  252.   Mth,
  253.   Dy,
  254.   Yr : String;
  255.  
  256. Begin
  257.  
  258.   DPM[1]:=31;
  259.   DPM[2]:=28;
  260.   DPM[3]:=31;
  261.   DPM[4]:=30;
  262.   DPM[5]:=31;
  263.   DPM[6]:=30;
  264.   DPM[7]:=31;
  265.   DPM[8]:=31;
  266.   DPM[9]:=30;
  267.   DPM[10]:=31;
  268.   DPM[11]:=30;
  269.   DPM[12]:=31;
  270.  
  271.   CheckDate:=TRUE;
  272.   Leap:=FALSE;
  273.   Mth:='';
  274.   Dy:='';
  275.   Yr:='';
  276.   L:=Length(Arrive);
  277.   Wm:=Pos('/',Arrive);
  278.    For D:=Wm To L Do
  279.     Begin
  280.      If Arrive[D]='/' Then
  281.      Wd:=D
  282.     End;
  283.     For D:=1 To (Wm-1) Do
  284.      Begin
  285.       Mth:=Mth+Arrive[D];
  286.      End;
  287.     For D:=(Wm+1) To (Wd-1) Do
  288.      Begin
  289.       Dy:=Dy+Arrive[D];
  290.      End;
  291.     For D:=Wd+1 To L Do
  292.      Begin
  293.       Yr:=Yr+Arrive[D]
  294.      End;
  295.      Val(Mth,Month,Code);
  296.      Val(Dy,Day,Code);
  297.      Val(Yr,Year,Code);
  298.     If (Year/4) = (Year Div 4) Then
  299.      Leap:=TRUE;
  300.     If ((Month>12) Or (Month<1)) Or ((Day<1) Or (Day>31)) Then
  301.          CheckDate:=FALSE;
  302.  
  303.     If Day>DPM[Month] Then
  304.          CheckDate:=FALSE;
  305.  
  306.     If ((Month=2) And (Leap)) And (Day=29) Then
  307.          CheckDate:=TRUE;
  308. End;
  309.  
  310.  
  311. Function CallH.Eight(Temp_Arrive : String ) : String;
  312.  
  313. Var
  314.   C, L : Integer;
  315.   ND, NM : String[2];
  316.   DD,MM,YY : String[3];
  317.  
  318. Begin
  319.  
  320.   DD:=Temp_Arrive[1]+Temp_Arrive[2];
  321.   MM:=Temp_Arrive[3]+Temp_Arrive[4]+Temp_Arrive[5];
  322.   YY:=Temp_Arrive[(Length(Temp_Arrive)-1)]+Temp_Arrive[(Length(Temp_Arrive))];
  323.   If DD[2]='/' Then ND:='0'+DD[1] Else ND:=DD;
  324.  
  325.   If ((MM[1]='/') And (MM[3]='/')) Then NM:='0'+MM[2];
  326.   If ((MM[1]='/') And (MM[3]<>'/')) Then NM:=MM[2]+MM[3];
  327.   If MM[2]='/' Then NM:='0'+MM[1];
  328.   If ((MM[3]='/') And (MM[1]<>'/')) Then NM:=MM[1]+MM[2];
  329.  
  330.   Eight:=ND+'/'+NM+'/'+YY;
  331. End;
  332.  
  333.  
  334.  
  335. Function CallH.GetYear(Arrive:String):Integer;
  336.  
  337. Var
  338.   D,
  339.   L,
  340.   Code,
  341.   Year : Integer;
  342.   Yr : String;
  343.  
  344. Begin
  345.   Yr:='';
  346.   L:=Length(Arrive);
  347.     For D:=(L-1) To L DO
  348.       Yr:=Yr+Arrive[D];
  349.   Val(Yr,Year,Code);
  350.   GetYear:=Year
  351. End;
  352.  
  353. Function CallH.LeadingZero(w : Word) : String;
  354. var
  355.   s : String;
  356. begin
  357.   Str(w:0,s);
  358.   if Length(s) = 1 then
  359.     s := '0' + s;
  360.   LeadingZero := s;
  361. end;
  362.  
  363. Function CallH.GetSelection(Pressed : Char) : Integer;
  364.  
  365.  Var
  366.   RealKey : Real;
  367.   Code : Integer;
  368.  
  369.  Begin
  370.   Val(Pressed,RealKey,Code);
  371.   If Code=0 Then
  372.       GetSelection := Trunc(RealKey)
  373.  End;
  374.  
  375. Function CallH.GetDayOfWeek(Year:Integer):Integer;
  376.  
  377. Var
  378.  OldYear,
  379.  OldMonth,
  380.  OldDay,
  381.  OldDOW,
  382.  NewYear,
  383.  NewMonth,
  384.  NewDay,
  385.  NewDOW : Word;
  386.  
  387. Begin
  388.  GetDate(OldYear,OldMonth,OldDay,OldDOW);
  389.  Year:=Year+1900;
  390.  SetDate(Year,1,1);
  391.  GetDate(NewYear,NewMonth,NewDay,NewDOW);
  392.  SetDate(OldYear,OldMonth,OldDay);
  393.  GetDayOfWeek:=NewDOW;
  394. End;
  395.  
  396. Function CallH.DayOfYear(Arrive:String):Integer;
  397.  
  398. Var
  399.   DPlus : Array[1..12] Of Integer;
  400.   L,
  401.   D, YearAdd,
  402.   Code,
  403.   Wm,
  404.   Wd,
  405.   Month,
  406.   Day,
  407.   Year : Integer;
  408.   Mth,
  409.   Dy,
  410.   Yr : String;
  411.  
  412. Begin
  413.   Mth:='';
  414.   Dy:='';
  415.   Yr:='';
  416.   L:=Length(Arrive);
  417.   Wm:=Pos('/',Arrive);
  418.    For D:=Wm To L Do
  419.     Begin
  420.      If Arrive[D]='/' Then
  421.      Wd:=D
  422.     End;
  423.     For D:=1 To (Wm-1) Do
  424.       Mth:=Mth+Arrive[D];
  425.     For D:=(Wm+1) To (Wd-1) Do
  426.       Dy:=Dy+Arrive[D];
  427.     For D:=(Wd+1) To L Do
  428.       Yr:=Yr+Arrive[D];
  429.  
  430.   Val(Mth,Month,Code);
  431.   Val(Dy,Day,Code);
  432.   Val(Yr,Year,Code);
  433.   DPlus[1]:=0;
  434.   DPlus[2]:=31;
  435.   DPlus[3]:=59;
  436.   DPlus[4]:=90;
  437.   DPlus[5]:=120;
  438.   DPlus[6]:=151;
  439.   DPlus[7]:=181;
  440.   DPlus[8]:=212;
  441.   DPlus[9]:=242;
  442.   DPlus[10]:=273;
  443.   DPlus[11]:=303;
  444.   DPlus[12]:=334;
  445.      If ((Year/4) = Trunc(Year/4)) And (Month>2) Then Day:=Day+1;
  446.   DayOfYear:=DPlus[Month]+Day;
  447. End;
  448.  
  449.  
  450. End.
  451.