Changeset 393


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.
Location:
Common
Files:
1 added
6 edited

Legend:

Unmodified
Added
Removed

  • Common/Common.lpk

    r390 r393  
    2222    <License Value="GNU/GPL"/>
    2323    <Version Minor="7"/>
    24     <Files Count="14">
     24    <Files Count="15">
    2525      <Item1>
    2626        <Filename Value="StopWatch.pas"/>
    … …  
    7070      </Item11>
    7171      <Item12>
     72        <Filename Value="URegistry.pas"/>
     73        <UnitName Value="URegistry"/>
     74      </Item12>
     75      <Item13>
    7276        <Filename Value="UJobProgressView.pas"/>
    7377        <HasRegisterProc Value="True"/>
    7478        <UnitName Value="UJobProgressView"/>
    75       </Item12>
    76       <Item13>
     79      </Item13>
     80      <Item14>
    7781        <Filename Value="UXMLUtils.pas"/>
    7882        <UnitName Value="UXMLUtils"/>
    79       </Item13>
    80       <Item14>
     83      </Item14>
     84      <Item15>
    8185        <Filename Value="UApplicationInfo.pas"/>
    8286        <HasRegisterProc Value="True"/>
    8387        <UnitName Value="UApplicationInfo"/>
    84       </Item14>
     88      </Item15>
    8589    </Files>
    8690    <i18n>
    … …  
    8993    </i18n>
    9094    <Type Value="RunAndDesignTime"/>
    91     <RequiredPkgs Count="3">
     95    <RequiredPkgs Count="2">
    9296      <Item1>
    93         <PackageName Value="GeneralRegistry"/>
    94         <MinVersion Minor="1" Valid="True"/>
     97        <PackageName Value="TemplateGenerics"/>
    9598      </Item1>
    9699      <Item2>
    97         <PackageName Value="TemplateGenerics"/>
    98       </Item2>
    99       <Item3>
    100100        <PackageName Value="FCL"/>
    101101        <MinVersion Major="1" Valid="True"/>
    102       </Item3>
     102      </Item2>
    103103    </RequiredPkgs>
    104104    <UsageOptions>

  • Common/Common.pas

    r387 r393  
    99uses
    1010  StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading,
    11   UMemory, UResetableThread, UPool, ULastOpenedList, UJobProgressView,
    12   UXMLUtils, UApplicationInfo, LazarusPackageIntf;
     11  UMemory, UResetableThread, UPool, ULastOpenedList, URegistry,
     12  UJobProgressView, UXMLUtils, UApplicationInfo, LazarusPackageIntf;
    1313
    1414implementation

  • Common/StopWatch.pas

    r390 r393  
    2222    function GetElapsed: string;
    2323  public
    24     constructor Create(const startOnCreate: Boolean = False) ;
     24    constructor Create(const startOnCreate : Boolean = False) ;
    2525    procedure Start;
    2626    procedure Stop;
    27     property IsHighResolution: Boolean read fIsHighResolution;
    28     property ElapsedTicks: TLargeInteger read GetElapsedTicks;
    29     property ElapsedMiliseconds: TLargeInteger read GetElapsedMiliseconds;
    30     property Elapsed: string read GetElapsed;
    31     property IsRunning: Boolean read fIsRunning;
     27    property IsHighResolution : Boolean read fIsHighResolution;
     28    property ElapsedTicks : TLargeInteger read GetElapsedTicks;
     29    property ElapsedMiliseconds : TLargeInteger read GetElapsedMiliseconds;
     30    property Elapsed : string read GetElapsed;
     31    property IsRunning : Boolean read fIsRunning;
    3232  end;
    3333

  • Common/UApplicationInfo.pas

    r390 r393  
    66
    77uses
    8   SysUtils, Classes, Forms, UGeneralRegistry;
     8  SysUtils, Registry, Classes, Forms, URegistry;
    99
    1010type
    … …  
    7474  FAppName := Application.Name;
    7575  FRegistryKey := '\Software\' + FAppName;
    76   FRegistryRoot := rrApplicationUser;
     76  FRegistryRoot := rrKeyCurrentUser;
    7777end;
    7878

  • Common/ULastOpenedList.pas

    r390 r393  
    66
    77uses
    8   Classes, SysUtils, UGeneralRegistry, Menus;
     8  Classes, SysUtils, Registry, URegistry, Menus;
    99
    1010type
    … …  
    2323    destructor Destroy; override;
    2424    procedure LoadToMenuItem(MenuItem: TMenuItem; ClickAction: TNotifyEvent);
    25     procedure LoadFromRegistry(Root: Integer; const Key: string);
    26     procedure SaveToRegistry(Root: Integer; const Key: string);
     25    procedure LoadFromRegistry(Root: HKEY; Key: string);
     26    procedure SaveToRegistry(Root: HKEY; Key: string);
    2727    procedure AddItem(FileName: string);
    2828  published
    … …  
    8787end;
    8888
    89 procedure TLastOpenedList.LoadFromRegistry(Root: Integer; const Key: string);
     89procedure TLastOpenedList.LoadFromRegistry(Root: HKEY; Key: string);
    9090var
    9191  I: Integer;
    92   Registry: TGeneralRegistry;
     92  Registry: TRegistryEx;
    9393  FileName: string;
    9494begin
    95   Registry := TGeneralRegistry.Create(nil);
     95  Registry := TRegistryEx.Create;
    9696  with Registry do
    9797  try
    98     CurrentRoot := Root;
     98    RootKey := Root;
    9999    OpenKey(Key, True);
    100100    Items.Clear;
    101101    I := 0;
    102102    while ValueExists('File' + IntToStr(I)) and (I < MaxCount) do begin
    103       if ValueExists('File' + IntToStr(I)) then
    104         FileName := UTF8Encode(ReadString('File' + IntToStr(I)))
    105         else FileName := '';
     103      FileName := UTF8Encode(ReadStringWithDefault('File' + IntToStr(I), ''));
    106104      if Trim(FileName) <> '' then Items.Add(FileName);
    107105      Inc(I);
    … …  
    114112end;
    115113
    116 procedure TLastOpenedList.SaveToRegistry(Root: Integer; const Key: string);
     114procedure TLastOpenedList.SaveToRegistry(Root: HKEY; Key: string);
    117115var
    118116  I: Integer;
    119   Registry: TGeneralRegistry;
     117  Registry: TRegistryEx;
    120118begin
    121   Registry := TGeneralRegistry.Create(nil);
     119  Registry := TRegistryEx.Create;
    122120  with Registry do
    123121  try
    124     CurrentRoot := Root;
     122    RootKey := Root;
    125123    OpenKey(Key, True);
    126124    for I := 0 to Items.Count - 1 do

  • 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.