Changeset 539
- Timestamp:
- Aug 7, 2019, 12:04:53 AM (5 years ago)
- Location:
- Registry
- Files:
-
- 2 added
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
Registry/Demo/RegistryDemo.lpi
r538 r539 36 36 </Item2> 37 37 </RequiredPackages> 38 <Units Count=" 3">38 <Units Count="4"> 39 39 <Unit0> 40 40 <Filename Value="RegistryDemo.lpr"/> … … 55 55 <ResourceBaseClass Value="DataModule"/> 56 56 </Unit2> 57 <Unit3> 58 <Filename Value="UFormValue.pas"/> 59 <IsPartOfProject Value="True"/> 60 <ComponentName Value="FormValue"/> 61 <ResourceBaseClass Value="Form"/> 62 </Unit3> 57 63 </Units> 58 64 </ProjectOptions> -
Registry/Demo/RegistryDemo.lpr
r392 r539 8 8 {$ENDIF}{$ENDIF} 9 9 Interfaces, // this includes the LCL widgetset 10 Forms, UFormMain, UCore 10 Forms, UFormMain, UCore, UFormValue 11 11 { you can add units after this }; 12 12 -
Registry/Demo/UFormMain.lfm
r538 r539 1 1 object FormMain: TFormMain 2 2 Left = 354 3 Height = 5683 Height = 682 4 4 Top = 285 5 Width = 8845 Width = 1061 6 6 Caption = 'General registry editor' 7 ClientHeight = 5438 ClientWidth = 8849 DesignTimePPI = 1 207 ClientHeight = 648 8 ClientWidth = 1061 9 DesignTimePPI = 144 10 10 Menu = MainMenu1 11 11 OnShow = FormShow … … 14 14 Left = 0 15 15 Height = 28 16 Top = 51517 Width = 88416 Top = 620 17 Width = 1061 18 18 Panels = <> 19 19 ParentFont = False … … 21 21 object TreeView1: TTreeView 22 22 Left = 0 23 Height = 51523 Height = 620 24 24 Top = 0 25 Width = 28025 Width = 336 26 26 Align = alLeft 27 27 ParentFont = False … … 29 29 end 30 30 object Splitter1: TSplitter 31 Left = 28032 Height = 51531 Left = 336 32 Height = 620 33 33 Top = 0 34 Width = 634 Width = 7 35 35 end 36 36 object ListView1: TListView 37 Left = 28638 Height = 51537 Left = 343 38 Height = 620 39 39 Top = 0 40 Width = 59840 Width = 718 41 41 Align = alClient 42 42 Columns = < 43 43 item 44 44 Caption = 'Name' 45 Width = 18845 Width = 226 46 46 end 47 47 item 48 48 Caption = 'Type' 49 Width = 18849 Width = 226 50 50 end 51 51 item 52 52 Caption = 'Value' 53 Width = 12553 Width = 251 54 54 end> 55 55 OwnerData = True 56 56 ParentFont = False 57 PopupMenu = PopupMenuValue 57 58 ReadOnly = True 58 59 RowSelect = True … … 60 61 ViewStyle = vsReport 61 62 OnData = ListView1Data 63 OnDblClick = ListView1DblClick 62 64 end 63 65 object MainMenu1: TMainMenu 64 left = 1 6065 top = 9066 left = 192 67 top = 108 66 68 object MenuItem1: TMenuItem 67 69 Caption = 'File' … … 75 77 end 76 78 object ActionList1: TActionList 77 left = 1 6078 top = 1 6079 left = 192 80 top = 192 79 81 object AImport: TAction 80 82 Caption = 'Import' … … 85 87 object AConnectionAdd: TAction 86 88 Caption = 'Add connection' 89 OnExecute = AConnectionAddExecute 87 90 end 88 91 object AConnectionDelete: TAction … … 98 101 object AValueDelete: TAction 99 102 Caption = 'Delete' 103 OnExecute = AValueDeleteExecute 100 104 end 101 105 object AValueEdit: TAction 102 106 Caption = 'Edit' 107 OnExecute = AValueEditExecute 103 108 end 104 109 end 105 object PopupMenu 1: TPopupMenu106 left = 492107 top = 177110 object PopupMenuValue: TPopupMenu 111 left = 590 112 top = 212 108 113 object MenuItem4: TMenuItem 109 114 Action = AValueAdd -
Registry/Demo/UFormMain.pas
r538 r539 31 31 MenuItem5: TMenuItem; 32 32 MenuItem6: TMenuItem; 33 PopupMenu 1: TPopupMenu;33 PopupMenuValue: TPopupMenu; 34 34 Splitter1: TSplitter; 35 35 StatusBar1: TStatusBar; 36 36 TreeView1: TTreeView; 37 procedure AConnectionAddExecute(Sender: TObject); 37 38 procedure AValueAddExecute(Sender: TObject); 39 procedure AValueDeleteExecute(Sender: TObject); 40 procedure AValueEditExecute(Sender: TObject); 38 41 procedure FormShow(Sender: TObject); 39 42 procedure ListView1Data(Sender: TObject; Item: TListItem); 43 procedure ListView1DblClick(Sender: TObject); 40 44 private 41 function RegValueToString( Name: string): string;45 function RegValueToString(ValueName: string): string; 42 46 procedure LoadNode(Node: TTreeNode; Key: TRegKey); 43 47 procedure ReloadTreeNode(Node: TTreeNode; Reg: TGeneralRegistry); … … 50 54 FormMain: TFormMain; 51 55 56 52 57 implementation 53 58 54 59 uses 55 UCore ;60 UCore, UFormValue; 56 61 57 62 {$R *.lfm} … … 80 85 end; 81 86 87 procedure TFormMain.ListView1DblClick(Sender: TObject); 88 begin 89 AValueEdit.Execute; 90 end; 91 82 92 procedure TFormMain.FormShow(Sender: TObject); 83 93 begin … … 86 96 end; 87 97 98 99 procedure TFormMain.AConnectionAddExecute(Sender: TObject); 100 begin 101 end; 102 103 procedure TFormMain.AValueDeleteExecute(Sender: TObject); 104 var 105 I: Integer; 106 begin 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; 116 end; 117 88 118 procedure TFormMain.AValueAddExecute(Sender: TObject); 89 begin 90 // Core.ActiveRegistry.Write; 91 end; 92 93 function TFormMain.RegValueToString(Name: string): string; 119 var 120 FormValue: TFormValue; 121 begin 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; 137 end; 138 139 procedure TFormMain.AValueEditExecute(Sender: TObject); 140 var 141 FormValue: TFormValue; 142 ValueInfo: TRegValueInfo; 143 PrevValueType: TRegValueType; 144 begin 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; 170 end; 171 172 function TFormMain.RegValueToString(ValueName: string): string; 94 173 var 95 174 ValueType: TRegValueType; … … 98 177 begin 99 178 with Core.ActiveRegistry do begin 100 ValueType := GetValueType( Name);179 ValueType := GetValueType(ValueName); 101 180 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)); 106 185 vtUnknown: Result := '?'; 107 vtText: Result := ReadString( Name);186 vtText: Result := ReadString(ValueName); 108 187 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)); 111 190 Result := ''; 112 191 for I := 0 to Length(Buffer) - 1 do begin -
Registry/UGeneralRegistry.pas
r538 r539 147 147 end; 148 148 149 {$IFDEF Windows}150 151 149 { TWinRegistry } 152 150 … … 187 185 destructor Destroy; override; 188 186 end; 189 {$ENDIF}190 187 191 188 const … … 206 203 end; 207 204 208 { TBaseRegistry }209 210 {$IFDEF Windows}211 205 { TWinRegistry } 212 206 … … 419 413 inherited Destroy; 420 414 end; 421 {$ENDIF}422 415 423 416 { TIniRegistry } … … 686 679 constructor TGeneralRegistry.Create(AOwner: TComponent); 687 680 begin 688 {$IFDEF Windows}689 681 Backend := TWinRegistry.Create; 690 682 TWinRegistry(Backend).CurrentRoot := HKEY_CURRENT_USER; … … 693 685 // TWinRegistry(Backend).CurrentKey := 'Software\' + VendorName + '\' + 694 686 // ApplicationName; 695 {$ENDIF}696 {$IFDEF Linux}697 Backend := TXMLRegistry.Create;698 //TXMLRegistry(Backend).FileName := HomeDir + DirectorySeparator + ApplicationName +699 // ExtensionSeparator + '.xml';700 {$ENDIF}701 687 inherited Create(AOwner); 702 688 end;
Note:
See TracChangeset
for help on using the changeset viewer.