summaryrefslogtreecommitdiff
path: root/examples/apps/uidesigner/vfddesigner.pas
diff options
context:
space:
mode:
Diffstat (limited to 'examples/apps/uidesigner/vfddesigner.pas')
-rw-r--r--examples/apps/uidesigner/vfddesigner.pas1576
1 files changed, 0 insertions, 1576 deletions
diff --git a/examples/apps/uidesigner/vfddesigner.pas b/examples/apps/uidesigner/vfddesigner.pas
deleted file mode 100644
index f8bb23af..00000000
--- a/examples/apps/uidesigner/vfddesigner.pas
+++ /dev/null
@@ -1,1576 +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:
- A lot of the main code is here.
-}
-
-
-unit vfddesigner;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Classes,
- SysUtils,
- gfxbase,
- fpgfx,
- gfx_widget,
- gui_form,
- gui_dialogs,
- gui_label,
- gui_edit,
- gui_button,
- gui_listbox,
- gui_memo,
- gui_combobox,
- gui_checkbox,
- 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;
-
-
-{ 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;
-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;
-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, i: integer;
- cd: TWidgetDesigner;
- identlevel: integer;
- s: string;
- 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;
-
- Exit;
- {
- with PropertyForm do
- begin
- if wg is TOtherWidget then lbClass.Text8 := TOtherWidget(wg).wgClassName
- else lbClass.Text8 := wg.ClassName;
-
- edName.Text8 := wg.Name;
-
- lbLeft.Text8 := IntToStr(wg.Left);
- lbTop.Text8 := IntToStr(wg.Top);
- lbWidth.Text8 := IntToStr(wg.Width);
- lbHeight.Text8 := IntToStr(wg.Height);
-
- cbAL.Checked := anLeft in wg.Anchors;
- cbAT.Checked := anTop in wg.Anchors;
- cbAR.Checked := anRight in wg.Anchors;
- cbAB.Checked := anBottom in wg.Anchors;
-
- btxt := true;
- bedit := false;
- lbText.Text := u8('Text:');
-
- if wg is TGfxForm then edText.Text := TGfxForm(wg).WindowTitle
- else if wg is TwgLabel then edText.Text := TwgLabel(wg).Text
- else if wg is TwgEdit then edText.Text := TwgEdit(wg).Text
- else if wg is TwgButton then edText.Text := TwgButton(wg).Text
- else if wg is TwgCheckBox then edText.Text := TwgCheckBox(wg).Text
- else btxt := false;
-
- if not btxt and ((wg is TwgMemo) or (wg is TwgChoiceList) or (wg is TwgTextListBox))
- then
- begin
- bedit := true;
- lbText.Text := u8('Items:');
- btnEdit.Text := u8('Edit items...');
- end
- else if (wg is TwgDBGrid) then
- begin
- bedit := true;
- //lbText.Text := u8('Items:');
- btnEdit.Text := u8('Edit columns...');
- end;
-
- if scd <> nil then
- begin
- edOther.Text := str8to16(scd.other.Text);
- end
- else
- begin
- edOther.Text := str8to16(FFormOther);
- end;
-
- edText.Visible := btxt;
- lbText.Visible := btxt;
- btnEdit.Visible := bedit;
- edName.Visible := (wgcnt < 2);
- edOther.Visible := (wgcnt < 2);
-
- end; // with PropertyForm
-}
-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;
- ax: TfpgCoord;
- ay: TfpgCoord;
- wg: TfpgWidget;
- n: integer;
- cd: TWidgetDesigner;
- posval: integer;
- pt: TPoint;
-
- 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;
-
- 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: string;
- sl: TStringList;
- n: integer;
- wd: TWidgetDesigner;
- wg: TfpgWidget;
- wgclass, pwgname: string;
-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;
-
- //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.
-
generated by cgit v1.2.3-54-g00ecf (git 2.44.0) at 2024-08-19 05:45:52 +0000