diff options
Diffstat (limited to 'examples/apps/uidesigner/vfdfile.pas')
-rw-r--r-- | examples/apps/uidesigner/vfdfile.pas | 388 |
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. - |