Skip to content

Commit ca08534

Browse files
PascalCorpsmanPascalCorpsman
committed
ADD: Settings dialog
ADD: custom file opener
1 parent 648d31a commit ca08534

9 files changed

Lines changed: 1101 additions & 486 deletions

File tree

‎src/CopyCommander2.lpi‎

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@
3737
<PackageName Value="LCL"/>
3838
</Item3>
3939
</RequiredPackages>
40-
<Units Count="16">
40+
<Units Count="18">
4141
<Unit0>
4242
<Filename Value="CopyCommander2.lpr"/>
4343
<IsPartOfProject Value="True"/>
@@ -127,6 +127,20 @@
127127
<Filename Value="..\Sample\DatenSteuerung\uncommenter.pas"/>
128128
<IsPartOfProject Value="True"/>
129129
</Unit15>
130+
<Unit16>
131+
<Filename Value="unit7.pas"/>
132+
<IsPartOfProject Value="True"/>
133+
<ComponentName Value="Form7"/>
134+
<ResourceBaseClass Value="Form"/>
135+
<UnitName Value="Unit7"/>
136+
</Unit16>
137+
<Unit17>
138+
<Filename Value="unit8.pas"/>
139+
<IsPartOfProject Value="True"/>
140+
<ComponentName Value="Form8"/>
141+
<ResourceBaseClass Value="Form"/>
142+
<UnitName Value="Unit8"/>
143+
</Unit17>
130144
</Units>
131145
</ProjectOptions>
132146
<CompilerOptions>

‎src/CopyCommander2.lpr‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@
2424
athreads,
2525
{$ENDIF}
2626
Interfaces, // this includes the LCL widgetset
27-
Forms, lnetvisual, Unit1, Unit2, Unit3, Unit4, Unit5, Unit6
27+
Forms, lnetvisual, Unit1, Unit2, Unit3, Unit4, Unit5, Unit6, Unit7, Unit8
2828
{ you can add units after this };
2929

3030
{$R *.res}
@@ -39,6 +39,8 @@
3939
Application.CreateForm(TForm4, Form4);
4040
Application.CreateForm(TForm5, Form5);
4141
Application.CreateForm(TForm6, Form6);
42+
Application.CreateForm(TForm7, Form7);
43+
Application.CreateForm(TForm8, Form8);
4244
Application.Run;
4345
End.
4446

‎src/uJSON.pas‎

Lines changed: 85 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
(******************************************************************************)
22
(* uJSON.pas ??.??.???? *)
33
(* *)
4-
(* Version : 0.14 *)
4+
(* Version : 0.15 *)
55
(* *)
66
(* Author : Uwe Schächterle (Corpsman) *)
77
(* *)
@@ -41,12 +41,18 @@
4141
(* 0.13 = Erste Versuche eine Zeilennummer aus zu geben, wenn *)
4242
(* der JSON Text falsch ist.. *)
4343
(* 0.14 = Ignore \u tags instead of throwing an exception *)
44+
(* 0.15 = ADD IJSONAddobjInterface *)
45+
(* Parent Property *)
46+
(* Validy Checks on TJSONArray.addobj *)
47+
(* FIX: linebreak on TJSONNodeObj.ToString *)
4448
(* *)
4549
(******************************************************************************)
4650
Unit uJSON;
4751

4852
{$MODE objfpc}{$H+}
4953

54+
{$INTERFACES CORBA}
55+
5056
Interface
5157

5258
(*
@@ -137,10 +143,12 @@
137143
private
138144
fName: String; // Wird in Findpath benötigt
139145
fobjs: Array Of TJSONObj; // Das ist damit TJSONObj das Findpath bereitstellen kann, sonst müssten das die Kindklassen alle Redundant implementieren
146+
fParent: TJSONObj; // das Eltern JSON Element, wenn es eines gibt, sonst NIL
140147
protected
141148
Procedure Clear; virtual;
142149
public
143150
Tag: PtrInt; // For the User, is not needed by the JSON Library = 0 on Create
151+
Property Parent: TJSONObj read fParent;
144152
Constructor Create; virtual;
145153
Destructor Destroy; override;
146154

@@ -150,9 +158,14 @@
150158
Function Clone: TJSONObj; virtual; // Abstract; // Das Object "Clont" sich selbst und wird als neue Instanz zurück gegeben
151159
End;
152160

161+
IJSONChildobjInterface = Interface
162+
['{121D69AC-9738-455E-B2EA-C80C409D588F}'] // Created with Lazarus IDE, using CTRL+SHIFT+G
163+
Procedure AddObj(JSONObj: TJSONObj);
164+
Function RemoveObj(JSONObj: TJSONObj): Boolean;
165+
End;
153166
{ TJSONComment }
154167

155-
TJSONComment = Class(TJSONObj) // Will man einen JSON 5.0 Kommantar erzeugen der Parser wirft alle Kommentare weg
168+
TJSONComment = Class(TJSONObj) // Falls man einen JSON 5.0 Kommantar erzeugen will, der Parser wirft alle Kommentare weg
156169
private
157170

158171
public
@@ -168,7 +181,7 @@
168181

169182
{ TJSONArray }
170183

171-
TJSONArray = Class(TJSONObj)
184+
TJSONArray = Class(TJSONObj, IJSONChildobjInterface)
172185
private
173186
Function getObjCount: integer;
174187
Function getObj(index: integer): TJSONObj;
@@ -181,6 +194,7 @@
181194
Constructor Create; override;
182195

183196
Procedure AddObj(JSONObj: TJSONObj);
197+
Function RemoveObj(JSONObj: TJSONObj): Boolean;
184198
Procedure Clear; override;
185199

186200
Function ToString(FrontSpace: String = ''): String; override;
@@ -190,7 +204,7 @@
190204

191205
{ TJSONNode }
192206

193-
TJSONNode = Class(TJSONObj)
207+
TJSONNode = Class(TJSONObj, IJSONChildobjInterface)
194208
private
195209
Function getObjCount: integer;
196210
Function getObj(index: integer): TJSONObj;
@@ -201,6 +215,7 @@
201215
Constructor Create; override;
202216

203217
Procedure AddObj(JSONObj: TJSONObj);
218+
Function RemoveObj(JSONObj: TJSONObj): Boolean;
204219
Procedure Clear; override;
205220

206221
Function ToString(FrontSpace: String = ''): String; override;
@@ -366,21 +381,23 @@
366381
{ TJSONTerminal }
367382

368383
Constructor TJSONTerminal.Create(aValue: String);
384+
Var
385+
i: Integer;
369386
Begin
370387
Inherited create;
388+
fName := aValue;
371389
If length(aValue) > 1 Then Begin
372390
If (avalue[1] = '"') And (avalue[length(aValue)] = '"') Then Begin
373391
fName := copy(aValue, 2, length(aValue) - 2);
392+
End;
393+
End;
394+
fIsString := false;
395+
For i := 1 To length(fName) Do Begin
396+
// TODO: Das ist eigentlich falsch, weil es einen String wie 1.1.1 auch als gültige Zahl erkennen würde ..
397+
If Not (fName[i] In ['0'..'9', DefaultFormatSettings.DecimalSeparator]) Then Begin
374398
fIsString := true;
375-
End
376-
Else Begin
377-
fName := aValue; // Eigentlich müsste hier ne AV kommen
378-
fIsString := false;
399+
break;
379400
End;
380-
End
381-
Else Begin
382-
fName := aValue; // Eigentlich müsste hier ne AV kommen
383-
fIsString := false;
384401
End;
385402
End;
386403

@@ -419,6 +436,7 @@
419436
Tag := 0;
420437
fName := '';
421438
fobjs := Nil;
439+
fParent := Nil;
422440
End;
423441

424442
Destructor TJSONObj.Destroy;
@@ -535,13 +553,39 @@
535553
setlength(result.fobjs, length(Self.fobjs));
536554
For i := 0 To high(fobjs) Do Begin
537555
result.fobjs[i] := Self.fobjs[i].Clone;
556+
result.fobjs[i].fParent := result;
538557
End;
539558
End;
540559

541560
Procedure TJSONArray.AddObj(JSONObj: TJSONObj);
542561
Begin
543-
setlength(fobjs, High(fobjs) + 2);
544-
fobjs[High(fobjs)] := JSONObj;
562+
If (JSONObj Is TJSONTerminal) Or
563+
(JSONObj Is TJSONNode) Then Begin
564+
setlength(fobjs, High(fobjs) + 2);
565+
fobjs[High(fobjs)] := JSONObj;
566+
JSONObj.fParent := self;
567+
End
568+
Else Begin
569+
Raise exception.create('Error: ' + JSONObj.ClassName + ' not allowed as element for ' + ClassName);
570+
End;
571+
End;
572+
573+
Function TJSONArray.RemoveObj(JSONObj: TJSONObj): Boolean;
574+
Var
575+
i, j: Integer;
576+
Begin
577+
result := false;
578+
For i := 0 To high(fobjs) Do Begin
579+
If fobjs[i] = JSONObj Then Begin
580+
result := true;
581+
fobjs[i].Free;
582+
For j := i To high(fobjs) - 1 Do Begin
583+
fobjs[j] := fobjs[j + 1];
584+
End;
585+
setlength(fobjs, high(fobjs));
586+
exit;
587+
End;
588+
End;
545589
End;
546590

547591
Procedure TJSONArray.Clear;
@@ -595,13 +639,34 @@
595639
setlength(result.fobjs, length(Self.fobjs));
596640
For i := 0 To high(fobjs) Do Begin
597641
result.fobjs[i] := Self.fobjs[i].Clone;
642+
result.fobjs[i].fParent := result;
598643
End;
599644
End;
600645

601646
Procedure TJSONNode.AddObj(JSONObj: TJSONObj);
602647
Begin
648+
// TODO: darf hier wirklich alles hinzugefügt werden ?
603649
setlength(fobjs, High(fobjs) + 2);
604650
fobjs[High(fobjs)] := JSONObj;
651+
JSONObj.fParent := self;
652+
End;
653+
654+
Function TJSONNode.RemoveObj(JSONObj: TJSONObj): Boolean;
655+
Var
656+
i, j: Integer;
657+
Begin
658+
result := false;
659+
For i := 0 To high(fobjs) Do Begin
660+
If fobjs[i] = JSONObj Then Begin
661+
result := true;
662+
fobjs[i].Free;
663+
For j := i To high(fobjs) - 1 Do Begin
664+
fobjs[j] := fobjs[j + 1];
665+
End;
666+
setlength(fobjs, high(fobjs));
667+
exit;
668+
End;
669+
End;
605670
End;
606671

607672
Procedure TJSONNode.Clear;
@@ -917,12 +982,17 @@
917982
Inherited Create;
918983
fName := aName;
919984
fvalue := aValue;
985+
fvalue.fParent := self;
920986
End;
921987

922988
Function TJSONNodeObj.ToString(FrontSpace: String): String;
989+
Var
990+
maybeLE: String;
923991
Begin
924992
If assigned(fvalue) Then Begin
925-
result := FrontSpace + StringToJsonString(fName) + ':' + fvalue.ToString(FrontSpace);
993+
maybeLE := '';
994+
If fvalue Is TJSONNode Then maybeLE := LineEnding;
995+
result := FrontSpace + StringToJsonString(fName) + ':' + maybeLE + fvalue.ToString(FrontSpace);
926996
End
927997
Else Begin
928998
result := FrontSpace + StringToJsonString(fName) + ':""';

0 commit comments

Comments
 (0)