You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

blinklist.pas 2.3KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106
  1. { Copyright (C) 2005 Bas Steendijk
  2. For conditions of distribution and use, see copyright notice in zlib_license.txt
  3. which is included in the package
  4. ----------------------------------------------------------------------------- }
  5. unit blinklist;
  6. {$ifdef fpc}
  7. {$mode delphi}
  8. {$endif}
  9. interface
  10. type
  11. tlinklist=class(tobject)
  12. next:tlinklist;
  13. prev:tlinklist;
  14. constructor create;
  15. destructor destroy; override;
  16. end;
  17. {linklist with 2 links}
  18. tlinklist2=class(tlinklist)
  19. next2:tlinklist2;
  20. prev2:tlinklist2;
  21. end;
  22. {linklist with one pointer}
  23. tplinklist=class(tlinklist)
  24. p:pointer
  25. end;
  26. tstringlinklist=class(tlinklist)
  27. s:string;
  28. end;
  29. tthing=class(tlinklist)
  30. name:string; {name/nick}
  31. hashname:integer; {hash of name}
  32. end;
  33. {
  34. adding new block to list (baseptr)
  35. }
  36. procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);
  37. procedure linklistdel(var baseptr:tlinklist;item:tlinklist);
  38. procedure linklist2add(var baseptr,newptr:tlinklist2);
  39. procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);
  40. var
  41. linklistdebug:integer;
  42. implementation
  43. procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);
  44. var
  45. p:tlinklist;
  46. begin
  47. p := baseptr;
  48. baseptr := newptr;
  49. baseptr.prev := nil;
  50. baseptr.next := p;
  51. if p <> nil then p.prev := baseptr;
  52. end;
  53. procedure linklistdel(var baseptr:tlinklist;item:tlinklist);
  54. begin
  55. if item = baseptr then baseptr := item.next;
  56. if item.prev <> nil then item.prev.next := item.next;
  57. if item.next <> nil then item.next.prev := item.prev;
  58. end;
  59. procedure linklist2add(var baseptr,newptr:tlinklist2);
  60. var
  61. p:tlinklist2;
  62. begin
  63. p := baseptr;
  64. baseptr := newptr;
  65. baseptr.prev2 := nil;
  66. baseptr.next2 := p;
  67. if p <> nil then p.prev2 := baseptr;
  68. end;
  69. procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);
  70. begin
  71. if item = baseptr then baseptr := item.next2;
  72. if item.prev2 <> nil then item.prev2.next2 := item.next2;
  73. if item.next2 <> nil then item.next2.prev2 := item.prev2;
  74. end;
  75. constructor tlinklist.create;
  76. begin
  77. inherited create;
  78. inc(linklistdebug);
  79. end;
  80. destructor tlinklist.destroy;
  81. begin
  82. dec(linklistdebug);
  83. inherited destroy;
  84. end;
  85. end.