Changeset 472 for GraphicTest/Packages/bgrabitmap/bgralayers.pas

Timestamp:

Apr 9, 2015, 9:58:36 PM (10 years ago)

Author:

chronos

Message:

• Fixed: Use csOpaque control style also to Image, PaintBox and OpenGLControl.
• Modified: Change size of test frame with SpinEdits as delayed using timer.
• Updated: BRGABitmap package to version 8.1.

File:

• GraphicTest/Packages/bgrabitmap/bgralayers.pas (modified) (23 diffs)

GraphicTest/Packages/bgrabitmap/bgralayers.pas

@@ -14 +14 @@
   TBGRALayeredBitmap = class;
   TBGRALayeredBitmapClass = class of TBGRALayeredBitmap;
+
+  TBGRALayeredBitmapSaveToStreamProc = procedure(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
+  TBGRALayeredBitmapLoadFromStreamProc = function(AStream: TStream): TBGRALayeredBitmap;
 
   { TBGRACustomLayeredBitmap }
@@ -36 +39 @@
     function GetLayerName(layer: integer): string; virtual;
     function GetLayerOffset(layer: integer): TPoint; virtual;
-    function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; virtual;
     function GetLayerFrozenRange(layer: integer): integer;
     function GetLayerFrozen(layer: integer): boolean; virtual;
+    function GetLayerUniqueId(layer: integer): integer; virtual;
     procedure SetLayerFrozen(layer: integer; AValue: boolean); virtual;
     function RangeIntersect(first1,last1,first2,last2: integer): boolean;
@@ -50 +53 @@
 
   public
-    procedure SaveToFile(const filename: string); override;
+    procedure SaveToFile(const filenameUTF8: string); override;
     procedure SaveToStream(Stream: TStream); override;
     constructor Create; override;
     destructor Destroy; override;
     function ToString: ansistring; override;
+    function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; virtual;
     function GetLayerBitmapCopy(layer: integer): TBGRABitmap; virtual; abstract;
     function ComputeFlatImage: TBGRABitmap; overload;
@@ -80 +84 @@
     property LayerOffset[layer: integer]: TPoint read GetLayerOffset;
     property LayerFrozen[layer: integer]: boolean read GetLayerFrozen;
+    property LayerUniqueId[layer: integer]: integer read GetLayerUniqueId;
     property LinearBlend: boolean read GetLinearBlend write SetLinearBlend; //use linear blending unless specified
     property DefaultBlendingOperation: TBlendOperation read GetDefaultBlendingOperation;
@@ -103 +108 @@
     FLayers: array of TBGRALayerInfo;
     FWidth,FHeight: integer;
-    function GetLayerUniqueId(layer: integer): integer;
-    procedure SetLayerUniqueId(layer: integer; AValue: integer);
 
   protected
@@ -122 +125 @@
     procedure SetLayerName(layer: integer; AValue: string);
     procedure SetLayerFrozen(layer: integer; AValue: boolean); override;
-    function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; override;
+    function GetLayerUniqueId(layer: integer): integer; override;
+    procedure SetLayerUniqueId(layer: integer; AValue: integer);
 
   public
-    procedure LoadFromFile(const filename: string); override;
+    procedure LoadFromFile(const filenameUTF8: string); override;
     procedure LoadFromStream(stream: TStream); override;
     procedure SetSize(AWidth, AHeight: integer); virtual;
@@ -155 +159 @@
     function AddOwnedLayer(ABitmap: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
     destructor Destroy; override;
-    constructor Create; override;
-    constructor Create(AWidth, AHeight: integer);
+    constructor Create; override; overload;
+    constructor Create(AWidth, AHeight: integer); virtual; overload;
+    function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; override;
     function GetLayerBitmapCopy(layer: integer): TBGRABitmap; override;
     function GetLayerIndexFromId(AIdentifier: integer): integer;
     function Duplicate(ASharedLayerIds: boolean = false): TBGRALayeredBitmap;
+    function ProduceLayerUniqueId: integer;
 
     procedure RotateCW;
@@ -180 +186 @@
   end;
 
-procedure RegisterLayeredBitmapWriter(AExtension: string; AWriter: TBGRALayeredBitmapClass);
-procedure RegisterLayeredBitmapReader(AExtension: string; AReader: TBGRACustomLayeredBitmapClass);
+procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass);
+procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass);
+
+var
+  LayeredBitmapSaveToStreamProc : TBGRALayeredBitmapSaveToStreamProc;
+  LayeredBitmapLoadFromStreamProc : TBGRALayeredBitmapLoadFromStreamProc;
+
+type
+  TOnLayeredBitmapLoadStartProc = procedure(AFilenameUTF8: string) of object;
+  TOnLayeredBitmapLoadProgressProc = procedure(APercentage: integer) of object;
+  TOnLayeredBitmapLoadedProc = procedure() of object;
+
+procedure OnLayeredBitmapLoadFromStreamStart;
+procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string);
+procedure OnLayeredBitmapLoadProgress(APercentage: integer);
+procedure OnLayeredBitmapLoaded();
+procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc;
+     ADone: TOnLayeredBitmapLoadedProc);
+procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc;
+     ADone: TOnLayeredBitmapLoadedProc);
 
 implementation
+
+uses LCLProc;
+
+var
+  OnLayeredBitmapLoadStartProc: TOnLayeredBitmapLoadStartProc;
+  OnLayeredBitmapLoadProgressProc: TOnLayeredBitmapLoadProgressProc;
+  OnLayeredBitmapLoadedProc: TOnLayeredBitmapLoadedProc;
 
 var
@@ -380 +411 @@
 end;
 
-procedure TBGRALayeredBitmap.LoadFromFile(const filename: string);
+procedure TBGRALayeredBitmap.LoadFromFile(const filenameUTF8: string);
 var bmp: TBGRABitmap;
     index: integer;
@@ -387 +418 @@
     i: integer;
 begin
-  ext := lowercase(ExtractFileExt(filename));
+  ext := UTF8LowerCase(ExtractFileExt(filenameUTF8));
   for i := 0 to high(LayeredBitmapReaders) do
     if '.'+LayeredBitmapReaders[i].extension = ext then
@@ -393 +424 @@
       temp := LayeredBitmapReaders[i].theClass.Create;
       try
-        temp.LoadFromFile(filename);
+        temp.LoadFromFile(filenameUTF8);
         Assign(temp);
       finally
@@ -401 +432 @@
     end;
 
-  bmp := TBGRABitmap.Create(filename);
+  bmp := TBGRABitmap.Create(filenameUTF8, True);
   Clear;
   SetSize(bmp.Width,bmp.Height);
@@ -411 +442 @@
 var bmp: TBGRABitmap;
    index: integer;
-begin
+   temp: TBGRALayeredBitmap;
+begin
+  if Assigned(LayeredBitmapLoadFromStreamProc) then
+  begin
+    temp := LayeredBitmapLoadFromStreamProc(Stream);
+    if temp <> nil then
+    begin
+      Assign(temp);
+      temp.Free;
+      exit;
+    end;
+  end;
   bmp := TBGRABitmap.Create(stream);
   Clear;
@@ -538 +580 @@
   FLayers[FNbLayers].Visible := true;
   FLayers[FNbLayers].Frozen := false;
-  FLayers[FNbLayers].UniqueId := InterLockedIncrement(NextLayerUniqueId);
+  FLayers[FNbLayers].UniqueId := ProduceLayerUniqueId;
   if Shared then
   begin
@@ -694 +736 @@
   result := TBGRALayeredBitmap.Create;
   result.Assign(self, ASharedLayerIds);
+end;
+
+function TBGRALayeredBitmap.ProduceLayerUniqueId: integer;
+begin
+  result := InterLockedIncrement(NextLayerUniqueId);
 end;
 
@@ -841 +888 @@
     end;
   result := false;
+end;
+
+function TBGRACustomLayeredBitmap.GetLayerUniqueId(layer: integer): integer;
+begin
+  result := layer;
 end;
 
@@ -903 +955 @@
 end;
 
-procedure TBGRACustomLayeredBitmap.SaveToFile(const filename: string);
+procedure TBGRACustomLayeredBitmap.SaveToFile(const filenameUTF8: string);
 var bmp: TBGRABitmap;
     ext: string;
@@ -909 +961 @@
     i: integer;
 begin
-  ext := lowercase(ExtractFileExt(filename));
+  ext := UTF8LowerCase(ExtractFileExt(filenameUTF8));
   for i := 0 to high(LayeredBitmapWriters) do
     if '.'+LayeredBitmapWriters[i].extension = ext then
@@ -916 +968 @@
       try
         temp.Assign(self);
-        temp.SaveToFile(filename);
+        temp.SaveToFile(filenameUTF8);
       finally
         temp.Free;
@@ -925 +977 @@
   bmp := ComputeFlatImage;
   try
-    bmp.SaveToFile(filename);
+    bmp.SaveToFileUTF8(filenameUTF8);
   finally
     bmp.Free;
@@ -933 +985 @@
 procedure TBGRACustomLayeredBitmap.SaveToStream(Stream: TStream);
 begin
-  raise exception.Create('Not implemented');
+  if Assigned(LayeredBitmapSaveToStreamProc) then
+    LayeredBitmapSaveToStreamProc(Stream, self)
+  else
+    raise exception.Create('Call BGRAStreamLayers.RegisterStreamLayers first');
 end;
 
@@ -1188 +1243 @@
   linear := false; //to avoid hint
   for j := firstlayer to lastLayer do
-  if (BlendOperation[j] in [boTransparent,boLinearBlend]) or (start= 0) then
+  if (BlendOperation[j] in [boTransparent,boLinearBlend]) or (start = 0) or ((firstlayer= 0) and (j=0)) then
   begin
     nextLinear := (BlendOperation[j] = boLinearBlend) or self.LinearBlend;
@@ -1239 +1294 @@
 end;
 
-procedure RegisterLayeredBitmapReader(AExtension: string; AReader: TBGRACustomLayeredBitmapClass);
+procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass);
 begin
   setlength(LayeredBitmapReaders,length(LayeredBitmapReaders)+1);
   with LayeredBitmapReaders[high(LayeredBitmapReaders)] do
   begin
-    extension:= AExtension;
+    extension:= UTF8LowerCase(AExtensionUTF8);
     theClass := AReader;
   end;
 end;
 
-procedure RegisterLayeredBitmapWriter(AExtension: string; AWriter: TBGRALayeredBitmapClass);
-begin
+procedure OnLayeredBitmapLoadFromStreamStart;
+begin
+  OnLayeredBitmapLoadStart('<Stream>');
+end;
+
+procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string);
+begin
+  if Assigned(OnLayeredBitmapLoadStartProc) then
+    OnLayeredBitmapLoadStartProc(AFilenameUTF8);
+end;
+
+procedure OnLayeredBitmapLoadProgress(APercentage: integer);
+begin
+  if Assigned(OnLayeredBitmapLoadProgressProc) then
+    OnLayeredBitmapLoadProgressProc(APercentage);
+end;
+
+procedure OnLayeredBitmapLoaded;
+begin
+  if Assigned(OnLayeredBitmapLoadedProc) then
+    OnLayeredBitmapLoadedProc();
+end;
+
+procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc;
+  AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc
+  );
+begin
+  OnLayeredBitmapLoadProgressProc:= AProgress;
+  OnLayeredBitmapLoadStartProc := AStart;
+  OnLayeredBitmapLoadedProc:= ADone;
+end;
+
+procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc;
+  AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc);
+begin
+  if OnLayeredBitmapLoadProgressProc = AProgress then OnLayeredBitmapLoadProgressProc := nil;
+  if OnLayeredBitmapLoadStartProc = AStart then OnLayeredBitmapLoadStartProc := nil;
+  if OnLayeredBitmapLoadedProc = ADone then OnLayeredBitmapLoadedProc := nil;
+end;
+
+procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass);
+begin
+  while (length(AExtensionUTF8)>0) and (AExtensionUTF8[1]='.') do delete(AExtensionUTF8,1,1);
   setlength(LayeredBitmapWriters,length(LayeredBitmapWriters)+1);
   with LayeredBitmapWriters[high(LayeredBitmapWriters)] do
   begin
-    extension:= AExtension;
+    extension:= UTF8LowerCase(AExtensionUTF8);
     theClass := AWriter;
   end;