summaryrefslogtreecommitdiff
path: root/examples/apps/uidesigner/vfdfile.pas
diff options
context:
space:
mode:
Diffstat (limited to 'examples/apps/uidesigner/vfdfile.pas')
-rw-r--r--examples/apps/uidesigner/vfdfile.pas388
1 files changed, 0 insertions, 388 deletions
diff --git a/examples/apps/uidesigner/vfdfile.pas b/examples/apps/uidesigner/vfdfile.pas
deleted file mode 100644
index 16910883..00000000
--- a/examples/apps/uidesigner/vfdfile.pas
+++ /dev/null
@@ -1,388 +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:
- This unit handles the load, save and merge functions. Doing
- marker searching.
-}
-
-unit vfdfile;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- SysUtils,
- Classes,
- gfx_utils;
-
-type
- TVFDFileBlock = class
- public
- BlockID: string;
- FormName: string;
- Position: integer;
- Data: string;
- end;
-
-
- TVFDFile = class
- protected
- FFileData: string;
- FParsedData: string;
- FBlocks: TList;
- public
- NewFormsDecl: string;
- NewFormsImpl: string;
- constructor Create;
- destructor Destroy; override;
- function LoadFile(fname: string): boolean;
- procedure AddBlock(aposition: integer; ablockid, aformname, ablockdata: string);
- function BlockCount: integer;
- function Block(index: integer): TVFDFileBlock;
- procedure FreeBlocks;
- function GetBlocks: integer; // parse file
- function MergeBlocks: string; // store file
- procedure AddNewFormDecl(formname, formheadblock: string);
- procedure AddNewFormImpl(formname, formbody: string);
- function FindFormBlock(blockid, formname: string): TVFDFileBlock;
- procedure SetFormData(formname, headblock, bodyblock: string);
- procedure NewFileSkeleton(unitname: string);
- end;
-
-
-implementation
-
-{ TVFDFile }
-
-procedure TVFDFile.AddBlock(aposition: integer; ablockid, aformname, ablockdata: string);
-var
- fb: TVFDFileBlock;
-begin
- fb := TVFDFileBlock.Create;
- fb.Position := aposition;
- fb.BlockID := ablockid;
- fb.FormName := aformname;
- fb.Data := ablockdata;
- FBlocks.Add(fb);
-end;
-
-procedure TVFDFile.AddNewFormDecl(formname, formheadblock: string);
-var
- s: string;
-begin
- s :=
- ' T' + formname + ' = class(TfpgForm)' + LineEnding +
- ' public' + LineEnding +
- ' {@VFD_HEAD_BEGIN: ' + formname + '}' + LineEnding +
- formheadblock +
- ' {@VFD_HEAD_END: ' + formname + '}' + LineEnding +
- ' procedure AfterCreate; override;' + LineEnding
- + ' end;' + LineEnding + LineEnding;
- NewFormsDecl := NewFormsDecl + s;
-end;
-
-procedure TVFDFile.AddNewFormImpl(formname, formbody: string);
-var
- s: string;
-begin
- s := LineEnding + LineEnding +
- 'procedure T' + formname + '.AfterCreate;' + LineEnding +
- 'begin' + LineEnding +
- ' {@VFD_BODY_BEGIN: ' + formname + '}' + LineEnding +
- formbody +
- ' {@VFD_BODY_END: ' + formname + '}' + LineEnding +
- 'end;' + LineEnding;
- NewFormsImpl := NewFormsImpl + s;
-end;
-
-function TVFDFile.Block(index: integer): TVFDFileBlock;
-begin
- Result := nil;
- if (index < 0) or (index > FBlocks.Count-1) then
- Exit;
- Result := TVFDFileBlock(FBlocks[index]);
-end;
-
-function TVFDFile.BlockCount: integer;
-begin
- Result := FBlocks.Count;
-end;
-
-constructor TVFDFile.Create;
-begin
- FFileData := '';
- FParsedData := '';
- NewFormsDecl := '';
- NewFormsImpl := '';
- FBlocks := TList.Create;
-end;
-
-destructor TVFDFile.Destroy;
-begin
- FreeBlocks;
- FBlocks.Free;
- inherited;
-end;
-
-function TVFDFile.FindFormBlock(blockid, formname: string): TVFDFileBlock;
-var
- n: integer;
- fb: TVFDFileBlock;
-begin
- Result := nil;
- for n := 0 to BlockCount-1 do
- begin
- fb := Block(n);
- if (fb.BlockID = blockid) and (UpperCase(fb.FormName) = UpperCase(formname)) then
- begin
- Result := fb;
- Exit;
- end;
- end;
-end;
-
-procedure TVFDFile.FreeBlocks;
-var
- n: integer;
-begin
- for n := 0 to FBlocks.Count-1 do
- TVFDFileBlock(FBlocks[n]).Free;
- FBlocks.Clear;
- NewFormsDecl := '';
- NewFormsImpl := '';
-end;
-
-function TVFDFile.GetBlocks: integer;
-var
- n: integer;
-
- s: string;
-
- startp, endp: integer;
- formname: string;
- bname, startmarker, endmarker: string;
- datablock: string;
- deletelen: integer;
-
- dropmarker: boolean;
-begin
- FreeBlocks;
-
- FParsedData := FFileData;
-
- // searching blocks:
-
- repeat
-
- bname := '';
- formname := '';
- datablock := '';
-
- s := '{@VFD_';
- startp := pos(s, FParsedData);
- if startp > 0 then
- begin
- // marker found
- n := startp + 2;
- while (n < length(FParsedData)) and (FParsedData[n] in ['_', 'A'..'Z']) do
- begin
- bname := bname + FParsedData[n];
- Inc(n);
- end;
-
- if FParsedData[n] = ':' then
- Inc(n, 2);
-
- while (n < length(FParsedData)) and (FParsedData[n] <> '}') do
- begin
- formname := formname + FParsedData[n];
- Inc(n);
- end;
-
- startmarker := copy(FParsedData, startp, n - startp + 1);
- deletelen := length(startmarker);
- dropmarker := False;
-
-// Writeln('marker: ', startmarker);
-
- // block marker ?
-
- endmarker := '';
- if bname = 'VFD_HEAD_BEGIN' then //or (bname = 'VFD_BODY_BEGIN') then
- endmarker := '{@VFD_HEAD_END: ' + formname + '}'
- else if bname = 'VFD_BODY_BEGIN' then
- endmarker := '{@VFD_BODY_END: ' + formname + '}';
-
- if endmarker <> '' then
- begin
- //Writeln('Block: ',bname,' form: ',formname);
- // find the end of the block
- endp := pos(endmarker, FParsedData);
- if endp > 0 then
- begin
- //Writeln('end marker found.');
- datablock := copy(FParsedData, startp + length(startmarker), endp - startp - length(startmarker));
- //Writeln('data block:');
- //writeln(datablock);
- //writeln('.');
- deletelen := endp - startp + length(endmarker);
- end
- else
- dropmarker := True// error: end marker did not found
- //Writeln('file error: ',endmarker,' marker wasn''t found.');
- // block length = 0
- ;
- end;
-
- Delete(FParsedData, startp, deletelen);
-
- if not dropmarker then
- AddBlock(startp, bname, formname, datablock);
-
- end;
-
- until startp <= 0;
-
- //writeln(FParsedData);
-
- Result := BlockCount;
-end;
-
-function TVFDFile.LoadFile(fname: string): boolean;
-var
- ff: file;
- s: string;
- cnt: integer;
-begin
- Result := False;
- AssignFile(ff, fpgToOSEncoding(fname));
- try
- Reset(ff, 1);
- except
- Exit;
- end;
-
- FFileData := '';
- try
- while not EOF(ff) do
- begin
- SetLength(s, 4096);
- BlockRead(ff, s[1], length(s), cnt);
- FFileData := FFileData + copy(s, 1, cnt);
- if cnt < length(s) then
- break;
- end;
- Result := True;
- finally
- CloseFile(ff);
- end;
- //Writeln('data length: ',length(FFileData));
-end;
-
-function TVFDFile.MergeBlocks: string;
-var
- rs: string;
- n: integer;
- iofs, startp: integer;
- fb: TVFDFileBlock;
- startmarker, endmarker: string;
- iblock: string;
-
- newsaved: boolean;
-
-begin
- // Writeln('merging blocks: ');
- newsaved := False;
- rs := FParsedData;
- iofs := 0;
- for n := 0 to FBlocks.Count - 1 do
- begin
- fb := TVFDFileBlock(FBlocks[n]);
- startmarker := '{@' + fb.BlockID;
- if fb.formname <> '' then
- startmarker := startmarker + ': ' + fb.FormName;
- startmarker := startmarker + '}';
- if fb.BlockID = 'VFD_HEAD_BEGIN' then
- endmarker := ' {@VFD_HEAD_END: ' + fb.FormName + '}'
- else if fb.BlockID = 'VFD_BODY_BEGIN' then
- endmarker := ' {@VFD_BODY_END: ' + fb.FormName + '}'
- else
- endmarker := '';
-
- iblock := startmarker;
- if endmarker <> '' then
- iblock := iblock + LineEnding + fb.Data + endmarker;
-
- if fb.BlockID = 'VFD_NEWFORM_DECL' then
- iblock := NewFormsDecl + iblock
- else if fb.BlockID = 'VFD_NEWFORM_IMPL' then
- begin
- iblock := iblock + NewFormsImpl;
- newsaved := True;
- end;
-
- startp := fb.Position + iofs;
- insert(iblock, rs, startp);
- Inc(iofs, length(iblock));
- end;
-
- if not newsaved and (NewFormsImpl <> '') then
- rs := rs + NewFormsImpl; // do not loose new form data.
-
- Result := rs;
-end;
-
-procedure TVFDFile.NewFileSkeleton(unitname: string);
-begin
- FFileData :=
- 'unit ' + unitname + ';'+ LineEnding + LineEnding +
- '{$mode objfpc}{$H+}' + LineEnding + LineEnding +
- 'interface' + LineEnding + LineEnding +
- 'uses' + LineEnding +
- ' SysUtils, Classes, gfxbase, fpgfx, gui_edit, ' + LineEnding +
- ' gfx_widget, gui_form, gui_label, gui_button,' + LineEnding +
- ' gui_listbox, gui_memo, gui_combobox, gui_basegrid, gui_grid, ' + LineEnding +
- ' gui_dialogs, gui_checkbox, gui_tree, gui_trackbar, ' + LineEnding +
- ' gui_progressbar, gui_radiobutton, gui_tab, gui_menu,' + LineEnding +
- ' gui_panel, gui_popupcalendar, gui_gauge;' + LineEnding + LineEnding +
- 'type' + LineEnding + LineEnding +
- '{@VFD_NEWFORM_DECL}' + LineEnding + LineEnding +
- 'implementation' + LineEnding + LineEnding +
- '{@VFD_NEWFORM_IMPL}' + LineEnding + LineEnding +
- 'end.' + LineEnding;
-
- GetBlocks;
-end;
-
-procedure TVFDFile.SetFormData(formname, headblock, bodyblock: string);
-var
- fb: TVFDFileBlock;
-begin
- fb := FindFormBlock('VFD_HEAD_BEGIN', formname);
- if fb <> nil then
- fb.Data := HeadBlock
- else
- AddNewFormDecl(formname, headblock);
-
- fb := FindFormBlock('VFD_BODY_BEGIN', formname);
- if fb <> nil then
- fb.Data := bodyblock
- else
- AddNewFormImpl(formname, bodyblock);
-end;
-
-
-end.
-
generated by cgit v1.2.3-54-g00ecf (git 2.44.0) at 2024-08-19 06:02:47 +0000