Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/MFM_119C.ZIP/DISPLAY.PAS

Pascal/Delphi Source File | 1993-06-03 | 8.9 KB | 303 lines

Unit Display;
{========================================================================}
Interface
  Uses
    MfmDefs;
  Function GetDateString(PackedTime : Longint) : S8;
  Function GetTimeString(PackedTime : Longint) : S8;
  Function GetPackedTime(DateString, TimeString : S8) : Longint;
  Procedure ShowSortRange(Row : Byte; EntryToShow : ListPtr);
  Procedure BlankCurrentLocation;
  Procedure DisplayCurrentLocation;
  Procedure DisplayRecord(Row : Byte);
  Procedure DisplayScreen;
  Procedure LineUp;
  Procedure LineDown;
  Procedure PageUp;
  Procedure PageDown;
  Procedure TopOfList;
  Procedure BottomOfList;
{========================================================================}
Implementation
  Uses
    Crt, Dos, Screen;
{========================================================================}
Function GetDateString(PackedTime : Longint) : S8;
  Var
    Month, Day : String[2];
    Year : String[4];
  Begin
    UnpackTime(PackedTime,Date);
    Str(Date.Month,Month); Str(Date.Day,Day); Str(Date.Year,Year);
    If Length(Month) = 1 Then Month := '0' + Month;
    If Length(Day) = 1 Then Day := '0' + Day;
    Year := Copy(Year,3,2);
    GetDateString := Month + '/' + Day + '/' + Year;
  End;
{========================================================================}
Function GetTimeString(PackedTime : Longint) : S8;
  Var
    Hour, Min, Sec : String[2];
  Begin
    UnpackTime(PackedTime,Date);
    Str(Date.Hour,Hour); Str(Date.Min,Min); Str(Date.Sec,Sec);
    If Length(Hour) = 1 Then Hour := '0' + Hour;
    If Length(Min) = 1 Then Min := '0' + Min;
    If Length(Sec) = 1 Then Sec := '0' + Sec;
    GetTimeString := Hour + ':' + Min + ':' + Sec;
  End;
{========================================================================}
Function GetPackedTime(DateString, TimeString : S8) : Longint;
  Var
    Code : Word;
    PackedTime : Longint;
  Begin
    Val(Copy(DateString,1,2),Date.Month,Code);
    Val(Copy(DateString,4,2),Date.Day,Code);
    Val('19'+Copy(DateString,7,2),Date.Year,Code);
    Val(Copy(TimeString,1,2),Date.Hour,Code);
    Val(Copy(TimeString,4,2),Date.Min,Code);
    Val(Copy(TimeString,7,2),Date.Sec,Code);
    PackTime(Date,PackedTime);
    GetPackedTime := PackedTime;
  End;
{========================================================================}
Procedure ShowSortRange(Row : Byte; EntryToShow : ListPtr);
  Begin
    If EntryToShow = BeginSort Then
    Begin
      AnsiGotoXY(Row,22);
      NewTextColor(Blink+White);
      If RedirectTo = Console Then Write('') Else Write('F');
      NewTextColor(White);
    End;
    If EntryToShow = EndSort Then
    Begin
      AnsiGotoXY(Row,22);
      NewTextColor(Blink+White);
      If BeginSort = EndSort Then
      Begin
        If RedirectTo = Console Then Write('') Else Write('B');
      End
      Else
      Begin
        If RedirectTo = Console Then Write('') Else Write('L');
      End;
      NewTextColor(White);
    End;
  End;
{========================================================================}
Procedure BlankCurrentLocation;
  Begin
    AnsiGotoXY(Row,1);
    If CurrentEntry^.Tagged Then
    Begin
      NewTextColor(White); Write('∙');
    End
    Else
    Begin
      NewTextColor(White); Write(' ');
    End;
    ShowSortRange(Row,CurrentEntry);
    AnsiGotoXY(24,80);
  End;
{========================================================================}
Procedure DisplayCurrentLocation;
  Begin
    AnsiGotoXY(Row,1);
    If CurrentEntry^.Tagged Then
    Begin
      NewTextColor(White+Blink); Write('»'); NewTextColor(White);
    End
    Else
    Begin
      NewTextColor(White+Blink); Write('>'); NewTextColor(White);
    End;
    AnsiGotoXY(24,80);
  End;
{========================================================================}
Procedure DisplayRecord(Row : Byte);
  Begin
    AnsiGotoXY(Row,1); AnsiClearToEOL;
    NewTextColor(White);
    If NextPrintEntry^.Tagged Then Write('∙');
    AnsiGotoXY(Row,2);
    Case NextPrintEntry^.TypeOfRecord Of
      Comment :
      Begin
        NewTextColor(White);
        Write(NextPrintEntry^.Description);
      End;
      FileRecord :
      Begin
        NewTextColor(Yellow);
        Write(Copy(NextPrintEntry^.FileName+'            ',1,12));
        NewTextColor(Magenta);
        Write(NextPrintEntry^.FileSize:8);
        NewTextColor(Green);
        Write(' '+GetDateString(NextPrintEntry^.FileDate)+'  ');
        NewTextColor(Cyan);
        Write(Copy(NextPrintEntry^.Description,1,47));
      End;
      Orphan :
      Begin
        NewTextColor(Yellow);
        Write(Copy(NextPrintEntry^.FileName+'            ',1,12));
        NewTextColor(Magenta);
        Write(NextPrintEntry^.FileSize:8);
        NewTextColor(Green);
        Write(' '+GetDateString(NextPrintEntry^.FileDate)+'  ');
        NewTextColor(Red);
        Write('Orphan');
      End;
      Offline :
      Begin
        NewTextColor(Yellow);
        Write(Copy(NextPrintEntry^.FileName+'            ',1,12));
        NewTextColor(Red);
        Write(' offline           ');
        NewTextColor(Cyan);
        Write(Copy(NextPrintEntry^.Description,1,47));
      End;
    End;
    ShowSortRange(Row,NextPrintEntry);
  End;
{========================================================================}
Procedure DisplayScreen;
  Var
    Dsb : Byte;
  Begin
    NextPrintEntry := TopEntry;
    Dsb := 1;
    While (Dsb < 23) And (NextPrintEntry^.NextEntry <> NIL) Do
    Begin
      DisplayRecord(Dsb);
      NextPrintEntry := NextPrintEntry^.NextEntry; Inc(Dsb);
    End;
    DisplayRecord(Dsb);
    DisplayCurrentLocation;
    If Dsb < 23 Then
    Begin
      Repeat
        Inc(Dsb);
        AnsiGotoXY(Dsb,1); AnsiClearToEOL;
      Until Dsb = 23;
    End;
    AnsiGotoXY(24,80);
  End;
{========================================================================}
Procedure LineUp;
  Begin
    If CurrentEntry^.PrevEntry <> NIL Then
    Begin
      If Row > 1 Then
      Begin
        BlankCurrentLocation;
        Dec(Row); CurrentEntry := CurrentEntry^.PrevEntry;
        DisplayCurrentLocation;
      End
      Else
      Begin
        CurrentEntry := CurrentEntry^.PrevEntry;
        TopEntry := CurrentEntry;
        DisplayScreen;
      End;
    End;
  End;
{========================================================================}
Procedure LineDown;
  Begin
    If CurrentEntry^.NextEntry <> NIL Then
    Begin
      If Row <= 22 Then
      Begin
        BlankCurrentLocation;
        Inc(Row); CurrentEntry := CurrentEntry^.NextEntry;
        DisplayCurrentLocation;
      End
      Else
      Begin
        CurrentEntry := CurrentEntry^.NextEntry;
        TopEntry := TopEntry^.NextEntry;
        DisplayScreen;
      End;
    End;
  End;
{========================================================================}
Procedure PageUp;
  Begin
    If NumberOfEntries <= 23 Then
    Begin
      CurrentEntry := FirstEntry; Row := 1;
      DisplayScreen;
    End
    Else
    Begin
      Counter := 1;
      While (Counter < 23) And (TopEntry^.PrevEntry <> NIL) Do
      Begin
        Inc(Counter); TopEntry := TopEntry^.PrevEntry;
      End;
      While (Counter > 1) And (CurrentEntry^.PrevEntry <> NIL) Do
      Begin
        Dec(Counter); CurrentEntry := CurrentEntry^.PrevEntry;
      End;
      Row := Row - (Counter - 1);
      DisplayScreen;
    End;
  End;
{========================================================================}
Procedure PageDown;
  Begin
    If NumberOfEntries <= 23 Then
    Begin
      CurrentEntry := LastEntry; Row := NumberOfEntries;
      DisplayScreen;
    End
    Else
    Begin
      Counter := 1;
      While (Counter < 23) And (TopEntry^.NextEntry <> NIL) Do
      Begin
        Inc(Counter); TopEntry := TopEntry^.NextEntry;
      End;
      While (Counter > 1) And (CurrentEntry^.NextEntry <> NIL) Do
      Begin
        Dec(Counter); CurrentEntry := CurrentEntry^.NextEntry;
      End;
      Row := Row - (Counter - 1);
      DisplayScreen;
    End;
  End;
{========================================================================}
Procedure TopOfList;
  Begin
    CurrentEntry := FirstEntry; TopEntry := FirstEntry; Row := 1;
    DisplayScreen;
  End;
{========================================================================}
Procedure BottomOfList;
  Begin
    If NumberOfEntries <= 23 Then
    Begin
      CurrentEntry := LastEntry;
      Row := NumberOfEntries;
      DisplayScreen;
    End
    Else
    Begin
      CurrentEntry := LastEntry; TopEntry := LastEntry;
      Row := 23;
      Repeat
        TopEntry := TopEntry^.PrevEntry;
        Dec(Row);
      Until Row = 1;
      Row := 23;
      DisplayScreen;
    End;
  End;
{========================================================================}
Begin
End.
{========================================================================}