Changeset 37 for trunk/Packages/Common/UMemory.pas

Timestamp:

May 9, 2018, 1:22:44 PM (7 years ago)

Author:

chronos

Message:

• Added: Multi-lingual support.

Location:

trunk

Files:

• . (modified) (1 prop)
• Packages/Common/UMemory.pas (modified) (3 diffs)

trunk

@@ -3 +3 @@
 lib
 backup
+LibrePaint.exe
+*.lrj

@@ -3 +3 @@
 lib
 backup
+LibrePaint.exe
+*.lrj

trunk/Packages/Common/UMemory.pas

@@ -10 +10 @@
 type
 
-  { TMemory }
-
-  TMemory = class
+  { TBlock }
+
+  TBlock = class
   private
     FData: PByte;
     FSize: Integer;
-    function GetItem(Index: Integer): Byte;
-    procedure SetItem(Index: Integer; AValue: Byte);
-    procedure SetSize(AValue: Integer); virtual;
-  public
-    procedure Clear(Value: Byte = 0);
-    procedure Assign(Source: TMemory);
+    function GetItem(Index: Integer): Byte; virtual; abstract;
+    procedure SetItem(Index: Integer; AValue: Byte); virtual; abstract;
+    procedure SetSize(AValue: Integer); virtual; abstract;
+  public
+    procedure ReadBlock(Block: TBlock; Position: Integer); virtual;
+    procedure WriteBlock(Block: TBlock; Position: Integer); virtual;
+    procedure Clear(Value: Byte = 0); virtual;
+    procedure Assign(Source: TBlock); virtual;
+    property Size: Integer read FSize write SetSize;
+    property Items[Index: Integer]: Byte read GetItem write SetItem; default;
+  end;
+
+  { TMemory }
+
+  TMemory = class(TBlock)
+  private
+    FData: PByte;
+    FSize: Integer;
+    function GetItem(Index: Integer): Byte; override;
+    procedure SetItem(Index: Integer; AValue: Byte); override;
+    procedure SetSize(AValue: Integer); override;
+  public
+    procedure Clear(Value: Byte = 0); override;
+    procedure Assign(Source: TBlock); override;
     constructor Create;
     destructor Destroy; override;
     property Data: PByte read FData;
-    property Size: Integer read FSize write SetSize;
-    property Items[Index: Integer]: Byte read GetItem write SetItem; default;
   end;
 
@@ -42 +58 @@
   end;
 
+  { TBitBlock }
+
+  TBitBlock = class
+  private
+    function GetItem(Index: Integer): Byte; virtual;
+    function GetSize: Integer; virtual;
+    procedure SetItem(Index: Integer; AValue: Byte); virtual;
+    procedure SetSize(AValue: Integer); virtual;
+  public
+    procedure Invert; virtual;
+    function GetInteger: Integer; virtual;
+    procedure SetInteger(Value: Integer); virtual;
+    procedure ReadBlock(Block: TBitBlock; Position: Integer); virtual;
+    procedure WriteBlock(Block: TBitBlock; Position: Integer); virtual;
+    procedure Clear(Value: Byte = 0); virtual;
+    procedure Assign(Source: TBlock); virtual;
+    property Size: Integer read GetSize write SetSize;
+    property Items[Index: Integer]: Byte read GetItem write SetItem; default;
+  end;
+
+  { TBitMemory }
+
+  TBitMemory = class(TBitBlock)
+  private
+    FData: PByte;
+    FSize: Integer;
+    function GetSize: Integer; override;
+    procedure SetSize(AValue: Integer); override;
+    function GetItem(Index: Integer): Byte; override;
+    procedure SetItem(Index: Integer; AValue: Byte); override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function GetInteger: Integer; override;
+    procedure SetInteger(Value: Integer); override;
+    procedure Clear(Value: Byte = 0); override;
+    procedure ReadBlock(Block: TBitBlock; Position: Integer); override;
+    procedure WriteBlock(Block: TBitBlock; Position: Integer); override;
+    property Data: PByte read FData;
+    procedure Invert; override;
+  end;
+
+
 implementation
+
+{ TBitMemory }
+
+procedure TBitMemory.Clear(Value: Byte);
+begin
+  if (Size and 7) = 0 then begin
+    if Value = 0 then FillChar(FData^, Size shr 3, 0)
+      else FillChar(FData^, Size shr 3, $ff);
+  end else inherited;
+end;
+
+procedure TBitMemory.ReadBlock(Block: TBitBlock; Position: Integer);
+begin
+  if Block is TBitMemory then begin
+    if (Position and 7) = 0 then begin
+      if (Block.Size and 7) = 0 then
+        Move(PByte(FData + Position shr 3)^, TBitMemory(Block).Data^, Block.Size shr 3)
+        else inherited;
+    end else inherited;
+  end else inherited;
+end;
+
+procedure TBitMemory.WriteBlock(Block: TBitBlock; Position: Integer);
+begin
+  if Block is TBitMemory then begin
+    if (Position and 7) = 0 then begin
+      if (Block.Size and 7) = 0 then
+        Move(TBitMemory(Block).Data^, PByte(FData + Position shr 3)^, Block.Size shr 3)
+        else inherited;
+    end else inherited;
+  end else inherited;
+end;
+
+procedure TBitMemory.Invert;
+var
+  I: Integer;
+begin
+  if (Size and 7) = 0 then begin
+    for I := 0 to (Size shr 3) - 1 do
+      PByte(FData + I)^ := PByte(FData + I)^ xor $ff;
+  end
+  else inherited;
+
+end;
+
+function TBitMemory.GetInteger: Integer;
+var
+  I: Integer;
+  V: Integer;
+begin
+  Result := 0;
+  I := 0;
+  while (I < 32) and (I < Size) do begin
+    V := FData[I shr 3];
+    V := V shl I;
+    Result := Result or V;
+//    Result := Result or (FData[I shr 3] shl I);
+    Inc(I, 8);
+  end;
+  if Size < 32 then
+    Result := Result and ((1 shl Size) - 1);
+end;
+
+procedure TBitMemory.SetInteger(Value: Integer);
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < 32) and (I < Size) do begin
+    FData[I shr 3] := (Value shr I) and $ff;
+    Inc(I, 8);
+  end;
+end;
+
+function TBitMemory.GetSize: Integer;
+begin
+  Result := FSize;
+end;
+
+procedure TBitMemory.SetSize(AValue: Integer);
+var
+  ByteSize: Integer;
+begin
+  if AValue = FSize then Exit;
+  FSize := AValue;
+  ByteSize := FSize shr 3;
+  if (FSize and 7) > 0 then Inc(ByteSize);
+  FData := ReAllocMem(FData, ByteSize);
+end;
+
+function TBitMemory.GetItem(Index: Integer): Byte;
+begin
+  if Index >= Size then raise Exception.Create('Out of range');
+  Result := (PByte(FData + (Index shr 3))^ shr (Index and 7)) and 1;
+end;
+
+procedure TBitMemory.SetItem(Index: Integer; AValue: Byte);
+begin
+  if Index >= Size then raise Exception.Create('Out of range, Size:' + IntToStr(Size) + ', Index:' + IntToStr(Index));
+  PByte(FData + (Index shr 3))^ := PByte(FData + (Index shr 3))^ and not (1 shl (Index and 7))
+    or ((AValue and 1) shl (Index and 7));
+end;
+
+constructor TBitMemory.Create;
+begin
+  FData := nil;
+end;
+
+destructor TBitMemory.Destroy;
+begin
+  FreeMem(FData);
+  inherited Destroy;
+end;
+
+{ TBitBlock }
+
+function TBitBlock.GetItem(Index: Integer): Byte;
+begin
+  Result := 0;
+end;
+
+function TBitBlock.GetSize: Integer;
+begin
+  Result := 0;
+end;
+
+procedure TBitBlock.SetItem(Index: Integer; AValue: Byte);
+begin
+
+end;
+
+procedure TBitBlock.SetSize(AValue: Integer);
+begin
+end;
+
+procedure TBitBlock.Invert;
+var
+  I: Integer;
+begin
+  for I := 0 to Size - 1 do
+    Items[I] := not Items[I];
+end;
+
+function TBitBlock.GetInteger: Integer;
+begin
+  Result := 0;
+end;
+
+procedure TBitBlock.SetInteger(Value: Integer);
+begin
+
+end;
+
+procedure TBitBlock.ReadBlock(Block: TBitBlock; Position: Integer);
+var
+  I: Integer;
+begin
+  for I := 0 to Block.Size - 1 do
+    Block.Items[I] := Items[Position + I];
+end;
+
+procedure TBitBlock.WriteBlock(Block: TBitBlock; Position: Integer);
+var
+  I: Integer;
+begin
+  for I := 0 to Block.Size - 1 do
+    Items[Position + I] := Block.Items[I];
+end;
+
+procedure TBitBlock.Clear(Value: Byte);
+var
+  I: Integer;
+begin
+  for I := 0 to Size - 1 do
+    Items[I] := Value;
+end;
+
+procedure TBitBlock.Assign(Source: TBlock);
+var
+  I: Integer;
+begin
+  Size := Source.Size;
+  for I := 0 to Size - 1 do
+    Items[I] := Source.Items[I];
+end;
+
+{ TBlock }
+
+procedure TBlock.ReadBlock(Block: TBlock; Position: Integer);
+var
+  I: Integer;
+begin
+  if Position + Block.Size > Size then raise Exception.Create('');
+  for I := 0 to Block.Size - 1 do
+    Items[I] := Items[Position + I];
+end;
+
+procedure TBlock.WriteBlock(Block: TBlock; Position: Integer);
+var
+  I: Integer;
+begin
+  if Position + Block.Size > Size then raise Exception.Create('');
+  for I := 0 to Block.Size - 1 do
+    Items[Position + I] := Items[I];
+end;
+
+procedure TBlock.Clear(Value: Byte);
+var
+  I: Integer;
+begin
+  for I := 0 to Size - 1 do
+    Items[I] := Value;
+end;
+
+procedure TBlock.Assign(Source: TBlock);
+var
+  I: Integer;
+begin
+  Size := Source.Size;
+  for I := 0 to Size - 1 do
+    Items[I] := Source.Items[I];
+end;
 
 { TPositionMemory }
@@ -90 +371 @@
 end;
 
-procedure TMemory.Assign(Source: TMemory);
-begin
-  Size := Source.Size;
-  Move(Source.Data^, FData^, Size);
+procedure TMemory.Assign(Source: TBlock);
+begin
+  if Source is TMemory then begin
+    Size := Source.Size;
+    Move(TMemory(Source).Data^, FData^, Size);
+  end else inherited;
 end;
 

@@ -3 +3 @@
 lib
 backup
+LibrePaint.exe
+*.lrj