home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mailpro / sortlisu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  4.9 KB  |  178 lines
  1. unit SortLisU;
  2.  
  3. interface
  4. uses Crt,     Def,    ColorDef, SetBU,    ShadoU,   FastWr, LPaU, Str2InU,
  5.      GetForU, UCasU,  RE,       CursorOU, DrawSqar, CPaU;
  6. procedure SortList( var Stack:              BlockArray;
  7.                          StackTop:          integer;
  8.                      var FirstSortElement:  integer);
  9.  
  10. implementation
  11.  
  12. procedure SortList;
  13. type
  14. LinkPointer = ^Node;
  15. Node        = record
  16.               Info:       string;
  17.               RecordNum:  integer;
  18.               Left,
  19.               Right:      LinkPointer
  20.               end;
  21.  
  22. var
  23. Info:         string;
  24. Offset,
  25. Position,
  26. I:            integer;
  27. Top,
  28. P,
  29. A:            LinkPointer;
  30. Order:        array [0..LastDescription] of integer;
  31.  
  32.  
  33.    procedure SelectOrder;
  34.    var Error,
  35.        I,
  36.        AllowControl,
  37.        Entry:            integer;
  38.        TempStr:          S10;
  39.        AllowInput:       boolean;
  40.    begin
  41.    SetBG;
  42.    clrscr;
  43.    Order[0] := 0;
  44.    Shadow( 1, 3, 29, LastDescription+4, Menus.Attr, true);
  45.    for I := 1 to LastDescription do
  46.        begin
  47.        str(I:3,TempStr);
  48.        FastWrite( LPad(TempStr+' '+Description[I],25), I+3, 3, Menus.Attr);
  49.        end;
  50.    Entry := 7;
  51.    FastWrite( 'Enter zero (0) to sort !', 1, 33, Msgs.Attr);
  52.    while Entry <> 0 do
  53.       begin
  54.       FastWrite('Next in order ? (-1 = restart)  ', 3+Order[0], 33, Inputs.Attr);
  55.       AllowInput := true;
  56.       AllowControl := -1;
  57.       Entry := Str2Int( GetForm( 67, 3+Order[0], 2, '  ', '0', AllowControl,
  58.                         AllowInput, (Inputs.Attr or $0008), ['0'..'9','-']),
  59.                Error);
  60.       SetBG;
  61.       if ((Entry < 1) and (Entry <> -1)) or (Entry > LastDescription) then
  62.          Entry := 0
  63.         else
  64.          if Entry <> -1 then
  65.             begin
  66.             inc(Order[0]);
  67.             Order[Order[0]] := Entry;
  68.             gotoxy(33,2+Order[0]);    clreol;
  69.             FastWrite( LPad( Description[Order[Order[0]]],45),
  70.                        2+Order[0], 33, Msgs.Attr);
  71.             end
  72.            else
  73.             begin
  74.             for I := 1 to succ(Order[0]) do
  75.                 begin
  76.                 FastWrite( copy(BlankLine,1,49), 2+I, 33, Displays.Attr);
  77.                 end;
  78.             Order[0] := 0;
  79.             end;
  80.       end;
  81.    end;
  82.  
  83.    procedure AssignValues( RecordNum: integer; var A: LinkPointer);
  84.    var Field,
  85.        ZipPositions,
  86.        I:                      integer;
  87.        TempEntry:                 MainRecordType;
  88.    begin
  89.    GetRec(TempEntry,RecordNum);
  90.    with TempEntry do
  91.       begin
  92.       new(A);
  93.       A^.Left := nil;
  94.       A^.Right := nil;
  95.       A^.RecordNum  := RecordNum;
  96.       A^.Info := '';
  97.       for I := 1 to Order[0] do
  98.           begin
  99.           Field := Order[I];
  100.           case Field of
  101.               1:  A^.Info := A^.Info + UCase(Addressee);
  102.               2:  A^.Info := A^.Info + UCase(Title);
  103.               3:  A^.Info := A^.Info + UCase(Company);
  104.               4:  A^.Info := A^.Info + UCase(AuxAddress);
  105.               5:  A^.Info := A^.Info + UCase(MailAddress);
  106.               6:  A^.Info := A^.Info + UCase(City);
  107.               7:  A^.Info := A^.Info + UCase(State);
  108.               8:  begin
  109.                   if (ord(ZipCode[7]) < 48)
  110.                   or (ord(ZipCode[7]) > 57) then
  111.                         ZipPositions := 5
  112.                        else
  113.                         ZipPositions := 10;
  114.                   A^.Info := A^.Info + UCase(copy(ZipCode,1,ZipPositions));
  115.                   end;
  116.               9:  A^.Info := A^.Info + UCase(Phone1);
  117.              10:  A^.Info := A^.Info + UCase(Phone2);
  118.              11:  A^.Info := A^.Info + UCase(Comments);
  119.              end;   (* case *)
  120.           end;      (* for loop *)
  121.       end;          (* with statement *)
  122.    end;
  123.  
  124.    procedure Sort( Info: string; A,P: LinkPointer);
  125.    begin
  126.    if Info >= P^.Info then
  127.       begin
  128.       if P^.Right = nil then
  129.          P^.Right := A
  130.         else
  131.          Sort(Info,A,P^.Right);
  132.       end
  133.      else
  134.       begin
  135.       if P^.Left = nil then
  136.          P^.Left := A
  137.         else
  138.          Sort(Info,A,P^.Left);
  139.       end;
  140.    end;
  141.  
  142.    procedure Traverse( A: LinkPointer);
  143.    begin
  144.    if A <> nil then
  145.       begin
  146.       Traverse(A^.Left);
  147.       inc(Position);
  148.       Stack[Position] := A^.RecordNum;
  149.       Traverse(A^.Right)
  150.       end;
  151.    end;
  152.  
  153. begin
  154. SelectOrder;
  155. if Order[0]  >  0 then
  156.    begin
  157.    CursorOn(false);
  158.    SetBG;
  159.    clrscr;
  160.    DrawSquare( 30, 10, 50, 15, Msgs.Attr, true);
  161.    FastWrite( CPad('Standby',10), 12, 35, Msgs.Attr);
  162.    FastWrite( CPad('Sorting',10), 13, 35, (Msgs.Attr or $0080));
  163.    AssignValues(Stack[1],Top);
  164.    for I := 2 to StackTop do
  165.        begin
  166.        AssignValues(Stack[I],A);
  167.        Sort(A^.Info,A,Top)
  168.        end;
  169.    Position := 0;
  170.    Traverse(Top);
  171.    FirstSortElement := Order[1];
  172.    clrscr;
  173.    CursorOn(true);
  174.    end;
  175. end;
  176.  
  177. end.
  178.