mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-23 07:48:50 -05:00
Setting test base
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@376 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
parent
6eb1f5af23
commit
906d4c9b98
BIN
Projects/settings/project1.ico
Normal file
BIN
Projects/settings/project1.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 134 KiB |
296
Projects/settings/project1.lpi
Normal file
296
Projects/settings/project1.lpi
Normal file
@ -0,0 +1,296 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="7"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<UseDefaultCompilerOptions Value="True"/>
|
||||
</Flags>
|
||||
<MainUnit Value="0"/>
|
||||
<TargetFileExt Value=""/>
|
||||
<Icon Value="0"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<ActiveEditorIndexAtStart Value="1"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
<Language Value=""/>
|
||||
<CharSet Value=""/>
|
||||
</VersionInfo>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="13">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="project1"/>
|
||||
<UsageCount Value="33"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
<CursorPos X="30" Y="172"/>
|
||||
<TopLine Value="154"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="33"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="../SAMufasaGUI/colourhistory.pas"/>
|
||||
<ComponentName Value="ColourHistoryForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="colourhistory"/>
|
||||
<CursorPos X="26" Y="184"/>
|
||||
<TopLine Value="156"/>
|
||||
<UsageCount Value="16"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="../../../../Documents/fpc/packages/fcl-xml/src/dom.pp"/>
|
||||
<UnitName Value="DOM"/>
|
||||
<CursorPos X="25" Y="115"/>
|
||||
<TopLine Value="97"/>
|
||||
<UsageCount Value="9"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="../SAMufasaGUI/framefunctionlist.pas"/>
|
||||
<ComponentName Value="FunctionListFrame"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Frame"/>
|
||||
<UnitName Value="framefunctionlist"/>
|
||||
<CursorPos X="70" Y="204"/>
|
||||
<TopLine Value="184"/>
|
||||
<UsageCount Value="16"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="settings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="settings"/>
|
||||
<CursorPos X="75" Y="164"/>
|
||||
<TopLine Value="142"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<UsageCount Value="31"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="../../Units/MMLAddon/updater.pas"/>
|
||||
<UnitName Value="updater"/>
|
||||
<CursorPos X="2" Y="88"/>
|
||||
<TopLine Value="55"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<UsageCount Value="16"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="../../../../Documents/lazarus/lcl/comctrls.pp"/>
|
||||
<UnitName Value="ComCtrls"/>
|
||||
<CursorPos X="77" Y="1920"/>
|
||||
<TopLine Value="1902"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<UsageCount Value="13"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="../../../../Documents/lazarus/lcl/include/treeview.inc"/>
|
||||
<CursorPos X="72" Y="2253"/>
|
||||
<TopLine Value="2219"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="../../../../Documents/fpc/rtl/inc/strings.pp"/>
|
||||
<UnitName Value="strings"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="78"/>
|
||||
<UsageCount Value="8"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="../../../../Documents/fpc/rtl/objpas/strutils.pp"/>
|
||||
<UnitName Value="strutils"/>
|
||||
<CursorPos X="1" Y="176"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<UsageCount Value="16"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="../../../../Documents/fpc/packages/unixutil/src/unixutils.pp"/>
|
||||
<UnitName Value="UnixUtils"/>
|
||||
<CursorPos X="1" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="9"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="../../../../Documents/lazarus/lcl/include/control.inc"/>
|
||||
<CursorPos X="1" Y="2289"/>
|
||||
<TopLine Value="2271"/>
|
||||
<UsageCount Value="9"/>
|
||||
</Unit12>
|
||||
</Units>
|
||||
<JumpHistory Count="30" HistoryIndex="29">
|
||||
<Position1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="130" Column="15" TopLine="113"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="97" Column="5" TopLine="79"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="96" Column="14" TopLine="78"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="79" Column="33" TopLine="61"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="96" Column="12" TopLine="78"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="79" Column="12" TopLine="61"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="86" Column="46" TopLine="68"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="167" Column="23" TopLine="139"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="settings.pas"/>
|
||||
<Caret Line="141" Column="6" TopLine="111"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="167" Column="32" TopLine="148"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="196" Column="5" TopLine="166"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="24" Column="1" TopLine="4"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="197" Column="1" TopLine="164"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="194" Column="30" TopLine="166"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="20" Column="30" TopLine="12"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="settings.pas"/>
|
||||
<Caret Line="156" Column="3" TopLine="136"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="settings.pas"/>
|
||||
<Caret Line="84" Column="19" TopLine="59"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="settings.pas"/>
|
||||
<Caret Line="81" Column="11" TopLine="72"/>
|
||||
</Position18>
|
||||
<Position19>
|
||||
<Filename Value="settings.pas"/>
|
||||
<Caret Line="173" Column="1" TopLine="161"/>
|
||||
</Position19>
|
||||
<Position20>
|
||||
<Filename Value="settings.pas"/>
|
||||
<Caret Line="184" Column="3" TopLine="166"/>
|
||||
</Position20>
|
||||
<Position21>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="154" Column="1" TopLine="137"/>
|
||||
</Position21>
|
||||
<Position22>
|
||||
<Filename Value="settings.pas"/>
|
||||
<Caret Line="76" Column="3" TopLine="56"/>
|
||||
</Position22>
|
||||
<Position23>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="65" Column="32" TopLine="39"/>
|
||||
</Position23>
|
||||
<Position24>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="42" Column="6" TopLine="42"/>
|
||||
</Position24>
|
||||
<Position25>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="70" Column="2" TopLine="56"/>
|
||||
</Position25>
|
||||
<Position26>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="75" Column="8" TopLine="62"/>
|
||||
</Position26>
|
||||
<Position27>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="80" Column="1" TopLine="52"/>
|
||||
</Position27>
|
||||
<Position28>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="79" Column="3" TopLine="51"/>
|
||||
</Position28>
|
||||
<Position29>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<Caret Line="173" Column="19" TopLine="143"/>
|
||||
</Position29>
|
||||
<Position30>
|
||||
<Filename Value="settings.pas"/>
|
||||
<Caret Line="38" Column="24" TopLine="24"/>
|
||||
</Position30>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="8"/>
|
||||
<Target>
|
||||
<Filename Value="project1"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)/"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
21
Projects/settings/project1.lpr
Normal file
21
Projects/settings/project1.lpr
Normal file
@ -0,0 +1,21 @@
|
||||
program project1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1, LResources, settings
|
||||
{ you can add units after this };
|
||||
|
||||
{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}
|
||||
|
||||
begin
|
||||
{$I project1.lrs}
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
5237
Projects/settings/project1.lrs
Normal file
5237
Projects/settings/project1.lrs
Normal file
File diff suppressed because it is too large
Load Diff
1
Projects/settings/project1.rc
Normal file
1
Projects/settings/project1.rc
Normal file
@ -0,0 +1 @@
|
||||
MAINICON ICON "project1.ico"
|
315
Projects/settings/settings.pas
Normal file
315
Projects/settings/settings.pas
Normal file
@ -0,0 +1,315 @@
|
||||
unit settings;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, ComCtrls;
|
||||
|
||||
|
||||
|
||||
type
|
||||
// remove later
|
||||
TStringArray = Array Of String;
|
||||
|
||||
TSettingData = class(TObject)
|
||||
public
|
||||
Val: String;
|
||||
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
end;
|
||||
|
||||
TMMLSettings = class(TObject)
|
||||
|
||||
public
|
||||
constructor Create(aNodes: TTreeNodes);
|
||||
destructor Destroy; override;
|
||||
|
||||
private
|
||||
Nodes: TTreeNodes;
|
||||
function KeyNameToKeys(KeyName: String): TStringArray;
|
||||
function WalkToNode(KeyName: String): TTreeNode;
|
||||
function GetNodePath(Node: TTreeNode): String;
|
||||
|
||||
public
|
||||
function ListKeys(KeyName: String): TStringArray;
|
||||
function KeyExists(KeyName: String): Boolean;
|
||||
function IsKey(KeyName: String): Boolean;
|
||||
function IsDirectory(KeyName: String): Boolean;
|
||||
procedure SetKey(KeyName: String; KeyValue: String);
|
||||
function CreateKey(KeyName: String; CreatePath: Boolean = False): Boolean;
|
||||
function GetKeyValue(KeyName: String): String;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses
|
||||
strutils;
|
||||
|
||||
constructor TSettingData.Create;
|
||||
begin
|
||||
inherited;
|
||||
Val := '';
|
||||
end;
|
||||
|
||||
destructor TSettingData.Destroy;
|
||||
begin
|
||||
Val := '';
|
||||
inherited;
|
||||
end;
|
||||
|
||||
|
||||
constructor TMMLSettings.Create(aNodes: TTreeNodes);
|
||||
begin
|
||||
Self.Nodes := aNodes;
|
||||
end;
|
||||
|
||||
destructor TMMLSettings.Destroy;
|
||||
begin
|
||||
Nodes := nil;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMMLSettings.KeyNameToKeys(KeyName: String): TStringArray;
|
||||
// yay for SRL!
|
||||
function srl_Explode(str, del: string): TStringArray;
|
||||
var
|
||||
i, l, dL: Integer;
|
||||
begin
|
||||
i := 0;
|
||||
l := -1;
|
||||
SetLength(Result, 0);
|
||||
if (str = '') then
|
||||
Exit;
|
||||
dL := Length(del) - 1;
|
||||
repeat
|
||||
Inc(l);
|
||||
SetLength(Result, l + 1);
|
||||
i := Pos(del, str);
|
||||
if i <= 0 then
|
||||
Break;
|
||||
Result[l] := Copy(str, 1, i - 1);
|
||||
Delete(str, 1, i + dL);
|
||||
until false;
|
||||
Result[l] := Copy(str, 1, Length(str));
|
||||
end;
|
||||
begin
|
||||
Result := srl_Explode(KeyName, '/');
|
||||
end;
|
||||
|
||||
function TMMLSettings.WalkToNode(KeyName: String): TTreeNode;
|
||||
var
|
||||
N: TTreeNode;
|
||||
i: Integer;
|
||||
S: TStringArray;
|
||||
begin
|
||||
Result := nil;
|
||||
|
||||
if KeyName[length(KeyName)]='/' then setlength(KeyName,length(KeyName)-1);
|
||||
S := KeyNameToKeys(KeyName);
|
||||
|
||||
if not assigned(s) then
|
||||
Exit(nil);
|
||||
|
||||
N := Nodes.GetFirstNode;
|
||||
i := 0;
|
||||
|
||||
while N <> nil do
|
||||
begin
|
||||
if N.Text = s[i] then
|
||||
begin
|
||||
inc(i);
|
||||
if i = length(s) then
|
||||
break;
|
||||
n := N.GetFirstChild;
|
||||
end else
|
||||
n := n.GetNextSibling;
|
||||
end;
|
||||
|
||||
Result := N;
|
||||
|
||||
end;
|
||||
|
||||
function TMMLSettings.GetNodePath(Node: TTreeNode): String;
|
||||
var
|
||||
N: TTreeNode;
|
||||
s: TStringArray;
|
||||
i: Integer;
|
||||
begin
|
||||
if Node = nil then
|
||||
Exit('');
|
||||
|
||||
N := Node;
|
||||
setlength(s, 0);
|
||||
while N <> nil do
|
||||
begin
|
||||
setlength(s,length(s) + 1);
|
||||
s[high(s)] := N.Text;
|
||||
N := N.Parent;
|
||||
end;
|
||||
|
||||
result := '';
|
||||
for i := high(s) downto 0 do
|
||||
result := result + s[i] + '/';
|
||||
end;
|
||||
|
||||
function TMMLSettings.ListKeys(KeyName: String): TStringArray;
|
||||
var
|
||||
N: TTreeNode;
|
||||
i: Integer;
|
||||
S: TStringArray;
|
||||
begin
|
||||
SetLength(Result, 0);
|
||||
N := WalkToNode(KeyName);
|
||||
if N <> nil then
|
||||
N := N.GetFirstChild;
|
||||
|
||||
while N <> nil do
|
||||
begin
|
||||
setlength(result,length(result)+1);
|
||||
result[high(result)] := N.Text;
|
||||
N := N.GetNextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMMLSettings.KeyExists(KeyName: String): Boolean;
|
||||
|
||||
begin
|
||||
Result := WalkToNode(KeyName) <> nil;
|
||||
end;
|
||||
|
||||
function TMMLSettings.IsKey(KeyName: String): Boolean;
|
||||
var
|
||||
N: TTreeNode;
|
||||
i: Integer;
|
||||
begin
|
||||
N := WalkToNode(KeyName);
|
||||
if N = nil then
|
||||
Exit(False);
|
||||
|
||||
i := 0;
|
||||
|
||||
N := N.GetNextSibling;
|
||||
while N <> nil do
|
||||
begin
|
||||
if N.Text <> 'Value' then
|
||||
begin
|
||||
writeln(N.text);
|
||||
inc(i);
|
||||
end;
|
||||
N := N.GetNextSibling;
|
||||
end;
|
||||
|
||||
Exit(i = 0);
|
||||
end;
|
||||
|
||||
function TMMLSettings.IsDirectory(KeyName: String): Boolean;
|
||||
var
|
||||
N: TTreeNode;
|
||||
begin
|
||||
N := WalkToNode(KeyName);
|
||||
if N <> nil then
|
||||
Exit(N.HasChildren);
|
||||
Exit(False);
|
||||
end;
|
||||
|
||||
function TMMLSettings.GetKeyValue(KeyName: String): String;
|
||||
var
|
||||
N: TTreeNode;
|
||||
begin
|
||||
if IsKey(KeyName) then
|
||||
Exit('');
|
||||
N := WalkToNode(KeyName);
|
||||
if N <> nil then
|
||||
if N.GetFirstChild <> nil then
|
||||
if assigned(n.GetFirstChild.Data) then
|
||||
Exit(TSettingData(n.GetFirstChild.Data).Val);
|
||||
|
||||
Exit('');
|
||||
end;
|
||||
|
||||
function TMMLSettings.CreateKey(KeyName: String; CreatePath: Boolean = False): Boolean;
|
||||
var
|
||||
N, newN, nParent: TTreeNode;
|
||||
Path: TStringArray;
|
||||
NewPath: String;
|
||||
i: Integer;
|
||||
|
||||
begin
|
||||
if KeyExists(KeyName) then
|
||||
begin
|
||||
writeln('Key: ' + KeyName + ' exists');
|
||||
Exit(False);
|
||||
end;
|
||||
NewPath := '';
|
||||
N := nil;
|
||||
nParent := Nodes.GetFirstNode;
|
||||
|
||||
Path := KeyNameToKeys(KeyName);
|
||||
if length(path) < 2 then
|
||||
begin
|
||||
writeln('Path too short!');
|
||||
exit(false);
|
||||
end;
|
||||
|
||||
if path[0] <> nParent.Text then
|
||||
begin
|
||||
writeln('First key doesn''t match. First key should always match');
|
||||
end;
|
||||
for i := 0 to length(Path) - 2 do
|
||||
begin
|
||||
if Path[i] = '' then
|
||||
begin
|
||||
writeln('Invalid Key Path / Name');
|
||||
exit(false);
|
||||
end;
|
||||
NewPath := NewPath + Path[i] + '/';
|
||||
N := WalkToNode(NewPath);
|
||||
|
||||
if (N = nil) and (not CreatePath) then
|
||||
begin
|
||||
writeln('(N = nil) and (not CreatePath)');
|
||||
exit(false);
|
||||
end;
|
||||
|
||||
if (N = nil) and CreatePath then
|
||||
begin
|
||||
newN := TTreeNode.Create(Nodes);
|
||||
newN.Text := Path[i];
|
||||
if (nParent = nil) then
|
||||
begin
|
||||
writeln('This shouldn''t happen...');
|
||||
newN.MoveTo(Nodes.GetFirstNode, naAddChild);
|
||||
nParent := newN;
|
||||
end
|
||||
else
|
||||
begin
|
||||
newN.MoveTo(nParent, naAddChild);
|
||||
nParent := newN;
|
||||
end;
|
||||
end;
|
||||
|
||||
if N <> nil then
|
||||
nParent := N;
|
||||
end;
|
||||
|
||||
if nParent = nil then
|
||||
exit(false);
|
||||
|
||||
newN := TTreeNode.Create(Nodes);
|
||||
newN.Text := Path[High(Path)];
|
||||
newN.MoveTo(nParent, naAddChild);
|
||||
end;
|
||||
|
||||
procedure TMMLSettings.SetKey(KeyName: String; KeyValue: String);
|
||||
begin
|
||||
if IsKey(KeyName) then
|
||||
Exit;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
46
Projects/settings/unit1.lfm
Normal file
46
Projects/settings/unit1.lfm
Normal file
@ -0,0 +1,46 @@
|
||||
object Form1: TForm1
|
||||
Left = 264
|
||||
Height = 467
|
||||
Top = 183
|
||||
Width = 734
|
||||
ActiveControl = TreeView1
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 467
|
||||
ClientWidth = 734
|
||||
LCLVersion = '0.9.29'
|
||||
object TreeView1: TTreeView
|
||||
Left = 16
|
||||
Height = 376
|
||||
Top = 24
|
||||
Width = 344
|
||||
DefaultItemHeight = 19
|
||||
TabOrder = 0
|
||||
end
|
||||
object SaveButton: TButton
|
||||
Left = 272
|
||||
Height = 25
|
||||
Top = 432
|
||||
Width = 88
|
||||
Caption = 'SaveButton'
|
||||
OnClick = SaveButtonClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object LoadButton: TButton
|
||||
Left = 16
|
||||
Height = 25
|
||||
Top = 432
|
||||
Width = 91
|
||||
Caption = 'LoadButton'
|
||||
OnClick = LoadButtonClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object ListView1: TListView
|
||||
Left = 376
|
||||
Height = 376
|
||||
Top = 24
|
||||
Width = 336
|
||||
Columns = <>
|
||||
ItemIndex = -1
|
||||
TabOrder = 3
|
||||
end
|
||||
end
|
207
Projects/settings/unit1.pas
Normal file
207
Projects/settings/unit1.pas
Normal file
@ -0,0 +1,207 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
ComCtrls, StdCtrls, xml2, XMLRead, XMLWrite, DOM;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
ListView1: TListView;
|
||||
SaveButton: TButton;
|
||||
LoadButton: TButton;
|
||||
TreeView1: TTreeView;
|
||||
procedure SaveButtonClick(Sender: TObject);
|
||||
procedure LoadButtonClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
|
||||
procedure LoadFromXML(tree: TTreeView; XMLDoc: TXMLDocument);
|
||||
procedure SaveToXML(s: String);
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
uses
|
||||
settings;
|
||||
|
||||
|
||||
procedure WriteXMLData(n: TTreeNode;
|
||||
XMLNode: TDOMNode; XMLDoc: TXMLDocument;
|
||||
var XMLChild: TDOMNode; var C: Integer);
|
||||
|
||||
var
|
||||
DDataNode, DataNode: TDOMNode;
|
||||
|
||||
begin
|
||||
XMLChild := XMLDoc.CreateElement(n.Text);
|
||||
Inc(C);
|
||||
XMLNode.AppendChild(XMLChild);
|
||||
end;
|
||||
|
||||
procedure WalkTree(Node: TTreeNode; XMLNode: TDOMNode; XMLDoc: TXMLDocument;
|
||||
var C: Integer);
|
||||
var
|
||||
N: TTreeNode;
|
||||
XMLChild: TDOMNode;
|
||||
|
||||
begin
|
||||
N := Node.GetFirstChild;
|
||||
|
||||
while assigned(n) do
|
||||
begin
|
||||
WriteXMLData(n, XMLNode, XMLDoc, XMLChild, C);
|
||||
|
||||
WalkTree(n, XMLChild, XMLDoc, C);
|
||||
n := n.GetNextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.SaveToXML(s: String);
|
||||
var
|
||||
XMLDoc: TXMLDocument;
|
||||
RootNode: TDOMNode;
|
||||
C: Integer;
|
||||
|
||||
begin
|
||||
XMLDoc := TXMLDocument.Create;
|
||||
|
||||
RootNode := XMLDoc.CreateElement('Settings');
|
||||
XMLDoc.AppendChild(RootNode);
|
||||
|
||||
RootNode := XMLDoc.DocumentElement;
|
||||
|
||||
C := 0;
|
||||
if TreeView1.Items.GetFirstNode <> nil then
|
||||
WalkTree(TreeView1.Items.GetFirstNode, RootNode, XMLDoc, C);
|
||||
|
||||
{ writeln(TreeView1.Items.TopLvlCount);
|
||||
for i := 0 to TreeView1.Items.TopLvlCount -1 do
|
||||
begin
|
||||
WriteXMLData(TreeView1.Items.TopLvlItems[i], RootNode, XMLDoc, XMLChild, C);
|
||||
WalkTree(TreeView1.Items.TopLvlItems[i], XMLChild, XMLDoc, C);
|
||||
end; }
|
||||
|
||||
WriteXMLFile(XMLDoc, s);
|
||||
|
||||
XMLDoc.Free;
|
||||
end;
|
||||
|
||||
procedure TForm1.LoadFromXML(tree: TTreeView; XMLDoc: TXMLDocument);
|
||||
var
|
||||
iNode: TDOMNode;
|
||||
|
||||
procedure ProcessNode(Node: TDOMNode; TreeNode: TTreeNode);
|
||||
var
|
||||
cNode: TDOMNode;
|
||||
s: string;
|
||||
d: TSettingData;
|
||||
|
||||
begin
|
||||
if Node = nil then Exit; // Stops if reached a leaf
|
||||
|
||||
// Adds a node to the tree
|
||||
if (Node.NodeType = 3) then
|
||||
s := 'Data'
|
||||
else
|
||||
s := Node.NodeName;
|
||||
|
||||
TreeNode := tree.Items.AddChild(TreeNode, s);
|
||||
if (Node.NodeType = 3) then
|
||||
begin
|
||||
d := TSettingData.Create;
|
||||
D.Val := Node.NodeValue;
|
||||
TreeNode.Data := D;
|
||||
|
||||
TreeNode.Text := 'Value';
|
||||
end;
|
||||
// Goes to the child node
|
||||
cNode := Node.FirstChild;
|
||||
|
||||
// Processes all child nodes
|
||||
while cNode <> nil do
|
||||
begin
|
||||
ProcessNode(cNode, TreeNode);
|
||||
cNode := cNode.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
iNode := XMLDoc.DocumentElement;
|
||||
while iNode <> nil do
|
||||
begin
|
||||
ProcessNode(iNode, nil); // Recursive
|
||||
iNode := iNode.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.SaveButtonClick(Sender: TObject);
|
||||
var
|
||||
sett: TMMLSettings;
|
||||
s: TStringArray;
|
||||
i: Integer;
|
||||
|
||||
begin
|
||||
sett := TMMLSettings.Create(TreeView1.Items);
|
||||
|
||||
if sett.KeyExists('') then
|
||||
writeln('Tree exists');
|
||||
if sett.KeyExists('Settings/a/b/c') then
|
||||
writeln('Settings exists');
|
||||
|
||||
{writeln(sett.GetKeyValue('Settings/hoi0/Item1/Item2/Item3/wattt')); }
|
||||
sett.CreateKey('Settings/a/b/c', true);
|
||||
|
||||
if sett.iskey('Settings/a/b/c') then
|
||||
writeln('is key');
|
||||
|
||||
s := sett.ListKeys('Settings');
|
||||
for i := 0 to high(s) do
|
||||
writeln(s[i]);
|
||||
|
||||
|
||||
{ ss:='Settings' + '/' + s[0];
|
||||
while length(s) > 0 do
|
||||
begin
|
||||
s := sett.ListKeys(ss);
|
||||
if(length(s)>0) then
|
||||
ss:=ss +'/' + s[0];
|
||||
end; }
|
||||
|
||||
sett.Free;
|
||||
SaveToXML('settings.xml');
|
||||
end;
|
||||
|
||||
procedure TForm1.LoadButtonClick(Sender: TObject);
|
||||
var
|
||||
doc: TXMLDocument;
|
||||
begin
|
||||
if not FileExists('settings.xml') then
|
||||
begin
|
||||
TreeView1.Items.Clear;
|
||||
SaveToXML('settings.xml');
|
||||
end;
|
||||
ReadXMLFile(doc, 'settings.xml');
|
||||
|
||||
TreeView1.Items.Clear;
|
||||
LoadFromXML(TreeView1, doc);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I unit1.lrs}
|
||||
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user