Changeset 387 for Common

Timestamp:

Jul 17, 2012, 10:25:56 PM (12 years ago)

Author:

chronos

Message:

• Modified: URegistry unit moved from Common package to separated RegistryPkg.

Location:

Common

Files:

• Common.lpk (modified) (3 diffs)
• Common.pas (modified) (1 diff)
• UApplicationInfo.pas (modified) (1 diff)
• ULastOpenedList.pas (modified) (1 diff)
• UMemory.pas (modified) (7 diffs)

Common/Common.lpk

@@ -22 +22 @@
     <License Value="GNU/GPL"/>
     <Version Minor="7"/>
-    <Files Count="15">
+    <Files Count="14">
       <Item1>
         <Filename Value="StopWatch.pas"/>
@@ -70 +70 @@
       </Item11>
       <Item12>
-        <Filename Value="URegistry.pas"/>
-        <UnitName Value="URegistry"/>
-      </Item12>
-      <Item13>
         <Filename Value="UJobProgressView.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="UJobProgressView"/>
+      </Item12>
+      <Item13>
+        <Filename Value="UXMLUtils.pas"/>
+        <UnitName Value="UXMLUtils"/>
       </Item13>
       <Item14>
-        <Filename Value="UXMLUtils.pas"/>
-        <UnitName Value="UXMLUtils"/>
-      </Item14>
-      <Item15>
         <Filename Value="UApplicationInfo.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="UApplicationInfo"/>
-      </Item15>
+      </Item14>
     </Files>
     <i18n>
@@ -93 +89 @@
     </i18n>
     <Type Value="RunAndDesignTime"/>
-    <RequiredPkgs Count="2">
+    <RequiredPkgs Count="3">
       <Item1>
-        <PackageName Value="TemplateGenerics"/>
+        <PackageName Value="RegistryPkg"/>
       </Item1>
       <Item2>
+        <PackageName Value="TemplateGenerics"/>
+      </Item2>
+      <Item3>
         <PackageName Value="FCL"/>
         <MinVersion Major="1" Valid="True"/>
-      </Item2>
+      </Item3>
     </RequiredPkgs>
     <UsageOptions>

Common/Common.pas

@@ -9 +9 @@
 uses
   StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading, 
-  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 
-  UJobProgressView, UXMLUtils, UApplicationInfo, LazarusPackageIntf;
+  UMemory, UResetableThread, UPool, ULastOpenedList, UJobProgressView, 
+  UXMLUtils, UApplicationInfo, LazarusPackageIntf;
 
 implementation

Common/UApplicationInfo.pas

@@ -6 +6 @@
 
 uses
-  SysUtils, Registry, Classes, Forms, URegistry;
+  SysUtils, Registry2, Classes, Forms, URegistry;
 
 type

Common/ULastOpenedList.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Registry, URegistry, Menus;
+  Classes, SysUtils, Registry2, URegistry, Menus;
 
 type

Common/UMemory.pas

@@ -9 +9 @@
 
 type
-
   { TMemory }
 
@@ -15 +14 @@
   private
     FData: PByte;
-    FSize: Integer;
     function GetItem(Index: Integer): Byte;
     procedure SetItem(Index: Integer; AValue: Byte);
+    function GetSize: Integer; virtual;
     procedure SetSize(AValue: Integer); virtual;
   public
-    procedure Clear(Value: Byte = 0);
+    procedure Fill(Value: Byte = 0);
     procedure Assign(Source: TMemory);
     constructor Create;
     destructor Destroy; override;
     property Data: PByte read FData;
-    property Size: Integer read FSize write SetSize;
+    property Size: Integer read GetSize write SetSize;
     property Items[Index: Integer]: Byte read GetItem write SetItem; default;
   end;
@@ -42 +41 @@
   end;
 
+  { TMemoryRec }
+
+  TMemoryRec = record
+  private
+    FData: PByte;
+    function GetItem(Index: Integer): Byte; inline;
+    procedure SetItem(Index: Integer; AValue: Byte); inline;
+    function GetSize: Integer; inline;
+    procedure SetSize(AValue: Integer); inline;
+  public
+    procedure Fill(Value: Byte = 0); inline;
+    procedure Assign(Source: TMemoryRec); inline;
+    property Data: PByte read FData;
+    property Size: Integer read GetSize write SetSize;
+    property Items[Index: Integer]: Byte read GetItem write SetItem; default;
+  end;
+
+  { TBitMemoryRec }
+
+  TBitMemoryRec = record
+  private
+    FMemory: TMemoryRec;
+    FSize: Cardinal;
+    function GetItem(Index: Cardinal): Boolean; inline;
+    function GetSize: Cardinal; inline;
+    procedure SetItem(Index: Cardinal; AValue: Boolean); inline;
+    procedure SetSize(AValue: Cardinal); inline;
+  public
+    procedure WriteItems(Addr: Cardinal; Items: TBitMemoryRec);
+    procedure Fill(Value: Boolean = False);
+    procedure Assign(Source: TBitMemoryRec); inline;
+    property Memory: TMemoryRec read FMemory;
+    property Size: Cardinal read GetSize write SetSize;
+    property Items[Index: Cardinal]: Boolean read GetItem write SetItem; default;
+  end;
+
+
 implementation
 
+{ TBitMemoryRec }
+
+function TBitMemoryRec.GetItem(Index: Cardinal): Boolean;
+begin
+  Result := Boolean((FMemory[Index shr 3] shr (Index and 7)) and 1);
+end;
+
+function TBitMemoryRec.GetSize: Cardinal;
+begin
+  Result := FSize;
+end;
+
+procedure TBitMemoryRec.SetItem(Index: Cardinal; AValue: Boolean);
+begin
+  FMemory[Index shr 3] := (FMemory[Index shr 3] and ($ff xor (1 shl (Index and 7)))) or
+    (Byte(AValue) shl (Index and 7));
+end;
+
+procedure TBitMemoryRec.SetSize(AValue: Cardinal);
+begin
+  FSize := AValue;
+  FMemory.Size := (AValue - 1) shr 3 + 1;
+end;
+
+procedure TBitMemoryRec.WriteItems(Addr: Cardinal; Items: TBitMemoryRec);
+begin
+
+end;
+
+procedure TBitMemoryRec.Fill(Value: Boolean);
+begin
+  FMemory.Fill($ff * Byte(Value));
+end;
+
+procedure TBitMemoryRec.Assign(Source: TBitMemoryRec);
+begin
+  Size := Source.Size;
+  FMemory.Assign(Source.Memory);
+end;
+
+{ TMemoryRec }
+
+function TMemoryRec.GetItem(Index: Integer): Byte;
+begin
+  Result := PByte(FData + Index)^;
+end;
+
+procedure TMemoryRec.SetItem(Index: Integer; AValue: Byte);
+begin
+  PByte(FData + Index)^ := AValue;
+end;
+
+function TMemoryRec.GetSize: Integer;
+begin
+  Result := MemSize(FData);
+end;
+
+procedure TMemoryRec.SetSize(AValue: Integer);
+begin
+  FData := ReAllocMem(FData, AValue);
+end;
+
+procedure TMemoryRec.Fill(Value: Byte);
+begin
+  FillChar(FData^, Size, Value);
+end;
+
+procedure TMemoryRec.Assign(Source: TMemoryRec);
+begin
+  Size := Source.Size;
+  Move(Source.Data^, FData^, Size);
+end;
+
 { TPositionMemory }
 
@@ -49 +158 @@
 begin
   inherited SetSize(AValue);
-  if FPosition > FSize then FPosition := FSize;
+  if FPosition > Size then FPosition := Size;
 end;
 
@@ -70 +179 @@
 procedure TMemory.SetSize(AValue: Integer);
 begin
-  if FSize = AValue then Exit;
-  FSize := AValue;
-  FData := ReAllocMem(FData, FSize);
+  FData := ReAllocMem(FData, AValue);
 end;
 
@@ -85 +192 @@
 end;
 
-procedure TMemory.Clear(Value: Byte);
+function TMemory.GetSize: Integer;
+begin
+  Result := MemSize(FData);
+end;
+
+procedure TMemory.Fill(Value: Byte);
 begin
   FillChar(FData^, Size, Value);
@@ -99 +211 @@
 begin
   FData := nil;
-  FSize := 0;
+  Size := 0;
 end;