paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 12:39:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Implement TImage.OnPaintBackground. Issue #29581, patch from Alexey Torgashin.

Browse Source 
git-svn-id: trunk@51507 -
This commit is contained in:
juha 2016-02-05 23:03:16 +00:00
parent 7714ec4ab7
commit bf09dadd9a
2 changed files with 6 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/extctrls.pp
View File

@ -37,6 +37,7 @@ type
TPage = class;
TBeforeShowPageEvent = procedure (ASender: TObject; ANewPage: TPage; ANewIndex: Integer) of object;
TImagePaintBackgroundEvent = procedure (ASender: TObject; ACanvas: TCanvas; ARect: TRect) of object;
TPage = class(TCustomControl)
private
@ -481,6 +482,7 @@ type
private
FAntialiasingMode: TAntialiasingMode;
FOnPictureChanged: TNotifyEvent;
FOnPaintBackground: TImagePaintBackgroundEvent;
FPicture: TPicture;
FCenter: Boolean;
FKeepOriginXWhenClipped: Boolean;
@ -536,6 +538,7 @@ type
property Transparent: Boolean read FTransparent write SetTransparent default False;
property Proportional: Boolean read FProportional write SetProportional default False;
property OnPictureChanged: TNotifyEvent read FOnPictureChanged write FOnPictureChanged;
property OnPaintBackground: TImagePaintBackgroundEvent read FOnPaintBackground write FOnPaintBackground;
end;
@ -571,6 +574,7 @@ type
property OnMouseWheelUp;
property OnPaint;
property OnPictureChanged;
property OnPaintBackground;
property OnResize;
property OnStartDrag;
property ParentShowHint;

2
lcl/include/customimage.inc
View File

@ -239,6 +239,8 @@ begin
C.AntialiasingMode := FAntialiasingMode;
FPainting:=true;
try
if Assigned(FOnPaintBackground) then
FOnPaintBackground(Self, C, R);
C.StretchDraw(R, Picture.Graphic);
finally
FPainting:=false;