path: root/uidesigner/vfddesigner.pas

{
    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:
      A lot of the main code is here.
}


unit vfddesigner;

{$mode objfpc}{$H+}

interface

uses
  Classes,
  SysUtils,
  fpg_base,
  fpg_main,
  fpg_widget,
  fpg_form,
  fpg_dialogs,
  fpg_label,
  fpg_edit,
  fpg_button,
  fpg_listbox,
  fpg_memo,
  fpg_combobox,
  fpg_checkbox,
  fpg_menu,
  vfdresizer,
  vfdforms,
  vfdeditors,
  vfdwidgetclass,
  vfdwidgets,
  newformdesigner;

type

  TOtherWidget = class(TfpgWidget)
  protected
    FFont: TfpgFont;
    procedure   HandlePaint; override;
  public
    wgClassName: string;
    constructor Create(AOwner: TComponent); override;
  end;


  TFormDesigner = class;    // forward declaration


  TDesignedForm = class(TfpgForm)
  public
    procedure   AfterCreate; override;
  end;


  TWidgetDesigner = class(TObject)
  private
    procedure   SetSelected(const AValue: boolean);
  public
    FFormDesigner: TFormDesigner;
    FWidget: TfpgWidget;
    FVFDClass: TVFDWidgetClass;
    FSelected: boolean;
    resizer: array[1..8] of TwgResizer;
    other: TStringList;
    constructor Create(AFormDesigner: TFormDesigner; wg: TfpgWidget; wgc: TVFDWidgetClass);
    destructor  Destroy; override;
    property    Selected: boolean read FSelected write SetSelected;
    property    Widget: TfpgWidget read FWidget;
    procedure   UpdateResizerPositions;
    property    FormDesigner: TFormDesigner read FFormDesigner;
  end;


  TFormDesigner = class(TObject)
  protected
    FWidgets: TList;
    FForm: TDesignedForm;
    FFormOther: string;
    FDragging: boolean;
    FDragPosX,
    FDragPosY: TfpgCoord;
    FWasDrag: boolean;
  protected
    // messages of the designed widgets
    procedure   MsgMouseDown(var msg: TfpgMessageRec); message FPGM_MOUSEDOWN;
    procedure   MsgMouseUp(var msg: TfpgMessageRec); message FPGM_MOUSEUP;
    procedure   MsgMouseMove(var msg: TfpgMessageRec); message FPGM_MOUSEMOVE;
    procedure   MsgKeyPress(var msg: TfpgMessageRec); message FPGM_KEYPRESS;
    procedure   MsgMove(var msg: TfpgMessageRec); message FPGM_MOVE;
    procedure   MsgResize(var msg: TfpgMessageRec); message FPGM_RESIZE;
    procedure   MsgActivate(var msg: TfpgMessageRec); message FPGM_ACTIVATE;
    procedure   DesignerKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);
  public
    OneClickMove: boolean; // the widgets can be selected and dragged within one click
    constructor Create;
    destructor  Destroy; override;
    procedure   ClearForm;
    procedure   DefaultHandler(var msg); override;
    procedure   Show;
    function    AddWidget(wg: TfpgWidget; wgc: TVFDWidgetClass): TWidgetDesigner;
    function    WidgetDesigner(wg: TfpgWidget): TWidgetDesigner;
    function    FindWidgetByName(const wgname: string): TfpgWidget;
    procedure   DeSelectAll;
    procedure   SelectAll;
    procedure   SelectNextWidget(fw: boolean);
    procedure   MoveResizeWidgets(dx, dy, dw, dh: integer);
    procedure   DeleteWidgets;
    procedure   EditWidgetOrder;
    procedure   EditTabOrder;
    procedure   InsertWidget(pwg: TfpgWidget; x, y: integer; wgc: TVFDWidgetClass);
    procedure   UpdatePropWin;
    procedure   OnPropTextChange(Sender: TObject);
    procedure   OnPropNameChange(Sender: TObject);
    procedure   OnPropPosEdit(Sender: TObject);
    procedure   OnOtherChange(Sender: TObject);
    procedure   OnAnchorChange(Sender: TObject);
    procedure   OnEditWidget(Sender: TObject);
    function    GenerateNewName(namebase: string): string;
    procedure   RunWidgetEditor(wgd: TWidgetDesigner; wg: TfpgWidget);
    function    GetFormSourceDecl: string;
    function    GetFormSourceImpl: string;
    function    GetWidgetSourceImpl(wd: TWidgetDesigner; ident: string): string;
    property    Form: TDesignedForm read FForm;
    property    FormOther: string read FFormOther write FFormOther;
  end;


implementation

uses
  vfdmain,
  TypInfo,
  fpg_tab;


{ TWidgetDesigner }

procedure TWidgetDesigner.SetSelected(const AValue: boolean);
var
  n: integer;
begin
  if FSelected = AValue then
    Exit;
  FSelected := AValue;

  if FSelected then
    Widget.MouseCursor := mcMove
  else
    Widget.MouseCursor := mcDefault;

  for n := 1 to 8 do
    if FSelected then
      resizer[n] := TwgResizer.Create(self, n)
    else
    begin
      if resizer[n] <> nil then
        resizer[n].Free;
      resizer[n] := nil;
    end;

  UpdateResizerPositions;

  if FSelected and Widget.Parent.HasHandle then
    for n := 1 to 8 do
      resizer[n].Show;
end;

constructor TWidgetDesigner.Create(AFormDesigner: TFormDesigner; wg: TfpgWidget; wgc: TVFDWidgetClass);
var
  n: integer;
begin
  FFormDesigner := AFormDesigner;
  FWidget       := wg;
  FVFDClass     := wgc;
  for n := 1 to 8 do
    resizer[n] := nil;
  FSelected := False;
  wg.MouseCursor := mcDefault;
  other := TStringList.Create;
end;

destructor TWidgetDesigner.Destroy;
var
  n: integer;
begin
  for n := 1 to 8 do
    if resizer[n] <> nil then
      resizer[n].Free;
  other.Free;
  inherited Destroy;
end;

procedure TWidgetDesigner.UpdateResizerPositions;
var
  n: integer;
  rs: TwgResizer;
begin
  if not FSelected then
    Exit;

  for n := 1 to 8 do
  begin
    rs := resizer[n];

    if rs <> nil then
    begin
      case n of
        1:
        begin
          rs.left := Widget.left - 2;
          rs.Top  := Widget.Top - 2;
        end;
        2:
        begin
          rs.Top  := Widget.Top - 2;
          rs.left := Widget.left + Widget.Width div 2 - 2;
        end;
        3:
        begin
          rs.Top  := Widget.Top - 2;
          rs.left := Widget.left + Widget.Width - 1 - 2;
        end;
        4:
        begin
          rs.Top  := Widget.Top + Widget.Height div 2 - 2;
          rs.left := Widget.left + Widget.Width - 1 - 2;
        end;
        5:
        begin
          rs.Top  := Widget.Top + Widget.Height - 1 - 2;
          rs.left := Widget.left + Widget.Width - 1 - 2;
        end;
        6:
        begin
          rs.Top  := Widget.Top + Widget.Height - 1 - 2;
          rs.left := Widget.left + Widget.Width div 2 - 2;
        end;
        7:
        begin
          rs.Top  := Widget.Top + Widget.Height - 1 - 2;
          rs.left := Widget.left - 2;
        end;
        8:
        begin
          rs.Top  := Widget.Top + Widget.Height div 2 - 2;
          rs.left := Widget.left - 2;
        end;
      end; // case
      if rs.HasHandle then
        rs.UpdateWindowPosition;
    end;
  end;

end;

{ TFormDesigner }

procedure TFormDesigner.MsgMouseDown(var msg: TfpgMessageRec);
var
  wgd: TWidgetDesigner;
  shift: boolean;
begin
//  writeln('TFormDesigner.MsgMouseDown');
  msg.Stop  := True;
  FDragging := True;
  FWasDrag  := False;
  FDragPosX := msg.Params.mouse.x;
  FDragPosy := msg.Params.mouse.y;

  if msg.dest = FForm then
    Exit;

  wgd := WidgetDesigner(TfpgWidget(msg.dest));
  if wgd = nil then
    Exit;

  if not OneClickMove then
    Exit; // this Exit disables one click move

  shift := (ssShift in msg.Params.mouse.shiftstate);

  if shift then
    Exit;

  if not wgd.Selected then
  begin
    DeSelectAll;
    wgd.Selected := True;
    UpdatePropWin;
  end;
end;

procedure TFormDesigner.MsgMouseUp(var msg: TfpgMessageRec);
var
  wgd: TWidgetDesigner;
  wgc: TVFDWidgetClass;
  pwg: TfpgWidget;
  shift: boolean;
  x, y: integer;
  pmenu: TfpgPopupMenu;
begin
//  writeln('TFormDesigner.MsgMouseUp');
  msg.Stop  := True;
  FDragging := False;

  shift := (ssShift in msg.Params.mouse.shiftstate);

  wgc := frmMain.SelectedWidget;
  pwg := TfpgWidget(msg.dest);
  wgd := WidgetDesigner(TfpgWidget(msg.dest));
  if wgd = nil then
    pwg := FForm
  else if not wgd.FVFDClass.Container then
    wgc := nil;

  if wgc <> nil then
  begin
    DeSelectAll;

    if wgc <> nil then
    begin
      x := msg.Params.mouse.x;
      y := msg.Params.mouse.y;

      if maindsgn.GridResolution > 1 then
      begin
        x := x - x mod maindsgn.GridResolution;
        y := y - y mod maindsgn.GridResolution;
      end;

      InsertWidget(pwg, x, y, wgc);

      if not shift then
      begin
        FForm.MouseCursor      := mcDefault;
        frmMain.SelectedWidget := nil;
      end;
    end;
  end
  else
  begin
    wgd := WidgetDesigner(TfpgWidget(msg.dest));
    if wgd = nil then
    begin
      DeSelectAll;
      UpdatePropWin;
      Exit;
    end;

    if not shift then
    begin
      if not wgd.Selected then
        DeSelectAll;
      wgd.Selected := True;
    end
    else
      wgd.Selected := not wgd.Selected;
  end;

  UpdatePropWin;

  if msg.Params.mouse.Buttons = 3 then {right mouse button }
  begin
    if TfpgWidget(msg.Dest).ClassType = TfpgPageControl then
    begin
      writeln('Right click on page control');
      wgd := WidgetDesigner(TfpgWidget(msg.dest));
      if wgd <> nil then
        pmenu := wgd.FVFDClass.CreatePopupMenu(TfpgWidget(msg.dest));
        if Assigned(pmenu) then
          pmenu.ShowAt(wgd.Widget, msg.Params.mouse.x, msg.Params.mouse.y);
    end;
  end;
end;

procedure TFormDesigner.MsgMouseMove(var msg: TfpgMessageRec);
var
  dx, dy: integer;
  wgd: TWidgetDesigner;
begin
  msg.Stop  := True;
  if not FDragging then
    Exit;

  FWasDrag := True;

  dx := msg.Params.mouse.x - FDragPosX;
  dy := msg.Params.mouse.y - FDragPosY;

  wgd := WidgetDesigner(TfpgWidget(msg.dest));
  if (wgd = nil) or (not wgd.Selected) then
    Exit;

  if maindsgn.GridResolution > 1 then
  begin
    dx := dx - (dx mod maindsgn.GridResolution);
    dy := dy - (dy mod maindsgn.GridResolution);
  end;

  MoveResizeWidgets(dx, dy, 0, 0);
end;

procedure TFormDesigner.MsgKeyPress(var msg: TfpgMessageRec);
var
  key: word;
  ss: TShiftState;
  consumed: boolean;
begin
  key := msg.params.keyboard.keycode;
  ss  := msg.params.keyboard.shiftstate;

  msg.Stop := True;
  consumed := False;

  DesignerKeyPress(key, ss, consumed);
end;

procedure TFormDesigner.MsgMove(var msg: TfpgMessageRec);
begin
  if msg.dest = FForm then
    UpdatePropWin;
  msg.Stop  := True;
end;

procedure TFormDesigner.MsgResize(var msg: TfpgMessageRec);
begin
  msg.Stop := True;
  if msg.dest = FForm then
  begin
    DeSelectAll; // because of the anchorings
    UpdatePropWin;
  end;
end;

constructor TFormDesigner.Create;
begin
  FWidgets := TList.Create;
  FWasDrag := False;

  OneClickMove := True;

  FForm               := TDesignedForm.Create(nil);
  FForm.FormDesigner  := self;
  FForm.Name          := maindsgn.NewFormName;
  FForm.WindowTitle   := FForm.Name;
  FFormOther          := '';
end;

destructor TFormDesigner.Destroy;
var
  n: integer;
begin
  for n := 0 to FWidgets.Count - 1 do
    TObject(FWidgets.Items[n]).Free;
  FWidgets.Free;

  if FForm <> nil then
    FForm.Free;
  inherited Destroy;
end;

procedure TFormDesigner.ClearForm;
var
  n: integer;
begin
  for n := 0 to FWidgets.Count - 1 do
  begin
    TWidgetDesigner(FWidgets.Items[n]).Widget.Free;
    TObject(FWidgets.Items[n]).Free;
  end;
  FWidgets.Clear;
end;

procedure TFormDesigner.DefaultHandler(var msg);
begin
  //Writeln('Designer message: ',TMessageRec(msg).msgcode,' from ',TMessageRec(msg).dest.ClassName);
end;

procedure TFormDesigner.Show;
begin
  FForm.Show;
  UpdatePropWin;
end;

function TFormDesigner.AddWidget(wg: TfpgWidget; wgc: TVFDWidgetClass): TWidgetDesigner;
var
  cd: TWidgetDesigner;
begin
//  writeln('TFormDesigner.AddWidget');
  cd     := TWidgetDesigner.Create(self, wg, wgc);
  FWidgets.Add(cd);
  //cd.Selected := true;
  if wg is TDesignedForm then
    TDesignedForm(wg).FormDesigner := self;
  Result := cd;
end;

function TFormDesigner.WidgetDesigner(wg: TfpgWidget): TWidgetDesigner;
var
  n: integer;
  cd: TWidgetDesigner;
begin
  Result := nil;
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Widget = wg then
    begin
      Result := cd;
      Exit;
    end;
  end;
end;

procedure TFormDesigner.DeSelectAll;
var
  n: integer;
  cd: TWidgetDesigner;
begin
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd          := TWidgetDesigner(FWidgets.Items[n]);
    cd.Selected := False;
  end;
end;

procedure TFormDesigner.SelectAll;
var
  n: integer;
  cd: TWidgetDesigner;
begin
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd          := TWidgetDesigner(FWidgets.Items[n]);
    cd.Selected := True;
  end;
end;

procedure TFormDesigner.SelectNextWidget(fw: boolean);
var
  n, dir: integer;
  cd, scd: TWidgetDesigner;
begin
  if FWidgets.Count = 0 then
    Exit;

  if fw then
  begin
    n   := 0;
    dir := 1;
  end
  else
  begin
    dir := -1;
    n   := FWidgets.Count - 1;
  end;

  scd := TWidgetDesigner(FWidgets.Items[n]);

  while (n >= 0) and (n < FWidgets.Count) do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Selected then
    begin
      if fw then
      begin
        if n < FWidgets.Count - 1 then
          scd := TWidgetDesigner(FWidgets.Items[n + 1]);
      end
      else if n > 0 then
        scd := TWidgetDesigner(FWidgets.Items[n - 1]);
      break;
    end;
    n := n + dir;
  end;
  DeSelectAll;
  scd.Selected := True;
  UpdatePropWin;
end;

procedure TFormDesigner.MoveResizeWidgets(dx, dy, dw, dh: integer);
var
  n: integer;
  cd: TWidgetDesigner;
begin
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Selected then
    begin
//      if maindsgn.GridResolution > 1 then;
      cd.Widget.MoveAndResizeBy(dx, dy, dw, dh);
      cd.UpdateResizerPositions;
    end;
  end;
  UpdatePropWin;
end;

procedure TFormDesigner.DeleteWidgets;
var
  n: integer;
  cd: TWidgetDesigner;
begin
  n := 0;
  while n < FWidgets.Count do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Selected then
    begin
      cd.Widget.Free;
      cd.Free;
      FWidgets.Delete(n);
    end
    else
      Inc(n);
  end;
  UpdatePropWin;
end;


procedure TFormDesigner.EditWidgetOrder;
var
  frm: TWidgetOrderForm;
  n, fi: integer;
  cd: TWidgetDesigner;
  identlevel: integer;

  procedure AddChildWidgets(pwg: TfpgWidget; slist: TStrings);
  var
    f: integer;
    fcd: TWidgetDesigner;
  begin
    for f := 0 to FWidgets.Count - 1 do
    begin
      fcd := TWidgetDesigner(FWidgets.Items[f]);

      if fcd.Widget.Parent = pwg then
      begin
        frm.list.Items.AddObject(StringOfChar(' ', identlevel) + fcd.Widget.Name + ' : ' + fcd.Widget.ClassName, fcd);
        Inc(identlevel);
        AddChildWidgets(fcd.Widget, slist);
        Dec(identlevel);
      end;

      if fcd.Selected then
        fi := f + 1;
    end;
  end;

begin
  frm := TWidgetOrderForm.Create(nil);
  fi  := 1;

  identlevel := 0;

  AddChildWidgets(FForm, frm.list.Items);

  if fi <= frm.list.ItemCount then
    frm.list.FocusItem := fi;

  if frm.ShowModal = 1 then
  begin
    for n := 0 to FWidgets.Count - 1 do
      TWidgetDesigner(FWidgets.Items[n]).Widget.Visible := False;

    for n := 0 to FWidgets.Count - 1 do
      FWidgets.Items[n] := frm.List.Items.Objects[n];

    for n := 0 to FWidgets.Count - 1 do
    begin
      cd := TWidgetDesigner(FWidgets.Items[n]);
      cd.Widget.Visible := True;
    end;

    for n := 0 to FWidgets.Count - 1 do
    begin
      cd := TWidgetDesigner(FWidgets.Items[n]);
      if cd.Selected then
      begin
        // re-creating the resizers
        cd.Selected := False;
        cd.Selected := True;
      end;
    end;

  end;
  frm.Free;
end;

procedure TFormDesigner.EditTabOrder;
const
  cDivider = ' : ';
var
  frm: TWidgetOrderForm;
  n, fi: integer;
  cd: TWidgetDesigner;
  identlevel: integer;
  taborder: integer;

  procedure AddChildWidgets(pwg: TfpgWidget; slist: TStrings);
  var
    f: integer;
    fcd: TWidgetDesigner;
  begin
    for f := 0 to FWidgets.Count - 1 do
    begin
      fcd := TWidgetDesigner(FWidgets.Items[f]);

      if fcd.Widget.Parent = pwg then
      begin
        frm.list.Items.AddObject(StringOfChar(' ', identlevel) + fcd.Widget.Name + cDivider + fcd.Widget.ClassName, fcd);
        Inc(identlevel, 2);
        AddChildWidgets(fcd.Widget, slist);
        Dec(identlevel, 2);
      end;

      if fcd.Selected then
        fi := f + 1;
    end;
  end;

begin
  frm := TWidgetOrderForm.Create(nil);
  frm.WindowTitle := 'Tab Order';
  fi  := 1;
  identlevel := 0;

  AddChildWidgets(FForm, frm.list.Items);

  if fi <= frm.list.ItemCount then
    frm.list.FocusItem := fi;

  if frm.ShowModal = 1 then
  begin
    taborder := 1;
    for n := 0 to frm.List.Items.Count - 1 do
    begin
        try
          if IsPublishedProp(TWidgetDesigner(frm.List.Items.Objects[n]).Widget, 'TabOrder') then
          begin
//            SetPropValue(TWidgetDesigner(frm.List.Items.Objects[n]).Widget, 'TabOrder', taborder);
            TWidgetDesigner(frm.List.Items.Objects[n]).Widget.TabOrder := taborder;
            inc(taborder);
          end;
        except
          // do nothing. TabOrder was not published
        end;
    end;
  end;  { if }
  frm.Free;
end;

procedure TFormDesigner.DesignerKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);
var
  dx,
  dy: integer;
begin
  dx       := 0;
  dy       := 0;
  consumed := True;

  case keycode of
    keyLeft:    dx := -1;
    keyRight:   dx := +1;
    keyUp:      dy := -1;
    keyDown:    dy := +1;

    keyDelete: DeleteWidgets;

    keyTab:
        begin
          if ssShift in shiftstate then
            SelectNextWidget(False) // tab backwards
          else
            SelectNextWidget(True); // tab forward
        end;

    keyF1:
      ShowMessage('F11: switch to Properties' + LineEnding +
        'TAB, SHIFT+TAB: select next widget' + LineEnding +
        'F2: edit widget order' + LineEnding {+
        'F4: edit items' + LineEnding}, 'Small help');

    keyF2:
      EditWidgetOrder;

    //keyF4:
      //if frmProperties.btnEdit.Visible then
        //frmProperties.btnEdit.Click;

    keyF11:
      begin
        frmProperties.SetFocus;
        frmProperties.ActivateWindow;
      end;
    else
      consumed := False;
  end;

  if (dx <> 0) or (dy <> 0) then
    if (ssShift in shiftstate) then
      MoveResizeWidgets(0, 0, dx, dy)
    else
      MoveResizeWidgets(dx, dy, 0, 0);
end;

procedure TFormDesigner.UpdatePropWin;
var
  n, i: integer;
  cd, scd: TWidgetDesigner;
  wg: TfpgWidget;

  wgcnt: integer;
  //btxt  : boolean;
  //bedit : boolean;

  lastpropname: string;

  wgc: TVFDWidgetClass;
begin
  wgcnt := 0;
  wg    := FForm;
  wgc   := VFDFormWidget;
  scd   := nil;
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Selected then
    begin
      Inc(wgcnt);
      if wgcnt < 2 then
      begin
        wg  := cd.Widget;
        scd := cd;
      end;
    end;
  end;

  if scd <> nil then
    wgc := scd.FVFDClass;

  n := frmProperties.lstProps.FocusItem;
  if (n >= 0) and (PropList.GetItem(n) <> nil) then
    lastpropname := PropList.GetItem(n).Name
  else
    lastpropname := '';

  i := -1;

  if PropList.Widget <> wg then
  begin
    frmProperties.lstProps.ReleaseEditor;
    PropList.Clear;
    for n := 0 to wgc.PropertyCount-1 do
    begin
      PropList.AddItem(wgc.GetProperty(n));
      if UpperCase(wgc.GetProperty(n).Name) = UpperCase(lastPropName) then
        i := n;
    end;
    PropList.Widget := wg;
    frmProperties.lstProps.Update;
    if i > -1 then
      frmProperties.lstProps.FocusItem := i;
  end;

  with frmProperties do
  begin
    if wg is TOtherWidget then
      lbClass.Text := TOtherWidget(wg).wgClassName
    else
      lbClass.Text := wg.ClassName;
    edName.Text := wg.Name;

    if scd <> nil then
      edOther.Text := scd.other.Text
    else
      edOther.Text := FFormOther;

    edName.Visible  := (wgcnt < 2);
    edOther.Visible := (wgcnt < 2);

    lstProps.Update;
  end;

  with frmProperties do
  begin
    btnLeft.Text    := IntToStr(wg.Left);
    btnTop.Text     := IntToStr(wg.Top);
    btnWidth.Text   := IntToStr(wg.Width);
    btnHeight.Text  := IntToStr(wg.Height);

    btnAnLeft.Down   := anLeft in wg.Anchors;
    btnAnTop.Down    := anTop in wg.Anchors;
    btnAnRight.Down  := anRight in wg.Anchors;
    btnAnBottom.Down := anBottom in wg.Anchors;
  end;
end;

procedure TFormDesigner.OnPropTextChange(Sender: TObject);
{
var
  n : integer;
  cd : TWidgetDesigner;
  wg : TWidget;
  s : string16;
}
begin
  {
  s := PropertyForm.edText.Text;
  wg := nil;
  for n:=0 to FWidgets.Count-1 do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Selected then
    begin
      wg := cd.Widget;
      SetWidgetText(wg,s);
      if wg is TwgLabel then
      with TwgLabel(wg) do
      begin
        if Font.TextWidth16(Text) > width then
        begin
          Width := Font.TextWidth16(Text);
          UpdateWindowPosition;
          cd.UpdateResizerPositions;
        end;
      end;
    end;
  end;

  if wg = nil then
  begin
    FForm.WindowTitle := s;
  end;
}
end;

procedure TFormDesigner.OnPropNameChange(Sender: TObject);
var
  n: integer;
  cd: TWidgetDesigner;
  wg: TfpgWidget;
  s: string;
begin
  //  writeln('namechange');
  s := frmProperties.edName.Text;
  wg := nil;
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Selected then
      wg := cd.Widget;
{
      if GetWidgetText(wg,s) and (wg.Name = str16to8(s)) then
      begin
        PropertyForm.edText.Text8 := s8;
        OnPropTextChange(sender);
      end;
}
  end;

  if wg = nil then
    wg := FForm{
    if FForm.Name = FForm.WindowTitle8 then
    begin
      FForm.WindowTitle8 := s8;
      PropertyForm.edText.Text8 := s8;
    end;
};

  try
    wg.Name := s;
  except
    // invalid name...
  end;
end;

procedure TFormDesigner.OnPropPosEdit(Sender: TObject);
var
  frm: TEditPositionForm;
  wg: TfpgWidget;
  n: integer;
  cd: TWidgetDesigner;
  posval: integer;

  procedure SetNewPos(awg: TfpgWidget; pval: integer);
  begin
    if Sender = frmProperties.btnLeft then
      awg.Left   := pval
    else if Sender = frmProperties.btnTop then
      awg.Top    := pval
    else if Sender = frmProperties.btnWidth then
      awg.Width  := pval
    else if Sender = frmProperties.btnHeight then
      awg.Height := pval;
  end;

begin
  wg := nil;
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Selected then
    begin
      wg := cd.Widget;
      break;
    end;
  end;

  if wg = nil then
    wg := Form;

  frm := TEditPositionForm.Create(nil);

  if Sender = frmProperties.btnLeft then
  begin
    frm.lbPos.Text := 'Left:';
    frm.edPos.Text := IntToStr(wg.Left);
  end
  else if Sender = frmProperties.btnTop then
  begin
    frm.lbPos.Text := 'Top:';
    frm.edPos.Text := IntToStr(wg.Top);
  end
  else if Sender = frmProperties.btnWidth then
  begin
    frm.lbPos.Text := 'Width:';
    frm.edPos.Text := IntToStr(wg.Width);
  end
  else if Sender = frmProperties.btnHeight then
  begin
    frm.lbPos.Text := 'Height:';
    frm.edPos.Text := IntToStr(wg.Height);
  end;

  posval := -9999;
  if frm.ShowModal = 1 then
    posval := StrToIntDef(frm.edPos.Text, -9999);
  frm.Free;

  if posval > -999 then
  begin
    wg := nil;
    for n := 0 to FWidgets.Count - 1 do
    begin
      cd := TWidgetDesigner(FWidgets.Items[n]);
      if cd.Selected then
      begin
        wg := cd.Widget;
        SetNewPos(wg, posval);
        wg.UpdateWindowPosition;
        cd.UpdateResizerPositions;
      end;
    end;

    if wg = nil then
    begin
      SetNewPos(FForm, posval);
      FForm.UpdateWindowPosition;
    end;
  end; { if }

  UpdatePropWin;
end;

procedure TFormDesigner.OnOtherChange(Sender: TObject);
var
  n: integer;
  cd: TWidgetDesigner;
  s: string;
  sc: integer;
begin
  sc := 0;
  s  := frmProperties.edOther.Text;
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Selected then
    begin
      cd.other.Text := s;
      Inc(sc);
    end;
  end;

  if sc < 1 then
    FFormOther := s;
end;

procedure TFormDesigner.OnAnchorChange(Sender: TObject);
var
  n: integer;
  cd: TWidgetDesigner;
  wg: TfpgWidget;
begin
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Selected then
    begin
      wg := cd.Widget;

      wg.Anchors := [];
      if frmProperties.btnAnLeft.Down then
        wg.Anchors := wg.Anchors + [anLeft];
      if frmProperties.btnAnTop.Down then
        wg.Anchors := wg.Anchors + [anTop];
      if frmProperties.btnAnRight.Down then
        wg.Anchors := wg.Anchors + [anRight];
      if frmProperties.btnAnBottom.Down then
        wg.Anchors := wg.Anchors + [anBottom];
    end;
  end;
end;

function TFormDesigner.GenerateNewName(namebase: string): string;
var
  nind, n: integer;
  cd: TWidgetDesigner;
  newname: string;
  bok: boolean;
begin
  nind := 1;
  repeat
    newname := namebase + IntToStr(nind);
    bok := True;
    for n := 0 to FWidgets.Count - 1 do
    begin
      cd := TWidgetDesigner(FWidgets.Items[n]);
      if cd.Widget.Name = newname then
      begin
        bok := False;
        break;
      end;
    end;
    Inc(nind);
  until bok;
  Result := newname;
end;


procedure TFormDesigner.MsgActivate(var msg: TfpgMessageRec);
begin
  msg.Stop := True;
  maindsgn.SelectForm(self);
end;

function TFormDesigner.GetFormSourceDecl: string;
var
  n: integer;
  wd: TWidgetDesigner;
  wgclass: string;
begin
  Result := '';
  for n := 0 to FWidgets.Count - 1 do
  begin
    wd := TWidgetDesigner(FWidgets.Items[n]);
    if wd.Widget is TOtherWidget then
      wgclass := TOtherWidget(wd.Widget).wgClassName
    else
      wgclass := wd.Widget.ClassName;
    Result := Result + '    ' + wd.Widget.Name + ': ' + wgclass + ';' + LineEnding;
  end;
end;

function TFormDesigner.GetFormSourceImpl: string;
var
  s: TfpgString;
  sl: TStringList;
  n: integer;
  wd: TWidgetDesigner;
  wg: TfpgWidget;
  wgclass, pwgname: string;

  t: TfpgString;
  i: integer;
  PropInfo: PPropInfo;
begin
  s := '';

  if maindsgn.SaveComponentNames then
    s := s + '  Name := ' + QuotedStr(FForm.Name) + ';' + LineEnding;

  s := s + '  SetPosition('
      + IntToStr(FForm.Left) + ', '
      + IntToStr(FForm.Top) + ', '
      + IntToStr(FForm.Width) + ', '
      + IntToStr(FForm.Height) + ');' + LineEnding;

{
  // Extend this and the Form Parser to handle WindowPosition, Width and Height
  case FForm.WindowPosition of
    wpUser:
        begin
          s := s + '  SetPosition('
              + IntToStr(FForm.Left) + ', '
              + IntToStr(FForm.Top) + ', '
              + IntToStr(FForm.Width) + ', '
              + IntToStr(FForm.Height) + ');' + LineEnding;
        end;
    else
        begin
          s := s + 'WindowPosition := wpScreenCenter;' + LineEnding;
          s := s + 'Width := ' + IntToStr(FForm.Width) + ';' + LineEnding
              + 'Height := ' + IntToStr(FForm.Height) + ';' + LineEnding;
        end;
  end;
}
  s := s + '  WindowTitle := ' + QuotedStr(FForm.WindowTitle) + ';' + LineEnding;

  // ShowHint property - This is ugly, Form's properties or not handled well!!
  PropInfo := GetPropInfo(FForm.ClassType, 'ShowHint');
  i := GetOrdProp(FForm, 'ShowHint');
  if IsStoredProp(FForm, PropInfo) then
  begin
    if PropInfo^.Default <> i then
    begin
      if i = 1 then
        t := 'True'
      else
        t := 'False';
      s := s + '  ShowHint := ' + t + ';' + LineEnding;
    end;
  end;

  //adding other form properties, idented
  sl      := TStringList.Create;
  sl.Text := FFormOther;
  for n := 0 to sl.Count - 1 do
    s := s + '  ' + sl.Strings[n] + LineEnding;
  sl.Free;

  s := s + LineEnding;

  // FORM WIDGETS

  for n := 0 to FWidgets.Count - 1 do
  begin
    wd := TWidgetDesigner(FWidgets.Items[n]);
    wg := wd.Widget;
    if wg.Parent = FForm then
      pwgname := 'self'
    else
      pwgname := wg.Parent.Name;
    if wg is TOtherWidget then
      wgclass := TOtherWidget(wg).wgClassName
    else
      wgclass := wg.ClassName;

    s := s + '  ' + wg.Name + ' := ' + wgclass + '.Create(' + pwgname + ');' + LineEnding +
      '  with ' + wg.Name + ' do' + LineEnding + '  begin' + LineEnding + GetWidgetSourceImpl(wd, '    ') +
      '  end;' + LineEnding + LineEnding;
  end;

  Result := s;
end;

function TFormDesigner.GetWidgetSourceImpl(wd: TWidgetDesigner; ident: string): string;
var
  ts, cs: string;
  s: string;
  wg: TfpgWidget;
  wgc: TVFDWidgetClass;
  n: integer;

  procedure SaveItems(Name: string; sl: TStringList);
  var
    f: integer;
  begin
    for f := 0 to sl.Count - 1 do
      s := s + ident + Name + '.Add(' + QuotedStr(sl.Strings[f]) + ');' + LineEnding;
  end;

  {  procedure SaveColumns(grid : TwgDBGrid);
  var
    f : integer;
    c : TDBColumn;
    alstr : string;
  begin
    for f := 0 to grid.ColumnCount - 1 do
    begin
      c := grid.Columns[f];
      case c.Alignment of
      alRight  : alstr := 'alRight';
      alCenter : alstr := 'alCenter';
      else
        alstr := 'alLeft';
      end;
      s := s + ident + 'AddColumn8('+QuotedStr(u16u8safe(c.Title))+','+QuotedStr(c.FieldName8)
                +','+IntToStr(c.Width)+','+alstr+');'#10;
    end;
  end;
}
begin
  wg  := wd.Widget;
  wgc := wd.FVFDClass;
  s   := '';

  if maindsgn.SaveComponentNames then
    s := s + ident + 'Name := ' + QuotedStr(wg.Name) + ';' + LineEnding;

  s := s + ident + 'SetPosition('
      + IntToStr(wg.Left) + ', '
      + IntToStr(wg.Top) + ', '
      + IntToStr(wg.Width) + ', '
      + IntToStr(wg.Height) + ');' + LineEnding;

  if wg.Anchors <> [anLeft, anTop] then
  begin
    ts := '[';
    cs := '';
    if anLeft in wg.Anchors then
    begin
      ts := ts + cs + 'anLeft';
      cs := ',';
    end;
    if anRight in wg.Anchors then
    begin
      ts := ts + cs + 'anRight';
      cs := ',';
    end;
    if anTop in wg.Anchors then
    begin
      ts := ts + cs + 'anTop';
      cs := ',';
    end;
    if anBottom in wg.Anchors then
    begin
      ts := ts + cs + 'anBottom';
      cs := ',';
    end;
    ts := ts + '];';
    s := s + ident + 'Anchors := ' + ts + LineEnding;
  end;

  for n := 0 to wgc.PropertyCount-1 do
    s := s + wgc.GetProperty(n).GetPropertySource(wg, ident);

  {
  if wg is TwgMemo then
  begin
    SaveItems('Lines',TwgMemo(wg).Lines);
  end
  else if wg is TwgChoiceList then
  begin
    SaveItems('Items',TwgChoiceList(wg).Items);
  end
  else if wg is TwgTextListBox then
  begin
    SaveItems('Items',TwgTextListBox(wg).Items);
  end
  else if wg is TwgDBGrid then
  begin
    SaveColumns(TwgDBGrid(wg));
  end
  else
    if GetWidgetText(wg, ts) then
    begin
      s := s + ident + 'Text := u8('+QuotedStr(u8encode(ts))+');'#10;  // encoding with all printable characters
    end;
}

  for n := 0 to wd.other.Count - 1 do
    if trim(wd.other.Strings[n]) <> '' then
      s := s + ident + wd.other.Strings[n] + LineEnding;

  Result := s;
end;

procedure TFormDesigner.OnEditWidget(Sender: TObject);
var
  n: integer;
  cd: TWidgetDesigner;
  wg: TfpgWidget;
begin
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if cd.Selected then
    begin
      wg := cd.Widget;

      // Running widget editor;
      RunWidgetEditor(cd, wg);

      Exit;
    end;
  end;
end;

procedure EditItems(sl: TStringList);
var
  frmie: TItemEditorForm;
  //ax,ay : integer;
begin
  frmie := TItemEditorForm.Create(nil);
  //GfxGetAbsolutePosition(PropertyForm.btnEdit.WinHandle, PropertyForm.btnEdit.width, 0, ax,ay);
  //frmie.Left := ax;
  //frmie.Top := ay;

  frmie.edItems.Lines.Assign(sl);
  if frmie.ShowModal = 1 then
  begin
//    Writeln('OK');
    sl.Assign(frmie.edItems.Lines);
  end;
  frmie.Free;
end;

procedure TFormDesigner.RunWidgetEditor(wgd: TWidgetDesigner; wg: TfpgWidget);
begin
  if wg is TfpgMemo then
  begin
    EditItems(TfpgMemo(wg).Lines);
    wg.Invalidate;
  end
  else if wg is TfpgComboBox then
  begin
    EditItems(TfpgComboBox(wg).Items);
    wg.Invalidate;
  end
  else if wg is TfpgListBox then
  begin
    EditItems(TfpgListBox(wg).Items);
    wg.Invalidate;
  end;
end;

procedure TFormDesigner.InsertWidget(pwg: TfpgWidget; x, y: integer; wgc: TVFDWidgetClass);
var
  cfrm: TInsertCustomForm;
  newname, newclassname: string;
  wg: TfpgWidget;
  wgd: TWidgetDesigner;
begin
//  writeln('TFormDesigner.InsertWidget');
  if wgc = nil then
    Exit;

  newname := '';

  if wgc.WidgetClass = TOtherWidget then
  begin
    newclassname := '';
    cfrm         := TInsertCustomForm.Create(nil);
    cfrm.edName.Text := GenerateNewName(wgc.NameBase);
    cfrm.edClass.Text := 'Tfpg';
    if cfrm.ShowModal = 1 then
    begin
      newname      := cfrm.edName.Text;
      newClassName := cfrm.edClass.Text;
    end;
    cfrm.Free;
    if (newname = '') or (newclassname = '') then
      Exit;
  end;

  wg := wgc.CreateWidget(pwg);
  if wg <> nil then
  begin
    wg.FormDesigner := self;
    if newname = '' then
      newname := GenerateNewName(wgc.NameBase);
    wg.Name := newname;
    if wgc.WidgetClass = TOtherWidget then
      TOtherWidget(wg).wgClassName := newclassname;
    wgd          := AddWidget(wg, wgc);
    wg.Visible   := True;
    wg.SetPosition(x, y, wg.Width, wg.Height);
    DeSelectAll;
    wgd.Selected := True;
    UpdatePropWin;
  end;
end;

function TFormDesigner.FindWidgetByName(const wgname: string): TfpgWidget;
var
  n: integer;
  wgnameuc: string;
  cd: TWidgetDesigner;
begin
  wgnameuc := UpperCase(wgname);
  Result   := nil;
  for n := 0 to FWidgets.Count - 1 do
  begin
    cd := TWidgetDesigner(FWidgets.Items[n]);
    if UpperCase(cd.Widget.Name) = wgnameuc then
    begin
      Result := cd.Widget;
      Exit;
    end;
  end;
end;

{ TDesignedForm }

procedure TDesignedForm.AfterCreate;
begin
  inherited AfterCreate;
  WindowPosition := wpUser;
  WindowTitle := 'New Form';
  SetPosition(300, 150, 300, 250);
end;


{ TOtherWidget }

procedure TOtherWidget.HandlePaint;
var
  s: string;
begin
  Canvas.Clear(FBackgroundColor);
  Canvas.SetFont(FFont);
  Canvas.SetColor(clWidgetFrame);
  Canvas.DrawRectangle(0, 0, Width, Height);
  Canvas.SetTextColor(clText1);
  s := Name + ': ' + wgClassName;
  Canvas.DrawString(2, 2, s);
end;

constructor TOtherWidget.Create(AOwner: TComponent);
begin
  inherited;
  wgClassName := 'TfpgWidget';
  FBackgroundColor := $C0E0C0;
  FFont   := fpgStyle.DefaultFont;
  FWidth  := 120;
  FHeight := 32;
end;

end.