home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TOTSRC.ZIP / EXTLINK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-10  |  3.9 KB  |  148 lines
  1. Unit ExtLINK;
  2. {Illustrates how you can extend the Toolkit DLLOBJ to provide
  3.  a list for records}
  4.  
  5. {$I TOTFLAGS.INC}
  6. INTERFACE
  7. Uses DOS,CRT,
  8.      totINPUT, totFAST, totSTR, totDATE, totIO2, totLINK, totLIST;
  9.  
  10. TYPE
  11. RecordInfo = record
  12.    FirstName: string[15];
  13.    LastName: string[15];
  14.    Company: string[20];
  15.    Tel: string[10];
  16.    CumDollarsSpent: real;
  17.    LastOrder: longint;
  18.    Comments: string[40];
  19. end;
  20.  
  21. RecordDLLOBJ = object (DLLOBJ)
  22.    constructor Init;
  23.    function    Add(Rec:RecordInfo): integer;
  24.    function    Change(Node:DLLNodePtr;Rec:RecordInfo): integer;
  25.    function    InsertBefore(Node:DLLNodePtr;Rec:RecordInfo): integer;
  26.    function    WrongOrder(Node1,Node2:DLLNodePtr;Asc:boolean): boolean; VIRTUAL;
  27.    function    GetStr(Node:DLLNodePtr;Start,Finish: longint):string;    VIRTUAL;
  28.    destructor  Done; 
  29. end; {RecordDLLOBJ}
  30.  
  31. IMPLEMENTATION
  32.  
  33. {\\\\\\\\\\\\\\ RecordDLLOBJ METHODS \\\\\\\\\\\\\\\\\\\\}
  34.  
  35. constructor RecordDLLOBJ.Init;
  36. {}
  37. begin
  38.    DLLOBJ.Init;
  39. end; {RecordDLLOBJ.Init}
  40.  
  41. function RecordDLLOBJ.Add(Rec:RecordInfo): integer;
  42. {}
  43. begin
  44.    Add := DLLOBJ.Add(Rec,sizeof(Rec));
  45. end; {RecordDLLOBJ.Add}
  46.  
  47. function RecordDLLOBJ.Change(Node:DLLNodePtr;Rec:RecordInfo): integer;
  48. {}
  49. begin
  50.    Change := DLLOBJ.Change(Node,Rec,sizeof(Rec));
  51. end; {RecordDLLOBJ.Change}
  52.  
  53. function RecordDLLOBJ.InsertBefore(Node:DLLNodePtr;Rec:RecordInfo): integer;
  54. {}
  55. begin
  56.    InsertBefore := DLLOBJ.InsertBefore(Node,Rec,sizeof(Rec));
  57. end; {RecordDLLOBJ.InsertBefore}
  58.  
  59. function RecordDLLOBJ.WrongOrder(Node1,Node2:DLLNodePtr;Asc:boolean): boolean;
  60. {This is called by the DLLOBJ sort routine to see if two items are in the
  61.  correct order. You must check vSortID to determine which element of the 
  62.  record to sort on.}
  63. var
  64.   S1,S2: string;
  65.   Rec1,Rec2: RecordInfo;
  66.   R1,R2: real;
  67.   D1,D2: longint;
  68. begin
  69.    GetNodeData(Node1,Rec1);
  70.    GetNodeData(Node2,Rec2);
  71.    if vSortID in [1,2,3] then
  72.    begin
  73.       case vSortID of
  74.          1:begin      {LastName}
  75.             S1 := Rec1.LastName;
  76.             S2 := Rec2.LastName;
  77.          end;
  78.          2: begin     {Company}
  79.             S1 := Rec1.Company;
  80.             S2 := Rec2.Company;
  81.          end;
  82.          3: begin     {Tel}
  83.             S1 := Rec1.Tel;
  84.             S2 := Rec2.Tel;
  85.          end;
  86.       end; {case}
  87.       if Asc then
  88.          WrongOrder := (S1 > S2)
  89.       else
  90.          WrongOrder := (S2 > S1);
  91.    end
  92.    else if vSortID = 4 then  {CumDollars}
  93.    begin
  94.       R1 := Rec1.CumDollarsSpent;
  95.       R2 := Rec2.CumDollarsSpent;
  96.       if Asc then
  97.          WrongOrder := (R1 > R2)
  98.       else
  99.          WrongOrder := (R2 > R1);
  100.    end
  101.    else  {LastOrder}
  102.    begin
  103.       D1 := Rec1.LastOrder;
  104.       D2 := Rec2.LastOrder;
  105.       if Asc then
  106.          WrongOrder := (D1 > D2)
  107.       else
  108.          WrongOrder := (D2 > D1);
  109.    end;
  110. end; {RecordDLLOBJ.WrongOrder}
  111.  
  112. function RecordDLLOBJ.GetStr(Node:DLLNodePtr;Start,Finish: longint):string;   
  113. {Returns string representation of record}
  114. var 
  115.   Temp: string;
  116.   Rec: RecordInfo;
  117. begin
  118.    if Node = nil then
  119.       GetStr := 'Not found'
  120.    else
  121.    begin
  122.       GetNodeData(Node,Rec);  {inherited method}
  123.       with Rec do
  124.       begin
  125.          Temp := inttostr(ActiveNodeNumber)+': '+
  126.                  FirstName+
  127.                  LastName+
  128.                  Company;
  129.          if Finish > 53 then
  130.             Temp := Temp + PicFormat(Tel,'(###) ###-####',' ')+' ';
  131.          if Finish > 68 then
  132.             Temp := Temp + JultoStr(LastOrder,MMDDYY)+' ';
  133.          if Finish > 77 then
  134.             Temp := Temp + FmtNumberTOT.FormattedReal(CumDollarsSpent,2,10)+' ';
  135.          if Finish > 88 then
  136.             Temp := Temp + Comments;
  137.        end;
  138.        GetStr := copy(Temp,Start,succ(Finish-start));
  139.     end;
  140. end; {RecordDLLOBJ.GetStr}
  141.  
  142. destructor RecordDLLOBJ.Done; 
  143. {}
  144. begin
  145.    DLLOBJ.Done;
  146. end; {RecordDLLOBJ.Done}
  147.  
  148. end.