ginsonic
asked on
Where is wrong ?
I try to make a component .
I load a bmp to PicFrom . All is OK .
But when I try to delete the bmp from PicFrom I still have TBitmap in PicFrom How can I fix that ?
This is my code . Compile and try that .
unit GNSlide;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TGNSlide = class(TGraphicControl)
private
{ Private declarations }
FPicFrom:TPicture;
FPicTo:TPicture;
picT:TBitmap;
procedure PictureFrom(Pic:TPicture);
procedure PictureTo(Pic:TPicture);
procedure changePicFrom(Sender : TObject);
procedure changesize(Sender : TObject);
protected
{ Protected declarations }
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Paint; override;
published
{ Published declarations }
property PicFrom : TPicture read FPicFrom write PictureFrom;
property PicTo : TPicture read FPicTo write PictureTo;
property Autosize ;
end;
procedure Register;
implementation
constructor TGNSlide.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FPicFrom := TPicture.Create;
FPicTo := TPicture.Create;
Height:=105;
Width:=105;
FPicFrom.OnChange := changePicFrom;
Canvas.OnChanging:= changesize;
end;
function TGNSlide.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True ;
if not (csDesigning in ComponentState) or (PicFrom.Width > 0) and
(PicFrom.Height > 0) then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := PicFrom.Width;
if Align in [alNone, alTop, alBottom] then
NewHeight := PicFrom.Height;
end;
end;
procedure TGNSlide.Paint;
begin
Canvas.Draw(0,0,picT);
end;
procedure TGNSlide.PictureFrom(Pic:T Picture);
begin
FPicFrom.Assign(Pic);
end;
procedure TGNSlide.PictureTo(Pic:TPi cture);
begin
FPicTo.Assign(Pic);
end;
procedure TGNSlide.changePicFrom(Sen der : TObject);
begin
Width:=FPicFrom.Width;
Height:=FPicFrom.Height;
picT := TBitmap.Create;
picT.Canvas.Brush.Color := clBlack;
picT.Width := Width;
picT.Height := Height;
if AutoSize and (PicFrom.Width > 0) and (PicFrom.Height > 0) then
SetBounds(Left, Top, PicFrom.Width, PicFrom.Height);
picT.Assign(FPicFrom.Bitma p);
end;
procedure TGNSlide.changesize(Sender :TObject);
begin
if Width>PicFrom.Width then Width:=PicFrom.Width;
if Height>PicFrom.Height then Height:=PicFrom.Height;
end;
destructor TGNSlide.Destroy;
begin
FPicFrom.Free;
FPicTo.Free;
picT.Free;
inherited Destroy;
end;
procedure Register;
begin
RegisterComponents('Nick', [TGNSlide]);
end;
end.
I load a bmp to PicFrom . All is OK .
But when I try to delete the bmp from PicFrom I still have TBitmap in PicFrom How can I fix that ?
This is my code . Compile and try that .
unit GNSlide;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TGNSlide = class(TGraphicControl)
private
{ Private declarations }
FPicFrom:TPicture;
FPicTo:TPicture;
picT:TBitmap;
procedure PictureFrom(Pic:TPicture);
procedure PictureTo(Pic:TPicture);
procedure changePicFrom(Sender : TObject);
procedure changesize(Sender : TObject);
protected
{ Protected declarations }
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Paint; override;
published
{ Published declarations }
property PicFrom : TPicture read FPicFrom write PictureFrom;
property PicTo : TPicture read FPicTo write PictureTo;
property Autosize ;
end;
procedure Register;
implementation
constructor TGNSlide.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FPicFrom := TPicture.Create;
FPicTo := TPicture.Create;
Height:=105;
Width:=105;
FPicFrom.OnChange := changePicFrom;
Canvas.OnChanging:= changesize;
end;
function TGNSlide.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True ;
if not (csDesigning in ComponentState) or (PicFrom.Width > 0) and
(PicFrom.Height > 0) then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := PicFrom.Width;
if Align in [alNone, alTop, alBottom] then
NewHeight := PicFrom.Height;
end;
end;
procedure TGNSlide.Paint;
begin
Canvas.Draw(0,0,picT);
end;
procedure TGNSlide.PictureFrom(Pic:T
begin
FPicFrom.Assign(Pic);
end;
procedure TGNSlide.PictureTo(Pic:TPi
begin
FPicTo.Assign(Pic);
end;
procedure TGNSlide.changePicFrom(Sen
begin
Width:=FPicFrom.Width;
Height:=FPicFrom.Height;
picT := TBitmap.Create;
picT.Canvas.Brush.Color := clBlack;
picT.Width := Width;
picT.Height := Height;
if AutoSize and (PicFrom.Width > 0) and (PicFrom.Height > 0) then
SetBounds(Left, Top, PicFrom.Width, PicFrom.Height);
picT.Assign(FPicFrom.Bitma
end;
procedure TGNSlide.changesize(Sender
begin
if Width>PicFrom.Width then Width:=PicFrom.Width;
if Height>PicFrom.Height then Height:=PicFrom.Height;
end;
destructor TGNSlide.Destroy;
begin
FPicFrom.Free;
FPicTo.Free;
picT.Free;
inherited Destroy;
end;
procedure Register;
begin
RegisterComponents('Nick',
end;
end.
ASKER
In design time , yes .
ASKER
I select PicFrom from ObjectInspector , delete TBitmap , but when I press enter object inspector return TBitmap and not None .
In this time , the component don't display the initial bitmap ( the bitmap is erased from it , but object inspector report that the bitmap is still there ( in PicFrom ) .
In this time , the component don't display the initial bitmap ( the bitmap is erased from it , but object inspector report that the bitmap is still there ( in PicFrom ) .
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thx , man !
Is it in designtime you have the problem ??