我的控件为什么设计的时候都好的，可运行时候却不灵了。

[smilelhh]

类似于TImage图像控件,但它支持二幅图像,可以通过DisablePic进行手工切换,另外提供了定时器功能.设置TimerEnabled如果没有为OnTimer事件写代码,那么它就自动定时切换这二幅图片,达到动画的效果.

现在有几个小问题，搞了几天都找不到原因：
1、我在设计状态设置TimerEnabled属性为TRUE，都能看到效果，可是编译后就不闪烁了，非要手工再设置TimerEnabled才行。为什么？
2、如果我是通过程序动态创建的这个控件，通过setpicturefile,函数调用图片，怎么就不行呢？不是程序创建的就可以（见1）。

procedure TForm1.NewButton(bmp: string);
var
tmp: TDragImage;
begin
tmp:= TDragImage.Create(MainPanel);
tmp.OnClick:= DragImageClick;
tmp.Parent := MainPanel;
tmp.SetPictureFile(bmp+'a.bmp');
tmp.SetPictureBakFile(bmp+'b.bmp');
tmp.TimerEnabled := true;
tmp.PopupMenu := PopupMenu1;
end;

以下为控件原码：


unit DragImage;

interface

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


type
TDragImage = class(TGraphicControl)
private
FPicture: TPicture; //使能图片
FPictureBak: TPicture;//禁止图片
FDisablePic: Boolean;
FStretch: Boolean;
FCenter: Boolean;
FTransparent: Boolean;
FDrawing: Boolean;
FPictureFile: string;
FPictureBakFile: string;
//定时闪烁
FInterval: Cardinal;
FWindowHandle: HWND;
FTimerEnabled: Boolean;
FOnTimer: TNotifyEvent;
procedure UpdateTimer;
procedure SetTimerEnabled(Value: Boolean);
procedure SetInterval(Value: Cardinal);
procedure SetOnTimer(Value: TNotifyEvent);
procedure WndProc(var Msg: TMessage);
//
function GetCanvas: TCanvas;
procedure PictureChanged(Sender: TObject);
procedure SetCenter(Value: Boolean);
procedure SetPicture(const Value: TPicture);
procedure SetPictureBak(const Value: TPicture);
procedure SetDisablePic(Value: Boolean);
procedure SetStretch(Value: Boolean);
procedure SetTransparent(Value: Boolean);
protected
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
function DestRect: TRect;
procedure Paint; override;
procedure Timer;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read GetCanvas;
procedure SetPictureFile(filename: string);
procedure SetPictureBakFile(filename: string);
Function GetPictureFile: string;
Function GetPictureBakFile: string;
published
property AutoSize;
property Center: Boolean read FCenter write SetCenter default False;
property Picture: TPicture read FPicture write SetPicture;
property PictureBak: TPicture read FPictureBak write SetPictureBak;
property DisablePic: Boolean read FDisablePic write SetDisablePic;
property PopupMenu;
property Stretch: Boolean read FStretch write SetStretch default False;
property Transparent: Boolean read FTransparent write SetTransparent default False;
property Visible;
property OnClick;
property OnDblClick;
property TimerEnabled: Boolean read FTimerEnabled write SetTimerEnabled default True;
property TimerInterval: Cardinal read FInterval write SetInterval default 500;
property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
end;

procedure Register;
implementation

procedure Register;
begin
RegisterComponents('System', [TDragImage]);
end;

constructor TDragImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
DisablePic:= false;
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
FPictureBak := TPicture.Create;
FPictureBak.OnChange := PictureChanged;
//定时触发
FTimerEnabled := false;
FInterval := 500;
FWindowHandle := Classes.AllocateHWnd(WndProc);
//
Stretch := true;
Transparent:= true;
Height := 105;
Width := 105;
//Invalidate;
end;

destructor TDragImage.Destroy;
begin
FPicture.Free;
FPictureBak.Free;
//解除定时器
FTimerEnabled := False;
UpdateTimer;
Classes.DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure TDragImage.WndProc(var Msg: TMessage);
begin
with Msg do
if Msg = WM_TIMER then
try
Timer;
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure TDragImage.UpdateTimer;
begin
KillTimer(FWindowHandle, 1);
if (FInterval <> 0) and FTimerEnabled then
if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
raise EOutOfResources.Create(SNoTimers);
end;

procedure TDragImage.SetTimerEnabled(Value: Boolean);
begin
if Value <> FTimerEnabled then
begin
FTimerEnabled := Value;
UpdateTimer;
end;
end;

procedure TDragImage.SetInterval(Value: Cardinal);
begin
if Value <> FInterval then
begin
FInterval := Value;
UpdateTimer;
end;
end;

procedure TDragImage.SetOnTimer(Value: TNotifyEvent);
begin
FOnTimer := Value;
UpdateTimer;
end;

procedure TDragImage.Timer;
begin
if (TimerInterval <> 0) and TimerEnabled then
begin
if Assigned(FOnTimer) then
FOnTimer(Self)
else
DisablePic := not DisablePic;
end;

end;

procedure TDragImage.SetPicture(const Value: TPicture);
begin
FPicture.Assign(Value);
end;

procedure TDragImage.SetPictureFile(filename: string);
begin
FPictureFile := filename;
if FPictureFile <>'' then
try
Picture.LoadFromFile(FPictureFile);
except end;
end;
procedure TDragImage.SetPictureBakFile(filename: string);
begin
FPictureBakFile := filename;
if FPictureBakFile <>'' then
try
PictureBak.LoadFromFile(FPictureFile);
except end;
end;

procedure TDragImage.SetPictureBak(const Value: TPicture);
begin
FPictureBak.Assign(Value);
end;

procedure TDragImage.SetDisablePic(Value: Boolean);
begin
if Value <> FDisablePic then
begin
FDisablePic := Value;
PictureChanged(Self);
end;
end;

procedure TDragImage.PictureChanged(Sender: TObject);
var
G: TGraphic;
D : TRect;
begin
if DisablePic then
begin
if AutoSize and (PictureBak.Width > 0) and (PictureBak.Height > 0) then
SetBounds(Left, Top, PictureBak.Width, PictureBak.Height);
G := PictureBak.Graphic;
end
else
begin
if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
SetBounds(Left, Top, Picture.Width, Picture.Height);
G := Picture.Graphic;
end;
if G <> nil then
begin
if not ((G is TMetaFile) or (G is TIcon)) then
G.Transparent := FTransparent;
D := DestRect;
if (not G.Transparent) and (D.Left <= 0) and (D.Top <= 0) and
(D.Right >= Width) and (D.Bottom >= Height) then
ControlStyle := ControlStyle + [csOpaque]
else
ControlStyle := ControlStyle - [csOpaque];
end
else ControlStyle := ControlStyle - [csOpaque];
if not FDrawing then Invalidate;

end;

procedure TDragImage.Paint;
var
Save: Boolean;
begin
if csDesigning in ComponentState then
with inherited Canvas do
begin
Pen.Style := psDash;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;
Save := FDrawing;
FDrawing := True;
try
with inherited Canvas do
if FDisablePic then
StretchDraw(DestRect, PictureBak.Graphic)
else
StretchDraw(DestRect, Picture.Graphic);
finally
FDrawing := Save;
end;
end;
end.

[smilelhh]

由于太长了，这二个函数单出来贴上。

function TDragImage.GetCanvas: TCanvas;
var
Bitmap: TBitmap;
begin
if FDisablePic then
begin
if PictureBak.Graphic = nil then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
PictureBak.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;
if PictureBak.Graphic is TBitmap then
Result := TBitmap(PictureBak.Graphic).Canvas
else
raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
end
else
begin
if Picture.Graphic = nil then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
Picture.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;
if Picture.Graphic is TBitmap then
Result := TBitmap(Picture.Graphic).Canvas
else
raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
end;
end;
function TDragImage.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True;
if FDisablePic then
if not (csDesigning in ComponentState) or (PictureBak.Width > 0) and
(PictureBak.Height > 0) then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := PictureBak.Width;
if Align in [alNone, alTop, alBottom] then
NewHeight := PictureBak.Height;
end
else
if not (csDesigning in ComponentState) or (Picture.Width > 0) and
(Picture.Height > 0) then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := Picture.Width;
if Align in [alNone, alTop, alBottom] then
NewHeight := Picture.Height;
end;
end;
function TDragImage.DestRect: TRect;
var
w, h, cw, ch: Integer;
xyaspect: Double;
begin
if FDisablePic then
begin
w := PictureBak.Width;
h := PictureBak.Height;
end
else
begin
w := Picture.Width;
h := Picture.Height;
end;
cw := ClientWidth;
ch := ClientHeight;

if Stretch or (((w > cw) or (h > ch))) then
begin
if (w > 0) and (h > 0) then
begin
xyaspect := w / h;
if w > h then
begin
w := cw;
h := Trunc(cw / xyaspect);
if h > ch then // woops, too big
begin
h := ch;
w := Trunc(ch * xyaspect);
end;
end
else
begin
h := ch;
w := Trunc(ch * xyaspect);
if w > cw then // woops, too big
begin
w := cw;
h := Trunc(cw / xyaspect);
end;
end;
end
else
begin
w := cw;
h := ch;
end;
end;

with Result do
begin
Left := 0;
Top := 0;
Right := w;
Bottom := h;
end;

if Center then
OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
end;

[smilelhh]

自己UP一下。

[aiirii]

代碼比較長, 我看得不是很仔細:
你應該在
constructor TDragImage.Create(AOwner: TComponent);
中將create 定時器才對啊!
如調用
UpdateTimer

[aiirii]

>>1、我在设计状态设置TimerEnabled属性为TRUE
是手動調用了
procedure TDragImage.SetTimerEnabled(Value: Boolean);
但你運行時, 并沒有相應調用的代碼, 你設計時的要影響到運行時, 要在

constructor TDragImage.Create(AOwner: TComponent);
中加入一句
SetTimerEnabled(XXX)

>>2、如果我是通过程序动态创建的这个控件，通过setpicturefile,函

procedure TDragImage.SetPictureFile(filename: string);
begin
FPictureFile := filename;
if FPictureFile <>'' then
try
// 修改為 Picture.LoadFromFile(FPictureFile);
FPicture.LoadFromFile(FPictureFile);
except end;
end;

[aiirii]

constructor TDragImage.Create(AOwner: TComponent);
中加入一句
SetTimerEnabled(XXX)
or 用
TimerEnabled := true;

[smilelhh]

谢谢，给分。