home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MFM_119C.ZIP / DISPLAY.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-03  |  9KB  |  303 lines
  1. Unit Display;
  2. {========================================================================}
  3. Interface
  4.   Uses
  5.     MfmDefs;
  6.   Function GetDateString(PackedTime : Longint) : S8;
  7.   Function GetTimeString(PackedTime : Longint) : S8;
  8.   Function GetPackedTime(DateString, TimeString : S8) : Longint;
  9.   Procedure ShowSortRange(Row : Byte; EntryToShow : ListPtr);
  10.   Procedure BlankCurrentLocation;
  11.   Procedure DisplayCurrentLocation;
  12.   Procedure DisplayRecord(Row : Byte);
  13.   Procedure DisplayScreen;
  14.   Procedure LineUp;
  15.   Procedure LineDown;
  16.   Procedure PageUp;
  17.   Procedure PageDown;
  18.   Procedure TopOfList;
  19.   Procedure BottomOfList;
  20. {========================================================================}
  21. Implementation
  22.   Uses
  23.     Crt, Dos, Screen;
  24. {========================================================================}
  25. Function GetDateString(PackedTime : Longint) : S8;
  26.   Var
  27.     Month, Day : String[2];
  28.     Year : String[4];
  29.   Begin
  30.     UnpackTime(PackedTime,Date);
  31.     Str(Date.Month,Month); Str(Date.Day,Day); Str(Date.Year,Year);
  32.     If Length(Month) = 1 Then Month := '0' + Month;
  33.     If Length(Day) = 1 Then Day := '0' + Day;
  34.     Year := Copy(Year,3,2);
  35.     GetDateString := Month + '/' + Day + '/' + Year;
  36.   End;
  37. {========================================================================}
  38. Function GetTimeString(PackedTime : Longint) : S8;
  39.   Var
  40.     Hour, Min, Sec : String[2];
  41.   Begin
  42.     UnpackTime(PackedTime,Date);
  43.     Str(Date.Hour,Hour); Str(Date.Min,Min); Str(Date.Sec,Sec);
  44.     If Length(Hour) = 1 Then Hour := '0' + Hour;
  45.     If Length(Min) = 1 Then Min := '0' + Min;
  46.     If Length(Sec) = 1 Then Sec := '0' + Sec;
  47.     GetTimeString := Hour + ':' + Min + ':' + Sec;
  48.   End;
  49. {========================================================================}
  50. Function GetPackedTime(DateString, TimeString : S8) : Longint;
  51.   Var
  52.     Code : Word;
  53.     PackedTime : Longint;
  54.   Begin
  55.     Val(Copy(DateString,1,2),Date.Month,Code);
  56.     Val(Copy(DateString,4,2),Date.Day,Code);
  57.     Val('19'+Copy(DateString,7,2),Date.Year,Code);
  58.     Val(Copy(TimeString,1,2),Date.Hour,Code);
  59.     Val(Copy(TimeString,4,2),Date.Min,Code);
  60.     Val(Copy(TimeString,7,2),Date.Sec,Code);
  61.     PackTime(Date,PackedTime);
  62.     GetPackedTime := PackedTime;
  63.   End;
  64. {========================================================================}
  65. Procedure ShowSortRange(Row : Byte; EntryToShow : ListPtr);
  66.   Begin
  67.     If EntryToShow = BeginSort Then
  68.     Begin
  69.       AnsiGotoXY(Row,22);
  70.       NewTextColor(Blink+White);
  71.       If RedirectTo = Console Then Write('') Else Write('F');
  72.       NewTextColor(White);
  73.     End;
  74.     If EntryToShow = EndSort Then
  75.     Begin
  76.       AnsiGotoXY(Row,22);
  77.       NewTextColor(Blink+White);
  78.       If BeginSort = EndSort Then
  79.       Begin
  80.         If RedirectTo = Console Then Write('') Else Write('B');
  81.       End
  82.       Else
  83.       Begin
  84.         If RedirectTo = Console Then Write('') Else Write('L');
  85.       End;
  86.       NewTextColor(White);
  87.     End;
  88.   End;
  89. {========================================================================}
  90. Procedure BlankCurrentLocation;
  91.   Begin
  92.     AnsiGotoXY(Row,1);
  93.     If CurrentEntry^.Tagged Then
  94.     Begin
  95.       NewTextColor(White); Write('∙');
  96.     End
  97.     Else
  98.     Begin
  99.       NewTextColor(White); Write(' ');
  100.     End;
  101.     ShowSortRange(Row,CurrentEntry);
  102.     AnsiGotoXY(24,80);
  103.   End;
  104. {========================================================================}
  105. Procedure DisplayCurrentLocation;
  106.   Begin
  107.     AnsiGotoXY(Row,1);
  108.     If CurrentEntry^.Tagged Then
  109.     Begin
  110.       NewTextColor(White+Blink); Write('»'); NewTextColor(White);
  111.     End
  112.     Else
  113.     Begin
  114.       NewTextColor(White+Blink); Write('>'); NewTextColor(White);
  115.     End;
  116.     AnsiGotoXY(24,80);
  117.   End;
  118. {========================================================================}
  119. Procedure DisplayRecord(Row : Byte);
  120.   Begin
  121.     AnsiGotoXY(Row,1); AnsiClearToEOL;
  122.     NewTextColor(White);
  123.     If NextPrintEntry^.Tagged Then Write('∙');
  124.     AnsiGotoXY(Row,2);
  125.     Case NextPrintEntry^.TypeOfRecord Of
  126.       Comment :
  127.       Begin
  128.         NewTextColor(White);
  129.         Write(NextPrintEntry^.Description);
  130.       End;
  131.       FileRecord :
  132.       Begin
  133.         NewTextColor(Yellow);
  134.         Write(Copy(NextPrintEntry^.FileName+'            ',1,12));
  135.         NewTextColor(Magenta);
  136.         Write(NextPrintEntry^.FileSize:8);
  137.         NewTextColor(Green);
  138.         Write(' '+GetDateString(NextPrintEntry^.FileDate)+'  ');
  139.         NewTextColor(Cyan);
  140.         Write(Copy(NextPrintEntry^.Description,1,47));
  141.       End;
  142.       Orphan :
  143.       Begin
  144.         NewTextColor(Yellow);
  145.         Write(Copy(NextPrintEntry^.FileName+'            ',1,12));
  146.         NewTextColor(Magenta);
  147.         Write(NextPrintEntry^.FileSize:8);
  148.         NewTextColor(Green);
  149.         Write(' '+GetDateString(NextPrintEntry^.FileDate)+'  ');
  150.         NewTextColor(Red);
  151.         Write('Orphan');
  152.       End;
  153.       Offline :
  154.       Begin
  155.         NewTextColor(Yellow);
  156.         Write(Copy(NextPrintEntry^.FileName+'            ',1,12));
  157.         NewTextColor(Red);
  158.         Write(' offline           ');
  159.         NewTextColor(Cyan);
  160.         Write(Copy(NextPrintEntry^.Description,1,47));
  161.       End;
  162.     End;
  163.     ShowSortRange(Row,NextPrintEntry);
  164.   End;
  165. {========================================================================}
  166. Procedure DisplayScreen;
  167.   Var
  168.     Dsb : Byte;
  169.   Begin
  170.     NextPrintEntry := TopEntry;
  171.     Dsb := 1;
  172.     While (Dsb < 23) And (NextPrintEntry^.NextEntry <> NIL) Do
  173.     Begin
  174.       DisplayRecord(Dsb);
  175.       NextPrintEntry := NextPrintEntry^.NextEntry; Inc(Dsb);
  176.     End;
  177.     DisplayRecord(Dsb);
  178.     DisplayCurrentLocation;
  179.     If Dsb < 23 Then
  180.     Begin
  181.       Repeat
  182.         Inc(Dsb);
  183.         AnsiGotoXY(Dsb,1); AnsiClearToEOL;
  184.       Until Dsb = 23;
  185.     End;
  186.     AnsiGotoXY(24,80);
  187.   End;
  188. {========================================================================}
  189. Procedure LineUp;
  190.   Begin
  191.     If CurrentEntry^.PrevEntry <> NIL Then
  192.     Begin
  193.       If Row > 1 Then
  194.       Begin
  195.         BlankCurrentLocation;
  196.         Dec(Row); CurrentEntry := CurrentEntry^.PrevEntry;
  197.         DisplayCurrentLocation;
  198.       End
  199.       Else
  200.       Begin
  201.         CurrentEntry := CurrentEntry^.PrevEntry;
  202.         TopEntry := CurrentEntry;
  203.         DisplayScreen;
  204.       End;
  205.     End;
  206.   End;
  207. {========================================================================}
  208. Procedure LineDown;
  209.   Begin
  210.     If CurrentEntry^.NextEntry <> NIL Then
  211.     Begin
  212.       If Row <= 22 Then
  213.       Begin
  214.         BlankCurrentLocation;
  215.         Inc(Row); CurrentEntry := CurrentEntry^.NextEntry;
  216.         DisplayCurrentLocation;
  217.       End
  218.       Else
  219.       Begin
  220.         CurrentEntry := CurrentEntry^.NextEntry;
  221.         TopEntry := TopEntry^.NextEntry;
  222.         DisplayScreen;
  223.       End;
  224.     End;
  225.   End;
  226. {========================================================================}
  227. Procedure PageUp;
  228.   Begin
  229.     If NumberOfEntries <= 23 Then
  230.     Begin
  231.       CurrentEntry := FirstEntry; Row := 1;
  232.       DisplayScreen;
  233.     End
  234.     Else
  235.     Begin
  236.       Counter := 1;
  237.       While (Counter < 23) And (TopEntry^.PrevEntry <> NIL) Do
  238.       Begin
  239.         Inc(Counter); TopEntry := TopEntry^.PrevEntry;
  240.       End;
  241.       While (Counter > 1) And (CurrentEntry^.PrevEntry <> NIL) Do
  242.       Begin
  243.         Dec(Counter); CurrentEntry := CurrentEntry^.PrevEntry;
  244.       End;
  245.       Row := Row - (Counter - 1);
  246.       DisplayScreen;
  247.     End;
  248.   End;
  249. {========================================================================}
  250. Procedure PageDown;
  251.   Begin
  252.     If NumberOfEntries <= 23 Then
  253.     Begin
  254.       CurrentEntry := LastEntry; Row := NumberOfEntries;
  255.       DisplayScreen;
  256.     End
  257.     Else
  258.     Begin
  259.       Counter := 1;
  260.       While (Counter < 23) And (TopEntry^.NextEntry <> NIL) Do
  261.       Begin
  262.         Inc(Counter); TopEntry := TopEntry^.NextEntry;
  263.       End;
  264.       While (Counter > 1) And (CurrentEntry^.NextEntry <> NIL) Do
  265.       Begin
  266.         Dec(Counter); CurrentEntry := CurrentEntry^.NextEntry;
  267.       End;
  268.       Row := Row - (Counter - 1);
  269.       DisplayScreen;
  270.     End;
  271.   End;
  272. {========================================================================}
  273. Procedure TopOfList;
  274.   Begin
  275.     CurrentEntry := FirstEntry; TopEntry := FirstEntry; Row := 1;
  276.     DisplayScreen;
  277.   End;
  278. {========================================================================}
  279. Procedure BottomOfList;
  280.   Begin
  281.     If NumberOfEntries <= 23 Then
  282.     Begin
  283.       CurrentEntry := LastEntry;
  284.       Row := NumberOfEntries;
  285.       DisplayScreen;
  286.     End
  287.     Else
  288.     Begin
  289.       CurrentEntry := LastEntry; TopEntry := LastEntry;
  290.       Row := 23;
  291.       Repeat
  292.         TopEntry := TopEntry^.PrevEntry;
  293.         Dec(Row);
  294.       Until Row = 1;
  295.       Row := 23;
  296.       DisplayScreen;
  297.     End;
  298.   End;
  299. {========================================================================}
  300. Begin
  301. End.
  302. {========================================================================}
  303.