Changeset 539 for Registry


Ignore:
Timestamp:
Aug 7, 2019, 12:04:53 AM (5 years ago)
Author:
chronos
Message:
  • Added: Allow to add, edit and delete registry values.
Location:
Registry
Files:
2 added
5 edited

Legend:

Unmodified
Added
Removed

  • Registry/Demo/RegistryDemo.lpi

    r538 r539  
    3636      </Item2>
    3737    </RequiredPackages>
    38     <Units Count="3">
     38    <Units Count="4">
    3939      <Unit0>
    4040        <Filename Value="RegistryDemo.lpr"/>
    … …  
    5555        <ResourceBaseClass Value="DataModule"/>
    5656      </Unit2>
     57      <Unit3>
     58        <Filename Value="UFormValue.pas"/>
     59        <IsPartOfProject Value="True"/>
     60        <ComponentName Value="FormValue"/>
     61        <ResourceBaseClass Value="Form"/>
     62      </Unit3>
    5763    </Units>
    5864  </ProjectOptions>

  • Registry/Demo/RegistryDemo.lpr

    r392 r539  
    88  {$ENDIF}{$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UFormMain, UCore
     10  Forms, UFormMain, UCore, UFormValue
    1111  { you can add units after this };
    1212

  • Registry/Demo/UFormMain.lfm

    r538 r539  
    11object FormMain: TFormMain
    22  Left = 354
    3   Height = 568
     3  Height = 682
    44  Top = 285
    5   Width = 884
     5  Width = 1061
    66  Caption = 'General registry editor'
    7   ClientHeight = 543
    8   ClientWidth = 884
    9   DesignTimePPI = 120
     7  ClientHeight = 648
     8  ClientWidth = 1061
     9  DesignTimePPI = 144
    1010  Menu = MainMenu1
    1111  OnShow = FormShow
    … …  
    1414    Left = 0
    1515    Height = 28
    16     Top = 515
    17     Width = 884
     16    Top = 620
     17    Width = 1061
    1818    Panels = <>
    1919    ParentFont = False
    … …  
    2121  object TreeView1: TTreeView
    2222    Left = 0
    23     Height = 515
     23    Height = 620
    2424    Top = 0
    25     Width = 280
     25    Width = 336
    2626    Align = alLeft
    2727    ParentFont = False
    … …  
    2929  end
    3030  object Splitter1: TSplitter
    31     Left = 280
    32     Height = 515
     31    Left = 336
     32    Height = 620
    3333    Top = 0
    34     Width = 6
     34    Width = 7
    3535  end
    3636  object ListView1: TListView
    37     Left = 286
    38     Height = 515
     37    Left = 343
     38    Height = 620
    3939    Top = 0
    40     Width = 598
     40    Width = 718
    4141    Align = alClient
    4242    Columns = <   
    4343      item
    4444        Caption = 'Name'
    45         Width = 188
     45        Width = 226
    4646      end   
    4747      item
    4848        Caption = 'Type'
    49         Width = 188
     49        Width = 226
    5050      end   
    5151      item
    5252        Caption = 'Value'
    53         Width = 125
     53        Width = 251
    5454      end>
    5555    OwnerData = True
    5656    ParentFont = False
     57    PopupMenu = PopupMenuValue
    5758    ReadOnly = True
    5859    RowSelect = True
    … …  
    6061    ViewStyle = vsReport
    6162    OnData = ListView1Data
     63    OnDblClick = ListView1DblClick
    6264  end
    6365  object MainMenu1: TMainMenu
    64     left = 160
    65     top = 90
     66    left = 192
     67    top = 108
    6668    object MenuItem1: TMenuItem
    6769      Caption = 'File'
    … …  
    7577  end
    7678  object ActionList1: TActionList
    77     left = 160
    78     top = 160
     79    left = 192
     80    top = 192
    7981    object AImport: TAction
    8082      Caption = 'Import'
    … …  
    8587    object AConnectionAdd: TAction
    8688      Caption = 'Add connection'
     89      OnExecute = AConnectionAddExecute
    8790    end
    8891    object AConnectionDelete: TAction
    … …  
    98101    object AValueDelete: TAction
    99102      Caption = 'Delete'
     103      OnExecute = AValueDeleteExecute
    100104    end
    101105    object AValueEdit: TAction
    102106      Caption = 'Edit'
     107      OnExecute = AValueEditExecute
    103108    end
    104109  end
    105   object PopupMenu1: TPopupMenu
    106     left = 492
    107     top = 177
     110  object PopupMenuValue: TPopupMenu
     111    left = 590
     112    top = 212
    108113    object MenuItem4: TMenuItem
    109114      Action = AValueAdd

  • Registry/Demo/UFormMain.pas

    r538 r539  
    3131    MenuItem5: TMenuItem;
    3232    MenuItem6: TMenuItem;
    33     PopupMenu1: TPopupMenu;
     33    PopupMenuValue: TPopupMenu;
    3434    Splitter1: TSplitter;
    3535    StatusBar1: TStatusBar;
    3636    TreeView1: TTreeView;
     37    procedure AConnectionAddExecute(Sender: TObject);
    3738    procedure AValueAddExecute(Sender: TObject);
     39    procedure AValueDeleteExecute(Sender: TObject);
     40    procedure AValueEditExecute(Sender: TObject);
    3841    procedure FormShow(Sender: TObject);
    3942    procedure ListView1Data(Sender: TObject; Item: TListItem);
     43    procedure ListView1DblClick(Sender: TObject);
    4044  private
    41     function RegValueToString(Name: string): string;
     45    function RegValueToString(ValueName: string): string;
    4246    procedure LoadNode(Node: TTreeNode; Key: TRegKey);
    4347    procedure ReloadTreeNode(Node: TTreeNode; Reg: TGeneralRegistry);
    … …  
    5054  FormMain: TFormMain;
    5155
     56
    5257implementation
    5358
    5459uses
    55   UCore;
     60  UCore, UFormValue;
    5661
    5762{$R *.lfm}
    … …  
    8085end;
    8186
     87procedure TFormMain.ListView1DblClick(Sender: TObject);
     88begin
     89  AValueEdit.Execute;
     90end;
     91
    8292procedure TFormMain.FormShow(Sender: TObject);
    8393begin
    … …  
    8696end;
    8797
     98
     99procedure TFormMain.AConnectionAddExecute(Sender: TObject);
     100begin
     101end;
     102
     103procedure TFormMain.AValueDeleteExecute(Sender: TObject);
     104var
     105  I: Integer;
     106begin
     107  if MessageDlg('Delete value', 'Do you want to delete value?', mtConfirmation,
     108    [mbCancel, mbOk], 0) = mrOk then begin
     109      for I := ListView1.Items.Count - 1 downto 0 do
     110      if ListView1.Items[I].Selected then begin
     111        ListView1.Items[I].Selected := False;
     112        Core.ActiveRegistry.DeleteValue(ListView1.Items[I].Caption);
     113      end;
     114      ReloadValues;
     115    end;
     116end;
     117
    88118procedure TFormMain.AValueAddExecute(Sender: TObject);
    89 begin
    90 //  Core.ActiveRegistry.Write;
    91 end;
    92 
    93 function TFormMain.RegValueToString(Name: string): string;
     119var
     120  FormValue: TFormValue;
     121begin
     122  FormValue := TFormValue.Create(nil);
     123  FormValue.EditName.Text := 'New value';
     124  FormValue.EditName.Enabled := True;
     125  FormValue.SetValueType(vtString);
     126  if FormValue.ShowModal = mrOk then begin
     127    if FormValue.GetValueType = vtString then
     128      Core.ActiveRegistry.WriteString(FormValue.EditName.Text, FormValue.EditValue.Text)
     129    else if FormValue.GetValueType = vtInteger then
     130      Core.ActiveRegistry.WriteInteger(FormValue.EditName.Text, FormValue.SpinEditValue.Value)
     131    else if FormValue.GetValueType = vtBoolean then
     132      Core.ActiveRegistry.WriteBool(FormValue.EditName.Text, FormValue.CheckBoxValue.Checked)
     133    else raise Exception.Create('Unsupported type ' + RegValueTypeName[TRegValueType(FormValue.ComboBoxType.ItemIndex)]);
     134    ReloadValues;
     135  end;
     136  FormValue.Free;
     137end;
     138
     139procedure TFormMain.AValueEditExecute(Sender: TObject);
     140var
     141  FormValue: TFormValue;
     142  ValueInfo: TRegValueInfo;
     143  PrevValueType: TRegValueType;
     144begin
     145  FormValue := TFormValue.Create(nil);
     146  FormValue.EditName.Text := ListView1.Selected.Caption;
     147  FormValue.EditName.Enabled := False;
     148  Core.ActiveRegistry.GetValueInfo(ListView1.Selected.Caption, ValueInfo);
     149  PrevValueType := ValueInfo.ValueType;
     150  FormValue.SetValueType(ValueInfo.ValueType);
     151  if PrevValueType = vtString then
     152    FormValue.EditValue.Text := Core.ActiveRegistry.ReadString(ListView1.Selected.Caption)
     153  else if PrevValueType = vtInteger then
     154    FormValue.SpinEditValue.Value := Core.ActiveRegistry.ReadInteger(ListView1.Selected.Caption)
     155  else if PrevValueType = vtBoolean then
     156    FormValue.CheckBoxValue.Checked := Core.ActiveRegistry.ReadBool(ListView1.Selected.Caption);
     157  if FormValue.ShowModal = mrOk then begin
     158    if FormValue.GetValueType <> PrevValueType then
     159      Core.ActiveRegistry.DeleteValue(FormValue.EditName.Text);
     160    if FormValue.GetValueType = vtString then
     161      Core.ActiveRegistry.WriteString(FormValue.EditName.Text, FormValue.EditValue.Text)
     162    else if FormValue.GetValueType = vtInteger then
     163      Core.ActiveRegistry.WriteInteger(FormValue.EditName.Text, FormValue.SpinEditValue.Value)
     164    else if FormValue.GetValueType = vtBoolean then
     165      Core.ActiveRegistry.WriteBool(FormValue.EditName.Text, FormValue.CheckBoxValue.Checked)
     166    else raise Exception.Create('Unsupported type ' + RegValueTypeName[TRegValueType(FormValue.ComboBoxType.ItemIndex)]);
     167    ReloadValues;
     168  end;
     169  FormValue.Free;
     170end;
     171
     172function TFormMain.RegValueToString(ValueName: string): string;
    94173var
    95174  ValueType: TRegValueType;
    … …  
    98177begin
    99178  with Core.ActiveRegistry do begin
    100     ValueType := GetValueType(Name);
     179    ValueType := GetValueType(ValueName);
    101180    case ValueType of
    102       vtBoolean: if ReadBool(Name) then Result := 'True' else Result := 'False';
    103       vtInteger: Result := IntToStr(ReadInteger(Name));
    104       vtString: Result := ReadString(Name);
    105       vtFloat: Result := FloatToStr(ReadFloat(Name));
     181      vtBoolean: if ReadBool(ValueName) then Result := 'True' else Result := 'False';
     182      vtInteger: Result := IntToStr(ReadInteger(ValueName));
     183      vtString: Result := ReadString(ValueName);
     184      vtFloat: Result := FloatToStr(ReadFloat(ValueName));
    106185      vtUnknown: Result := '?';
    107       vtText: Result := ReadString(Name);
     186      vtText: Result := ReadString(ValueName);
    108187      vtBinary: begin
    109         SetLength(Buffer, GetValueSize(Name));
    110         ReadBinaryData(Name, PByte(Buffer)^, Length(Buffer));
     188        SetLength(Buffer, GetValueSize(ValueName));
     189        ReadBinaryData(ValueName, PByte(Buffer)^, Length(Buffer));
    111190        Result := '';
    112191        for I := 0 to Length(Buffer) - 1 do begin

  • Registry/UGeneralRegistry.pas

    r538 r539  
    147147  end;
    148148
    149   {$IFDEF Windows}
    150 
    151149  { TWinRegistry }
    152150
    … …  
    187185    destructor Destroy; override;
    188186  end;
    189   {$ENDIF}
    190187
    191188const
    … …  
    206203end;
    207204
    208 { TBaseRegistry }
    209 
    210 {$IFDEF Windows}
    211205{ TWinRegistry }
    212206
    … …  
    419413  inherited Destroy;
    420414end;
    421 {$ENDIF}
    422415
    423416{ TIniRegistry }
    … …  
    686679constructor TGeneralRegistry.Create(AOwner: TComponent);
    687680begin
    688   {$IFDEF Windows}
    689681  Backend := TWinRegistry.Create;
    690682  TWinRegistry(Backend).CurrentRoot := HKEY_CURRENT_USER;
    … …  
    693685//  TWinRegistry(Backend).CurrentKey := 'Software\' + VendorName + '\' +
    694686//    ApplicationName;
    695   {$ENDIF}
    696   {$IFDEF Linux}
    697   Backend := TXMLRegistry.Create;
    698   //TXMLRegistry(Backend).FileName := HomeDir + DirectorySeparator + ApplicationName +
    699   //  ExtensionSeparator + '.xml';
    700   {$ENDIF}
    701687  inherited Create(AOwner);
    702688end;
Note: See TracChangeset for help on using the changeset viewer.