這是我第一次嘗試寫VCL , 以下有問題請教大大一下 |
|
尚未結案
|
|
SamSam1230
中階會員   發表：128 回覆：178 積分：65 註冊：2004-12-23 發送簡訊給我 |
unit LightBulb; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type
TLightBulbType = ( sstRectangle, sstSquare, sstRoundRect, sstRoundSquare, sstEllipse, sstCircle);
TLightBulb = class(TGraphicControl)
private
FInterval : Integer;
FEnable : Boolean;
FShape : TLightBulbType;
FPen : TPen;
FBrush : TBrush;
FOnColor : TColor;
FOffColor : TColor;
procedure SetInterval(Value:Integer);
procedure SetShape(Value: TLightBulbType);
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetEnabled(Value: Boolean);
{ Private declarations }
protected
procedure Paint;override;
{ Protected declarations }
public
constructor Create(AOwner: Tcomponent);override;
destructor Destroy;override;
property Enable : Boolean read FEnable write SetEnabled;
{ Public declarations }
published
property Interval: Integer read FInterval write FInterval default 1000;
property Enabled : Boolean read FEnable write SetEnabled default False;
property Brush : TBrush read FBrush write SetBrush;
property Pen : TPen read FPen write SetPen;
property Shape : TLightBulbType read FShape write SetShape;
property OnColor : TColor read FOnColor write FOnColor default clGreen;
property OffColor: TColor read FOffColor write FOffColor default clWhite;
property DragCursor;
property DragMode;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property Height default 65;
property Width default 65;
procedure StyleChanged(Sender: TObject);
{ Published declarations }
end; procedure Register; implementation procedure Register;
begin
RegisterComponents('Samples', [TLightBulb]);
end; procedure TLightBulb.SetInterval(Value :Integer);
begin
end; procedure TLightBulb.SetShape(Value: TLightBulbType);
begin
if Fshape <> Value then
begin
Fshape := Value;
Invalidate;
end;
end; constructor TLightBulb.Create(AOwner: Tcomponent);
begin
inherited Create(AOwner);
Width := 65;
Height := 65;
FPen := TPen.Create;
FPen.OnChange := StyleChanged;
Fbrush := TBrush.Create;
Fbrush.OnChange := StyleChanged;
end; destructor TLightBulb.Destroy;
begin
FPen.Free;
FBrush.Free;
inherited Destroy;
end; procedure TLightBulb.SetBrush(Value : TBrush);
begin
FBrush.Assign(Value);
end; procedure TLightBulb.SetPen(Value : TPen);
begin
FPen.Assign(Value);
end; procedure TLightBulb.StyleChanged(Sender: TObject);
begin
Invalidate;
end; procedure TLightBulb.Paint;
begin
with Canvas do
begin
Pen := FPen;
Brush := FBrush;
case FShape of
sstRectangle, sstSquare:
Rectangle(0,0,Width,Height);
sstRoundRect, sstRoundSquare :
RoundRect(0,0,Width,Height, Width div 4, height div 4);
sstCircle, sstEllipse:
Ellipse(0,0,Width,Height);
end;
end;
end; procedure TLightBulb.SetEnabled(Value: Boolean);
begin
While Value = True do
begin
Brush.Color := OffColor;
Sleep(1);
Brush.Color := OnColor;
end;
end; end.
我想在我的VCL 當中加 TTimer ? 請問可以怎樣加呢?
另外是那個 published enabled property , 怎樣設定在design mode 的時候不作出反應, 在 run time 的時候才動作, 另外是我現在的程式, 如果放到一個 test , 用一個button 去觸發 enabled , 按了之後, 整個程式都會hanged
請問是什麼問題呢? 是那個while -loop 造成的嗎?
|
|
SamSam1230
中階會員 發表：128 回覆：178 積分：65 註冊：2004-12-23 發送簡訊給我 |
procedure TLightBulb.SetEnabled(Value: Boolean);
var
FTimer : TTimer;
begin
if Value = True then
begin
FTimer := TTimer.Create(self);
FTimer.Name := 'Timer';
FTimer.Interval := Interval;
FTimer.Enabled := True;
end;
end;
我改了以上的code , 用意是用timer 去做不停換color 的動作
但我又不知道在怎樣call the ontimer 的procedure ??
有大大可以幫幫我嗎?
我只是要做一個類似紅綠燈的東西, enable 之後就按照設定 time interval去改變color ( cycle)
|
|
hagar
版主  發表：143 回覆：4056 積分：4445 註冊：2002-04-14 發送簡訊給我 |
加紅色的部份看行不行？
另外可參考 william 兄所示範的另一種方法: http://delphi.ktop.com.tw/topic.php?topic_id=40708
unit LightBulb; interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type
TLightBulbType = ( sstRectangle, sstSquare, sstRoundRect, sstRoundSquare, sstEllipse, sstCircle);
TLightBulb = class(TGraphicControl)
private
FInterval : Integer;
FEnable : Boolean;
FShape : TLightBulbType;
FPen : TPen;
FBrush : TBrush;
FOnColor : TColor;
FOffColor : TColor;
procedure SetInterval(Value:Integer);
procedure SetShape(Value: TLightBulbType);
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetEnabled(Value: Boolean);
procedure TimerTimer(Sender: TObject);
{ Private declarations }
protected
procedure Paint;override;
{ Protected declarations }
public
constructor Create(AOwner: Tcomponent);override;
destructor Destroy;override;
property Enable : Boolean read FEnable write SetEnabled;
{ Public declarations }
published
property Interval: Integer read FInterval write FInterval default 1000;
property Enabled : Boolean read FEnable write SetEnabled default False;
property Brush : TBrush read FBrush write SetBrush;
property Pen : TPen read FPen write SetPen;
property Shape : TLightBulbType read FShape write SetShape;
property OnColor : TColor read FOnColor write FOnColor default clGreen;
property OffColor: TColor read FOffColor write FOffColor default clWhite;
property DragCursor;
property DragMode;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property Height default 65;
property Width default 65;
procedure StyleChanged(Sender: TObject);
{ Published declarations }
end; procedure Register; implementation procedure Register;
begin
RegisterComponents('Samples', [TLightBulb]);
end; procedure TLightBulb.SetInterval(Value :Integer);
begin
end; procedure TLightBulb.SetShape(Value: TLightBulbType);
begin
if Fshape <> Value then
begin
Fshape := Value;
Invalidate;
end;
end; constructor TLightBulb.Create(AOwner: Tcomponent);
begin
inherited Create(AOwner);
Width := 65;
Height := 65;
FPen := TPen.Create;
FPen.OnChange := StyleChanged;
Fbrush := TBrush.Create;
Fbrush.OnChange := StyleChanged;
end; destructor TLightBulb.Destroy;
begin
FPen.Free;
FBrush.Free;
inherited Destroy;
end; procedure TLightBulb.SetBrush(Value : TBrush);
begin
FBrush.Assign(Value);
end; procedure TLightBulb.SetPen(Value : TPen);
begin
FPen.Assign(Value);
end; procedure TLightBulb.StyleChanged(Sender: TObject);
begin
Invalidate;
end; procedure TLightBulb.Paint;
begin
with Canvas do
begin
Pen := FPen;
Brush := FBrush;
case FShape of
sstRectangle, sstSquare:
Rectangle(0,0,Width,Height);
sstRoundRect, sstRoundSquare :
RoundRect(0,0,Width,Height, Width div 4, height div 4);
sstCircle, sstEllipse:
Ellipse(0,0,Width,Height);
end;
end;
end; procedure TLightBulb.SetEnabled(Value: Boolean);
var
FTimer : TTimer;
begin
if Value = True then
begin
FTimer := TTimer.Create(self);
FTimer.Name := 'Timer';
FTimer.Interval := Interval;
FTimer.OnTimer := TimerTimer;
FTimer.Enabled := True;
end;
end; procedure TLightBulb.TimerTimer(Sender: TObject);
begin
if Brush.Color = OffColor then
Brush.Color := OnColor
else
Brush.Color := OffColor;
end; end.
--
 發表人 - hagar 於 2005/03/22 16:49:01
|
|
SamSam1230
中階會員 發表：128 回覆：178 積分：65 註冊：2004-12-23 發送簡訊給我 |
|
|
hagar
版主 發表：143 回覆：4056 積分：4445 註冊：2002-04-14 發送簡訊給我 |
發表時間：2005-03-22 15:21:20
IP:218.103.xxx.xxx 未訂閱
系統時間：2024-06-13 23:58:30
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |