* Moved the UI Designer from the examples/apps directory to the root directory.

* Updated some build scripts

1 files changed, 388 insertions, 0 deletions

diff --git a/uidesigner/vfdfile.pas b/uidesigner/vfdfile.pas
new file mode 100644
index 00000000..16910883
--- /dev/null
+++ b/uidesigner/vfdfile.pas
@@ -0,0 +1,388 @@
+{
+    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.
+