paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-06 20:18:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/extctrls.pp
View File

@ -492,6 +492,7 @@ type
FProportional: Boolean; FProportional: Boolean;
FTransparent: Boolean; FTransparent: Boolean;
FStretch: Boolean; FStretch: Boolean;
function GetCanvas: TCanvas;
procedure SetPicture(const AValue: TPicture); procedure SetPicture(const AValue: TPicture);
procedure SetCenter(Value : Boolean); procedure SetCenter(Value : Boolean);
procedure SetProportional(const AValue: Boolean); procedure SetProportional(const AValue: Boolean);
@ -505,6 +506,7 @@ type
public public
constructor Create(TheOwner: TComponent); override; constructor Create(TheOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
property Canvas: TCanvas read GetCanvas;
public public
Property Align; Property Align;
property AutoSize; property AutoSize;
@ -986,6 +988,9 @@ end.
{ {
$Log$ $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 Revision 1.128 2005/01/10 16:35:35 vincents
made TabVisible public made TabVisible public

27
lcl/include/customimage.inc
View File

@ -38,6 +38,29 @@ begin
inherited Destroy; inherited Destroy;
end; 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); procedure TCustomImage.SetPicture(const AValue: TPicture);
begin begin
if FPicture=AValue then exit; if FPicture=AValue then exit;
@ -167,7 +190,7 @@ Procedure TCustomImage.Paint;
Procedure DrawFrame; Procedure DrawFrame;
begin begin
if csDesigning in ComponentState then begin if csDesigning in ComponentState then begin
With Canvas do begin With inherited Canvas do begin
Pen.Color := clBlack; Pen.Color := clBlack;
Pen.Style := psDash; Pen.Style := psDash;
MoveTo(0, 0); MoveTo(0, 0);
@ -183,7 +206,7 @@ var
iRect : TRect; iRect : TRect;
BackgroundColor: Integer; BackgroundColor: Integer;
begin begin
With Canvas do begin With inherited Canvas do begin
DrawFrame; DrawFrame;
If Picture.Graphic = nil then If Picture.Graphic = nil then
exit; exit;