自制控件的TStrings的属性为什么不能在运行时正常载入????请帮忙!!(200分)

  • 主题发起人 主题发起人 tomol
  • 开始时间 开始时间
T

tomol

Unregistered / Unconfirmed
GUEST, unregistred user!
我最近在做一个走马灯的控件,就是让文本不停地滚动,现在很多About上都是这样的
具体代码如下,但我在设计期设好的FLines在设计期可以正常显示,但一运行就被
Create里的初试字符串替代,请高手指点,多谢多谢!!!
另:请高手讲讲如何做属性编辑器,多谢多谢!!
解释:我定义的控件是从TScrollTitle = class(TCustomControl)继承的
其中有一个Panel和一个Label控件,label控件在Panel里滚动,又定义了
FLines来保存用户输入的字符串
private
{ Private declarations }
FLines: TStrings;
FLabelTitle: TLabel;
procedure SetLines(const Value: TStrings);
function GetLines: TStrings;
published
{ Published declarations }
property Lines: TStrings read GetLines write SetLines;

constructor TScrollTitle.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
。。。。。
FLines := TStringList.Create;
FLines.Add('This is a Scroll Title Component!');
FLines.Add('Welcome to Controls World');

FLabelTitle := TLabel.Create(Self);
FLabelTitle.Parent := FPanelTitle;
FLabelTitle.Caption := FLines.Text;
FLabelTitle.AutoSize := true;
FLabelTitle.Left := 10;
FLabelTitle.Top := FPanelTitle.Top + FPanelTitle.Height;
FLabelTitle.Color := FColor;
。。。。。。
end;

function TScrollTitle.GetLines: TStrings;
begin
Result := FLines;
FLabelTitle.Caption := FLines.Text;
end;

procedure TScrollTitle.SetLines(const Value: TStrings);
var
iCount: integer;
begin
iCount:=0;
FLines.Assign(Value);
FLabelTitle.Caption := '';
FLabelTitle.Caption := FLines.Strings[iCount];
for iCount:=1 to FLines.Count-1 do
FLabelTitle.Caption := FLabelTitle.Caption + #13 + FLines.Strings[iCount];
end;

急,在线等
 
好象是没什么问题. 如果Assign不行, 直接FLines.Text := Value.Text试试.
字符串的属性统计器请看Source目录下的Property Editors目录下的StringsEdit.pas打开一看就知道了.
 
to kkyy:
多谢,我试了您的方法,但问题仍存在,就是在设计期可以看到预期的效果,
但一运行就不行了。
我想知道TStrings类型是如何从DFM文件里读取字符串的?
我去看看StrEdit.pas里是如何写的,还请高手多多指点!!!
 
你是要更新显示是不是?
注意更/刷新, 重画看看.
 
FLines.Assign(Value);
FLabelTitle.Caption := '';
for iCount:=0 to FLines.Count-1 do
FLabelTitle.Caption := FLabelTitle.Caption + #13 + FLines.Strings[iCount];
FLabelTitle.Refresh;
Invalidate;
 
代码没有问题, 这只是一个刷新问题。
因为程序加载时并不会调用SetLines方法, 所以随便在SetLines中加多少Invalidate都没用。 程序加载时是直接将数据从dfm流中读入FLines的。
你所需要做的只是增加一个方法, 比如LinesChange(Sender: TObject); 并把它连接到FLines.OnChange事件上。 该方法只要一句Invalidate就够了
 
多谢两位,
不过我试了你们的方法还是不行
不知是为什么???
 
那就不知了, 呵呵, 反正你那控件也不是什么机密,可全帖在这里, 自然有人会为你调试了. 呵呵.
 
好的,源码如下:
unit ScrollTitle;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Extctrls, StdCtrls, ShellAPI;

type
TScrollTitle = class(TCustomControl)
private
{ Private declarations }
FPanelTray: TPanel;
FPanelTitle: TPanel;
FLabelTitle: TLabel;
FTimerScroll: TTimer;
FLines: TStrings;
FColor: TColor;
procedure SetLines(const Value: TStrings);
procedure SetColor(const Value: TColor);
procedure SetFont(const Value: TFont);
function GetFont: TFont;
function GetLines: TStrings;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent);override;
destructor Destroy; override;
procedure WMSize(var msg: TMessage);message WM_SIZE;
procedure MyOnTimer(Sender: TObject);
procedure LinesChange(Sender: TObject);
published
{ Published declarations }
property Lines: TStrings read GetLines write SetLines;
property Color: TColor read FColor write SetColor default clBtnFace;
property Font: TFont read GetFont write SetFont;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('RHControls', [TScrollTitle]);
end;

{ TScrollTitle }

constructor TScrollTitle.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 200;
Height:= 200;

FColor := clBtnFace;

FPanelTray := TPanel.Create(Self);
FPanelTray.Width := 200;
FPanelTray.Height := 200;
FPanelTray.Parent := self;
FPanelTray.BevelInner := bvLowered;
FPanelTray.BevelOuter := bvLowered;
FPanelTray.Caption := '';
FPanelTray.Color := FColor;

FPanelTitle := TPanel.Create(Self);
FPanelTitle.Width := 180;
FPanelTitle.Height := 180;
FPanelTitle.Parent := FPanelTray;
FPanelTitle.Top := 10;
FPanelTitle.Left := 10;
FPanelTitle.BevelInner := bvNone;
FPanelTitle.BevelOuter := bvNone;
FPanelTitle.Caption := '';
FPanelTitle.Color := FColor;

FLines := TStringList.Create;
FLines.Add('This is a Scroll Title Component!');
FLines.Add('Welcome to Richard Hu World');


FLabelTitle := TLabel.Create(Self);
FLabelTitle.Parent := FPanelTitle;
FLabelTitle.Caption := FLines.Text;
FLabelTitle.AutoSize := true;
FLabelTitle.Left := 10;
FLabelTitle.Top := FPanelTitle.Top + FPanelTitle.Height;
FLabelTitle.Color := FColor;

FTimerScroll := TTimer.Create(Self);
FTimerScroll.Enabled := true;
FTimerScroll.Interval := 200;
FTimerScroll.OnTimer := MyOnTimer;

end;

destructor TScrollTitle.Destroy;
begin
inherited;
end;

function TScrollTitle.GetFont: TFont;
begin
Result := FLabelTitle.Font;
end;

function TScrollTitle.GetLines: TStrings;
begin
Result := FLines;
FLabelTitle.Caption := FLines.Text;
end;

procedure TScrollTitle.LinesChange(Sender: TObject);
begin
Invalidate;
end;

procedure TScrollTitle.MyOnTimer(Sender: TObject);
var
iCount: integer;
begin
FLabelTitle.Caption := '';
for iCount:=1 to FLines.Count-1 do
FLabelTitle.Caption := FLabelTitle.Caption + #13 + FLines.Strings[iCount];
if (FLabelTitle.Top+FLabelTitle.Height)>0 then
FLabelTitle.Top := FLabelTitle.Top - 5
else
FLabelTitle.Top := FPanelTitle.Top + FPanelTitle.Height;
end;

procedure TScrollTitle.SetColor(const Value: TColor);
begin
FColor := Value;
FPanelTray.Color := FColor;
FPanelTitle.Color := FColor;
FLabelTitle.Color := FColor;
end;

procedure TScrollTitle.SetFont(const Value: TFont);
begin
if Assigned(FLabelTitle.Font) then
FLabelTitle.Font.Assign(Value);

end;

procedure TScrollTitle.SetLines(const Value: TStrings);
var
iCount: integer;
begin
iCount:=0;
FLines.Add(FLabelTitle.Caption);
FLines.Assign(Value);
FLabelTitle.Caption := '';
FLabelTitle.Caption := FLines.Strings[iCount];
for iCount:=1 to FLines.Count-1 do
FLabelTitle.Caption := FLabelTitle.Caption + #13 + FLines.Strings[iCount];
FLabelTitle.Refresh;
Invalidate;
end;

procedure TScrollTitle.WMSize(var msg: TMessage);
begin
FPanelTray.Width := Width;
FPanelTray.Height := Height;
FPanelTitle.Width := FPanelTray.Width - 20;
FPanelTitle.Height := FPanelTray.Height - 20;
end;

end.
 
我等下帮你试试, 因为上网的时候不能试. 呵呵/
 
两个for iCount:=1 to FLines.Count-1 do请改成for iCount:=0 to FLines.Count-1 do
FLabelTitle.Refresh;
Invalidate;
下加一句:
FPanelTray.Refresh;
 
create时需要指定:FLines.OnChange := LinesChanged;呀
 
我帮你改了一下,简化了一些,不过我想功能和你的是一样的,只不过去掉了一些无用的东东!
如果有什么问题可以发Email:aizb@163.net

unit UnitTitle;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Extctrls, StdCtrls, ShellAPI;

type
TScrollTitle = class(TPanel)
private
{ Private declarations }
FLabelTitle: TLabel;
FPanelTitle:TPanel;
FTimerScroll: TTimer;
FLines: TStringList;
procedure SetLines(const Value: TStringList);
//
procedure LinesChange(Sender: TObject);
procedure MyOnTimer(Sender: TObject);
//这两个方法是不用公开的.
//
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent);override;
destructor Destroy; override;
published
{ Published declarations }
property Lines: TStringList read FLines write SetLines;
end;

procedure Register;

implementation

uses Types;

procedure Register;
begin
RegisterComponents('Samples', [TScrollTitle]);
end;

{ TScrollTitle }

constructor TScrollTitle.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 200;
Height:= 200;

BevelInner := bvLowered;
BevelOuter := bvLowered;

FPanelTitle := TPanel.Create(Self);
FPanelTitle.Parent := Self;
FPanelTitle.ParentFont:=True;//不用去处理字体了.
FPanelTitle.Align := alClient;//不用处理位置了.
FPanelTitle.ParentColor:=True;//不用去处理颜色了
FPanelTitle.BevelInner:=bvNone;
FPanelTitle.BevelOuter:=bvNone;
//为了Label不会盖住控件的边框,定义这一个容器.

FLabelTitle := TLabel.Create(Self);
FLabelTitle.Parent := FPanelTitle;
FLabelTitle.ParentFont:=True;//不用去处理字体了.
FLabelTitle.AutoSize := true;
FLabelTitle.Left := 10;
FLabelTitle.Top := 0;
FLabelTitle.ParentColor:=True;//不用去处理颜色了

FLines := TStringList.Create;
FLines.OnChange:=LinesChange;//这里为FLines加事件,请注意FLines定义成TStringList而不是TStrings,因为TStrings是抽象类.
FLines.Add('This is a Scroll Title Component!');
FLines.Add('Welcome to Richard Hu World');

FTimerScroll := TTimer.Create(Self);
FTimerScroll.Enabled := true;
FTimerScroll.Interval := 200;
FTimerScroll.OnTimer := MyOnTimer;
end;

destructor TScrollTitle.Destroy;
begin
inherited;
end;

procedure TScrollTitle.LinesChange(Sender: TObject);
begin
FLabelTitle.Caption:=FLines.Text; //如果FLines改变了就把Text属性赋值给FLabelTitle的Caption已经可以保证FLines的内容与Label的内容一至了.
end;

procedure TScrollTitle.MyOnTimer(Sender: TObject);
begin
if (FLabelTitle.Top+FLabelTitle.Height)>0 then
FLabelTitle.Top := FLabelTitle.Top - 5
else
FLabelTitle.Top := FPanelTitle.Height;
end;

procedure TScrollTitle.SetLines(const Value: TStringList);
begin
FLines.Assign(Value);//这里不用把FLines的值赋给FLabelTitle了,因为Assign会触发OnChange事件而调用LinesChange方法.
end;

end.
 
后退
顶部