Changeset 393 for Common/UMemory.pas


Ignore:
Timestamp:
Jul 26, 2012, 1:15:17 PM (12 years ago)
Author:
chronos
Message:
  • Modified: Reverted deletion of URegistry unit. New package GeneralRegistry is not finished and 100% usable yet.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • Common/UMemory.pas

    r387 r393  
    99
    1010type
     11
    1112  { TMemory }
    1213
     
    1415  private
    1516    FData: PByte;
     17    FSize: Integer;
    1618    function GetItem(Index: Integer): Byte;
    1719    procedure SetItem(Index: Integer; AValue: Byte);
    18     function GetSize: Integer; virtual;
    1920    procedure SetSize(AValue: Integer); virtual;
    2021  public
    21     procedure Fill(Value: Byte = 0);
     22    procedure Clear(Value: Byte = 0);
    2223    procedure Assign(Source: TMemory);
    2324    constructor Create;
    2425    destructor Destroy; override;
    2526    property Data: PByte read FData;
    26     property Size: Integer read GetSize write SetSize;
     27    property Size: Integer read FSize write SetSize;
    2728    property Items[Index: Integer]: Byte read GetItem write SetItem; default;
    2829  end;
     
    4142  end;
    4243
    43   { TMemoryRec }
    44 
    45   TMemoryRec = record
    46   private
    47     FData: PByte;
    48     function GetItem(Index: Integer): Byte; inline;
    49     procedure SetItem(Index: Integer; AValue: Byte); inline;
    50     function GetSize: Integer; inline;
    51     procedure SetSize(AValue: Integer); inline;
    52   public
    53     procedure Fill(Value: Byte = 0); inline;
    54     procedure Assign(Source: TMemoryRec); inline;
    55     property Data: PByte read FData;
    56     property Size: Integer read GetSize write SetSize;
    57     property Items[Index: Integer]: Byte read GetItem write SetItem; default;
    58   end;
    59 
    60   { TBitMemoryRec }
    61 
    62   TBitMemoryRec = record
    63   private
    64     FMemory: TMemoryRec;
    65     FSize: Cardinal;
    66     function GetItem(Index: Cardinal): Boolean; inline;
    67     function GetSize: Cardinal; inline;
    68     procedure SetItem(Index: Cardinal; AValue: Boolean); inline;
    69     procedure SetSize(AValue: Cardinal); inline;
    70   public
    71     procedure WriteItems(Addr: Cardinal; Items: TBitMemoryRec);
    72     procedure Fill(Value: Boolean = False);
    73     procedure Assign(Source: TBitMemoryRec); inline;
    74     property Memory: TMemoryRec read FMemory;
    75     property Size: Cardinal read GetSize write SetSize;
    76     property Items[Index: Cardinal]: Boolean read GetItem write SetItem; default;
    77   end;
    78 
    79 
    8044implementation
    81 
    82 { TBitMemoryRec }
    83 
    84 function TBitMemoryRec.GetItem(Index: Cardinal): Boolean;
    85 begin
    86   Result := Boolean((FMemory[Index shr 3] shr (Index and 7)) and 1);
    87 end;
    88 
    89 function TBitMemoryRec.GetSize: Cardinal;
    90 begin
    91   Result := FSize;
    92 end;
    93 
    94 procedure TBitMemoryRec.SetItem(Index: Cardinal; AValue: Boolean);
    95 begin
    96   FMemory[Index shr 3] := (FMemory[Index shr 3] and ($ff xor (1 shl (Index and 7)))) or
    97     (Byte(AValue) shl (Index and 7));
    98 end;
    99 
    100 procedure TBitMemoryRec.SetSize(AValue: Cardinal);
    101 begin
    102   FSize := AValue;
    103   FMemory.Size := (AValue - 1) shr 3 + 1;
    104 end;
    105 
    106 procedure TBitMemoryRec.WriteItems(Addr: Cardinal; Items: TBitMemoryRec);
    107 begin
    108 
    109 end;
    110 
    111 procedure TBitMemoryRec.Fill(Value: Boolean);
    112 begin
    113   FMemory.Fill($ff * Byte(Value));
    114 end;
    115 
    116 procedure TBitMemoryRec.Assign(Source: TBitMemoryRec);
    117 begin
    118   Size := Source.Size;
    119   FMemory.Assign(Source.Memory);
    120 end;
    121 
    122 { TMemoryRec }
    123 
    124 function TMemoryRec.GetItem(Index: Integer): Byte;
    125 begin
    126   Result := PByte(FData + Index)^;
    127 end;
    128 
    129 procedure TMemoryRec.SetItem(Index: Integer; AValue: Byte);
    130 begin
    131   PByte(FData + Index)^ := AValue;
    132 end;
    133 
    134 function TMemoryRec.GetSize: Integer;
    135 begin
    136   Result := MemSize(FData);
    137 end;
    138 
    139 procedure TMemoryRec.SetSize(AValue: Integer);
    140 begin
    141   FData := ReAllocMem(FData, AValue);
    142 end;
    143 
    144 procedure TMemoryRec.Fill(Value: Byte);
    145 begin
    146   FillChar(FData^, Size, Value);
    147 end;
    148 
    149 procedure TMemoryRec.Assign(Source: TMemoryRec);
    150 begin
    151   Size := Source.Size;
    152   Move(Source.Data^, FData^, Size);
    153 end;
    15445
    15546{ TPositionMemory }
     
    15849begin
    15950  inherited SetSize(AValue);
    160   if FPosition > Size then FPosition := Size;
     51  if FPosition > FSize then FPosition := FSize;
    16152end;
    16253
     
    17970procedure TMemory.SetSize(AValue: Integer);
    18071begin
    181   FData := ReAllocMem(FData, AValue);
     72  if FSize = AValue then Exit;
     73  FSize := AValue;
     74  FData := ReAllocMem(FData, FSize);
    18275end;
    18376
     
    19285end;
    19386
    194 function TMemory.GetSize: Integer;
    195 begin
    196   Result := MemSize(FData);
    197 end;
    198 
    199 procedure TMemory.Fill(Value: Byte);
     87procedure TMemory.Clear(Value: Byte);
    20088begin
    20189  FillChar(FData^, Size, Value);
     
    21199begin
    212100  FData := nil;
    213   Size := 0;
     101  FSize := 0;
    214102end;
    215103
Note: See TracChangeset for help on using the changeset viewer.