Ignore:
Timestamp:
Apr 17, 2019, 12:58:41 AM (5 years ago)
Author:
chronos
Message:
  • Modified: Propagate project build mode options to used packages.
  • Added: Check memory leaks using heaptrc.
  • Modified: Update BGRABitmap package.
Location:
GraphicTest
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest

    • Property svn:ignore

      •  

        old new  
        88GraphicTest.lps
        99GraphicTest.dbg
         10heaptrclog.trc

  • GraphicTest/Packages/bgrabitmap/bgrastreamlayers.pas

    r494 r521  
    22
    33{$mode objfpc}{$H+}
     4{$MODESWITCH ADVANCEDRECORDS}
    45
    56interface
    … …  
    910
    1011function CheckStreamForLayers(AStream: TStream): boolean;
    11 function LoadLayersFromStream(AStream: TStream; out ASelectedLayerIndex: integer; ALoadLayerUniqueIds: boolean = false) : TBGRALayeredBitmap;
     12function LoadLayersFromStream(AStream: TStream; out ASelectedLayerIndex: integer; ALoadLayerUniqueIds: boolean = false;
     13         ADestination: TBGRALayeredBitmap = nil): TBGRALayeredBitmap;
    1214procedure SaveLayersToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap; ASelectedLayerIndex: integer; ACompression: TLzpCompression = lzpZStream);
    1315procedure SaveLayerBitmapToStream(AStream: TStream; ABitmap: TBGRABitmap; ACaption: string; ACompression: TLzpCompression = lzpZStream);
    … …  
    1820
    1921uses BGRABitmapTypes, BGRACompressableBitmap, zstream, BGRAReadLzp, BGRAWriteLzp,
    20      BGRAUTF8;
     22     BGRAUTF8, Math;
     23
     24type
     25  PLayerHeader = ^TLayerHeader;
     26
     27  { TLayerHeader }
     28
     29  TLayerHeader = packed record
     30    LayerOption, BlendOp,
     31    LayerOfsX, LayerOfsY,
     32    LayerUniqueId, LayerOpacity: Longint;
     33    LayerBitmapSize: int64;
     34    OriginalGuid: TGuid;
     35    OriginalMatrix: TAffineMatrix;
     36    procedure FixEndian;
     37  end;
     38
     39{ TLayerHeader }
     40
     41procedure TLayerHeader.FixEndian;
     42begin
     43  LayerOption := NtoLE(LayerOption);
     44  BlendOp := NtoLE(BlendOp);
     45  LayerOfsX := NtoLE(LayerOfsX);
     46  LayerOfsY := NtoLE(LayerOfsY);
     47  LayerUniqueId := NtoLE(LayerUniqueId);
     48  LayerOpacity := NtoLE(LayerOpacity);
     49  LayerBitmapSize := NtoLE(LayerBitmapSize);
     50  OriginalGuid.D1 := NtoBE(OriginalGuid.D1);
     51  OriginalGuid.D2 := NtoBE(OriginalGuid.D2);
     52  OriginalGuid.D3 := NtoBE(OriginalGuid.D3);
     53  DWord(OriginalMatrix[1,1]) := NtoLE(DWord(OriginalMatrix[1,1]));
     54  DWord(OriginalMatrix[2,1]) := NtoLE(DWord(OriginalMatrix[2,1]));
     55  DWord(OriginalMatrix[1,2]) := NtoLE(DWord(OriginalMatrix[1,2]));
     56  DWord(OriginalMatrix[2,2]) := NtoLE(DWord(OriginalMatrix[2,2]));
     57  DWord(OriginalMatrix[1,3]) := NtoLE(DWord(OriginalMatrix[1,3]));
     58  DWord(OriginalMatrix[2,3]) := NtoLE(DWord(OriginalMatrix[2,3]));
     59end;
    2160
    2261procedure SaveLayeredBitmapToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
    … …  
    2564end;
    2665
    27 function LoadLayeredBitmapFromStream(AStream: TStream) : TBGRALayeredBitmap;
     66procedure LoadLayeredBitmapFromStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
    2867var selectedIndex: integer;
    2968begin
    3069  if not CheckStreamForLayers(AStream) then
    31     result := nil
     70  begin
     71    if Assigned(ALayers) then ALayers.Clear;
     72  end
    3273  else
    33     result := LoadLayersFromStream(AStream,selectedIndex);
     74    LoadLayersFromStream(AStream,selectedIndex,false,ALayers as TBGRALayeredBitmap);
    3475end;
    3576
    … …  
    60101end;
    61102
    62 function LoadLayersFromStream(AStream: TStream; out ASelectedLayerIndex: integer; ALoadLayerUniqueIds: boolean = false): TBGRALayeredBitmap;
     103function LoadLayersFromStream(AStream: TStream; out ASelectedLayerIndex: integer; ALoadLayerUniqueIds: boolean = false;
     104         ADestination: TBGRALayeredBitmap = nil): TBGRALayeredBitmap;
    63105var
    64106  OldPosition: Int64;
    65107  HeaderFound: string;
    66   NbLayers: LongInt;
     108  NbLayers, canvasWidth, canvasHeight: LongInt;
    67109  HeaderSize, LayerHeaderSize: LongInt;
    68   LayerStackStartPosition, LayerHeaderPosition, LayerBitmapPosition, LayerEndPosition: Int64;
    69   LayerOption,StackOption: LongInt;
     110  LayerStackStartPosition, LayerHeaderPosition,
     111  LayerBitmapPosition, LayerEndPosition, MemDirPos: Int64;
     112  StackOption: LongInt;
    70113  Layer: TBGRABitmap;
    71114  i,LayerIndex: integer;
    72115  LayerName: string;
    73   LayerId: LongInt;
    74116  Compression: TLzpCompression;
    75   LayerVisible: boolean;
    76117  LayerBlendOp: TBlendOperation;
    77   LayerOffset: TPoint;
    78   LayerOpacity: integer;
    79118  LayerIdFound: boolean;
    80   LayerBitmapSize: integer;
    81 begin
    82   result := TBGRALayeredBitmap.Create;
     119  h: TLayerHeader;
     120begin
     121  if Assigned(ADestination) then
     122  begin
     123    result := ADestination;
     124    result.Clear;
     125  end else
     126    result := TBGRALayeredBitmap.Create;
    83127  OldPosition:= AStream.Position;
    84128  SetLength(HeaderFound, length(StreamHeader));
    … …  
    106150    result.LinearBlend := (StackOption and 1) = 1;
    107151    if (StackOption and 2) = 2 then Compression := lzpRLE else Compression:= lzpZStream;
     152
     153    if headerSize >= 20 then
     154    begin
     155      canvasWidth := LEReadLongint(AStream);
     156      canvasHeight := LEReadLongint(AStream);
     157      result.SetSize(canvasWidth,canvasHeight);
     158    end;
     159
     160    if headerSize >= 28 then
     161    begin
     162      MemDirPos := LEReadInt64(AStream);
     163    end else MemDirPos := 0;
    108164    //end of header
     165
     166    if MemDirPos <> 0 then
     167    begin
     168      AStream.Position:= MemDirPos+OldPosition;
     169      result.MemDirectory.LoadFromStream(AStream);
     170    end else
     171      result.MemDirectory.Clear;
    109172
    110173    AStream.Position:= LayerStackStartPosition;
    … …  
    112175    begin
    113176      LayerHeaderSize:= LEReadLongint(AStream);
     177
    114178      LayerHeaderPosition := AStream.Position;
    115179      LayerBitmapPosition := LayerHeaderPosition + LayerHeaderSize;
    116180      LayerEndPosition := -1;
    117181
    118       LayerVisible := true;
    119       LayerBlendOp := result.DefaultBlendingOperation;
    120       LayerOffset := Point(0,0);
    121       LayerId := 0;
    122       LayerIdFound := false;
    123       LayerOpacity := 255;
    124 
    125       if AStream.Position <= LayerBitmapPosition-4 then
    126       begin
    127         LayerOption := LEReadLongint(AStream);
    128         LayerVisible := (LayerOption and 1) = 1;
    129       end;
    130       if AStream.Position <= LayerBitmapPosition-4 then
    131         LayerBlendOp := TBlendOperation(LEReadLongint(AStream));
    132 
    133       if AStream.Position <= LayerBitmapPosition-8 then
    134       begin
    135         LayerOffset := Point(LEReadLongint(AStream),LEReadLongint(AStream));
    136         if AStream.Position <= LayerBitmapPosition-4 then
    137         begin
    138           LayerId := LEReadLongint(AStream);
    139           LayerIdFound := true;
    140         end;
    141         if AStream.Position <= LayerBitmapPosition-4 then
    142           LayerOpacity := LEReadLongint(AStream) shr 8;
    143       end;
    144       if AStream.Position <= LayerBitmapPosition-4 then
    145       begin
    146         LayerBitmapSize := LEReadLongint(AStream);
    147         LayerEndPosition:= LayerBitmapPosition+LayerBitmapSize;
    148       end;
     182      fillchar({%H-}h, sizeof(h), 0);
     183      h.LayerOption := 1; //visible
     184      h.BlendOp:= integer(result.DefaultBlendingOperation);
     185      h.LayerOpacity := 65535; //opaque
     186      h.LayerUniqueId:= maxLongint;
     187      h.FixEndian;
     188
     189      AStream.ReadBuffer(h, min(LayerHeaderSize, sizeof(h)));
     190      h.FixEndian;
     191
     192      if h.BlendOp > ord(high(TBlendOperation)) then
     193        LayerBlendOp := result.DefaultBlendingOperation
     194      else
     195        LayerBlendOp:= TBlendOperation(h.BlendOp);
     196
     197      LayerIdFound := h.LayerUniqueId <> maxLongint;
     198
     199      if h.LayerBitmapSize > 0 then
     200        LayerEndPosition:= LayerBitmapPosition+h.LayerBitmapSize;
    149201
    150202      AStream.Position:= LayerBitmapPosition;
    … …  
    155207
    156208      result.LayerName[LayerIndex] := LayerName;
    157       result.LayerVisible[LayerIndex] := LayerVisible;
     209      result.LayerVisible[LayerIndex] := (h.LayerOption and 1) = 1;
    158210      result.BlendOperation[LayerIndex]:= LayerBlendOp;
    159       result.LayerOffset[LayerIndex] := LayerOffset;
     211      result.LayerOffset[LayerIndex] := Point(h.LayerOfsX,h.LayerOfsY);
    160212      if ALoadLayerUniqueIds and LayerIdFound then
    161         result.LayerUniqueId[LayerIndex] := LayerId;
    162       result.LayerOpacity[LayerIndex] := LayerOpacity;
     213        result.LayerUniqueId[LayerIndex] := h.LayerUniqueId;
     214      result.LayerOpacity[LayerIndex] := h.LayerOpacity shr 8;
     215      result.LayerOriginalGuid[LayerIndex] := h.OriginalGuid;
     216      result.LayerOriginalMatrix[LayerIndex] := h.OriginalMatrix;
     217      result.LayerOriginalRenderStatus[layerIndex] := orsProof;
    163218
    164219      if LayerEndPosition <> -1 then AStream.Position := LayerEndPosition;
    165220    end;
     221    result.NotifyLoaded;
    166222  except
    167223    on ex: Exception do
    168224    begin
    169225      AStream.Position := OldPosition;
     226      if not Assigned(ADestination) then result.Free;
    170227      raise ex;
    171228    end;
    … …  
    175232procedure SaveLayersToStream(AStream: TStream; ALayers: TBGRACustomLayeredBitmap; ASelectedLayerIndex: integer; ACompression: TLzpCompression);
    176233var
    177   LayerOption,StackOption: longint;
     234  StackOption: longint;
    178235  i: integer;
    179   LayerHeaderSizePosition,LayerHeaderPosition: int64;
    180   LayerBitmapPosition,LayerBitmapSizePosition,BitmapSize: int64;
    181   LayerHeaderSize: integer;
     236  DirectoryOffsetPos, EndPos: int64;
     237  LayerHeaderPosition: int64;
     238  LayerBitmapPosition,BitmapSize, startPos: int64;
    182239  bitmap: TBGRABitmap;
     240  h: TLayerHeader;
    183241begin
    184242  if (ASelectedLayerIndex < -1) or (ASelectedLayerIndex >= ALayers.NbLayers) then
    185243    raise exception.Create('Selected layer out of bounds');
     244
     245  ALayers.NotifySaving;
     246
     247  startPos := AStream.Position;
    186248  AStream.Write(StreamHeader[1], length(StreamHeader));
    187   LEWriteLongint(AStream, 12); //header size
     249  LEWriteLongint(AStream, 28); //header size
    188250  LEWriteLongint(AStream, ALayers.NbLayers);
    189251  LEWriteLongint(AStream, ASelectedLayerIndex);
    … …  
    192254  if ACompression = lzpRLE then StackOption:= StackOption or 2;
    193255  LEWriteLongint(AStream, StackOption);
     256  LEWriteLongint(AStream, ALayers.Width);
     257  LEWriteLongint(AStream, ALayers.Height);
     258  DirectoryOffsetPos := AStream.Position;
     259  LEWriteInt64(AStream, 0);
    194260  //end of header
    195261
    196262  for i := 0 to ALayers.NbLayers-1 do
    197263  begin
    198     LayerHeaderSizePosition:= AStream.Position;
    199     LEWriteLongint(AStream, 0); //header size not computed yet
     264    LEWriteLongint(AStream, sizeof(h));
    200265    LayerHeaderPosition := AStream.Position;
    201266
    202     LayerOption := 0;
    203     if ALayers.LayerVisible[i] then LayerOption:= LayerOption or 1;
    204     LEWriteLongint(AStream, LayerOption);
    205     LEWriteLongint(AStream, Longint(ALayers.BlendOperation[i]));
    206     LEWriteLongint(AStream, ALayers.LayerOffset[i].x);
    207     LEWriteLongint(AStream, ALayers.LayerOffset[i].y);
    208     LEWriteLongint(AStream, ALayers.LayerUniqueId[i]);
    209     LEWriteLongint(AStream, integer(ALayers.LayerOpacity[i])*$101);
    210     LayerBitmapSizePosition:=AStream.Position;
    211     LEWriteLongint(AStream, 0);
     267    bitmap := ALayers.GetLayerBitmapDirectly(i); //do it before to ensure update from original
     268
     269    h.LayerOption:= 0;
     270    if ALayers.LayerVisible[i] then h.LayerOption:= h.LayerOption or 1;
     271    h.BlendOp:= Longint(ALayers.BlendOperation[i]);
     272    h.LayerOfsX:= ALayers.LayerOffset[i].x;
     273    h.LayerOfsY:= ALayers.LayerOffset[i].y;
     274    h.LayerUniqueId:= ALayers.LayerUniqueId[i];
     275    h.LayerOpacity:= integer(ALayers.LayerOpacity[i])*$101;
     276    h.LayerBitmapSize := 0;
     277    h.OriginalGuid := ALayers.LayerOriginalGuid[i];
     278    h.OriginalMatrix := ALayers.LayerOriginalMatrix[i];
     279    h.FixEndian;
     280    AStream.WriteBuffer(h, sizeof(h));
     281    //end of layer header
     282
    212283    LayerBitmapPosition:=AStream.Position;
    213     LayerHeaderSize := LayerBitmapPosition - LayerHeaderPosition;
    214     AStream.Position:= LayerHeaderSizePosition;
    215     LEWriteLongint(AStream, LayerHeaderSize);
    216     //end of layer header
    217 
    218     AStream.Position:= LayerBitmapPosition;
    219     bitmap := ALayers.GetLayerBitmapDirectly(i);
    220284    if bitmap <> nil then
    221285      SaveLayerBitmapToStream(AStream, bitmap, ALayers.LayerName[i], ACompression)
    … …  
    226290      bitmap.free;
    227291    end;
     292
    228293    BitmapSize := AStream.Position - LayerBitmapPosition;
    229     if BitmapSize > maxLongint then
    230       raise exception.Create('Image too big');
    231     AStream.Position:= LayerBitmapSizePosition;
    232     LEWriteLongint(AStream, BitmapSize);
     294
     295    //store back the bitmap size
     296    AStream.Position:= LayerHeaderPosition + (PByte(@PLayerHeader(nil)^.LayerBitmapSize)-PByte(nil));
     297    LEWriteInt64(AStream, BitmapSize);
     298
    233299    AStream.Position:= LayerBitmapPosition+BitmapSize;
     300  end;
     301
     302  EndPos:= AStream.Position;
     303  if ALayers.HasMemFiles then
     304  begin
     305    AStream.Position := DirectoryOffsetPos;
     306    LEWriteInt64(AStream,EndPos-startPos);
     307    AStream.Position:= EndPos;
     308    ALayers.MemDirectory.SaveToStream(AStream);
    234309  end;
    235310end;
    … …  
    271346  LayeredBitmapSaveToStreamProc := @SaveLayeredBitmapToStream;
    272347  LayeredBitmapLoadFromStreamProc := @LoadLayeredBitmapFromStream;
    273 end;
     348  LayeredBitmapCheckStreamProc := @CheckStreamForLayers;
     349end;
     350
     351initialization
     352
     353  RegisterStreamLayers;
    274354
    275355end.
Note: See TracChangeset for help on using the changeset viewer.