summaryrefslogtreecommitdiff
path: root/examples/apps/uidesigner/vfdformparser.pas
diff options
context:
space:
mode:
Diffstat (limited to 'examples/apps/uidesigner/vfdformparser.pas')
-rw-r--r--examples/apps/uidesigner/vfdformparser.pas545
1 files changed, 0 insertions, 545 deletions
diff --git a/examples/apps/uidesigner/vfdformparser.pas b/examples/apps/uidesigner/vfdformparser.pas
deleted file mode 100644
index a3d7c966..00000000
--- a/examples/apps/uidesigner/vfdformparser.pas
+++ /dev/null
@@ -1,545 +0,0 @@
-{
- fpGUI - Free Pascal GUI Toolkit
-
- Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this
- distribution, for details of the copyright.
-
- See the file COPYING.modifiedLGPL, included in this distribution,
- for details about redistributing fpGUI.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- Description:
- Some Pascal source code parsing functionality.
-}
-
-unit vfdformparser;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes,
- SysUtils,
- fpgfx,
- gfx_widget,
- gui_form,
- vfddesigner,
- vfdwidgetclass,
- vfdwidgets;
-
-type
- TVFDFormParser = class(TObject)
- protected
- ffd: TFormDesigner;
- fformname: string;
- BodyLines: TStringList;
- eob: boolean;
- line: string;
- lineindex: integer;
- public
- procedure NextLine;
- public
- constructor Create(const FormName, FormHead, FormBody: string);
- destructor Destroy; override;
- function ParseForm: TFormDesigner;
- procedure ParseFormProperties;
- procedure ParseFormWidgets;
- function ReadWGProperty(propline: string; wg: TfpgWidget; wgc: TVFDWidgetClass): boolean;
- end;
-
-
-function GetIdentifier(var s: string): string;
-function GetStringValue(var s: string): string;
-procedure SkipSpaces(var s: string);
-function CheckSymbol(var s: string; const sym: string): boolean;
-function GetIntValue(var s: string): integer;
-function GetBoolValue(var s: string): boolean;
-
-
-implementation
-
-
-{ TVFDFormParser }
-
-constructor TVFDFormParser.Create(const FormName, FormHead, FormBody: string);
-begin
- fformname := FormName;
- ffd := nil;
- BodyLines := TStringList.Create;
- BodyLines.Text := FormBody;
- lineindex := -1;
-end;
-
-destructor TVFDFormParser.Destroy;
-begin
- BodyLines.Free;
- inherited;
-end;
-
-procedure TVFDFormParser.NextLine;
-begin
- repeat
- Inc(lineindex);
- eob := (lineindex > BodyLines.Count-1);
- if not eob then
- line := trim(bodylines.Strings[lineindex])
- else
- line := '';
- until eob or (line <> '');
-end;
-
-function TVFDFormParser.ParseForm: TFormDesigner;
-begin
- ffd := TFormDesigner.Create;
- ffd.Form.Name := fformname;
- // parsing line by line
- // the unknown lines will be "other properties"
- lineindex := -1;
- NextLine;
- ParseFormProperties;
- ParseFormWidgets;
- Result := ffd;
-end;
-
-procedure SkipSpaces(var s: string);
-begin
- while (s <> '') and (s[1] in [' ', #9, #13, #10]) do
- Delete(s, 1, 1);
-end;
-
-function CheckSymbol(var s: string; const sym: string): boolean;
-begin
- SkipSpaces(s);
- Result := (pos(sym, s) = 1);
- if Result then
- Delete(s, 1, length(sym));
-end;
-
-function GetIntValue(var s: string): integer;
-var
- n: integer;
- ns: string;
-begin
- SkipSpaces(s);
- ns := '';
- n := 1;
- while (n <= length(s)) and (s[n] in ['0'..'9', '-']) do
- begin
- ns := ns + s[n];
- Inc(n);
- end;
- Result := StrToIntDef(ns, 0);
- Delete(s, 1, length(ns));
-end;
-
-function GetBoolValue(var s: string): boolean;
-var
- ts: string;
- fs: string;
-begin
- SkipSpaces(s);
- ts := copy(s, 1, 4); // true string
- fs := copy(s, 1, 5); // false string
- if UpperCase(ts) = 'TRUE' then
- Result := True
- else if UpperCase(fs) = 'FALSE' then
- Result := False
- else
- raise exception.Create('Failed to parse Boolean value <' + s + '>');
-
- if Result then
- Delete(s, 1, 4)
- else
- Delete(s, 1, 5);
-end;
-
-function GetStringValue(var s: string): string;
-var
- n: integer;
- quot: boolean;
- c, prevc: char;
- ccode: string;
- ids: string;
-begin
- Result := '';
- ids := GetIdentifier(s);
- if ids <> '' then
-{ if ids = 'u8' then
- begin
- if not CheckSymbol(s, '(') then
- Exit;
- end
- else
- Exit;
-}
- SkipSpaces(s);
- prevc := #0;
- n := 1;
- quot := False;
- while n <= length(s) do
- begin
- c := s[n];
- if c = '''' then
- begin
- quot := not quot;
- if quot and (prevc = '''') then
- Result := Result + c;
- end
- else if not quot then
- begin
- if not (c in ['+', ' ', #9, #13, #10]) then
- if (c = '#') then
- begin
- Inc(n);
- ccode := '';
- while (n <= length(s)) and (s[n] in ['0'..'9']) do
- begin
- ccode := ccode + s[n];
- Inc(n);
- end;
- c := chr(StrToIntDef(ccode, Ord('?')) and $FF);
- Result := Result + c;
- end
- else
- break;
- end
- else
- Result := Result + c;
- prevc := c;
- Inc(n);
- end;
- if (n - 1) > 0 then
- Delete(s, 1, n - 1);
-
- SkipSpaces(s);
-// if ids <> '' then
-// CheckSymbol(s, ')');
-// if ids = 'u8' then
-// Result := u8(Result);
-end;
-
-function GetIdentifier(var s: string): string;
-var
- n: integer;
-begin
- SkipSpaces(s);
- Result := '';
- n := 1;
- while n <= length(s) do
- begin
- if s[n] in ['_', 'a'..'z', 'A'..'Z', '0'..'9'] then
- Result := Result + s[n]
- else
- Break;
- Inc(n);
- end;
- if length(Result) > 0 then
- Delete(s, 1, length(Result));
-end;
-
-procedure TVFDFormParser.ParseFormProperties;
-var
- lok: boolean;
-begin
- while not eob and (pos('.CREATE(', UpperCase(line)) = 0) do
- begin
- lok := ReadWGProperty(line, ffd.Form, VFDFormWidget);
- if not lok then
- ffd.FormOther := ffd.FormOther + line + LineEnding;
- NextLine;
- end;
-end;
-
-procedure TVFDFormParser.ParseFormWidgets;
-var
- n: integer;
- lok: boolean;
- s: string;
- ident: string;
- wgname, wgclass, wgclassuc, wgparent: string;
- pwg, wg: TfpgWidget;
- wgother: string;
- wd: TWidgetDesigner;
- wgc: TVFDWidgetClass;
-begin
- while not eob do
- begin
- //s := UpperCase(line);
- s := line;
-
- wgname := GetIdentifier(s);
- //writeln('wg: ',wgname);
- lok := CheckSymbol(s, ':=');
- if lok then
- wgclass := GetIdentifier(s);
- lok := lok and CheckSymbol(s, '.');
- lok := lok and (UpperCase(GetIdentifier(s)) = 'CREATE');
- lok := lok and CheckSymbol(s, '(');
- if lok then
- wgparent := GetIdentifier(s);
- lok := lok and CheckSymbol(s, ')');
- lok := lok and CheckSymbol(s, ';');
-
- if lok then
- begin
-// writeln('wg create: ',wgname,' (',wgclass,') - ',wgparent);
-
- // searching for the parent ...
- pwg := nil;
- if UpperCase(wgparent) <> 'SELF' then
- begin
- pwg := ffd.FindWidgetByName(wgparent);
- if pwg = nil then
- Writeln('Warning! Parent object "' + wgparent + '" not found for "' + wgname + '"');
- end;
- if pwg = nil then
- pwg := ffd.Form;
-
- wgclassuc := UpperCase(wgclass);
-
- wg := nil;
- wgc := nil;
- for n := 0 to VFDWidgetCount-1 do
- begin
- wgc := VFDWidget(n);
- if wgclassuc = UpperCase(wgc.WidgetClass.ClassName) then
- begin
- wg := wgc.CreateWidget(pwg);
- break;
- end;
- end;
-
- if wg = nil then
- begin
- wgc := VFDOtherWidget;
- wg := TOtherWidget.Create(pwg);
- TOtherWidget(wg).wgClassName := wgclass;
- end;
-
- wg.Name := wgname;
- wg.FormDesigner := ffd;
-
- NextLine;
- s := UpperCase(line);
- ident := GetIdentifier(s);
- if ident = 'WITH' then
- begin
- // skip with line...
- NextLine;
-
- s := UpperCase(line);
- ident := GetIdentifier(s);
- if ident = 'BEGIN' then
- NextLine;
-
- // reading widget properties...
- wgother := '';
-
- while (not eob) and (pos('END;', UpperCase(line)) <> 1) do
- begin
- lok := ReadWGProperty(line, wg, wgc);
- if not lok then
- wgother := wgother + line + LineEnding;
- nextline;
- end;
-
- if (pos('END;', UpperCase(line)) = 1) then
- nextline;
-
- end;
-
- wd := ffd.AddWidget(wg, nil);
- wd.FVFDClass := wgc;
- wd.other.Text := wgother;
-
- end
- else
- begin
- ffd.FormOther := ffd.FormOther + line + LineEnding;
- NextLine;
- end;
-
- end;
-end;
-
-function TVFDFormParser.ReadWGProperty(propline: string; wg: TfpgWidget; wgc: TVFDWidgetClass): boolean;
-var
- s: string;
- n: integer;
- ident: string;
- lok: boolean;
- sval: string;
- wga: TAnchors;
-begin
- s := propline;
-
- ident := UpperCase(GetIdentifier(s));
- //writeln('ident: ',ident);
- sval := '';
-
- lok := False;
-
- if ident = 'NAME' then
- begin
- lok := CheckSymbol(s, ':=');
- if lok then
- begin
- sval := GetStringValue(s);
- lok := CheckSymbol(s, ';');
- end;
- if lok then
- wg.Name := sval;
- end
- {
- else if ident = 'TEXT' then
- begin
- lok := CheckSymbol(s, ':=');
- if lok then
- begin
- sval := GetStringValue(s);
- lok := CheckSymbol(s, ';');
- end;
- if lok then
- begin
- if wg is TwgLabel then TwgLabel(wg).Text := sval
- else if wg is TwgEdit then TwgEdit(wg).Text := sval
- else if wg is TwgButton then TwgButton(wg).Text := sval
- else if wg is TwgCheckBox then TwgCheckBox(wg).Text := sval
- else
- lok := false;
- end;
- if lok then SetWidgetText(wg, sval);
- end
- else if (ident = 'LINES') or (ident = 'ITEMS') then
- begin
- lok := CheckSymbol(s, '.');
- lok := lok and (UpperCase(GetIdentifier(s)) = 'ADD');
- lok := lok and CheckSymbol(s, '(');
- if lok then
- begin
- sval := GetStringValue(s);
- lok := lok and CheckSymbol(s, ')');
- lok := lok and CheckSymbol(s, ';');
- end;
- if lok then
- begin
- if wg is TwgMemo then TwgMemo(wg).Lines.Add(sval)
- else if wg is TwgChoiceList then TwgChoiceList(wg).Items.Add(sval)
- else if wg is TwgTextListBox then TwgTextListBox(wg).Items.Add(sval)
- else
- lok := false;
- end;
- end
-}
- else if ident = 'ANCHORS' then
- begin
- lok := CheckSymbol(s, ':=');
- lok := lok and CheckSymbol(s, '[');
- if lok then
- begin
- wga := [];
- repeat
- sval := UpperCase(GetIdentifier(s));
- if sval = 'ANLEFT' then
- wga := wga + [anLeft]
- else if sval = 'ANTOP' then
- wga := wga + [anTop]
- else if sval = 'ANRIGHT' then
- wga := wga + [anRight]
- else if sval = 'ANBOTTOM' then
- wga := wga + [anBottom];
- until not CheckSymbol(s, ',');
- end;
- lok := lok and CheckSymbol(s, ']');
- lok := lok and CheckSymbol(s, ';');
-
- if lok then
- wg.Anchors := wga;
- end
- else if ident = 'WINDOWTITLE' then
- begin
- lok := (wg is TfpgForm);
- if lok then
- begin
- lok := CheckSymbol(s, ':=');
- if lok then
- begin
- sval := GetStringValue(s);
- lok := CheckSymbol(s, ';');
- end;
- if lok then
- TfpgForm(wg).WindowTitle := sval;
- end;
- end
- else if ident = 'SETPOSITION' then
- begin
- lok := CheckSymbol(s, '(');
- if lok then
- wg.Left := GetIntValue(s);
- lok := lok and CheckSymbol(s, ',');
- if lok then
- wg.Top := GetIntValue(s);
- lok := lok and CheckSymbol(s, ',');
- if lok then
- wg.Width := GetIntValue(s);
- lok := lok and CheckSymbol(s, ',');
- if lok then
- wg.Height := GetIntValue(s);
- lok := lok and CheckSymbol(s, ')');
- lok := lok and CheckSymbol(s, ';');
- //if lok then Writeln('sd ok.');
- //writeln('WT: ',sval);
- end
- {
- else if (wg is TwgDBGrid) and (ident = 'ADDCOLUMN8') then
- begin
- c := TDBColumn.Create;
- lok := CheckSymbol(s, '(');
-
- if lok then c.Title := u8(GetStringValue(s));
- lok := lok and CheckSymbol(s, ',');
- if lok then c.FieldName8 := GetStringValue(s);
- lok := lok and CheckSymbol(s, ',');
- if lok then c.Width := GetIntValue(s);
- lok := lok and CheckSymbol(s, ',');
- if lok then
- begin
- sval := UpperCase(GetIdentifier(s));
- if sval = 'ALRIGHT' then c.Alignment := alRight
- else if sval = 'ALCENTER' then c.Alignment := alCenter
- else c.Alignment := alLeft;
- end;
-
- lok := lok and CheckSymbol(s, ')');
- lok := lok and CheckSymbol(s, ';');
-
- if lok then
- begin
- TwgDBGrid(wg).AddColumn(c.Title, c.FieldName8, c.Width, c.Alignment)
- end;
-
- c.Free;
- end;
-};
-
- if not lok then
- if wgc <> nil then
- for n := 0 to wgc.PropertyCount-1 do
- begin
- lok := wgc.GetProperty(n).ParseSourceLine(wg, line);
- if lok then
- Break;
- end;
-
- if not lok then
- Writeln('unknown: ', line);
-
- Result := lok;
-end;
-
-end.
-
generated by cgit v1.2.3-54-g00ecf (git 2.44.0) at 2024-08-19 07:48:33 +0000