Привет всем!!!
Я уже две недели мучаюсь с одной проблемой, пытался написать компонент (кнопку) на основе TCustomControl:
| Код | unit VTSButton;
interface
uses
SysUtils, Classes, Controls,
Windows, Graphics;
type
TVTSButton = class(TCustomControl)
private
FBack: TBitMap;
FLeaveImg: TBitMap;
procedure LoadImg(Value: TBitMap);
protected
public
constructor Create(AOWner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
published
property Image: TBitMap read FBack write LoadImg;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('VTSComponents', [TVTSButton]);
end;
{ TVTSButton }
constructor TVTSButton.Create(AOWner: TComponent);
begin
inherited Create(AOWner);
ControlStyle := ControlStyle - [csOpaque];
Width := 100;
Height := 20;
FBack := TBitMap.Create;
FLeaveImg := TBitMap.Create;
end;
destructor TVTSButton.Destroy;
begin
FBack.Destroy;
FLeaveImg.Destroy;
inherited;
end;
procedure TVTSButton.LoadImg(Value: TBitMap);
begin
FBack.Width := Value.Width;
FBack.Height := Value.Height;
BitBlt(FBack.Canvas.Handle, 0, 0, Value.Width, Value.Height,
Value.Canvas.Handle, 0, 0, SRCCOPY);
Width := FBack.Width;
Height := FBack.Height;
FLeaveImg.Width := FBack.Width;
FLeaveImg.Height := FBack.Height;
BitBlt(FLeaveImg.Canvas.Handle, 0, 0, FBack.Width, FBack.Height,
FBack.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure TVTSButton.Paint;
begin
inherited;
BitBlt(Canvas.Handle, 0, 0, Width, Height, FBack.Canvas.Handle,
0, 0, SRCCOPY);
end;
end. |
этот исходник работает, но если в процедуре Paint попробовать вывести FleaveImg
| Код | procedure TVTSButton.Paint;
begin
inherited;
BitBlt(Canvas.Handle, 0, 0, Width, Height, FLeaveImg.Canvas.Handle,
0, 0, SRCCOPY);
end; |
то при запуске программы cavas моего компонента пустой, почему?
как решить данную проблему? |