Changeset 539 for Registry/Demo

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/Demo

Files:

• RegistryDemo.lpi (modified) (2 diffs)
• RegistryDemo.lpr (modified) (1 diff)
• UFormMain.lfm (modified) (8 diffs)
• UFormMain.pas (modified) (5 diffs)
• UFormValue.lfm (added)
• UFormValue.pas (added)

Registry/Demo/RegistryDemo.lpi

@@ -36 +36 @@
       </Item2>
     </RequiredPackages>
-    <Units Count="3">
+    <Units Count="4">
       <Unit0>
         <Filename Value="RegistryDemo.lpr"/>
@@ -55 +55 @@
         <ResourceBaseClass Value="DataModule"/>
       </Unit2>
+      <Unit3>
+        <Filename Value="UFormValue.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="FormValue"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit3>
     </Units>
   </ProjectOptions>

Registry/Demo/RegistryDemo.lpr

@@ -8 +8 @@
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, UFormMain, UCore
+  Forms, UFormMain, UCore, UFormValue
   { you can add units after this };
 

Registry/Demo/UFormMain.lfm

@@ -1 +1 @@
 object FormMain: TFormMain
   Left = 354
-  Height = 568
+  Height = 682
   Top = 285
-  Width = 884
+  Width = 1061
   Caption = 'General registry editor'
-  ClientHeight = 543
-  ClientWidth = 884
-  DesignTimePPI = 120
+  ClientHeight = 648
+  ClientWidth = 1061
+  DesignTimePPI = 144
   Menu = MainMenu1
   OnShow = FormShow
@@ -14 +14 @@
     Left = 0
     Height = 28
-    Top = 515
-    Width = 884
+    Top = 620
+    Width = 1061
     Panels = <>
     ParentFont = False
@@ -21 +21 @@
   object TreeView1: TTreeView
     Left = 0
-    Height = 515
+    Height = 620
     Top = 0
-    Width = 280
+    Width = 336
     Align = alLeft
     ParentFont = False
@@ -29 +29 @@
   end
   object Splitter1: TSplitter
-    Left = 280
-    Height = 515
+    Left = 336
+    Height = 620
     Top = 0
-    Width = 6
+    Width = 7
   end
   object ListView1: TListView
-    Left = 286
-    Height = 515
+    Left = 343
+    Height = 620
     Top = 0
-    Width = 598
+    Width = 718
     Align = alClient
     Columns = <    
       item
         Caption = 'Name'
-        Width = 188
+        Width = 226
       end    
       item
         Caption = 'Type'
-        Width = 188
+        Width = 226
       end    
       item
         Caption = 'Value'
-        Width = 125
+        Width = 251
       end>
     OwnerData = True
     ParentFont = False
+    PopupMenu = PopupMenuValue
     ReadOnly = True
     RowSelect = True
@@ -60 +61 @@
     ViewStyle = vsReport
     OnData = ListView1Data
+    OnDblClick = ListView1DblClick
   end
   object MainMenu1: TMainMenu
-    left = 160
-    top = 90
+    left = 192
+    top = 108
     object MenuItem1: TMenuItem
       Caption = 'File'
@@ -75 +77 @@
   end
   object ActionList1: TActionList
-    left = 160
-    top = 160
+    left = 192
+    top = 192
     object AImport: TAction
       Caption = 'Import'
@@ -85 +87 @@
     object AConnectionAdd: TAction
       Caption = 'Add connection'
+      OnExecute = AConnectionAddExecute
     end
     object AConnectionDelete: TAction
@@ -98 +101 @@
     object AValueDelete: TAction
       Caption = 'Delete'
+      OnExecute = AValueDeleteExecute
     end
     object AValueEdit: TAction
       Caption = 'Edit'
+      OnExecute = AValueEditExecute
     end
   end
-  object PopupMenu1: TPopupMenu
-    left = 492
-    top = 177
+  object PopupMenuValue: TPopupMenu
+    left = 590
+    top = 212
     object MenuItem4: TMenuItem
       Action = AValueAdd

Registry/Demo/UFormMain.pas

@@ -31 +31 @@
     MenuItem5: TMenuItem;
     MenuItem6: TMenuItem;
-    PopupMenu1: TPopupMenu;
+    PopupMenuValue: TPopupMenu;
     Splitter1: TSplitter;
     StatusBar1: TStatusBar;
     TreeView1: TTreeView;
+    procedure AConnectionAddExecute(Sender: TObject);
     procedure AValueAddExecute(Sender: TObject);
+    procedure AValueDeleteExecute(Sender: TObject);
+    procedure AValueEditExecute(Sender: TObject);
     procedure FormShow(Sender: TObject);
     procedure ListView1Data(Sender: TObject; Item: TListItem);
+    procedure ListView1DblClick(Sender: TObject);
   private
-    function RegValueToString(Name: string): string;
+    function RegValueToString(ValueName: string): string;
     procedure LoadNode(Node: TTreeNode; Key: TRegKey);
     procedure ReloadTreeNode(Node: TTreeNode; Reg: TGeneralRegistry);
@@ -50 +54 @@
   FormMain: TFormMain;
 
+
 implementation
 
 uses
-  UCore;
+  UCore, UFormValue;
 
 {$R *.lfm}
@@ -80 +85 @@
 end;
 
+procedure TFormMain.ListView1DblClick(Sender: TObject);
+begin
+  AValueEdit.Execute;
+end;
+
 procedure TFormMain.FormShow(Sender: TObject);
 begin
@@ -86 +96 @@
 end;
 
+
+procedure TFormMain.AConnectionAddExecute(Sender: TObject);
+begin
+end;
+
+procedure TFormMain.AValueDeleteExecute(Sender: TObject);
+var
+  I: Integer;
+begin
+  if MessageDlg('Delete value', 'Do you want to delete value?', mtConfirmation,
+    [mbCancel, mbOk], 0) = mrOk then begin
+      for I := ListView1.Items.Count - 1 downto 0 do
+      if ListView1.Items[I].Selected then begin
+        ListView1.Items[I].Selected := False;
+        Core.ActiveRegistry.DeleteValue(ListView1.Items[I].Caption);
+      end;
+      ReloadValues;
+    end;
+end;
+
 procedure TFormMain.AValueAddExecute(Sender: TObject);
-begin
-//  Core.ActiveRegistry.Write;
-end;
-
-function TFormMain.RegValueToString(Name: string): string;
+var
+  FormValue: TFormValue;
+begin
+  FormValue := TFormValue.Create(nil);
+  FormValue.EditName.Text := 'New value';
+  FormValue.EditName.Enabled := True;
+  FormValue.SetValueType(vtString);
+  if FormValue.ShowModal = mrOk then begin
+    if FormValue.GetValueType = vtString then
+      Core.ActiveRegistry.WriteString(FormValue.EditName.Text, FormValue.EditValue.Text)
+    else if FormValue.GetValueType = vtInteger then
+      Core.ActiveRegistry.WriteInteger(FormValue.EditName.Text, FormValue.SpinEditValue.Value)
+    else if FormValue.GetValueType = vtBoolean then
+      Core.ActiveRegistry.WriteBool(FormValue.EditName.Text, FormValue.CheckBoxValue.Checked)
+    else raise Exception.Create('Unsupported type ' + RegValueTypeName[TRegValueType(FormValue.ComboBoxType.ItemIndex)]);
+    ReloadValues;
+  end;
+  FormValue.Free;
+end;
+
+procedure TFormMain.AValueEditExecute(Sender: TObject);
+var
+  FormValue: TFormValue;
+  ValueInfo: TRegValueInfo;
+  PrevValueType: TRegValueType;
+begin
+  FormValue := TFormValue.Create(nil);
+  FormValue.EditName.Text := ListView1.Selected.Caption;
+  FormValue.EditName.Enabled := False;
+  Core.ActiveRegistry.GetValueInfo(ListView1.Selected.Caption, ValueInfo);
+  PrevValueType := ValueInfo.ValueType;
+  FormValue.SetValueType(ValueInfo.ValueType);
+  if PrevValueType = vtString then
+    FormValue.EditValue.Text := Core.ActiveRegistry.ReadString(ListView1.Selected.Caption)
+  else if PrevValueType = vtInteger then
+    FormValue.SpinEditValue.Value := Core.ActiveRegistry.ReadInteger(ListView1.Selected.Caption)
+  else if PrevValueType = vtBoolean then
+    FormValue.CheckBoxValue.Checked := Core.ActiveRegistry.ReadBool(ListView1.Selected.Caption);
+  if FormValue.ShowModal = mrOk then begin
+    if FormValue.GetValueType <> PrevValueType then
+      Core.ActiveRegistry.DeleteValue(FormValue.EditName.Text);
+    if FormValue.GetValueType = vtString then
+      Core.ActiveRegistry.WriteString(FormValue.EditName.Text, FormValue.EditValue.Text)
+    else if FormValue.GetValueType = vtInteger then
+      Core.ActiveRegistry.WriteInteger(FormValue.EditName.Text, FormValue.SpinEditValue.Value)
+    else if FormValue.GetValueType = vtBoolean then
+      Core.ActiveRegistry.WriteBool(FormValue.EditName.Text, FormValue.CheckBoxValue.Checked)
+    else raise Exception.Create('Unsupported type ' + RegValueTypeName[TRegValueType(FormValue.ComboBoxType.ItemIndex)]);
+    ReloadValues;
+  end;
+  FormValue.Free;
+end;
+
+function TFormMain.RegValueToString(ValueName: string): string;
 var
   ValueType: TRegValueType;
@@ -98 +177 @@
 begin
   with Core.ActiveRegistry do begin
-    ValueType := GetValueType(Name);
+    ValueType := GetValueType(ValueName);
     case ValueType of
-      vtBoolean: if ReadBool(Name) then Result := 'True' else Result := 'False';
-      vtInteger: Result := IntToStr(ReadInteger(Name));
-      vtString: Result := ReadString(Name);
-      vtFloat: Result := FloatToStr(ReadFloat(Name));
+      vtBoolean: if ReadBool(ValueName) then Result := 'True' else Result := 'False';
+      vtInteger: Result := IntToStr(ReadInteger(ValueName));
+      vtString: Result := ReadString(ValueName);
+      vtFloat: Result := FloatToStr(ReadFloat(ValueName));
       vtUnknown: Result := '?';
-      vtText: Result := ReadString(Name);
+      vtText: Result := ReadString(ValueName);
       vtBinary: begin
-        SetLength(Buffer, GetValueSize(Name));
-        ReadBinaryData(Name, PByte(Buffer)^, Length(Buffer));
+        SetLength(Buffer, GetValueSize(ValueName));
+        ReadBinaryData(ValueName, PByte(Buffer)^, Length(Buffer));
         Result := '';
         for I := 0 to Length(Buffer) - 1 do begin