fix bug #464 and #514: create bitmap handle to back image drawing up

git-svn-id: trunk@6617 -
This commit is contained in:
micha 2005-01-16 19:46:39 +00:00
parent 82325ca16d
commit fe9b5eccd7
2 changed files with 30 additions and 2 deletions

View File

@ -492,6 +492,7 @@ type
FProportional: Boolean;
FTransparent: Boolean;
FStretch: Boolean;
function GetCanvas: TCanvas;
procedure SetPicture(const AValue: TPicture);
procedure SetCenter(Value : Boolean);
procedure SetProportional(const AValue: Boolean);
@ -505,6 +506,7 @@ type
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read GetCanvas;
public
Property Align;
property AutoSize;
@ -986,6 +988,9 @@ end.
{
$Log$
Revision 1.129 2005/01/16 19:46:39 micha
fix bug 464 and 514: create bitmap handle to back image drawing up
Revision 1.128 2005/01/10 16:35:35 vincents
made TabVisible public

View File

@ -38,6 +38,29 @@ begin
inherited Destroy;
end;
function TCustomImage.GetCanvas: TCanvas;
var
TempBitmap: TBitmap;
begin
if FPicture.Graphic = nil then
begin
// make a new bitmap to draw on
TempBitmap := TBitmap.Create;
try
TempBitmap.Width := Width;
TempBitmap.Height := Height;
FPicture.Graphic := TempBitmap;
finally
TempBitmap.Free;
end;
end;
// try draw on the bitmap, not on the form's canvas
if FPicture.Graphic is TBitmap then
Result := TBitmap(FPicture.Graphic).Canvas
else
Result := inherited Canvas;
end;
procedure TCustomImage.SetPicture(const AValue: TPicture);
begin
if FPicture=AValue then exit;
@ -167,7 +190,7 @@ Procedure TCustomImage.Paint;
Procedure DrawFrame;
begin
if csDesigning in ComponentState then begin
With Canvas do begin
With inherited Canvas do begin
Pen.Color := clBlack;
Pen.Style := psDash;
MoveTo(0, 0);
@ -183,7 +206,7 @@ var
iRect : TRect;
BackgroundColor: Integer;
begin
With Canvas do begin
With inherited Canvas do begin
DrawFrame;
If Picture.Graphic = nil then
exit;