home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / progm / tot5.zip / EXTDEM6.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-11  |  4KB  |  139 lines
  1. Program ExtendedDemoSix;
  2. {EXTDEM6 - this program shows how to extend RecordListOBJ object 
  3.            from the extLINK unit, and ListLinkDLL from totLINK to
  4.            produce a customised record Lister.}
  5.  
  6. Uses DOS,CRT,
  7.      totFAST, totINPUT, totIO2, totLIST, extLINK, totSTR, totLINK;
  8.  
  9.  
  10. TYPE
  11.   
  12. Rec2DLLOBJ = object (RecordDLLOBJ)
  13.    constructor Init;
  14.    function    GetStr(Node:DLLNodePtr;Start,Finish: longint):string;  VIRTUAL;
  15.    destructor  Done;                                                  VIRTUAL;
  16. end; {Rec2DLLOBJ}
  17.  
  18. ListRecOBJ = object (ListLinkOBJ)
  19.    constructor Init;
  20.    function    MessageTask(HiPick:longint):string;                    VIRTUAL;
  21.    destructor  Done;                                                  VIRTUAL;
  22. end; {ListRecOBJ}
  23.  
  24. VAR
  25.   RecList: Rec2DLLOBJ;
  26.   ListWin: ListRecOBJ;
  27.  
  28. {\\\\\\\\\\\\\\\\\\ OBJECT EXTENSIONS \\\\\\\\\\\\\\\\\\\\\\\\}
  29. constructor Rec2DLLOBJ.Init;
  30. {}
  31. begin
  32.    RecordDLLOBJ.Init;
  33. end; {Rec2DLLOBJ.Init}
  34.  
  35. function Rec2DLLOBJ.GetStr(Node:DLLNodePtr;Start,Finish: longint):string;
  36. {gets last name only for displaying in list}
  37. var 
  38.   Temp: string;
  39.   Rec: RecordInfo;
  40. begin
  41.    if Node = nil then
  42.       GetStr := 'Not found'
  43.    else
  44.    begin
  45.       If (Start = 0) and (Finish = 0) then {must be a call from message!}
  46.          GetStr := RecordDLLOBJ.GetStr(Node,1,80)
  47.       else
  48.       begin
  49.          GetNodeData(Node,Rec);  {inherited method}
  50.          Temp := Rec.LastName;
  51.          GetStr := copy(Temp,Start,succ(Finish-start));
  52.       end;
  53.    end;
  54. end; {Rec2DLLOBJ.GetStr}
  55.  
  56. destructor Rec2DLLOBJ.Done;
  57. {}
  58. begin
  59.    RecordDLLOBJ.Done;
  60. end; {Rec2DLLOBJ.Done}
  61.  
  62. constructor ListRecOBJ.Init;
  63. {}
  64. begin
  65.    ListLinkOBJ.Init;
  66.    vMsgActive := true;
  67. end; {ListRecOBJ.Init}
  68.  
  69. function ListRecOBJ.MessageTask(HiPick:longint):string;
  70. {returns the record details as the message}
  71. var 
  72.   Temp: string;
  73.   Rec: RecordInfo;
  74. begin
  75.    MessageTask := vLinkList^.GetStr(vLinkList^.NodePtr(HiPick),0,0);
  76. end; {ListRecOBJ.MessageTask}
  77.  
  78. destructor ListRecOBJ.Done;                              
  79. {}
  80. begin
  81.    ListLinkOBJ.Done;
  82. end; {ListRecOBJ.Done}
  83. {\\\\\\\\\\\\\\\\\\ MAIN PROGRAM CODE \\\\\\\\\\\\\\\\\\\\\\\\}
  84. procedure BuildTheList(Filename:string);
  85. {loads in the data from disk - could also be from d/b}
  86. var 
  87.   F: file of RecordInfo;
  88.   Rec: RecordInfo;
  89.   Ecode: integer;
  90. begin
  91.    assign(F,filename);
  92.    {$I-}
  93.    reset(F);
  94.    {$I+}
  95.    if ioresult <> 0 then
  96.    begin
  97.       clrscr;
  98.       writeln('The file ',filename,' cannot be located.');
  99.       writeln('Demo aborting. Run demo from directory containing file.');
  100.       halt(1);
  101.    end;
  102.    Ecode := 0;
  103.    RecList.Init;
  104.    while not eof(F) and (Ecode = 0) do
  105.    begin
  106.       Read(F,Rec);
  107.       with Rec do
  108.       begin
  109.          FirstName:= padleft(FirstName,15,' ');
  110.          LastName:= padleft(LastName,15,' ');
  111.          Company:= padleft(Company,20,' ');
  112.       end;
  113.       Ecode := RecList.Add(Rec);
  114.    end;
  115.    close(F);
  116. end; {BuildtheList}
  117.  
  118. begin {Main program}
  119.    Clrscr;
  120.    Screen.WriteCenter(12,143,'Reading and Sorting Database');
  121.    BuildTheList('EXTDEM5.DBF');
  122.    RecList.Sort(1,true);
  123.    Screen.Clear(white,'░'); {paint the screen}
  124.    Key.SetFast;
  125.    with FMTNumberTOT do
  126.    begin
  127.       SetJustification(JustRight);
  128.       SetPrefixSuffix('$','');
  129.    end;
  130.    with ListWin do
  131.    begin
  132.       Init;
  133.       Win^.SetTitle(' D/B List ');
  134.       AssignList(RecList);
  135.       SetColWidth(17);
  136.       Go;
  137.    end;
  138. end.
  139.