Changeset 521 for GraphicTest/Packages/bgrabitmap/bgramultifiletype.pas

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:

• . (modified) (1 prop)
• Packages/bgrabitmap/bgramultifiletype.pas (modified) (13 diffs)

GraphicTest

@@ -8 +8 @@
 GraphicTest.lps
 GraphicTest.dbg
+heaptrclog.trc

@@ -8 +8 @@
 GraphicTest.lps
 GraphicTest.dbg
+heaptrclog.trc

GraphicTest/Packages/bgrabitmap/bgramultifiletype.pas

@@ -2 +2 @@
 
 {$mode objfpc}{$H+}
+{$MODESWITCH ADVANCEDRECORDS}
 
 interface
@@ -7 +8 @@
 uses
   Classes, SysUtils, fgl;
+
+type
+
+  { TEntryFilename }
+
+  TEntryFilename = record
+  private
+    FExtension: utf8string;
+    FName: utf8string;
+    function GetFilename: utf8string;
+    function GetIsEmpty: boolean;
+    procedure SetExtension(AValue: utf8string);
+    procedure SetFilename(AValue: utf8string);
+    procedure SetName(AValue: utf8string);
+  public
+    class operator =(const AValue1,AValue2: TEntryFilename): boolean;
+    property Filename: utf8string read GetFilename write SetFilename;
+    property Name: utf8string read FName write SetName;
+    property Extension: utf8string read FExtension write SetExtension;
+    property IsEmpty: boolean read GetIsEmpty;
+  end;
+
+function EntryFilename(AName,AExtension: string): TEntryFilename; overload;
+function EntryFilename(AFilename: string): TEntryFilename; overload;
 
 type
@@ -22 +47 @@
   public
     constructor Create(AContainer: TMultiFileContainer);
-    function CopyTo({%H-}ADestination: TStream): integer; virtual;
+    function CopyTo({%H-}ADestination: TStream): int64; virtual;
     property Name: utf8string read GetName write SetName;
     property Extension: utf8string read GetExtension;
@@ -38 +63 @@
   protected
     procedure Init; virtual;
-    function AddEntry(AEntry: TMultiFileEntry): integer;
+    function AddEntry(AEntry: TMultiFileEntry; AIndex: integer = -1): integer;
     function GetCount: integer;
     function GetEntry(AIndex: integer): TMultiFileEntry;
     function CreateEntry(AName: utf8string; AExtension: utf8string; AContent: TStream): TMultiFileEntry; virtual; abstract;
+    function GetRawString(AIndex: integer): RawByteString;
+    function GetRawStringByFilename(AFilename: string): RawByteString;
+    procedure SetRawString(AIndex: integer; AValue: RawByteString);
+    procedure SetRawStringByFilename(AFilename: string; AValue: RawByteString);
   public
-    constructor Create;
-    constructor Create(AFilename: utf8string);
-    constructor Create(AStream: TStream);
-    constructor Create(AStream: TStream; AStartPos: Int64);
-    function Add(AName: utf8string; AExtension: utf8string; AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer;
-    function Add(AName: utf8string; AExtension: utf8string; AContent: utf8String; AOverwrite: boolean = false): integer;
+    constructor Create; overload;
+    constructor Create(AFilename: utf8string); overload;
+    constructor Create(AStream: TStream); overload;
+    constructor Create(AStream: TStream; AStartPos: Int64); overload;
+    function Add(AName: utf8string; AExtension: utf8string; AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload;
+    function Add(AName: utf8string; AExtension: utf8string; AContent: RawByteString; AOverwrite: boolean = false): integer; overload;
+    function Add(AFilename: TEntryFilename; AContent: TStream; AOverwrite: boolean = false; AOwnStream: boolean = true): integer; overload;
+    function Add(AFilename: TEntryFilename; AContent: RawByteString; AOverwrite: boolean = false): integer; overload;
     procedure Clear; virtual;
     destructor Destroy; override;
     procedure LoadFromFile(AFilename: utf8string);
     procedure LoadFromStream(AStream: TStream); virtual; abstract;
+    procedure LoadFromResource(AFilename: string); virtual;
     procedure SaveToFile(AFilename: utf8string);
     procedure SaveToStream(ADestination: TStream); virtual; abstract;
     procedure Remove(AEntry: TMultiFileEntry); virtual;
-    procedure Delete(AIndex: integer); virtual; overload;
-    function Delete(AName: utf8string; AExtension: utf8string;ACaseSensitive: boolean = True): boolean; overload;
-    function IndexOf(AEntry: TMultiFileEntry): integer;
-    function IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean = True): integer; virtual;
+    procedure Delete(AIndex: integer); overload; virtual;
+    function Delete(AName: utf8string; AExtension: utf8string; ACaseSensitive: boolean = True): boolean; overload;
+    function Delete(AFilename: TEntryFilename; ACaseSensitive: boolean = True): boolean; overload;
+    function IndexOf(AEntry: TMultiFileEntry): integer; overload;
+    function IndexOf(AName: utf8string; AExtenstion: utf8string; ACaseSensitive: boolean = True): integer; overload; virtual;
+    function IndexOf(AFilename: TEntryFilename; ACaseSensitive: boolean = True): integer; overload;
     property Count: integer read GetCount;
     property Entry[AIndex: integer]: TMultiFileEntry read GetEntry;
+    property RawString[AIndex: integer]: RawByteString read GetRawString write SetRawString;
+    property RawStringByFilename[AFilename: string]: RawByteString read GetRawStringByFilename write SetRawStringByFilename;
   end;
 
 implementation
 
-uses BGRAUTF8;
+uses BGRAUTF8, strutils, BGRABitmapTypes;
+
+{ TEntryFilename }
+
+function TEntryFilename.GetFilename: utf8string;
+begin
+  if Extension = '' then
+    result := Name
+  else
+    result := Name+'.'+Extension;
+end;
+
+function TEntryFilename.GetIsEmpty: boolean;
+begin
+  result := (FName='') and (FExtension = '');
+end;
+
+procedure TEntryFilename.SetExtension(AValue: utf8string);
+var
+  i: Integer;
+begin
+  if FExtension=AValue then Exit;
+  for i := 1 to length(AValue) do
+    if AValue[i] in ['.','/'] then
+      raise Exception.Create('Invalid extension');
+  FExtension:=AValue;
+end;
+
+procedure TEntryFilename.SetFilename(AValue: utf8string);
+var
+  idxDot: SizeInt;
+begin
+  idxDot := RPos('.',AValue);
+  if idxDot = 0 then
+  begin
+    Name := AValue;
+    Extension := '';
+  end
+  else
+  begin
+    Name := copy(AValue,1,idxDot-1);
+    Extension := copy(AValue,idxDot+1,length(AValue)-idxDot);
+  end;
+end;
+
+procedure TEntryFilename.SetName(AValue: utf8string);
+var
+  i: Integer;
+begin
+  if FName=AValue then Exit;
+  for i := 1 to length(AValue) do
+    if AValue[i] = '/' then
+      raise Exception.Create('Invalid name');
+  FName:=AValue;
+end;
+
+function EntryFilename(AName, AExtension: string): TEntryFilename;
+begin
+  result.Name := AName;
+  result.Extension:= AExtension;
+end;
+
+function EntryFilename(AFilename: string): TEntryFilename;
+begin
+  result.Filename:= AFilename;
+end;
+
+class operator TEntryFilename.=(const AValue1, AValue2: TEntryFilename): boolean;
+begin
+  result := (AValue1.Name = AValue2.Name) and (AValue1.Extension = AValue2.Extension);
+end;
 
 { TMultiFileEntry }
@@ -85 +191 @@
 end;
 
-function TMultiFileEntry.CopyTo(ADestination: TStream): integer;
+function TMultiFileEntry.CopyTo(ADestination: TStream): int64;
 begin
   result := 0;
@@ -94 +200 @@
 function TMultiFileContainer.GetCount: integer;
 begin
-  result := FEntries.Count;
+  if Assigned(FEntries) then
+    result := FEntries.Count
+  else
+    result := 0;
 end;
 
@@ -102 +211 @@
 end;
 
+function TMultiFileContainer.GetRawString(AIndex: integer): RawByteString;
+var s: TStringStream;
+begin
+  s := TStringStream.Create('');
+  try
+    Entry[AIndex].CopyTo(s);
+    result := s.DataString;
+  finally
+    s.Free;
+  end;
+end;
+
+function TMultiFileContainer.GetRawStringByFilename(AFilename: string
+  ): RawByteString;
+var
+  idx: Integer;
+begin
+  idx := IndexOf(EntryFilename(AFilename));
+  if idx = -1 then
+    result := ''
+  else
+    result := GetRawString(idx);
+end;
+
+procedure TMultiFileContainer.SetRawString(AIndex: integer;
+  AValue: RawByteString);
+begin
+  with Entry[AIndex] do
+    Add(Name, Extension, AValue, true);
+end;
+
+procedure TMultiFileContainer.SetRawStringByFilename(AFilename: string;
+  AValue: RawByteString);
+var
+  f: TEntryFilename;
+begin
+  f := EntryFilename(AFilename);
+  Add(f.Name,f.Extension,AValue,true);
+end;
+
 procedure TMultiFileContainer.Init;
 begin
@@ -107 +256 @@
 end;
 
-function TMultiFileContainer.AddEntry(AEntry: TMultiFileEntry): integer;
-begin
-  result := FEntries.Add(AEntry);
+function TMultiFileContainer.AddEntry(AEntry: TMultiFileEntry; AIndex: integer): integer;
+begin
+  if not Assigned(FEntries) then
+    raise exception.Create('Entry list not created');
+  if (AIndex >= 0) and (AIndex < FEntries.Count) then
+  begin
+    FEntries.Insert(AIndex, AEntry);
+    result := AIndex;
+  end
+  else
+    result := FEntries.Add(AEntry);
 end;
 
@@ -160 +317 @@
     newEntry := CreateEntry(AName, AExtension, AContent);
   if Assigned(newEntry) then
-    result := AddEntry(newEntry)
+    result := AddEntry(newEntry, index)
   else
     raise exception.Create('Unable to create entry');
@@ -166 +323 @@
 
 function TMultiFileContainer.Add(AName: utf8string; AExtension: utf8string;
-  AContent: utf8String; AOverwrite: boolean): integer;
+  AContent: RawByteString; AOverwrite: boolean): integer;
 var stream: TMemoryStream;
 begin
   stream := TMemoryStream.Create;
-  stream.Write(AContent[1],length(AContent));
+  if length(AContent) > 0 then stream.Write(AContent[1],length(AContent));
   result := Add(AName,AExtension,stream,AOverwrite);
+end;
+
+function TMultiFileContainer.Add(AFilename: TEntryFilename; AContent: TStream;
+  AOverwrite: boolean; AOwnStream: boolean): integer;
+begin
+  result := Add(AFilename.Name,AFilename.Extension, AContent, AOverwrite, AOwnStream);
+end;
+
+function TMultiFileContainer.Add(AFilename: TEntryFilename;
+  AContent: RawByteString; AOverwrite: boolean): integer;
+begin
+  result := Add(AFilename.Name,AFilename.Extension, AContent, AOverwrite);
 end;
 
@@ -187 +356 @@
   LoadFromStream(stream);
   stream.Free;
+end;
+
+procedure TMultiFileContainer.LoadFromResource(AFilename: string);
+var
+  stream: TStream;
+begin
+  stream := BGRAResource.GetResourceStream(AFilename);
+  try
+    LoadFromStream(stream);
+  finally
+    stream.Free;
+  end;
 end;
 
@@ -230 +411 @@
     result := true;
   end;
+end;
+
+function TMultiFileContainer.Delete(AFilename: TEntryFilename;
+  ACaseSensitive: boolean): boolean;
+begin
+  result := Delete(AFilename.Name,AFilename.Extension,ACaseSensitive);
 end;
 
@@ -259 +446 @@
 end;
 
+function TMultiFileContainer.IndexOf(AFilename: TEntryFilename;
+  ACaseSensitive: boolean): integer;
+begin
+  result := IndexOf(AFilename.Name,AFilename.Extension,ACaseSensitive);
+end;
+
 procedure TMultiFileContainer.Clear;
 var

@@ -8 +8 @@
 GraphicTest.lps
 GraphicTest.dbg
+heaptrclog.trc