Changeset 393 for Common/UMemory.pas
- Timestamp:
- Jul 26, 2012, 1:15:17 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/UMemory.pas
r387 r393 9 9 10 10 type 11 11 12 { TMemory } 12 13 … … 14 15 private 15 16 FData: PByte; 17 FSize: Integer; 16 18 function GetItem(Index: Integer): Byte; 17 19 procedure SetItem(Index: Integer; AValue: Byte); 18 function GetSize: Integer; virtual;19 20 procedure SetSize(AValue: Integer); virtual; 20 21 public 21 procedure Fill(Value: Byte = 0);22 procedure Clear(Value: Byte = 0); 22 23 procedure Assign(Source: TMemory); 23 24 constructor Create; 24 25 destructor Destroy; override; 25 26 property Data: PByte read FData; 26 property Size: Integer read GetSize write SetSize;27 property Size: Integer read FSize write SetSize; 27 28 property Items[Index: Integer]: Byte read GetItem write SetItem; default; 28 29 end; … … 41 42 end; 42 43 43 { TMemoryRec }44 45 TMemoryRec = record46 private47 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 public53 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 = record63 private64 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 public71 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 80 44 implementation 81 82 { TBitMemoryRec }83 84 function TBitMemoryRec.GetItem(Index: Cardinal): Boolean;85 begin86 Result := Boolean((FMemory[Index shr 3] shr (Index and 7)) and 1);87 end;88 89 function TBitMemoryRec.GetSize: Cardinal;90 begin91 Result := FSize;92 end;93 94 procedure TBitMemoryRec.SetItem(Index: Cardinal; AValue: Boolean);95 begin96 FMemory[Index shr 3] := (FMemory[Index shr 3] and ($ff xor (1 shl (Index and 7)))) or97 (Byte(AValue) shl (Index and 7));98 end;99 100 procedure TBitMemoryRec.SetSize(AValue: Cardinal);101 begin102 FSize := AValue;103 FMemory.Size := (AValue - 1) shr 3 + 1;104 end;105 106 procedure TBitMemoryRec.WriteItems(Addr: Cardinal; Items: TBitMemoryRec);107 begin108 109 end;110 111 procedure TBitMemoryRec.Fill(Value: Boolean);112 begin113 FMemory.Fill($ff * Byte(Value));114 end;115 116 procedure TBitMemoryRec.Assign(Source: TBitMemoryRec);117 begin118 Size := Source.Size;119 FMemory.Assign(Source.Memory);120 end;121 122 { TMemoryRec }123 124 function TMemoryRec.GetItem(Index: Integer): Byte;125 begin126 Result := PByte(FData + Index)^;127 end;128 129 procedure TMemoryRec.SetItem(Index: Integer; AValue: Byte);130 begin131 PByte(FData + Index)^ := AValue;132 end;133 134 function TMemoryRec.GetSize: Integer;135 begin136 Result := MemSize(FData);137 end;138 139 procedure TMemoryRec.SetSize(AValue: Integer);140 begin141 FData := ReAllocMem(FData, AValue);142 end;143 144 procedure TMemoryRec.Fill(Value: Byte);145 begin146 FillChar(FData^, Size, Value);147 end;148 149 procedure TMemoryRec.Assign(Source: TMemoryRec);150 begin151 Size := Source.Size;152 Move(Source.Data^, FData^, Size);153 end;154 45 155 46 { TPositionMemory } … … 158 49 begin 159 50 inherited SetSize(AValue); 160 if FPosition > Size then FPosition :=Size;51 if FPosition > FSize then FPosition := FSize; 161 52 end; 162 53 … … 179 70 procedure TMemory.SetSize(AValue: Integer); 180 71 begin 181 FData := ReAllocMem(FData, AValue); 72 if FSize = AValue then Exit; 73 FSize := AValue; 74 FData := ReAllocMem(FData, FSize); 182 75 end; 183 76 … … 192 85 end; 193 86 194 function TMemory.GetSize: Integer; 195 begin 196 Result := MemSize(FData); 197 end; 198 199 procedure TMemory.Fill(Value: Byte); 87 procedure TMemory.Clear(Value: Byte); 200 88 begin 201 89 FillChar(FData^, Size, Value); … … 211 99 begin 212 100 FData := nil; 213 Size := 0;101 FSize := 0; 214 102 end; 215 103
Note:
See TracChangeset
for help on using the changeset viewer.