浏览代码

Move OnPaint into TBitmapImageImplementation.

Martijn Laan 1 月之前
父节点
当前提交
8d152af312
共有 2 个文件被更改,包括 12 次插入11 次删除
  1. 2 8
      Components/BitmapButton.pas
  2. 10 3
      Components/BitmapImage.pas

+ 2 - 8
Components/BitmapButton.pas

@@ -22,15 +22,12 @@ uses
   BitmapImage;
   BitmapImage;
 
 
 type
 type
-  TPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; var ARect: TRect) of object;
-
   TBitmapButton = class(TCustomControl)
   TBitmapButton = class(TCustomControl)
   private
   private
     FFocusBorderWidth, FFocusBorderHeight: Integer;
     FFocusBorderWidth, FFocusBorderHeight: Integer;
     FImpl: TBitmapImageImplementation;
     FImpl: TBitmapImageImplementation;
     FOnClick: TNotifyEvent;
     FOnClick: TNotifyEvent;
     FOnDblClick: TNotifyEvent;
     FOnDblClick: TNotifyEvent;
-    FOnPaint: TPaintEvent;
     procedure SetBackColor(Value: TColor);
     procedure SetBackColor(Value: TColor);
     procedure SetBitmap(Value: TBitmap);
     procedure SetBitmap(Value: TBitmap);
     procedure SetCenter(Value: Boolean);
     procedure SetCenter(Value: Boolean);
@@ -70,7 +67,7 @@ type
     property Visible;
     property Visible;
     property OnClick: TNotifyEvent read FOnClick write FOnClick;
     property OnClick: TNotifyEvent read FOnClick write FOnClick;
     property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
     property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
-    property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
+    property OnPaint: TPaintEvent read FImpl.OnPaint write FImpl.OnPaint;
   end;
   end;
 
 
 procedure Register;
 procedure Register;
@@ -188,10 +185,7 @@ begin
 
 
   InflateRect(R, -FFocusBorderWidth, -FFocusBorderHeight);
   InflateRect(R, -FFocusBorderWidth, -FFocusBorderHeight);
 
 
-  FImpl.Paint(Canvas, R);
-
-  if Assigned(FOnPaint) then
-    FOnPaint(Self, Canvas, R);
+  FImpl.Paint(Self, Canvas, R);
 end;
 end;
 
 
 procedure TBitmapButton.WMSetFocus(var Message: TWMSetFocus);
 procedure TBitmapButton.WMSetFocus(var Message: TWMSetFocus);

+ 10 - 3
Components/BitmapImage.pas

@@ -17,6 +17,8 @@ uses
   Windows, Controls, Graphics, Classes;
   Windows, Controls, Graphics, Classes;
 
 
 type
 type
+  TPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; var ARect: TRect) of object;
+
   TBitmapImageImplementation = record
   TBitmapImageImplementation = record
   private
   private
     FControl: TControl;
     FControl: TControl;
@@ -31,6 +33,7 @@ type
     Stretch: Boolean;
     Stretch: Boolean;
     StretchedBitmap: TBitmap;
     StretchedBitmap: TBitmap;
     StretchedBitmapValid: Boolean;
     StretchedBitmapValid: Boolean;
+    OnPaint: TPaintEvent;
     procedure Init(const AControl: TControl; const AAutoSizeExtraWidth: Integer = 0;
     procedure Init(const AControl: TControl; const AAutoSizeExtraWidth: Integer = 0;
       const AAutoSizeExtraHeight: Integer = 0);
       const AAutoSizeExtraHeight: Integer = 0);
     procedure DeInit;
     procedure DeInit;
@@ -45,7 +48,7 @@ type
     procedure SetReplaceWithColor(Sender: TObject; Value: TColor);
     procedure SetReplaceWithColor(Sender: TObject; Value: TColor);
     procedure SetStretch(Sender: TObject; Value: Boolean);
     procedure SetStretch(Sender: TObject; Value: Boolean);
     function GetPalette: HPALETTE;
     function GetPalette: HPALETTE;
-    procedure Paint(const Canvas: TCanvas; var R: TRect);
+    procedure Paint(const Sender: TObject; const Canvas: TCanvas; var R: TRect);
   end;
   end;
 
 
   TBitmapImage = class(TGraphicControl)
   TBitmapImage = class(TGraphicControl)
@@ -90,6 +93,7 @@ type
     property OnMouseDown;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseMove;
     property OnMouseUp;
     property OnMouseUp;
+    property OnPaint: TPaintEvent read FImpl.OnPaint write FImpl.OnPaint;
     property OnStartDrag;
     property OnStartDrag;
   end;
   end;
 
 
@@ -250,7 +254,7 @@ begin
   Result := Bitmap.Palette;
   Result := Bitmap.Palette;
 end;
 end;
 
 
-procedure TBitmapImageImplementation.Paint(const Canvas: TCanvas; var R: TRect);
+procedure TBitmapImageImplementation.Paint(const Sender: TObject; const Canvas: TCanvas; var R: TRect);
 begin
 begin
   const Is32bit = (Bitmap.PixelFormat = pf32bit) and
   const Is32bit = (Bitmap.PixelFormat = pf32bit) and
     (Bitmap.AlphaFormat in [afDefined, afPremultiplied]);
     (Bitmap.AlphaFormat in [afDefined, afPremultiplied]);
@@ -315,6 +319,9 @@ begin
     Canvas.BrushCopy(Rect(X, Y, X + W, Y + H), Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), ReplaceColor);
     Canvas.BrushCopy(Rect(X, Y, X + W, Y + H), Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), ReplaceColor);
   end else
   end else
     Canvas.Draw(X, Y, Bmp);
     Canvas.Draw(X, Y, Bmp);
+
+  if Assigned(OnPaint) then
+    OnPaint(Sender, Canvas, R);
 end;
 end;
 
 
 { TBitmapImage }
 { TBitmapImage }
@@ -383,7 +390,7 @@ end;
 procedure TBitmapImage.Paint;
 procedure TBitmapImage.Paint;
 begin
 begin
   var R := ClientRect;
   var R := ClientRect;
-  FImpl.Paint(Canvas, R);
+  FImpl.Paint(Self, Canvas, R);
 end;
 end;
 
 
 end.
 end.