WebSVN – oidplus – Diff – /trunk_dos/STRLIST.PAS



unit STRLIST;
 
(************************************************)
(* STRLIST.PAS                                  *)
(* Author:   Daniel Marschall                   *)
(* Revision: 2022-02-14                         *)
(* License:  Apache 2.0                         *)
(* This file contains:                          *)
(* - StringList implementation for Turbo Pascal *)
(************************************************)
 

    init: boolean;
    element: string;
    next: PStringList;
  end;
 
procedure CreateList(var list: PStringList);
procedure FreeList(list: PStringList);
function ListContains(list: PStringList; val: string): boolean;
procedure ListClear(list: PStringList);
function ListAppend(list: PStringList; str: string): integer;
function ListCount(list: PStringList): integer;
procedure ListDeleteElement(list: PStringlist; idx: integer);
function ListGetElement(list: PStringList; idx: integer): string;
procedure ListSetElement(list: PStringList; idx: integer; value: string);
procedure ListInsert(list: PStringlist; str: string; idx: integer);

implementation
 
uses
  VtsFuncs;
 
procedure CreateList(var list: PStringList);
begin
  GetMem(list, SizeOf(TStringList));
  list^.init := false;
  list^.element := '';
  list^.next := nil;

  begin
    ListDeleteElement(list, 0);
  end;
end;
 
function ListAppend(list: PStringList; str: string): integer;
var
  new: PStringList;
  tmp: PStringList;
  cnt: integer;
begin
  cnt := 0;
  if not list^.init then
  begin
   list^.element := str;
   list^.init := true;
  end
  else
  begin
    Inc(cnt);
    GetMem(new, sizeof(TStringList));
    new^.element := str;
    new^.next := nil;
    new^.init := true;
 
    tmp := list;
    while tmp^.next <> nil do
    begin
      tmp := tmp^.next;
      Inc(cnt);
    end;
 
    tmp^.next := new;
  end;
 
  ListAppend := cnt; (* Return the index where the new element was put *)
end;
 
function ListCount(list: PStringList): integer;
var
  cnt: integer;

Rev 733	Rev 735
Line 1...	Line 1...
1	unit STRLIST;	1	unit STRLIST;
2		2
3	(************************************************)	3	(************************************************)
4	(* STRLIST.PAS *)	4	(* STRLIST.PAS *)
5	(* Author: Daniel Marschall *)	5	(* Author: Daniel Marschall *)
6	(* Revision: 2020-09-11 *)	6	(* Revision: 2022-02-14 *)
7	(* License: Apache 2.0 *)	7	(* License: Apache 2.0 *)
8	(* This file contains: *)	8	(* This file contains: *)
9	(* - StringList implementation for Turbo Pascal *)	9	(* - StringList implementation for Turbo Pascal *)
10	(************************************************)	10	(************************************************)
11		11
Line 17...	Line 17...
17	init: boolean;	17	init: boolean;
18	element: string;	18	element: string;
19	next: PStringList;	19	next: PStringList;
20	end;	20	end;
21		21
22	procedure InitList(var list: PStringList);	22	procedure CreateList(var list: PStringList);
23	procedure FreeList(list: PStringList);	23	procedure FreeList(list: PStringList);
24	function ListContains(list: PStringList; val: string): boolean;	24	function ListContains(list: PStringList; val: string): boolean;
25	procedure ListClear(list: PStringList);	25	procedure ListClear(list: PStringList);
26	procedure ListAppend(list: PStringList; str: string);	26	function ListAppend(list: PStringList; str: string): integer;
27	function ListCount(list: PStringList): integer;	27	function ListCount(list: PStringList): integer;
28	procedure ListDeleteElement(list: PStringlist; idx: integer);	28	procedure ListDeleteElement(list: PStringlist; idx: integer);
29	function ListGetElement(list: PStringList; idx: integer): string;	29	function ListGetElement(list: PStringList; idx: integer): string;
30	procedure ListSetElement(list: PStringList; idx: integer; value: string);	30	procedure ListSetElement(list: PStringList; idx: integer; value: string);
31	procedure ListInsert(list: PStringlist; str: string; idx: integer);	31	procedure ListInsert(list: PStringlist; str: string; idx: integer);
Line 37...	Line 37...
37	implementation	37	implementation
38		38
39	uses	39	uses
40	VtsFuncs;	40	VtsFuncs;
41		41
42	procedure InitList(var list: PStringList);	42	procedure CreateList(var list: PStringList);
43	begin	43	begin
44	GetMem(list, SizeOf(TStringList));	44	GetMem(list, SizeOf(TStringList));
45	list^.init := false;	45	list^.init := false;
46	list^.element := '';	46	list^.element := '';
47	list^.next := nil;	47	list^.next := nil;
Line 75...	Line 75...
75	begin	75	begin
76	ListDeleteElement(list, 0);	76	ListDeleteElement(list, 0);
77	end;	77	end;
78	end;	78	end;
79		79
80	procedure ListAppend(list: PStringList; str: string);	80	function ListAppend(list: PStringList; str: string): integer;
81	var	81	var
82	new: PStringList;	82	new: PStringList;
83	tmp: PStringList;	83	tmp: PStringList;
-		84	cnt: integer;
84	begin	85	begin
-		86	cnt := 0;
85	if not list^.init then	87	if not list^.init then
86	begin	88	begin
87	list^.element := str;	89	list^.element := str;
88	list^.init := true;	90	list^.init := true;
89	end	91	end
90	else	92	else
91	begin	93	begin
-		94	Inc(cnt);
92	GetMem(new, sizeof(TStringList));	95	GetMem(new, sizeof(TStringList));
93	new^.element := str;	96	new^.element := str;
94	new^.next := nil;	97	new^.next := nil;
95	new^.init := true;	98	new^.init := true;
96		99
97	tmp := list;	100	tmp := list;
98	while tmp^.next <> nil do	101	while tmp^.next <> nil do
99	begin	102	begin
100	tmp := tmp^.next;	103	tmp := tmp^.next;
-		104	Inc(cnt);
101	end;	105	end;
102		106
103	tmp^.next := new;	107	tmp^.next := new;
104	end;	108	end;
-		109
-		110	ListAppend := cnt; (* Return the index where the new element was put *)
105	end;	111	end;
106		112
107	function ListCount(list: PStringList): integer;	113	function ListCount(list: PStringList): integer;
108	var	114	var
109	cnt: integer;	115	cnt: integer;

Subversion Repositories oidplus

oidplus/trunk_dos/STRLIST.PAS – Rev 733 → 735