Pārlūkot izejas kodu

Make png images work at design-time and especially make it less akward for [Code] by having a regular PngImage property.

Martijn Laan 3 nedēļas atpakaļ
vecāks
revīzija
877392af9a
2 mainītis faili ar 41 papildinājumiem un 9 dzēšanām
  1. 11 4
      Components/BitmapButton.pas
  2. 30 5
      Components/BitmapImage.pas

+ 11 - 4
Components/BitmapButton.pas

@@ -6,11 +6,11 @@ unit BitmapButton;
   Portions by Martijn Laan
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
   For conditions of distribution and use, see LICENSE.TXT.
 
 
-  A TImage-like component for bitmaps without the TPicture bloat and
+  A TImage-like component for bitmaps and png files without the TPicture bloat and
   which is actually a button with a focus rectangle when focused - in
   which is actually a button with a focus rectangle when focused - in
   other words: an accessible TImage
   other words: an accessible TImage
 
 
-  Also supports other TGraphic types which can be assigned to a TBitmap, like TPngImage
+  Also supports other TGraphic types which can be assigned to a TBitmap
   
   
   Make sure to set the Caption property, even if it isn't visible
   Make sure to set the Caption property, even if it isn't visible
 
 
@@ -20,7 +20,7 @@ unit BitmapButton;
 interface
 interface
 
 
 uses
 uses
-  Windows, Messages, Controls, Graphics, Classes,
+  Windows, Messages, Controls, Graphics, Classes, Imaging.pngimage,
   BitmapImage;
   BitmapImage;
 
 
 type
 type
@@ -32,6 +32,7 @@ type
     procedure SetBitmap(Value: TBitmap);
     procedure SetBitmap(Value: TBitmap);
     procedure SetCenter(Value: Boolean);
     procedure SetCenter(Value: Boolean);
     procedure SetGraphic(Value: TGraphic);
     procedure SetGraphic(Value: TGraphic);
+    procedure SetPngImage(Value: TPngImage);
     procedure SetReplaceColor(Value: TColor);
     procedure SetReplaceColor(Value: TColor);
     procedure SetReplaceWithColor(Value: TColor);
     procedure SetReplaceWithColor(Value: TColor);
     procedure SetStretch(Value: Boolean);
     procedure SetStretch(Value: Boolean);
@@ -53,11 +54,12 @@ type
     property Anchors;
     property Anchors;
     property AutoSize: Boolean read FImpl.AutoSize write SetAutoSize default False;
     property AutoSize: Boolean read FImpl.AutoSize write SetAutoSize default False;
     property BackColor: TColor read FImpl.BackColor write SetBackColor default clNone;
     property BackColor: TColor read FImpl.BackColor write SetBackColor default clNone;
+    property Bitmap: TBitmap read FImpl.Bitmap write SetBitmap;
     property Caption;
     property Caption;
     property Center: Boolean read FImpl.Center write SetCenter default True;
     property Center: Boolean read FImpl.Center write SetCenter default True;
     property Enabled;
     property Enabled;
     property ParentShowHint;
     property ParentShowHint;
-    property Bitmap: TBitmap read FImpl.Bitmap write SetBitmap;
+    property PngImage: TPngImage read FImpl.PngImage write SetPngImage;
     property PopupMenu;
     property PopupMenu;
     property ShowHint;
     property ShowHint;
     property Stretch: Boolean read FImpl.Stretch write SetStretch default False;
     property Stretch: Boolean read FImpl.Stretch write SetStretch default False;
@@ -137,6 +139,11 @@ begin
   FImpl.SetGraphic(Value);
   FImpl.SetGraphic(Value);
 end;
 end;
 
 
+procedure TBitmapButton.SetPngImage(Value: TPngImage);
+begin
+  FImpl.SetPngImage(Value);
+end;
+
 procedure TBitmapButton.SetReplaceColor(Value: TColor);
 procedure TBitmapButton.SetReplaceColor(Value: TColor);
 begin
 begin
   FImpl.SetReplaceColor(Self, Value);
   FImpl.SetReplaceColor(Self, Value);

+ 30 - 5
Components/BitmapImage.pas

@@ -6,9 +6,9 @@ unit BitmapImage;
   Portions by Martijn Laan
   Portions by Martijn Laan
   For conditions of distribution and use, see LICENSE.TXT.
   For conditions of distribution and use, see LICENSE.TXT.
 
 
-  A TImage-like component for bitmaps without the TPicture bloat
+  A TImage-like component for bitmaps and png files without the TPicture bloat
   
   
-  Also supports other TGraphic types which can be assigned to a TBitmap, like TPngImage
+  Also supports other TGraphic types which can be assigned to a TBitmap
 
 
   Also see TBitmapButton which is the TWinControl version
   Also see TBitmapButton which is the TWinControl version
 }
 }
@@ -16,7 +16,7 @@ unit BitmapImage;
 interface
 interface
 
 
 uses
 uses
-  Windows, Controls, Graphics, Classes;
+  Windows, Controls, Graphics, Classes, Imaging.pngimage;
 
 
 type
 type
   TPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; var ARect: TRect) of object;
   TPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; var ARect: TRect) of object;
@@ -30,6 +30,7 @@ type
     BackColor: TColor;
     BackColor: TColor;
     Bitmap: TBitmap;
     Bitmap: TBitmap;
     Center: Boolean;
     Center: Boolean;
+    PngImage: TPngImage;
     ReplaceColor: TColor;
     ReplaceColor: TColor;
     ReplaceWithColor: TColor;
     ReplaceWithColor: TColor;
     Stretch: Boolean;
     Stretch: Boolean;
@@ -41,11 +42,13 @@ type
     procedure DeInit;
     procedure DeInit;
     function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
     function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
     procedure BitmapChanged(Sender: TObject);
     procedure BitmapChanged(Sender: TObject);
+    procedure PngImageChanged(Sender: TObject);
     procedure SetAutoSize(Sender: TObject; Value: Boolean);
     procedure SetAutoSize(Sender: TObject; Value: Boolean);
     procedure SetBackColor(Sender: TObject; Value: TColor);
     procedure SetBackColor(Sender: TObject; Value: TColor);
     procedure SetBitmap(Value: TBitmap);
     procedure SetBitmap(Value: TBitmap);
     procedure SetCenter(Sender: TObject; Value: Boolean);
     procedure SetCenter(Sender: TObject; Value: Boolean);
     procedure SetGraphic(Value: TGraphic);
     procedure SetGraphic(Value: TGraphic);
+    procedure SetPngImage(Value: TPngImage);
     procedure SetReplaceColor(Sender: TObject; Value: TColor);
     procedure SetReplaceColor(Sender: TObject; Value: TColor);
     procedure SetReplaceWithColor(Sender: TObject; Value: TColor);
     procedure SetReplaceWithColor(Sender: TObject; Value: TColor);
     procedure SetStretch(Sender: TObject; Value: Boolean);
     procedure SetStretch(Sender: TObject; Value: Boolean);
@@ -60,6 +63,7 @@ type
     procedure SetBitmap(Value: TBitmap);
     procedure SetBitmap(Value: TBitmap);
     procedure SetCenter(Value: Boolean);
     procedure SetCenter(Value: Boolean);
     procedure SetGraphic(Value: TGraphic);
     procedure SetGraphic(Value: TGraphic);
+    procedure SetPngImage(Value: TPngImage);
     procedure SetReplaceColor(Value: TColor);
     procedure SetReplaceColor(Value: TColor);
     procedure SetReplaceWithColor(Value: TColor);
     procedure SetReplaceWithColor(Value: TColor);
     procedure SetStretch(Value: Boolean);
     procedure SetStretch(Value: Boolean);
@@ -83,6 +87,7 @@ type
     property DragMode;
     property DragMode;
     property Enabled;
     property Enabled;
     property ParentShowHint;
     property ParentShowHint;
+    property PngImage: TPngImage read FImpl.PngImage write SetPngImage;
     property PopupMenu;
     property PopupMenu;
     property ShowHint;
     property ShowHint;
     property Stretch: Boolean read FImpl.Stretch write SetStretch default False;
     property Stretch: Boolean read FImpl.Stretch write SetStretch default False;
@@ -121,9 +126,11 @@ begin
   FControl := AControl;
   FControl := AControl;
   AutoSizeExtraWidth := AAutoSizeExtraWidth;
   AutoSizeExtraWidth := AAutoSizeExtraWidth;
   AutoSizeExtraHeight := AAutoSizeExtraHeight;
   AutoSizeExtraHeight := AAutoSizeExtraHeight;
+  BackColor := clNone;
   Bitmap := TBitmap.Create;
   Bitmap := TBitmap.Create;
   Bitmap.OnChange := BitmapChanged;
   Bitmap.OnChange := BitmapChanged;
-  BackColor := clNone;
+  PngImage := TPngImage.Create;
+  PngImage.OnChange := PngImageChanged;
   ReplaceColor := clNone;
   ReplaceColor := clNone;
   ReplaceWithColor := clNone;
   ReplaceWithColor := clNone;
   StretchedBitmap := TBitmap.Create;
   StretchedBitmap := TBitmap.Create;
@@ -187,6 +194,11 @@ begin
   FControl.Invalidate;
   FControl.Invalidate;
 end;
 end;
 
 
+procedure TBitmapImageImplementation.PngImageChanged(Sender: TObject);
+begin
+  Bitmap.Assign(PngImage);
+end;
+
 procedure TBitmapImageImplementation.SetAutoSize(Sender: TObject; Value: Boolean);
 procedure TBitmapImageImplementation.SetAutoSize(Sender: TObject; Value: Boolean);
 begin
 begin
   AutoSize := Value;
   AutoSize := Value;
@@ -216,7 +228,15 @@ end;
 
 
 procedure TBitmapImageImplementation.SetGraphic(Value: TGraphic);
 procedure TBitmapImageImplementation.SetGraphic(Value: TGraphic);
 begin
 begin
-  Bitmap.Assign(Value);
+  if Value is TPngImage then
+    SetPngImage(Value as TPngImage)
+  else
+    Bitmap.Assign(Value);
+end;
+
+procedure TBitmapImageImplementation.SetPngImage(Value: TPngImage);
+begin
+  PngImage.Assign(Value);
 end;
 end;
 
 
 procedure TBitmapImageImplementation.SetReplaceColor(Sender: TObject; Value: TColor);
 procedure TBitmapImageImplementation.SetReplaceColor(Sender: TObject; Value: TColor);
@@ -366,6 +386,11 @@ begin
   FImpl.SetGraphic(Value);
   FImpl.SetGraphic(Value);
 end;
 end;
 
 
+procedure TBitmapImage.SetPngImage(Value: TPngImage);
+begin
+  FImpl.SetPngImage(Value);
+end;
+
 procedure TBitmapImage.SetReplaceColor(Value: TColor);
 procedure TBitmapImage.SetReplaceColor(Value: TColor);
 begin
 begin
   FImpl.SetReplaceColor(Self, Value);
   FImpl.SetReplaceColor(Self, Value);