Skip to content

Commit

Permalink
PNG load inprovements, add hack for AlphaControls! AlphaControls is t…
Browse files Browse the repository at this point in the history
…rash.
  • Loading branch information
errorcalc committed Nov 20, 2018
1 parent 862f254 commit 4a8ba11
Show file tree
Hide file tree
Showing 3 changed files with 71 additions and 58 deletions.
22 changes: 9 additions & 13 deletions Source/ES.CfxClasses.pas
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
{******************************************************************************}
{ EsVclComponents/EsVclCore v2.0 }
{ ErrorSoft(c) 2009-2016 }
{ ErrorSoft(c) 2009-2018 }
{ }
{ More beautiful things: errorsoft.org }
{ }
Expand Down Expand Up @@ -668,11 +668,7 @@ constructor TNinePatchObject.Create;
FOverlayMargins := TImageMargins.Create(nil);
FOverlayMargins.OnChange := BoundsChange;
FBitmap := TBitMap.Create;
FBitmap.PixelFormat := pf32bit;
FBitmap.AlphaFormat := afPremultiplied;
FOverlay := TBitMap.Create;
FOverlay.PixelFormat := pf32bit;
FOverlay.AlphaFormat := afPremultiplied;
FOverlayAlign := TImageAlign.TopLeft;
// FContentSpace := True;
end;
Expand Down Expand Up @@ -796,20 +792,20 @@ procedure TNinePatchObject.SetMargins(const Value: TImageMargins);

procedure TNinePatchObject.AssignImage(G: TGraphic);
begin
FBitmap.SetSize(G.Width, G.Height);
FBitmap.Canvas.Brush.Color := 0;
FBitmap.Canvas.FillRect(Rect(0, 0, FBitmap.Width, FBitmap.Height));
FBitmap.Canvas.Draw(0, 0, G);
if G is TPngImage then
PngImageAssignToBitmap(FBitmap, TPngImage(G))
else
FBitmap.Assign(G);

NeedRepaint;
end;

procedure TNinePatchObject.AssignOverlay(G: TGraphic);
begin
FOverlay.SetSize(G.Width, G.Height);
FOverlay.Canvas.Brush.Color := 0;
FOverlay.Canvas.FillRect(Rect(0, 0, FOverlay.Width, FOverlay.Height));
FOverlay.Canvas.Draw(0, 0, G);
if G is TPngImage then
PngImageAssignToBitmap(FOverlay, TPngImage(G))
else
FOverlay.Assign(G);

NeedRepaint;
end;
Expand Down
33 changes: 23 additions & 10 deletions Source/ES.ExGraphics.pas
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
{******************************************************************************}
{ EsVclComponents/EsVclCore v2.0 }
{ ErrorSoft(c) 2009-2016 }
{ ErrorSoft(c) 2009-2018 }
{ }
{ More beautiful things: errorsoft.org }
{ }
Expand Down Expand Up @@ -160,7 +160,7 @@ implementation

uses
System.Classes, System.Types, Vcl.GraphUtil, System.UITypes,
System.TypInfo;
System.TypInfo, Vcl.Dialogs;

//------------------------------------------------------------------------------
// Utils
Expand Down Expand Up @@ -278,12 +278,22 @@ procedure PngImageAssignToBitmap(Bitmap: TBitmap; PngImage: TPngImage; IsPremult
C: TRGBQuad;
A: Byte;
begin
if PngImage.Empty or (PngImage.TransparencyMode <> ptmPartial) or (PngImage.Header.BitDepth <> 8) then
Bitmap.Assign(PngImage)
else
if (PngImage = nil) or (PngImage.Empty) then
begin
Bitmap.SetSize(0, 0);
Exit;
end;

if (PngImage.TransparencyMode <> ptmPartial) or (PngImage.Header.BitDepth <> 8) then
begin
Bitmap.Assign(PngImage);
end else
begin
Bitmap.SetSize(0, 0);
Bitmap.AlphaFormat := TAlphaFormat.afPremultiplied;
if IsPremultipledBitmap then
Bitmap.AlphaFormat := TAlphaFormat.afPremultiplied
else
Bitmap.AlphaFormat := TAlphaFormat.afDefined;
Bitmap.PixelFormat := pf32bit;
Bitmap.SetSize(PngImage.Width, PngImage.Height);

Expand Down Expand Up @@ -365,8 +375,9 @@ procedure BitmapAssignToPngImage(PngImage: TPngImage; Bitmap: TBitmap; IsPremult
pPngAlpha: PByteArray;
begin
if Bitmap.Empty or (Bitmap.PixelFormat <> pf32bit) then
PngImage.Assign(Bitmap)
else
begin
PngImage.Assign(Bitmap);
end else
begin
// set need settings
TempPng := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, 1, 1);
Expand Down Expand Up @@ -422,7 +433,6 @@ procedure GraphicAssignToBitmap(Bitmap: TBitmap; Graphic: TGraphic); Inline;
{$ifndef DISABLE_GDIPLUS}
function BitmapToGPBitmap(Bitmap: TBitmap): TGPBitmap;
begin
Result := nil;

if Bitmap.PixelFormat = pf32bit then
begin
Expand Down Expand Up @@ -959,7 +969,10 @@ procedure {$ifdef VER210UP}TEsCanvasHelper{$else}TEsCanvas{$endif}.
BF.BlendOp := AC_SRC_OVER;
BF.BlendFlags := 0;
BF.SourceConstantAlpha := Opacity;
BF.AlphaFormat := AC_SRC_ALPHA;
if Bitmap.PixelFormat = pf32bit then
BF.AlphaFormat := AC_SRC_ALPHA
else
BF.AlphaFormat := 0;

AlphaBlend(Handle, DestRect.Left, DestRect.Top, DestRect.Right - DestRect.Left, DestRect.Bottom - DestRect.Top,
Bitmap.Canvas.Handle, SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, BF);
Expand Down
74 changes: 39 additions & 35 deletions Source/ES.FreeEditors.pas
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
{******************************************************************************}
{ EsVclComponents v2.0 }
{ ErrorSoft(c) 2009-2016 }
{ ErrorSoft(c) 2009-2018 }
{ }
{ More beautiful things: errorsoft.org }
{ }
Expand All @@ -17,8 +17,8 @@
interface

uses
DesignEditors, DesignIntf, System.Classes, WinApi.Windows, Vcl.Graphics, Vcl.Imaging.PngImage, PicEdit,
Vcl.ImgList, VclEditors, System.Types, System.TypInfo;
DesignEditors, DesignIntf, DesignConst, System.Classes, WinApi.Windows, Vcl.Graphics,
Vcl.ImgList, PicEdit, VclEditors, Vcl.Imaging.PngImage, System.Types, System.TypInfo;

type
TEsPngPropertyFix = class(TGraphicProperty)
Expand Down Expand Up @@ -53,11 +53,41 @@ implementation

{TEsPngPropertyFix}

// AlphaControls/alphaskins is bad.
// I has too much head pain, because of them!
// Alpha controls COMPLETLY BREAK DOWN STANDART PNG LOADER.
procedure TEsPngPropertyFix.Edit;
var
PictureEditor: TPictureEditor;
Png: TPngImage;

begin
TPicture.RegisterFileFormat('PNG', 'ErrorSoft fix PNG loader', TPngImage);
inherited;
TPicture.UnregisterGraphicClass(TPngImage);
PictureEditor := TPictureEditor.Create(nil);
try
PictureEditor.GraphicClass := TGraphicClass(GetTypeData(GetPropType)^.ClassType);
PictureEditor.Picture.Graphic := TGraphic(Pointer(GetOrdValue));

if PictureEditor.Execute then
if (PictureEditor.Picture.Graphic = nil) or
(PictureEditor.Picture.Graphic is PictureEditor.GraphicClass) then
SetOrdValue(LongInt(PictureEditor.Picture.Graphic))
else
if (PictureEditor.Picture.Graphic is TBitmap) and
PictureEditor.Picture.Graphic.ClassNameIs('TPNGGraphic') then
begin
Png := TPngImage.Create;
try
BitmapAssignToPngImage(Png, TBitmap(PictureEditor.Picture.Graphic), False);
SetOrdValue(LongInt(Png));
finally
Png.Free;
end;
end
else
raise Exception.CreateRes(@SInvalidFormat);
finally
PictureEditor.Free;
end;
end;

{ TEsCustomImageIndexProperty }
Expand Down Expand Up @@ -137,40 +167,14 @@ procedure TEsCustomImageIndexProperty.ListMeasureWidth(const Value: string; ACan

{ TEsPicturePropertyFix }

type
TRawPngImage = class(TPngImage)
end;

// AlphaControls/alphaskins is bad.
// I has too much head pain, because of them!
// Alpha controls COMPLETLY BREAK DOWN STANDART PNG LOADER.
procedure TEsPicturePropertyFix.Edit;
var
Png: TPngImage;
Pic: TPicture;
begin
// PictureEditor := TPictureEditor.Create(nil);
// try
// TPicture.RegisterFileFormat('PNG', 'ErrorSoft fix PNG loader', TRawPngImage);
// PictureEditor.Picture := TPicture(Pointer(GetOrdValue));
//
// if PictureEditor.Execute then
// begin
// if PictureEditor.Picture.Graphic is TRawPngImage then
// begin
// Png := TPngImage.Create;
// try
// Png.Assign(PictureEditor.Picture.Graphic);
// PictureEditor.Picture.Assign(Png);
// finally
// Png.Free;
// end;
// end;
// SetOrdValue(Longint(PictureEditor.Picture));
// end;
//
// finally
// PictureEditor.Free;
// TPicture.UnregisterGraphicClass(TRawPngImage);
// end;

Inherited;
Pic := TPicture(Pointer(GetOrdValue));
if (Pic.Graphic is TBitmap) and Pic.Graphic.ClassNameIs('TPNGGraphic') then
Expand Down

0 comments on commit 4a8ba11

Please sign in to comment.