為什么使用開發的控件總提示:Abstract Error呢? ( 积分: 100 )

  • 主题发起人 主题发起人 胡圖崇
  • 开始时间 开始时间

胡圖崇

Unregistered / Unconfirmed
GUEST, unregistred user!
控件MutilLabel有個Lines屬性是Tstrings類型的,安裝好MutilLabel之后,調用:MutilLabel1.Lines.Add('123');
然而就報錯:Abstract Error!
我只會控件開發的一些皮毛,這個不知道是什么錯誤,望高手捫指點指點咯

以下是MutilLabel的架構:
unit MutilLabel;

interface

uses
Windows, SysUtils, Classes, Controls, StdCtrls, Graphics, Forms, Messages;

type
TEdgeModal=(bvNone,bvLowered,bvRaised);

TMutilLabel = class(TCustomLabel)
private
{ Private declarations }
FLines:TStrings;
FBevelOut:TEdgeModal;
FBevelIn:TEdgeModal;
procedure SetLines(Const Value:TStrings);
procedure SetBevelOut(Const Value:TEdgeModal);
procedure SetBevelIn(const Value:TEdgeModal);
protected
{ Protected declarations }
procedure paint;virtual;
procedure WMPAINT(var Msg:TWMPAINT);message WM_PAINT;
public
{ Public declarations }
constructor Create(Aowner:Tcomponent);override;
Destructor Destroy;override;
published
{ Published declarations }
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property BevelOut:TEdgeModal read FBevelOut write SetBevelOut;
property BevelIn:TEdgeModal read FBevelIn write SetBevelIn;
property Lines:TStrings read FLines write SetLines;
property Caption;
property Color ;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent;
property Layout;
property Visible;
property WordWrap;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter;
property OnMouseLeave;
property OnStartDock;
property OnStartDrag;
end;

type
TMutilString=class(TStrings)
private
Pchar:Char;
MutilLabel:TMutilLabel;
Function GetBuffText:string;
Procedure SetBuffText(Text:string);
protected
Function Get(index:integer):string;override;
Function GetCount:integer;override;
Procedure Put(index:integer;Const s:string);override;
public
Procedure Clear;override;
procedure Delete(index:integer);override;
procedure Insert(index:integer;Const S:string);override;
end;
 
控件MutilLabel有個Lines屬性是Tstrings類型的,安裝好MutilLabel之后,調用:MutilLabel1.Lines.Add('123');
然而就報錯:Abstract Error!
我只會控件開發的一些皮毛,這個不知道是什么錯誤,望高手捫指點指點咯

以下是MutilLabel的架構:
unit MutilLabel;

interface

uses
Windows, SysUtils, Classes, Controls, StdCtrls, Graphics, Forms, Messages;

type
TEdgeModal=(bvNone,bvLowered,bvRaised);

TMutilLabel = class(TCustomLabel)
private
{ Private declarations }
FLines:TStrings;
FBevelOut:TEdgeModal;
FBevelIn:TEdgeModal;
procedure SetLines(Const Value:TStrings);
procedure SetBevelOut(Const Value:TEdgeModal);
procedure SetBevelIn(const Value:TEdgeModal);
protected
{ Protected declarations }
procedure paint;virtual;
procedure WMPAINT(var Msg:TWMPAINT);message WM_PAINT;
public
{ Public declarations }
constructor Create(Aowner:Tcomponent);override;
Destructor Destroy;override;
published
{ Published declarations }
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property BevelOut:TEdgeModal read FBevelOut write SetBevelOut;
property BevelIn:TEdgeModal read FBevelIn write SetBevelIn;
property Lines:TStrings read FLines write SetLines;
property Caption;
property Color ;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent;
property Layout;
property Visible;
property WordWrap;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter;
property OnMouseLeave;
property OnStartDock;
property OnStartDrag;
end;

type
TMutilString=class(TStrings)
private
Pchar:Char;
MutilLabel:TMutilLabel;
Function GetBuffText:string;
Procedure SetBuffText(Text:string);
protected
Function Get(index:integer):string;override;
Function GetCount:integer;override;
Procedure Put(index:integer;Const s:string);override;
public
Procedure Clear;override;
procedure Delete(index:integer);override;
procedure Insert(index:integer;Const S:string);override;
end;
 
看看Memo的源代码你就知道了:

TCustomMemo = class(TCustomEdit)
private
FLines: TStrings;


constructor TCustomMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 185;
Height := 89;
AutoSize := False;
FWordWrap := True;
FWantReturns := True;
FLines := TMemoStrings.Create; //注意这里,创建FLines的时候不能用TStrings.create,因为TStrings有很多方法是虚方法。
TMemoStrings(FLines).Memo := Self;
ParentBackground := False;
end;
 
那用TMemoStrings?
 
不一定啊,比如用TStringList也可以啊
 
TStrings是不能直接用的,它是一个基类,通常直接使用从它继承的实体类如:TMemoStrings,TStringList等;TStrings.add是一个虚方法,它的子类实现后才能使用;
你在Create时使用实体类(如TStringList)创建,在使用时按照TStringList来使用即可;
 
liber_2000说的好,你出现该问题的主要原因就是没有在Create中用TStrings的继承实例化Lines对象,在应用中使用抽象类时就会出现你所见到的问题
 
各位好~!
根據jennykiller的意見,我參考了TMemo的寫法,發現我這個例子和TMemo的方法差不多,TMemo自己建立了一個TMemoStrings類,我這里建立了TMutilString類
所以我根據大家指出的問題,我把Create中的
Lines:=TMutilString.create
但是還是出現同樣的問題:Abstract Error!
 
而改為Lines:=TStringList.create,不會提示:Abstract Error,好象一切都正常了,但是在Object Inspector的Lines屬性中,輸入一些字符串后,單擊OK按鈕就死機了,不知道什么原因?
我還是把我的代碼貼出來吧,這樣大家可能會明了一些:
unit MutilLabel;

interface

uses
Windows, SysUtils, Classes, Controls, StdCtrls, Graphics, Forms, Messages;

type
TEdgeModal=(bvNone,bvLowered,bvRaised);

TMutilLabel = class(TCustomLabel)
private
{ Private declarations }
FLines:TStrings;
FBevelOut:TEdgeModal;
FBevelIn:TEdgeModal;
procedure SetLines(Const Value:TStrings);
procedure SetBevelOut(Const Value:TEdgeModal);
procedure SetBevelIn(const Value:TEdgeModal);
protected
{ Protected declarations }
procedure paint;virtual;
procedure WMPAINT(var Msg:TWMPAINT);message WM_PAINT;
public
{ Public declarations }
constructor Create(Aowner:Tcomponent);override;
Destructor Destroy;override;
published
{ Published declarations }
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property BevelOut:TEdgeModal read FBevelOut write SetBevelOut;
property BevelIn:TEdgeModal read FBevelIn write SetBevelIn;
property Lines:TStrings read FLines write SetLines;
property Color ;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent;
property Layout;
property Visible;
property WordWrap;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter;
property OnMouseLeave;
property OnStartDock;
property OnStartDrag;
end;

type
TMutilString=class(TStrings)
private
MutilLabel:TMutilLabel;
Function GetBuffText:string;
Procedure SetBuffText(Text:string);
protected
Function Get(index:integer):string;override;
Function GetCount:integer;override;
Procedure Put(index:integer;Const s:string);override;
public
Procedure Clear;override;
procedure Delete(index:integer);override;
procedure Insert(index:integer;Const S:string);override;
end;

procedure Register;

implementation

{ TMutilString }

procedure TMutilString.Clear;
begin
SetBuffText('');
end;

procedure TMutilString.Delete(index: integer);
var mlines:Tstrings;
begin
if (index<0) or (index>MutilLabel.Lines.Count) then
raise Exception.Create('訪問'+inttostr(index)+'溢出');
try
mlines:=Tstrings.Create;
mlines.Text:=GetBuffText;
mlines.Delete(index);
MutilLabel.Lines:=mlines;
finally
mlines.Free;
end;

end;

function TMutilString.Get(index: integer): string;
var mlines:TStrings;
begin
if (index<0) or (index>MutilLabel.Lines.Count) then
raise Exception.Create('訪問'+inttostr(index)+'溢出');
try
mlines:=Tstrings.Create;
mlines.Text:=GetBuffText;
result:=mlines.Strings[index];
finally
mlines.Free;
end;

end;

function TMutilString.GetBuffText: string;
begin
Result:=MutilLabel.Caption;
end;

function TMutilString.GetCount: integer;
var mlines:TStrings;
begin
Try
mlines:=TStrings.Create;
mlines.Text:=GetBuffText;
result:=mlines.Count;
finally
mlines.Free;
end;
end;

procedure TMutilString.Insert(index: integer;Const S: string);
var mlines:TStrings;
begin
try
mlines:=TStrings.Create;
mlines.Text:=GetBuffText;
TStrings(mlines).Insert(index,S);
MutilLabel.Caption:=mlines.Text;
finally
mlines.Free;
end;

end;

procedure TMutilString.Put(index: integer; const s: string);
var mlines:TStrings;
begin
try
mlines:=TStrings.Create;
mlines.Text:=GetBuffText;
mlines.Strings[index]:=s;
SetBuffText(mlines.Text);
finally
mlines.Free;
end;

end;

procedure TMutilString.SetBuffText(Text: string);
begin
MutilLabel.Caption:=Text;
end;

{ TMutilLabel }

constructor TMutilLabel.Create(Aowner: Tcomponent);
begin
inherited Create(Aowner);
Height:=89;
width:=200;
Autosize:=false;

FBevelOut:=bvLowered;
FBevelIn:=bvRaised;

FLines:=TStringList.Create;
TMutilString(FLines).MutilLabel:=self;

end;

destructor TMutilLabel.Destroy;
begin
if Assigned(FLines) then
FLines.Free;
FLines:=nil;
inherited;
end;

procedure TMutilLabel.paint;
procedure DrawEdgeRect(Rise:boolean;ARect:TRect);
var PDC:HDC;
begin
PDC:=Canvas.Handle;
if Rise then
begin
DrawEdge(PDC,ARect,BDR_Raisedinner,BF_BottomRight);
DrawEdge(PDC,ARect,BDR_Raisedinner,BF_TopLeft);
end
else
begin
DrawEdge(PDC,ARect,BDR_SunkenOuter,BF_BottomRight);
DrawEdge(PDC,ARect,BDR_SunkenOuter,BF_TopLeft);
end;
end;
var Rect:TRect;
begin
inherited;
Rect:=GetClientRect;
case FBevelOut of
bvLowered:DrawEdgeRect(false,Rect);
bvRaised:DrawEdgeRect(true,Rect);
end;
InflateRect(Rect,-1,-1);
case FBevelIn of
bvLowered:DrawEdgeRect(false,Rect);
bvRaised:DrawEdgeRect(true,Rect);
end;
end;

procedure TMutilLabel.SetBevelIn(const Value: TEdgeModal);
begin
FBevelIn:=value;
Invalidate;
end;

procedure TMutilLabel.SetBevelOut(const Value: TEdgeModal);
begin
FBevelOut:=value;
Invalidate;
end;

procedure TMutilLabel.SetLines(const Value: TStrings);
begin
FLines.Assign(value);
end;

procedure TMutilLabel.WMPAINT(var Msg: TWMPAINT);
begin
if Msg.DC<>0 then
begin
canvas.Lock;
try
canvas.Handle:=Msg.DC;
try
paint;
finally
canvas.Handle:=0;
end;
finally
canvas.Unlock;
end;
end;
end;


procedure Register;
begin
RegisterComponents('Sample', [TMutilLabel]);
end;

end.
 
将TMutilString的基类改为TStringList
constructor TMutilLabel.Create(Aowner: Tcomponent);
begin
inherited Create(Aowner);
Height:=89;
width:=200;
Autosize:=false;

FBevelOut:=bvLowered;
FBevelIn:=bvRaised;

FLines:=TMutilString.Create;//变化
TMutilString(FLines).MutilLabel:=self;

end;

这次应该可以了!
 
一樣的﹐還是不行
只有改為Lines:=TStringList.create,不會提示:Abstract Error,好象一切都正常了,但是在Object Inspector的Lines屬性中,輸入一些字符串后,單擊OK按鈕就死機了
我測試了一下﹐發現一調用MutilLabel1.Lines.Add('123')之后﹐系統就會報錯﹐報錯信息是提示﹕一連串的錯誤﹐訪問XXXXX地址錯誤.
這是什么原因導致的呢﹖
 
TStrings本来就是一个抽象类
用TStringList吧
 
但是用TStringList出現如ID:3252421的問題﹐怎么解決呢﹖
 
找到原因了
1﹑用Lines:=TMutilString.Create可以﹐因為TMutilString也是繼承TStrings類的。出現Abstract Error的原因是TMutilString的方法里mlines對象創建的時候是使用Tstrings.create﹐所以當mlines.Text=...調用了Tstrings.SetText等虛方法﹐所以才導致出現﹕Abstract Error
2﹑如果用TStringList創建Lines即﹕Lines:=TStringList.Create﹐出現一連串訪問地址錯誤是﹕TMutilString(Lines)...之后﹐并不會執行TMutilString的方法﹐因為Lines不是TMutilString類。
不知道我的說法對不對﹖
 
不对,主要是因为mLines使用了抽象类的CREATE方法,只要是使用了抽象类的方法就会出现Abstract Error错.另外你的TMutilString很成问题,直接抛弃,再改写constructor TMutilLabel.Create内的下列语句试试:
//FLines:=TMutilString.Create;
FLines:=TStringList.Create;
//TMutilString(FLines).MutilLabel:=self;
 
多人接受答案了。
 
后退
顶部