D
DBCB
Unregistered / Unconfirmed
GUEST, unregistred user!
[^] 精彩！
A
aimingoo
Unregistered / Unconfirmed
GUEST, unregistred user!
哈哈，creation-zy的分析的确有意思。我花了一个晚上的时间来想这个问题。
其实，“非连续区性结点的删除”的确是个问题，非常非常不小的问题。
我现在用到的是连续性区间的删除，最主要的是因为我用的TList是排过序的，我只需要
在List中找到需要删除的结点序列的起始结点，然后CutList()即可。原本我并没有太细
想“非连续区性结点的删除”。
CurList()中最主要的是两个技巧，一个是使用system.move()一次性的pack整个FList，
另一个是使用@Count来越过Delphi的类保护，直接性的修改FCount。这是因为我并没有继
承TList来实现新类，我无法使用任何正常的方法来修改私有属性。而CutList()中，如果
不修改私有属性，则无法跳过SetCount()中对TList.delete()的调用，因而也无法越过TList
类自身对FList这个数组的Pack.
所以，如果真的要象creation-zy所说，要实现TListEx类，则必须重新实现TListEx.delete()，
无论是在creation-zy所说的两种方案中的任意一种中，这都是必须的。在creation-zy的
第二方案中，是用了softDelete()来替代它。从编程思路上来讲，这要合理一些。
但是，还是有不可调和的矛盾。哈哈，这在TStringList中看不到，但在TList中就一定会有！
对了，这里说明一下，begin
Update()在TStrings中是虚方法，没有实现的，所以它实际是
TStringList的一个特性。
TStringList中每一个结点是一个TStringItem，它是一个记录，它的两个域用来存放FString
和FObject，这种情况下，如果FString如果是空串，最多只是FString=''而已，而结点仍然是
一个有效的TStringItem记录，不会为nil。
在TStringList中，我们用begin
Update()和EndUpdate()时，会将一个删除结点设成Nil，这时
是结点记录TStringItem为Nil，而不会是属性FString为Nil。这种情况下，EndUpdate可以很
容易的识别哪个结点是Delete掉的，不会误会。
而在TList中，却不是这样，TList的每个结点是一个Pointer，既然是Pointer，就有可能是Nil，
也就是说，我可能会用TList.add(nil)来加入一个有效的结点，不过它的值的确就是Nil罢了。
那么，在begin
Update后，EndUpdate将凭什么来认为哪一个结点是被删除的呢？？？——要知道，
指针，就可以是任意值。
TList中，提供了Pack()方法来清除Nil结点，本身就证明了在TList中，是允许存在Nil结点的了。
creation-zy的方法，只适合于TList.Pack()过之后的列表，你得先保证FList中有一个结点值是
永远不会存在的，用这个值为做标志值，才能实现EndUpdate()。
事实上，还有一种方法能够比creation-zy所提供的方法效率更高，但要求也更苛刻。——它不
但要求Flist被Pack()过，还要求FList被Sort()方法排序过，也就是说，FList是一个排过序的
指针列表，这样，我们只需要在FList中找到最后一个Nil指针的位置，然后用CutList()，一次
就可以实现“非连续区性结点的删除”了。——当然，其基本的思想，仍然是通过Sort()来将
一个非连续的删除，变成连续的删除。
Delphi的TList提供了Sort()方法，升序排序将导致所有Nil结点被排在最前面。
其实，“非连续区性结点的删除”的确是个问题，非常非常不小的问题。
我现在用到的是连续性区间的删除，最主要的是因为我用的TList是排过序的，我只需要
在List中找到需要删除的结点序列的起始结点，然后CutList()即可。原本我并没有太细
想“非连续区性结点的删除”。
CurList()中最主要的是两个技巧，一个是使用system.move()一次性的pack整个FList，
另一个是使用@Count来越过Delphi的类保护，直接性的修改FCount。这是因为我并没有继
承TList来实现新类，我无法使用任何正常的方法来修改私有属性。而CutList()中，如果
不修改私有属性，则无法跳过SetCount()中对TList.delete()的调用，因而也无法越过TList
类自身对FList这个数组的Pack.
所以，如果真的要象creation-zy所说，要实现TListEx类，则必须重新实现TListEx.delete()，
无论是在creation-zy所说的两种方案中的任意一种中，这都是必须的。在creation-zy的
第二方案中，是用了softDelete()来替代它。从编程思路上来讲，这要合理一些。
但是，还是有不可调和的矛盾。哈哈，这在TStringList中看不到，但在TList中就一定会有！
对了，这里说明一下，begin
Update()在TStrings中是虚方法，没有实现的，所以它实际是
TStringList的一个特性。
TStringList中每一个结点是一个TStringItem，它是一个记录，它的两个域用来存放FString
和FObject，这种情况下，如果FString如果是空串，最多只是FString=''而已，而结点仍然是
一个有效的TStringItem记录，不会为nil。
在TStringList中，我们用begin
Update()和EndUpdate()时，会将一个删除结点设成Nil，这时
是结点记录TStringItem为Nil，而不会是属性FString为Nil。这种情况下，EndUpdate可以很
容易的识别哪个结点是Delete掉的，不会误会。
而在TList中，却不是这样，TList的每个结点是一个Pointer，既然是Pointer，就有可能是Nil，
也就是说，我可能会用TList.add(nil)来加入一个有效的结点，不过它的值的确就是Nil罢了。
那么，在begin
Update后，EndUpdate将凭什么来认为哪一个结点是被删除的呢？？？——要知道，
指针，就可以是任意值。
TList中，提供了Pack()方法来清除Nil结点，本身就证明了在TList中，是允许存在Nil结点的了。
creation-zy的方法，只适合于TList.Pack()过之后的列表，你得先保证FList中有一个结点值是
永远不会存在的，用这个值为做标志值，才能实现EndUpdate()。
事实上，还有一种方法能够比creation-zy所提供的方法效率更高，但要求也更苛刻。——它不
但要求Flist被Pack()过，还要求FList被Sort()方法排序过，也就是说，FList是一个排过序的
指针列表，这样，我们只需要在FList中找到最后一个Nil指针的位置，然后用CutList()，一次
就可以实现“非连续区性结点的删除”了。——当然，其基本的思想，仍然是通过Sort()来将
一个非连续的删除，变成连续的删除。
Delphi的TList提供了Sort()方法，升序排序将导致所有Nil结点被排在最前面。
C
creation-zy
Unregistered / Unconfirmed
GUEST, unregistred user!
呵呵，被人找到破绽了。[]
您上面的过程中，主要的技巧是直接访问TList的保护区域，达到了高速进行特殊操作的目的，
而我却针对算法本身——好像有些离题了。
您提到的“指针，就可以是任意值”的确是我上面的算法中没有仔细考虑的，利用Nil作为标志位
仅仅是一个临时性的方案。我们可以通过增加 FPackedValueointer;
来让用户指定一个不会被
用到的值作为 Pack 的标志位（注意到在Windows系统中，为了防止非法指针，已经规定0~4k(1k?)
的指针是非法的，我们完全可以指定一个 1~4K 的值作为标志位）。
“通用的不一定是最好的”，如果要实现特殊的操作，并且对速度有较高的要求，我认为还是应该
自己来实现。前一阵想用一个循环队列，发现有现成的 TQueue，一看源代码——晕倒！得，还是
自己搞定吧。
]您上面的过程中，主要的技巧是直接访问TList的保护区域，达到了高速进行特殊操作的目的，
而我却针对算法本身——好像有些离题了。
您提到的“指针，就可以是任意值”的确是我上面的算法中没有仔细考虑的，利用Nil作为标志位
仅仅是一个临时性的方案。我们可以通过增加 FPackedValue
ointer;来让用户指定一个不会被
用到的值作为 Pack 的标志位（注意到在Windows系统中，为了防止非法指针，已经规定0~4k(1k?)
的指针是非法的，我们完全可以指定一个 1~4K 的值作为标志位）。
“通用的不一定是最好的”，如果要实现特殊的操作，并且对速度有较高的要求，我认为还是应该
自己来实现。前一阵想用一个循环队列，发现有现成的 TQueue，一看源代码——晕倒！得，还是
自己搞定吧。
A
aimingoo
Unregistered / Unconfirmed
GUEST, unregistred user!
哈哈哈~~~~~~~~
“注意到在Windows系统中，为了防止非法指针，已经规定0~4k(1k?)”
——这个，我的确不知道。黑黑，看来还是知之甚少啊~~~~~~~
不过，我倒是常把一个整型数给add进List的。原因很简单，我可不想去重做一个TIntList。
所以，我常常会做类似于这样的工作：
aInt:=5;
aList.add(pointer(aInt));
哈哈。^-^
“注意到在Windows系统中，为了防止非法指针，已经规定0~4k(1k?)”
——这个，我的确不知道。黑黑，看来还是知之甚少啊~~~~~~~
不过，我倒是常把一个整型数给add进List的。原因很简单，我可不想去重做一个TIntList。
所以，我常常会做类似于这样的工作：
aInt:=5;
aList.add(pointer(aInt));
哈哈。^-^
C
creation-zy
Unregistered / Unconfirmed
GUEST, unregistred user!
to aimingoo主席：
请注意：“让用户指定一个不会被用到的值作为 Pack 的标志位”
~~~~~~ 完全可以用 $FFFFFFFF、$80000000、... 嘛... 如果您说：不好意思，我
的数据分布在 0 - 2^32-1 的区间内，没有给我的FPackedValue留下任何余地，我只好投降了。
（我只是提一个合理化建议而已，何必这么认真呢？）
说实话，我极少用TList，用的话也从来都是把Pointer当成Integer来用，如果要带结构，都是
自己写的专用列表，不会用Delphi的TList——效率太低。
请注意：“让用户指定一个不会被用到的值作为 Pack 的标志位”
~~~~~~ 完全可以用 $FFFFFFFF、$80000000、... 嘛... 如果您说：不好意思，我
的数据分布在 0 - 2^32-1 的区间内，没有给我的FPackedValue留下任何余地，我只好投降了。
（我只是提一个合理化建议而已，何必这么认真呢？）
说实话，我极少用TList，用的话也从来都是把Pointer当成Integer来用，如果要带结构，都是
自己写的专用列表，不会用Delphi的TList——效率太低。
A
aimingoo
Unregistered / Unconfirmed
GUEST, unregistred user!
哈哈哈哈哈~~~~~
是呀是呀。感觉咱俩是在寸土寸金的争一般。哈哈哈。
认真是必要的。我们现在是在讨论一些基础的技术问题，更多的象是观点，如果不这样认
真，“会让同行笑话的”。哈哈哈。
另外，我之所以如此计较于这个值的设置，事实上与我这两天从事的工作有关。不妨也给
您细说一下。同时，大家也可以有个参考。
我在做一个ISAPI Filter，用于检测用户的在线状态，所有从开始检测起的用户的在线时
间长被用一个DWORD存放起来，直到它再一次访问，则将被修改成最新值。另外，我还将用
一个指针来存放该用户的有关信息，比如说名字或者ID号一类。
现在，我们有了两个列表，一个是DWORD的，它存放时间差值，另一个是Pointer的，它指
向用户记录结构。我将时间差值用Add()的方法存进TList，注意，这个值可能是0，即Nil，
但如creation-zy所说，它不会是$FFFFFFFF。另外，我将用户信息也Add()到另一个TList
中。
现在，UserInfoList.count与TimeInfoList.count是等值的。
接下来，我改写了Delphi在Classes中实现的QuickSort()函数，使它可以同时对两个Buffer
排序，准确的说，是使用Buffer_A中的值以DWORD作为排序的Key排序，同时，将Buffer_B中
的值以Pointer类型，参考Buffer_A中的Key的移动情况进行排序。
在本例中，我们事实上是将用户信息(Buffer_B)参考它的在线时间差值(Buffer_A)进行排序。
排序完成后，我们只需要在时间差值列表中CutList()掉“大于某个时间点”的所有结点，也
就完成了“删除所有超时用户”的操作。
事实上，我无非是要做到这个。但很显然，我们用TList来操作，既简单快速，编程上也方便。
另外，由于实现了CutList()，删除操作也将非常理想。
Delphi的TList的效率并不低，我仔细地看过它的源码，它的实现效率极高。尤其重要的是，
它的接口非常优秀，非常适合编写一些“序列性的”动作。
我之所以举出这个例子，是提醒大家，在TList的一个技巧性操作中，我们可能会将FList的
值变成任意的值。在这种情况下，creation-zy的方法是有局限的。
当然，我们通常情况下使用TList，不会遇到这种情况。说实在的，我对creation-zy提出用
softDelete()的方法来实现快速的“非连续性删除”的操作，也执赞同意见。——我一晚上
的思考的结果是：没有第二种快速的方法了。
是呀是呀。感觉咱俩是在寸土寸金的争一般。哈哈哈。
认真是必要的。我们现在是在讨论一些基础的技术问题，更多的象是观点，如果不这样认
真，“会让同行笑话的”。哈哈哈。
另外，我之所以如此计较于这个值的设置，事实上与我这两天从事的工作有关。不妨也给
您细说一下。同时，大家也可以有个参考。
我在做一个ISAPI Filter，用于检测用户的在线状态，所有从开始检测起的用户的在线时
间长被用一个DWORD存放起来，直到它再一次访问，则将被修改成最新值。另外，我还将用
一个指针来存放该用户的有关信息，比如说名字或者ID号一类。
现在，我们有了两个列表，一个是DWORD的，它存放时间差值，另一个是Pointer的，它指
向用户记录结构。我将时间差值用Add()的方法存进TList，注意，这个值可能是0，即Nil，
但如creation-zy所说，它不会是$FFFFFFFF。另外，我将用户信息也Add()到另一个TList
中。
现在，UserInfoList.count与TimeInfoList.count是等值的。
接下来，我改写了Delphi在Classes中实现的QuickSort()函数，使它可以同时对两个Buffer
排序，准确的说，是使用Buffer_A中的值以DWORD作为排序的Key排序，同时，将Buffer_B中
的值以Pointer类型，参考Buffer_A中的Key的移动情况进行排序。
在本例中，我们事实上是将用户信息(Buffer_B)参考它的在线时间差值(Buffer_A)进行排序。
排序完成后，我们只需要在时间差值列表中CutList()掉“大于某个时间点”的所有结点，也
就完成了“删除所有超时用户”的操作。
事实上，我无非是要做到这个。但很显然，我们用TList来操作，既简单快速，编程上也方便。
另外，由于实现了CutList()，删除操作也将非常理想。
Delphi的TList的效率并不低，我仔细地看过它的源码，它的实现效率极高。尤其重要的是，
它的接口非常优秀，非常适合编写一些“序列性的”动作。
我之所以举出这个例子，是提醒大家，在TList的一个技巧性操作中，我们可能会将FList的
值变成任意的值。在这种情况下，creation-zy的方法是有局限的。
当然，我们通常情况下使用TList，不会遇到这种情况。说实在的，我对creation-zy提出用
softDelete()的方法来实现快速的“非连续性删除”的操作，也执赞同意见。——我一晚上
的思考的结果是：没有第二种快速的方法了。
W
weiweiHU
Unregistered / Unconfirmed
GUEST, unregistred user!
DLL可否？
C
creation-zy
Unregistered / Unconfirmed
GUEST, unregistred user!
to aimingoo主席：
看了您的应用之后，我认为，如果采用我的方案，则可以不用对用户列表排序——在删除的时候，
只要遍历列表，判断用户的时间戳，然后SoftDelete即可，只要一个TList（节点为Pointer）就能
满足要求。
注意到为了应用CutList，必须用QuickSort进行排序，而它的时间复杂度为O(N*(LogN/Log2))，
CutList的时间复杂度为O(LeftN)，由于LeftN和N处于同一个数量级，可以写成O(N)。因此，整体
复杂度为O(N*(LogN/Log2))。
如果使用我的方案，复杂度仅为O(N)。
您意下如何？
看了您的应用之后，我认为，如果采用我的方案，则可以不用对用户列表排序——在删除的时候，
只要遍历列表，判断用户的时间戳，然后SoftDelete即可，只要一个TList（节点为Pointer）就能
满足要求。
注意到为了应用CutList，必须用QuickSort进行排序，而它的时间复杂度为O(N*(LogN/Log2))，
CutList的时间复杂度为O(LeftN)，由于LeftN和N处于同一个数量级，可以写成O(N)。因此，整体
复杂度为O(N*(LogN/Log2))。
如果使用我的方案，复杂度仅为O(N)。
您意下如何？
H
hubdog
Unregistered / Unconfirmed
GUEST, unregistred user!
{-----------------------------------------------------------------------------
Unit Name: SubDemo
Author: hubdog
Purpose: 一个父子控件嵌套的最小原型例子（高级VCL开发技巧）
其实TDemoListProperty可以不要，同时DemoList属性也可以不定义
这样代码就更精简了
begin
Date: 2001-10-22
EndDate:
History:
-----------------------------------------------------------------------------}
unit SubDemo;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DsgnIntf;
type
TSubComp=class;
TSubDemo = class(TComponent)
private
FDemoList: TList;
FDemo: string;
procedure RemoveSub(SubComp:TSubComp);
procedure AddSub(SubComp:TSubComp);
procedure SetDemoList(const Value: TList);
procedure SetDemo(const Value: string);
{ Private declarations }
protected
{ Protected declarations }
procedure GetChildren(Proc: TGetChildProc;
Root: TComponent);override;
public
{ Public declarations }
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
{ Published declarations }
property Demo:string read FDemo write SetDemo;
property DemoList: TList read FDemoList write SetDemoList;
end;
TSubComp = class(TComponent)
private
FSubDemo: TSubDemo;
procedure SetSubDemo(const Value: TSubDemo);
protected
procedure SetParentComponent(Value: TComponent);
override;
public
destructor Destroy;override;
function HasParent: Boolean;
override;
function GetParentComponent: TComponent;
override;
property SubDemo: TSubDemo read FSubDemo write SetSubDemo;
published
end;
TDemoListProperty = class(TPropertyEditor)
function GetAttributes: TPropertyAttributes;
override;
function GetValue: string;
override;
procedure Edit;
override;
end;
procedure Register;
implementation
const
Registered: Boolean = False;
procedure Register;
begin
RegisterComponents('CXLib', [TSubDemo]);
RegisterNoIcon([TSubComp]);
RegisterPropertyEditor(TypeInfo(TList), TSubDemo, 'DemoList',
TDemoListProperty);
end;
{ TSubDemo }
procedure TSubDemo.AddSub(SubComp: TSubComp);
begin
FDemoList.Add(SubComp);
SubComp.FSubDemo := Self;
end;
constructor TSubDemo.Create(AOwner: TComponent);
begin
inherited;
FDemoList := TList.create;
if not Registered then
begin
RegisterClasses([TSubComp]);
Registered := True;
end;
end;
destructor TSubDemo.Destroy;
var
SubComp: TSubComp;
begin
while FDemoList.Count > 0 do
begin
SubComp := FDemoList.Last;
RemoveSub(SubComp);
SubComp.Free;
end;
FDemoList.Free;
inherited;
end;
procedure TSubDemo.GetChildren(Proc: TGetChildProc;
Root: TComponent);
var
I: Integer;
begin
inherited GetChildren(Proc, Root );
for I := 0 to FDemoList.Count - 1 do
begin
Proc(TSubComp(FDemoList.Items));
end;
end;
procedure TSubDemo.RemoveSub(SubComp: TSubComp);
begin
SubComp.FSubDemo := nil;
FDemoList.Remove(SubComp);
end;
procedure TSubDemo.SetDemo(const Value: string);
var
SubComp:TSubComp;
begin
FDemo := Value+'1';
if Value='demo' then
begin
SubComp:= TSubComp.Create(Owner);
AddSub(SubComp);
SubComp.Name:=FDemo;
end;
end;
procedure TSubDemo.SetDemoList(const Value: TList);
begin
end;
{ TSubComp }
destructor TSubComp.Destroy;
begin
if FSubDemo <> nil then
FSubDemo.RemoveSub(Self);
inherited;
end;
function TSubComp.GetParentComponent: TComponent;
begin
Result := FSubDemo;
end;
function TSubComp.HasParent: Boolean;
begin
Result:=True;
end;
procedure TSubComp.SetSubDemo(const Value: TSubDemo);
begin
if FSubDemo <> nil then
FSubDemo.RemoveSub(Self);
if Value <> nil then
Value.AddSub(Self);
end;
procedure TSubComp.SetParentComponent(Value: TComponent);
begin
if FSubDemo <> nil then
FSubDemo.RemoveSub(Self);
if (Value <> nil) and (Value is TSubDemo) then
SubDemo := TSubDemo(Value);
end;
{ TDemoListProperty }
procedure TDemoListProperty.Edit;
begin
inherited;
end;
function TDemoListProperty.GetAttributes: TPropertyAttributes;
begin
Result:=[paDialog,paReadOnly];
end;
function TDemoListProperty.GetValue: string;
var
List: TList;
begin
List := TList(Pointer(GetOrdValue));
if (List = nil) or (List.Count = 0) then
Result := '[None]'
else
Result:=Format('(%s)', [GetPropType^.Name]);
end;
end.
Unit Name: SubDemo
Author: hubdog
Purpose: 一个父子控件嵌套的最小原型例子（高级VCL开发技巧）
其实TDemoListProperty可以不要，同时DemoList属性也可以不定义
这样代码就更精简了
begin
Date: 2001-10-22
EndDate:
History:
-----------------------------------------------------------------------------}
unit SubDemo;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DsgnIntf;
type
TSubComp=class;
TSubDemo = class(TComponent)
private
FDemoList: TList;
FDemo: string;
procedure RemoveSub(SubComp:TSubComp);
procedure AddSub(SubComp:TSubComp);
procedure SetDemoList(const Value: TList);
procedure SetDemo(const Value: string);
{ Private declarations }
protected
{ Protected declarations }
procedure GetChildren(Proc: TGetChildProc;
Root: TComponent);override;
public
{ Public declarations }
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
{ Published declarations }
property Demo:string read FDemo write SetDemo;
property DemoList: TList read FDemoList write SetDemoList;
end;
TSubComp = class(TComponent)
private
FSubDemo: TSubDemo;
procedure SetSubDemo(const Value: TSubDemo);
protected
procedure SetParentComponent(Value: TComponent);
override;
public
destructor Destroy;override;
function HasParent: Boolean;
override;
function GetParentComponent: TComponent;
override;
property SubDemo: TSubDemo read FSubDemo write SetSubDemo;
published
end;
TDemoListProperty = class(TPropertyEditor)
function GetAttributes: TPropertyAttributes;
override;
function GetValue: string;
override;
procedure Edit;
override;
end;
procedure Register;
implementation
const
Registered: Boolean = False;
procedure Register;
begin
RegisterComponents('CXLib', [TSubDemo]);
RegisterNoIcon([TSubComp]);
RegisterPropertyEditor(TypeInfo(TList), TSubDemo, 'DemoList',
TDemoListProperty);
end;
{ TSubDemo }
procedure TSubDemo.AddSub(SubComp: TSubComp);
begin
FDemoList.Add(SubComp);
SubComp.FSubDemo := Self;
end;
constructor TSubDemo.Create(AOwner: TComponent);
begin
inherited;
FDemoList := TList.create;
if not Registered then
begin
RegisterClasses([TSubComp]);
Registered := True;
end;
end;
destructor TSubDemo.Destroy;
var
SubComp: TSubComp;
begin
while FDemoList.Count > 0 do
begin
SubComp := FDemoList.Last;
RemoveSub(SubComp);
SubComp.Free;
end;
FDemoList.Free;
inherited;
end;
procedure TSubDemo.GetChildren(Proc: TGetChildProc;
Root: TComponent);
var
I: Integer;
begin
inherited GetChildren(Proc, Root );
for I := 0 to FDemoList.Count - 1 do
begin
Proc(TSubComp(FDemoList.Items));
end;
end;
procedure TSubDemo.RemoveSub(SubComp: TSubComp);
begin
SubComp.FSubDemo := nil;
FDemoList.Remove(SubComp);
end;
procedure TSubDemo.SetDemo(const Value: string);
var
SubComp:TSubComp;
begin
FDemo := Value+'1';
if Value='demo' then
begin
SubComp:= TSubComp.Create(Owner);
AddSub(SubComp);
SubComp.Name:=FDemo;
end;
end;
procedure TSubDemo.SetDemoList(const Value: TList);
begin
end;
{ TSubComp }
destructor TSubComp.Destroy;
begin
if FSubDemo <> nil then
FSubDemo.RemoveSub(Self);
inherited;
end;
function TSubComp.GetParentComponent: TComponent;
begin
Result := FSubDemo;
end;
function TSubComp.HasParent: Boolean;
begin
Result:=True;
end;
procedure TSubComp.SetSubDemo(const Value: TSubDemo);
begin
if FSubDemo <> nil then
FSubDemo.RemoveSub(Self);
if Value <> nil then
Value.AddSub(Self);
end;
procedure TSubComp.SetParentComponent(Value: TComponent);
begin
if FSubDemo <> nil then
FSubDemo.RemoveSub(Self);
if (Value <> nil) and (Value is TSubDemo) then
SubDemo := TSubDemo(Value);
end;
{ TDemoListProperty }
procedure TDemoListProperty.Edit;
begin
inherited;
end;
function TDemoListProperty.GetAttributes: TPropertyAttributes;
begin
Result:=[paDialog,paReadOnly];
end;
function TDemoListProperty.GetValue: string;
var
List: TList;
begin
List := TList(Pointer(GetOrdValue));
if (List = nil) or (List.Count = 0) then
Result := '[None]'
else
Result:=Format('(%s)', [GetPropType^.Name]);
end;
end.
H
hubdog
Unregistered / Unconfirmed
GUEST, unregistred user!
procedure TForm1.Button1Click(Sender: TObject);
var
FS:TFileStream;
Writer:TWriter;
begin
FS:=TFileStream.Create('c:/demo.txt',fmCreate);
Writer:=TWriter.Create(FS,4096);
Writer.WriteString(Edit1.Text);
Writer.WriteString('aaa');
Writer.Free;
FS.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
FS:TFileStream;
Reader:TReader;
S:string;
begin
FS:=TFileStream.Create('c:/demo.txt',fmOpenRead);
Reader:=TReader.Create(FS,4096);
ShowMessage(Reader.ReadString);
ShowMessage(Reader.ReadString);
end;
TReader 和 TWriter主要应用于将数据串行化的保存和加载出来
特点就是读和写的顺序是一样的。
var
FS:TFileStream;
Writer:TWriter;
begin
FS:=TFileStream.Create('c:/demo.txt',fmCreate);
Writer:=TWriter.Create(FS,4096);
Writer.WriteString(Edit1.Text);
Writer.WriteString('aaa');
Writer.Free;
FS.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
FS:TFileStream;
Reader:TReader;
S:string;
begin
FS:=TFileStream.Create('c:/demo.txt',fmOpenRead);
Reader:=TReader.Create(FS,4096);
ShowMessage(Reader.ReadString);
ShowMessage(Reader.ReadString);
end;
TReader 和 TWriter主要应用于将数据串行化的保存和加载出来
特点就是读和写的顺序是一样的。
J
JJams_King
Unregistered / Unconfirmed
GUEST, unregistred user!
离题万里，呵呵
有没有人玩C++
有没有人玩C++
代码:
//********************************************************************************************
//* Intelligent Pointer Unit
//********************************************************************************************
//* James Jin<JJams_King@yahoo.com>
//* $Date: 2001/10/22 13:57:04 $
//* $Revision: 1.1 $
//* $State: Exp $
//********************************************************************************************
#ifndef _IPOINTER_J_H_J_
#define _IPOINTER_J_H_J_
#ifdef _DEBUG_J_
#include <iostream.h>
#endif
//********************************************************************************************
//* CReferable_J
//********************************************************************************************
class CReferable_J
{
//*
//* Member variables
//*
protected:
//* m_nRefCount_J;
reference count
int m_nRefCount_J;
//* end protected
//*
//* public methods
//*
public:
//* constructor
CReferable_J(): m_nRefCount_J(0)
{
#ifdef _DEBUG_J_
cout<<"[CReferable] constructor"<<endl;
#endif
}
//* virtual destructor
virtual ~CReferable_J()
{
#ifdef _DEBUG_J_
cout<<"[CReferable] destructor <"<<m_nRefCount_J<<">"<<endl;
#endif
}
//* increaseReferenceCount_J;
increase reference count by one
int increaseReferenceCount_J()
{
#ifdef _DEBUG_J_
cout<<"[CReferable] increaseReferenceCount_J <"<<m_nRefCount_J+1<<">"<<endl;
#endif
return ++m_nRefCount_J;
}
//* decreaseReferenceCount_J;
decrease reference count by one
int decreaseReferenceCount_J()
{
#ifdef _DEBUG_J_
cout<<"[CReferable] decreaseReferenceCount_J <"<<m_nRefCount_J-1<<">"<<endl;
#endif
return --m_nRefCount_J;
}
//* end public
};
//********************************************************************************************
//********************************************************************************************
//* CIPointer_J
//********************************************************************************************
template<class T>
class CIPointer_J
{
//*
//* Member variables
//*
protected:
//* m_pointer;
pointer to instance of T
CReferable_J* m_pointer;
//* end protected
//*
//* helper functions
//*
protected:
void setPointer(CReferable_J* p)
{
if(m_pointer)
{
if(m_pointer->decreaseReferenceCount_J()<=0)
{
delete m_pointer;
}
m_pointer = 0;
}
m_pointer = p;
if(m_pointer)
{
m_pointer->increaseReferenceCount_J();
}
}
//* end protected
//*
//* public methods
//*
public:
//* virtual destructor
virtual ~CIPointer_J()
{
if(m_pointer)
{
if(m_pointer->decreaseReferenceCount_J()<=0)
{
delete m_pointer;
}
m_pointer = 0;
}
#ifdef _DEBUG_J_
cout<<"[CIPointer_J] destructor"<<endl;
#endif
}
//* default constructor
CIPointer_J()
{
m_pointer = 0;
#ifdef _DEBUG_J_
cout<<"[CIPointer_J] construtor()"<<endl;
#endif
}
//* copy constructor
CIPointer_J(CIPointer_J<T>&
p)
{
#ifdef _DEBUG_J_
cout<<"[CIPointer_J] construtor(&)"<<endl;
#endif
m_pointer = 0;
setPointer(p);
}
//* assign constructor
CIPointer_J(T* p)
{
#ifdef _DEBUG_J_
cout<<"[CIPointer_J] construtor(*)"<<endl;
#endif
m_pointer = 0;
setPointer(p);
}
//* operator->
T* operator->()
{
#ifdef _DEBUG_J_
cout<<"[CIPointer_J] operator->"<<endl;
#endif
return (T*)m_pointer;
}
//* operator T*
operator T*()
{
#ifdef _DEBUG_J_
cout<<"[CIPointer_J] operator T*"<<endl;
#endif
return (T*)m_pointer;
}
//* operator=
CIPointer_J<T>&
operator=(CIPointer_J<T>&
p)
{
#ifdef _DEBUG_J_
cout<<"[CIPointer_J] operator="<<endl;
#endif
setPointer(p.m_pointer);
return *this;
}
//* operator=
CIPointer_J<T>&
operator=(T* p)
{
#ifdef _DEBUG_J_
cout<<"[CIPointer_J] operator="<<endl;
#endif
setPointer(p);
return *this;
}
//* operator==
int operator==(CIPointer_J<T>&p)
{
#ifdef _DEBUG_J_
cout<<"[CIPointer_J] operator=="<<endl;
#endif
return m_pointer == p.m_pointer;
}
//* end public
};
//********************************************************************************************
//********************************************************************************************
//* CIPointer_1_J
//********************************************************************************************
template<class T,class T1>
class CIPointer_1_J: public CIPointer_J<T1>
{
//*
//* public methods
//*
public:
//* default constructor
CIPointer_1_J()
{
m_pointer = 0;
#ifdef _DEBUG_J_
cout<<"[CIPointer_1_J] construtor()"<<endl;
#endif
}
//* copy constructor
CIPointer_1_J(CIPointer_1_J<T,T1>&
p)
{
#ifdef _DEBUG_J_
cout<<"[CIPointer_1_J] construtor(&)"<<endl;
#endif
m_pointer = 0;
setPointer(p);
}
//* assign constructor
CIPointer_1_J(T* p)
{
#ifdef _DEBUG_J_
cout<<"[CIPointer_1_J] construtor(*)"<<endl;
#endif
m_pointer = 0;
setPointer(p);
}
//* do
wn cast constructor
CIPointer_1_J(CIPointer_J<T1>&p)
{
#ifdef _DEBUG_J_
cout<<"[CIPointer_1_J] construtor(down-cast)"<<endl;
#endif
m_pointer = 0;
setPointer((T1*)p);
}
//* operator->
T* operator->()
{
return (T*)m_pointer;
}
//* operator T*
operator T*()
{
return (T*)m_pointer;
}
//* operator=
CIPointer_1_J<T,T1>&
operator=(CIPointer_1_J<T,T1>&
p)
{
setPointer(p.m_pointer);
return *this;
}
//* operator=
CIPointer_1_J<T,T1>&
operator=(T* p)
{
setPointer(p);
return *this;
}
//* operator==
int operator==(CIPointer_1_J<T,T1>&p)
{
return m_pointer == p.m_pointer;
}
//* end public
};
//********************************************************************************************
#endif
//* End of file //
//********************************************************************************************
//* Test IPointer_J
//********************************************************************************************
//* James Jin<JJams_King@yahoo.com>
//* $Date: 2001/10/22 13:57:04 $
//* $Revision: 1.1 $
//* $State: Exp $
//********************************************************************************************
//#define _DEBUG_J_
#include <iostream.h>
#include "IPointer_J.h"
class CC1: public CReferable_J
{
protected:
int m_nMember;
//* end protected
public:
CC1(): m_nMember(1){}
void normal_function1()
{
cout<<"normal_1 <"<<m_nMember<<">"<<endl;
}
virtual void virtual_function()
{
cout<<"virtual_1"<<endl;
}
//* end public
};
class CC2: public CC1
{
protected:
int m_nMember2;
//* end protected
public:
CC2(): m_nMember2(2){}
void normal_function2()
{
cout<<"normal_2 <"<<m_nMember2<<">"<<endl;
}
virtual void virtual_function()
{
cout<<"virtual_2"<<endl;
}
//* end public
};
typedef CIPointer_J<CC1> CC1_ptr;
typedef CIPointer_1_J<CC2,CC1> CC2_ptr;
int main(int argc,char**argv)
{
CC1_ptr ptr1 = new CC1();
ptr1->normal_function1();
ptr1->virtual_function();
CC1_ptr ptr1_1 = ptr1;
ptr1_1 = NULL;
ptr1 = NULL;
cout<<"**********************"<<endl;
CC2_ptr ptr2 = new CC2();
ptr2->normal_function1();
ptr2->normal_function2();
ptr2->virtual_function();
cout<<"**********************"<<endl;
ptr1 = new CC2();
ptr1->normal_function1();
ptr1->virtual_function();
ptr1_1 = ptr2;
ptr1->normal_function1();
ptr1->virtual_function();
cout<<"**********************"<<endl;
((CC2_ptr)ptr1)->normal_function2();
((CC2_ptr)ptr1)->normal_function1();
cout<<"**********************"<<endl;
return 0;
}
//* End of file //
A
aimingoo
Unregistered / Unconfirmed
GUEST, unregistred user!
哦，哈哈，首先感谢creation-zy。
看见creation-zy的上一贴，的确引起了我的注意，我一直没怎么考虑QSort算法的
耗时问题。为了证明creation-zy所述，我做了下面的测试代码。哈哈，结果正如
creation-zy所说，使用排序后再cutList的方法并没有softDelete快。大概排序后
再cutList()的方法比softDelete要多耗时3.5倍，如果使用QStrings的Q_Sort_Integer()
来代替Delphi_QuickSort()，效率也提升不了太多，仍比softDelete要多耗时3倍。
在测试中，如果不计算QuickSort的时间消耗，则cutList效率仍然远高于softDelete。
[red]结论：[/red]
在做出结论之前，再次感谢creation-zy，谢谢他对本问题的关注。
——在删除结点在一个连续区间中的情况下，使用cutList()来进行一次性的操作，算
法效率极高。但在非连续区间中的删除的情况下，使用softDelete的方法来删除，其算
法效率是最好的。creation-zy对这个问题的分析是完全正确的。
不过，还是请大家注意对FullTagValue这个值的选择，要求这个值绝对不会出现在你的
TList结点中。在下面的算法实现过程中，FullTagValue值曾经一度困扰我，让我的代码
出了好几次错误。哈哈。
代码中用到的两个单元，请在下面的位置下载：
http://202.102.247.230/soft/myUpload/myRandom.pas
http://202.102.247.230/soft/myUpload/QStrings.pas
测试程序
--------------------------------
program myTestWithSoftDelete;
uses windows,classes, sysUtils, QStrings, myRandom;
var List1, List2 : TList;
i, minDelete, oldCount, delCount : integer;
delIt : integer;
oldTick : DWORD;
const FullTagValue : integer = maxInt;
type PIntegerList = ^TIntegerList;
TIntegerList = array[0..classes.MaxListSize - 1] of Integer;
//删除TList中的指定部分
procedure CutList(aList:TList;
left,len:integer);
begin
with aList do
begin
System.Move(List^[left+len], List^
看见creation-zy的上一贴，的确引起了我的注意，我一直没怎么考虑QSort算法的
耗时问题。为了证明creation-zy所述，我做了下面的测试代码。哈哈，结果正如
creation-zy所说，使用排序后再cutList的方法并没有softDelete快。大概排序后
再cutList()的方法比softDelete要多耗时3.5倍，如果使用QStrings的Q_Sort_Integer()
来代替Delphi_QuickSort()，效率也提升不了太多，仍比softDelete要多耗时3倍。
在测试中，如果不计算QuickSort的时间消耗，则cutList效率仍然远高于softDelete。
[red]结论：[/red]
在做出结论之前，再次感谢creation-zy，谢谢他对本问题的关注。
——在删除结点在一个连续区间中的情况下，使用cutList()来进行一次性的操作，算
法效率极高。但在非连续区间中的删除的情况下，使用softDelete的方法来删除，其算
法效率是最好的。creation-zy对这个问题的分析是完全正确的。
不过，还是请大家注意对FullTagValue这个值的选择，要求这个值绝对不会出现在你的
TList结点中。在下面的算法实现过程中，FullTagValue值曾经一度困扰我，让我的代码
出了好几次错误。哈哈。
代码中用到的两个单元，请在下面的位置下载：
http://202.102.247.230/soft/myUpload/myRandom.pas
http://202.102.247.230/soft/myUpload/QStrings.pas
测试程序
--------------------------------
program myTestWithSoftDelete;
uses windows,classes, sysUtils, QStrings, myRandom;
var List1, List2 : TList;
i, minDelete, oldCount, delCount : integer;
delIt : integer;
oldTick : DWORD;
const FullTagValue : integer = maxInt;
type PIntegerList = ^TIntegerList;
TIntegerList = array[0..classes.MaxListSize - 1] of Integer;
//删除TList中的指定部分
procedure CutList(aList:TList;
left,len:integer);
begin
with aList do
begin
System.Move(List^[left+len], List^
, (Count-left-len) * SizeOf(Pointer));
dec(integer((@Count)^), len);
end;
end;
//Delphi的QuickSort函数
procedure Delphi_QuickSort(var A: array of Integer;
iLo, iHi: Integer);
var
Lo, Hi, Mid, T: Integer;
begin
Lo := iLo;
Hi := iHi;
Mid := A[(Lo + Hi) div 2];
repeat
while A[Lo] < Mid do
Inc(Lo);
while A[Hi] > Mid do
Dec(Hi);
if Lo <= Hi then
begin
T := A[Lo];
A[Lo] := A[Hi];
A[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then
Delphi_QuickSort(A, iLo, Hi);
if Lo < iHi then
Delphi_QuickSort(A, Lo, iHi);
end;
//开始测试代码
begin
//1. 实现一个随机整型结点的TList, 用于模拟一个杂乱的TList
List1 := TList.create;
List2 := TList.create;
List1.count := 10*100000;
List2.count := 10*100000;
FillRND(List1.List, 10*100000);
move(List1.List^, List2.List^, 10*100000*4);
delIt := GetRNDInt(maxInt);
{ 2. 实现softDelete()
1). 取出minDelete
2). softDelete(), 删除所有>=delIt的结点
3). pack()
}
oldTick := GetTickCount;
minDelete := -1;
for i:=0 to List1.count-1 do
if integer(List1.list^)<=delIt then
begin
minDelete := i;
break;
end;
//找不任何一个可删除结点. 请重新运行本程序以重新生成的随机TList.
if minDelete = -1 then
exit;
oldCount := List1.count;
for i:= minDelete to oldCount-1 do
if integer(List1.list^)<=delIt then
integer(List1.list^) := FullTagValue;
delCount := minDelete;
for i:= minDelete to oldCount-1 do
if integer(List1)<>FullTagValue then
begin
List1[delCount] := List1;
inc(delCount);
end;
//直接置TList.FCount
integer((@List1.Count)^) := oldCount-delCount;
writeln('need:', GetTickCount-oldTick, 'ms');
{ 3. 实现CutList()
1). 排序
2). 找到删除点
2). cutList
}
oldTick := GetTickCount;
Delphi_QuickSort(PIntegerList(List2.List)^, 0, List2.count-1);
//Q_Sort_Integer(List2.List, List2.count);
//oldTick := GetTickCount;
minDelete := Q_SearchFirstGE_Integer(delIt, @(List2.List^), List2.count);
if minDelete=-1 then
minDelete := 0;
cutList(List2, minDelete, List2.count-minDelete);
writeln('need:', GetTickCount-oldTick, 'ms');
//判断删除结果是否有效
writeln(List1.Count=list2.count);
end.
dec(integer((@Count)^), len);
end;
end;
//Delphi的QuickSort函数
procedure Delphi_QuickSort(var A: array of Integer;
iLo, iHi: Integer);
var
Lo, Hi, Mid, T: Integer;
begin
Lo := iLo;
Hi := iHi;
Mid := A[(Lo + Hi) div 2];
repeat
while A[Lo] < Mid do
Inc(Lo);
while A[Hi] > Mid do
Dec(Hi);
if Lo <= Hi then
begin
T := A[Lo];
A[Lo] := A[Hi];
A[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then
Delphi_QuickSort(A, iLo, Hi);
if Lo < iHi then
Delphi_QuickSort(A, Lo, iHi);
end;
//开始测试代码
begin
//1. 实现一个随机整型结点的TList, 用于模拟一个杂乱的TList
List1 := TList.create;
List2 := TList.create;
List1.count := 10*100000;
List2.count := 10*100000;
FillRND(List1.List, 10*100000);
move(List1.List^, List2.List^, 10*100000*4);
delIt := GetRNDInt(maxInt);
{ 2. 实现softDelete()
1). 取出minDelete
2). softDelete(), 删除所有>=delIt的结点
3). pack()
}
oldTick := GetTickCount;
minDelete := -1;
for i:=0 to List1.count-1 do
if integer(List1.list^)<=delIt then
begin
minDelete := i;
break;
end;
//找不任何一个可删除结点. 请重新运行本程序以重新生成的随机TList.
if minDelete = -1 then
exit;
oldCount := List1.count;
for i:= minDelete to oldCount-1 do
if integer(List1.list^)<=delIt then
integer(List1.list^) := FullTagValue;
delCount := minDelete;
for i:= minDelete to oldCount-1 do
if integer(List1)<>FullTagValue then
begin
List1[delCount] := List1;
inc(delCount);
end;
//直接置TList.FCount
integer((@List1.Count)^) := oldCount-delCount;
writeln('need:', GetTickCount-oldTick, 'ms');
{ 3. 实现CutList()
1). 排序
2). 找到删除点
2). cutList
}
oldTick := GetTickCount;
Delphi_QuickSort(PIntegerList(List2.List)^, 0, List2.count-1);
//Q_Sort_Integer(List2.List, List2.count);
//oldTick := GetTickCount;
minDelete := Q_SearchFirstGE_Integer(delIt, @(List2.List^), List2.count);
if minDelete=-1 then
minDelete := 0;
cutList(List2, minDelete, List2.count-minDelete);
writeln('need:', GetTickCount-oldTick, 'ms');
//判断删除结果是否有效
writeln(List1.Count=list2.count);
end.
L
ljbXS
Unregistered / Unconfirmed
GUEST, unregistred user!
我在写一个海鲜投标系统，有好多人同是竟价好多海鲜，选出每种价格最底的竟标人，
显示字段有：编号、 品名、 日期、价格、 姓名 、 要求
我已经把这些都放在一个表中。
query1.SQL.Add('select min(单价)');
query1.SQL.Add('from date/huo.db');
query1.SQL.Add('group by 编号');
如果这样只能显示；编号；单价 如何显示全部；
query1.SQL.Add('select *');
query1.SQL.Add('from date/huo.db');
query1.SQL.Add('where (单价 in');
query1.SQL.Add('(select min(单价) from DATE/huo.db');
query1.SQL.Add('group by 品名))');
如果这有时是数据对，有时有几个品名没有选出最底价，价格高也在.
显示字段有：编号、 品名、 日期、价格、 姓名 、 要求
我已经把这些都放在一个表中。
query1.SQL.Add('select min(单价)');
query1.SQL.Add('from date/huo.db');
query1.SQL.Add('group by 编号');
如果这样只能显示；编号；单价 如何显示全部；
query1.SQL.Add('select *');
query1.SQL.Add('from date/huo.db');
query1.SQL.Add('where (单价 in');
query1.SQL.Add('(select min(单价) from DATE/huo.db');
query1.SQL.Add('group by 品名))');
如果这有时是数据对，有时有几个品名没有选出最底价，价格高也在.
小
小雨哥
Unregistered / Unconfirmed
GUEST, unregistred user!
[入库]
J
jrq
Unregistered / Unconfirmed
GUEST, unregistred user!
我来凑凑热闹
P
peter_peng1980
Unregistered / Unconfirmed
GUEST, unregistred user!
支持....
C
creation-zy
Unregistered / Unconfirmed
GUEST, unregistred user!
to aimingoo主席：
在您上面的算法中，频繁的使用List1，它会调用TList的Get、Put方法，对效率有很大影响
（我在前面说TList效率低就是因为这个——我可不希望每次取值、赋值的时候都用Call XXX）。
在我使用了指针以后，提速大约40%左右（由约120ms降为70～80ms）。
我又想到了一个可能更快的算法
——在您的方案中，由于要对整个List进行严格的排序，使复杂度不必要的增大了许多，而在我的
方案中，虽然没有进行排序，未增加复杂度，但是由于区间的不连续特性，无法进行一次性Move，
因此在速度上并没有出现我在前面预测的“好几个数量级”的差别。
综合两个方案的优缺点，我认为，应该进行“部分排序”之后，再使用您的一次性CutList方法。
“部分排序”的基本思路是：遍历列表，将满足被删除条件的元素做标记之后，并不是把它留在原
地，而是将将他们集中起来，放在List的头部，这样，遍历完成之后，列表中的元素就被分成了两
大阵营——一部分是要被删除的，另一部分是要保留的，这两部分在物理上并不是交错分布的。
这样“部分排序”之后，就可以利用CutList进行高速删除了。
为了实现新的算法，我们需要几个过程，它们的大致算法如下：
(具体实现时，为了提速，可以将过程调用在代码中展开 (BTW: call+ret 要多少个时钟周期？))
procedure TListEx.PrepareSoftDelete;
begin
//在此过程中，可以增加参数，好在以后自动判断哪些数据应该被删除 (FMaxDelValue ?)
FWriteIndex:=0;
//将被删除元素放到头部
FDeleteCount:=0;
//被删除元素个数
end;
procedure TListEx.AdvSoftDelete(const DelIndex:Integer);
begin
if DelIndex<FDeleteCount then
exit;
List^[DelIndex]:=List^[FDeleteCount];
//直接覆盖之，未作保存
Inc(FDeleteCount);
end;
procedure TListEx.PackAdvSoftDel;
//CutList
begin
System.Move(List^[FDeleteCount],List^[0],(Count-FDeleteCount)*4);
Dec(integer((@Count)^),FDeleteCount);
end;
注意：上面的AdvSoftDelete过程在使用时必须严格遵守DelIndex从小到大的原则！
还有，由于直接进行了覆盖，删除之后的列表顺序将发生改变。
如果将被删除元素放在List的尾部，我们又可以发现：未被删除的元素都被集中到了头部——
哈哈!只要简单的改变FCount的值即可，连移动都省了！
Label BreakForLoop;
var
PInt1,PInt2Integer;
K:Integer=4000000;
begin
List1:=TList.create;
List2:=TList.create;
List3:=TList.create;
List1.count:=K;
List2.count:=K;
List3.count:=K;
FillRND(List1.List,K*4);
//呵呵，这里也要 *4 哟
Move(List1.List^,List2.List^,K*4);
Move(List1.List^,List3.List^,K*4);
delIt:=-GetRNDInt(maxInt);
//负数，将删除的部分控制在总数的一半以下
Writeln('DelIt: '+IntToStr(DelIt));
Writeln;
{ SoftDelete }
oldTick := GetTickCount;
minDelete := -1;
PInt1:=@List1.list^[0];
for i:=0 to List1.count-1 do
begin
if PInt1^<=delIt then
begin
minDelete := i;
break;
end;
Inc(PInt1);
end;
if minDelete = -1 then
exit;
oldCount := List1.count;
delCount:=0;
PInt1:=@List1.List^[minDelete];
for i:= minDelete to oldCount-1 do
begin
if PInt1^<=delIt then
PInt1^:=FullTagValue;
Inc(PInt1);
end;
PInt1:=@List1.List^[minDelete];
PInt2:=PInt1;
for i:= minDelete to oldCount-1 do
begin
if PInt1^<>FullTagValue then
begin
PInt2^:=PInt1^;
Inc(PInt2);
end;
Inc(PInt1);
end;
delCount:=(DWord(PInt1)-DWord(PInt2)) shr 2;
integer((@List1.Count)^) := oldCount-delCount;
writeln('Old SoftDelete: ', GetTickCount-oldTick, 'ms');
Writeln('DelCount is '+IntToStr(delCount));
{ New AdvSoftDelete }
oldTick := GetTickCount;
PInt1:=@List2.list^[0];
PInt2:=@List2.list^[List2.Count];
while DWord(PInt1)<=DWord(PInt2) do
begin
if PInt1^<=delIt then
begin
Dec(PInt2);
while PInt2^<=DelIt do
begin
if DWord(PInt1)>=DWord(PInt2) then
goto BreakForLoop;
//没面子呀
Dec(PInt2);
end;
PInt1^:=PInt2^;
end;
Inc(PInt1);
end;
BreakForLoop:
DWord((@List2.Count)^):=(DWord(PInt2)-DWord(@List2.list^[0])) shr 2;
writeln('New AdvSoftDelete: ', GetTickCount-oldTick, 'ms');
{ QuickSort+CutList }
oldTick := GetTickCount;
Delphi_QuickSort(PIntegerList(List3.List)^, 0, List3.count-1);
Tick1 := GetTickCount-OldTick;
//我下载不了QStrings.pas，只好偷懒了
minDelete:=List3.Count-delCount;
//Q_SearchFirstGE_Integer(。。。);
if minDelete=-1 then
minDelete:=0;
cutList(List3, 0, List3.count-minDelete);
oldTick:=GetTickCount-OldTick;
Writeln('QuickSort+CutList: ', oldTick, 'ms');
Writeln('QuickSort: ', Tick1, 'ms');
Writeln('CutList: ', oldTick-Tick1, 'ms');
Writeln('Count1:'+IntToStr(List1.Count));
Writeln('Count2:'+IntToStr(List2.count));
Writeln('Count3:'+IntToStr(List3.count));
readln;
end.
实验表明，新的算法比用指针实现的SoftDelete快了约60%。 []
DelIt: -1221190538
Old SoftDelete: 361ms
DelCount is 862913
New AdvSoftDelete: 160ms //****
QuickSort+CutList: 4166ms //****
QuickSort: 4026ms
CutList: 140ms //****
Count1:3137087
Count2:3137087
Count3:3137087
(请注意，New AdvSoftDelete 的效率几可直追单纯的 CutList ！比QuickSort+CutList
快了20倍以上！！！)
上面的算法没有用到空闲标志，彻底解决了FPackedValue的取值难问题，唯一的缺陷是元素的
相对顺序发生了变化（没什么关系吧...）。
另：这个帖子实在太长了，新开一个吧。
在您上面的算法中，频繁的使用List1，它会调用TList的Get、Put方法，对效率有很大影响
（我在前面说TList效率低就是因为这个——我可不希望每次取值、赋值的时候都用Call XXX）。
在我使用了指针以后，提速大约40%左右（由约120ms降为70～80ms）。
我又想到了一个可能更快的算法
——在您的方案中，由于要对整个List进行严格的排序，使复杂度不必要的增大了许多，而在我的
方案中，虽然没有进行排序，未增加复杂度，但是由于区间的不连续特性，无法进行一次性Move，
因此在速度上并没有出现我在前面预测的“好几个数量级”的差别。
综合两个方案的优缺点，我认为，应该进行“部分排序”之后，再使用您的一次性CutList方法。
“部分排序”的基本思路是：遍历列表，将满足被删除条件的元素做标记之后，并不是把它留在原
地，而是将将他们集中起来，放在List的头部，这样，遍历完成之后，列表中的元素就被分成了两
大阵营——一部分是要被删除的，另一部分是要保留的，这两部分在物理上并不是交错分布的。
这样“部分排序”之后，就可以利用CutList进行高速删除了。
为了实现新的算法，我们需要几个过程，它们的大致算法如下：
(具体实现时，为了提速，可以将过程调用在代码中展开 (BTW: call+ret 要多少个时钟周期？))
procedure TListEx.PrepareSoftDelete;
begin
//在此过程中，可以增加参数，好在以后自动判断哪些数据应该被删除 (FMaxDelValue ?)
FWriteIndex:=0;
//将被删除元素放到头部
FDeleteCount:=0;
//被删除元素个数
end;
procedure TListEx.AdvSoftDelete(const DelIndex:Integer);
begin
if DelIndex<FDeleteCount then
exit;
List^[DelIndex]:=List^[FDeleteCount];
//直接覆盖之，未作保存
Inc(FDeleteCount);
end;
procedure TListEx.PackAdvSoftDel;
//CutList
begin
System.Move(List^[FDeleteCount],List^[0],(Count-FDeleteCount)*4);
Dec(integer((@Count)^),FDeleteCount);
end;
注意：上面的AdvSoftDelete过程在使用时必须严格遵守DelIndex从小到大的原则！
还有，由于直接进行了覆盖，删除之后的列表顺序将发生改变。
如果将被删除元素放在List的尾部，我们又可以发现：未被删除的元素都被集中到了头部——
哈哈!只要简单的改变FCount的值即可，连移动都省了！
Label BreakForLoop;
var
PInt1,PInt2
Integer;K:Integer=4000000;
begin
List1:=TList.create;
List2:=TList.create;
List3:=TList.create;
List1.count:=K;
List2.count:=K;
List3.count:=K;
FillRND(List1.List,K*4);
//呵呵，这里也要 *4 哟
Move(List1.List^,List2.List^,K*4);
Move(List1.List^,List3.List^,K*4);
delIt:=-GetRNDInt(maxInt);
//负数，将删除的部分控制在总数的一半以下
Writeln('DelIt: '+IntToStr(DelIt));
Writeln;
{ SoftDelete }
oldTick := GetTickCount;
minDelete := -1;
PInt1:=@List1.list^[0];
for i:=0 to List1.count-1 do
begin
if PInt1^<=delIt then
begin
minDelete := i;
break;
end;
Inc(PInt1);
end;
if minDelete = -1 then
exit;
oldCount := List1.count;
delCount:=0;
PInt1:=@List1.List^[minDelete];
for i:= minDelete to oldCount-1 do
begin
if PInt1^<=delIt then
PInt1^:=FullTagValue;
Inc(PInt1);
end;
PInt1:=@List1.List^[minDelete];
PInt2:=PInt1;
for i:= minDelete to oldCount-1 do
begin
if PInt1^<>FullTagValue then
begin
PInt2^:=PInt1^;
Inc(PInt2);
end;
Inc(PInt1);
end;
delCount:=(DWord(PInt1)-DWord(PInt2)) shr 2;
integer((@List1.Count)^) := oldCount-delCount;
writeln('Old SoftDelete: ', GetTickCount-oldTick, 'ms');
Writeln('DelCount is '+IntToStr(delCount));
{ New AdvSoftDelete }
oldTick := GetTickCount;
PInt1:=@List2.list^[0];
PInt2:=@List2.list^[List2.Count];
while DWord(PInt1)<=DWord(PInt2) do
begin
if PInt1^<=delIt then
begin
Dec(PInt2);
while PInt2^<=DelIt do
begin
if DWord(PInt1)>=DWord(PInt2) then
goto BreakForLoop;
//没面子呀
Dec(PInt2);
end;
PInt1^:=PInt2^;
end;
Inc(PInt1);
end;
BreakForLoop:
DWord((@List2.Count)^):=(DWord(PInt2)-DWord(@List2.list^[0])) shr 2;
writeln('New AdvSoftDelete: ', GetTickCount-oldTick, 'ms');
{ QuickSort+CutList }
oldTick := GetTickCount;
Delphi_QuickSort(PIntegerList(List3.List)^, 0, List3.count-1);
Tick1 := GetTickCount-OldTick;
//我下载不了QStrings.pas，只好偷懒了
minDelete:=List3.Count-delCount;
//Q_SearchFirstGE_Integer(。。。);
if minDelete=-1 then
minDelete:=0;
cutList(List3, 0, List3.count-minDelete);
oldTick:=GetTickCount-OldTick;
Writeln('QuickSort+CutList: ', oldTick, 'ms');
Writeln('QuickSort: ', Tick1, 'ms');
Writeln('CutList: ', oldTick-Tick1, 'ms');
Writeln('Count1:'+IntToStr(List1.Count));
Writeln('Count2:'+IntToStr(List2.count));
Writeln('Count3:'+IntToStr(List3.count));
readln;
end.
实验表明，新的算法比用指针实现的SoftDelete快了约60%。 [
]DelIt: -1221190538
Old SoftDelete: 361ms
DelCount is 862913
New AdvSoftDelete: 160ms //****
QuickSort+CutList: 4166ms //****
QuickSort: 4026ms
CutList: 140ms //****
Count1:3137087
Count2:3137087
Count3:3137087
(请注意，New AdvSoftDelete 的效率几可直追单纯的 CutList ！比QuickSort+CutList
快了20倍以上！！！)
上面的算法没有用到空闲标志，彻底解决了FPackedValue的取值难问题，唯一的缺陷是元素的
相对顺序发生了变化（没什么关系吧...
）。另：这个帖子实在太长了，新开一个吧。
Y
yhjvc
Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, registry, ComCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Timer1: TTimer;
StatusBar1: TStatusBar;
procedure Timer1Timer(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Caption:='IE小工具V1.0'+#10#10+datetimetostr(now)+#10#10#10+'设计：杨红建'
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var myreg:TRegistry;
mytitle:string;
begin
mytitle:=edit1.Text+'恒升软件 设计：杨红建';//set window title string
myreg:=tregistry.Create;
myreg.RootKey:=HKEY_CURRENT_USER;
try
if myreg.OpenKey('/software/microsoft/internet explorer/main',true) then
begin
myreg.WriteString('window title',mytitle);
end;
finally
myreg.CloseKey;
myreg.Free;
end;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
var myreg:TRegistry;
mypage:string;
begin
mypage:=edit2.Text;//set window title string
myreg:=tregistry.Create;
myreg.RootKey:=HKEY_CURRENT_USER;
try
if myreg.OpenKey('/software/microsoft/internet explorer/main',true) then
begin
myreg.WriteString('start page',mypage);
end;
finally
myreg.CloseKey;
myreg.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StatusBar1.SimpleText:='单击修改后,重新打开IE，就能够看到效果!!!ok?';
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, registry, ComCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Timer1: TTimer;
StatusBar1: TStatusBar;
procedure Timer1Timer(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Caption:='IE小工具V1.0'+#10#10+datetimetostr(now)+#10#10#10+'设计：杨红建'
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var myreg:TRegistry;
mytitle:string;
begin
mytitle:=edit1.Text+'恒升软件 设计：杨红建';//set window title string
myreg:=tregistry.Create;
myreg.RootKey:=HKEY_CURRENT_USER;
try
if myreg.OpenKey('/software/microsoft/internet explorer/main',true) then
begin
myreg.WriteString('window title',mytitle);
end;
finally
myreg.CloseKey;
myreg.Free;
end;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
var myreg:TRegistry;
mypage:string;
begin
mypage:=edit2.Text;//set window title string
myreg:=tregistry.Create;
myreg.RootKey:=HKEY_CURRENT_USER;
try
if myreg.OpenKey('/software/microsoft/internet explorer/main',true) then
begin
myreg.WriteString('start page',mypage);
end;
finally
myreg.CloseKey;
myreg.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
StatusBar1.SimpleText:='单击修改后,重新打开IE，就能够看到效果!!!ok?';
end;
end.
T
Tense
Unregistered / Unconfirmed
GUEST, unregistred user!
明天来写一个。但不知道上面的有没有。呵呵，主要是上面的太多了，只看了一半。
R
ranksun
Unregistered / Unconfirmed
GUEST, unregistred user!
好有创意。。。