design.pas.svn-base

TFormDesigner allows you move and resize any control on your form. You need not prepare your form to

(*  GREATIS FORM DESIGNER DEMO                *)
(*  Copyright (C) 2001-2003 Greatis Software  *)
(*  http://www.greatis.com/formdes.htm        *)
(*  [e-mail]                        *)

unit Design;

interface

uses
  Windows, Messages, Forms, SysUtils, IniFiles, Classes, Controls,
  StdCtrls, ExtCtrls, Dialogs, FDMain;

type

  TfrmDesign = class(TForm)
    cmpFormDesigner: TFormDesigner;
    procedure FormShow(Sender: TObject);
    {$IFNDEF VER100}
    procedure cmpFormDesignerMessage(Sender: TObject; var Msg: tagMSG);
    {$ELSE}
    procedure cmpFormDesignerMessage(Sender: TObject; var Msg: TMSG);
    {$ENDIF}
    procedure cmpFormDesignerSelectControl(Sender: TObject;
      TheControl: TControl);
    procedure FormActivate(Sender: TObject);
    procedure cmpFormDesignerLoadControl(Sender: TObject;
      TheControl: TControl; IniFile: TIniFile);
    procedure cmpFormDesignerSaveControl(Sender: TObject;
      TheControl: TControl; IniFile: TIniFile);
    procedure FormCreate(Sender: TObject);
    procedure cmpFormDesignerControlDblClick(Sender: TObject;
      TheControl: TControl);
    procedure cmpFormDesignerKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cmpFormDesignerMoveSizeControl(Sender: TObject;
      TheControl: TControl);
    procedure cmpFormDesignerDeleteControl(Sender: TObject;
      TheControl: TControl);
  private
    { Private declarations }
    procedure UpdateInfo;
  public
    { Public declarations }
    function AutoName(Control: TControl): Boolean;
  end;

var
  frmDesign: TfrmDesign;

implementation

uses FDCmpPal, ToolForm;

{$R *.DFM}

procedure TfrmDesign.UpdateInfo;
begin
  if Assigned(cmpFormDesigner.Control) then
    with cmpFormDesigner do
      with Control do
        Caption:=Format(
          'Name: %s; Class: %s; Left: %d; Top: %d; Width: %d; Height: %d',
          [Name,ClassName,Left,Top,Width,Height])
  else Caption:='[no selected components]';
end;

function TfrmDesign.AutoName(Control: TControl): Boolean;
var
  i: Integer;
  CN: string;
begin
  Result:=False;
  if Assigned(Control) then
    with Control do
    begin
      if (Name='') or Assigned(Self.FindComponent(Name)) then
      begin
        CN:=Copy(ClassName,2,Pred(Length(ClassName)));
        for i:=1 to 32768 do
          if not Assigned(Self.FindComponent(CN+IntToStr(i))) then
          begin
            Name:=CN+IntToStr(i);
            Result:=True;
            Break;
          end;
      end;
    end;
end;

procedure TfrmDesign.FormShow(Sender: TObject);
begin
  cmpFormDesigner.Active:=True;
end;

procedure TfrmDesign.cmpFormDesignerMessage(Sender: TObject; var Msg: TMSG);

var
  WinControl: TWinControl;
  NewControl: TControl;
  P: TPoint;

  function GetPopupParent(W: HWND): HWND;
  begin
    Result:=W;
    while (Result<>0) and (Result<>Application.Handle) and (Result<>Handle) do
      Result:=GetParent(Result);
  end;

begin
  with Msg do
    if (Message=WM_LBUTTONDOWN) and (GetPopupParent(hwnd)=Handle) then
    begin
      Message:=0;
      if hwnd=Handle then WinControl:=Self
      else
      begin
        WinControl:=cmpFormDesigner.FindWinControl(hwnd);
        while Assigned(WinControl) and
          not (csAcceptsControls in WinControl.ControlStyle) do
          WinControl:=WinControl.Parent;
      end;
      if Assigned(WinControl) and Assigned(frmToolForm.ControlClass) then
      begin
        NewControl:=TControl(frmToolForm.ControlClass.Create(Self));
        if Assigned(NewControl) then
          if not AutoName(NewControl) then NewControl.Free
          else
          begin
            with NewControl do
            begin
              P:=Point(LoWord(lParam),HiWord(lParam));
              MapWindowPoints(hwnd,WinControl.Handle,P,1);
              Left:=P.X;
              Top:=P.Y;
              with cmpFormDesigner do
                if SnapToGrid then AlignToGrid(NewControl);
              Parent:=WinControl;
            end;
            cmpFormDesigner.Control:=NewControl;
          end;
      end;
      EditMode(frmToolForm.pgcMain);
      cmpFormDesigner.Unlock;
    end;
end;

procedure TfrmDesign.cmpFormDesignerSelectControl(Sender: TObject;
  TheControl: TControl);
var
  E: Boolean;
begin
  if Assigned(TheControl) then
    {$IFDEF TFD1COMPATIBLE}
    frmToolForm.sbtLock.Down:=cmpFormDesigner.FixedControls.IndexOf(TheControl.Name)<>-1;
    {$ELSE}
    frmToolForm.sbtLock.Down:=cmpFormDesigner.LockedControls.IndexOf(TheControl.Name)<>-1;
    {$ENDIF}
  UpdateInfo;
  E:=Assigned(cmpFormDesigner.Control);
  with frmToolForm do
  begin
    sbtLock.Enabled:=E;
    sbtAlignToGrid.Enabled:=E;
    sbtAlign.Enabled:=E;
    sbtSize.Enabled:=E;
    sbtDelete.Enabled:=E;
    mniLock.Enabled:=E;
    mniAlignToGrid.Enabled:=E;
    mniDelete.Enabled:=E;
    sbtCopy.Enabled:=E;
    sbtCut.Enabled:=E;
    mniCopy.Enabled:=E;
    mniCut.Enabled:=E;
  end;
end;

procedure TfrmDesign.FormActivate(Sender: TObject);
begin
  ActiveControl:=nil;
  cmpFormDesigner.Update;
end;

procedure TfrmDesign.cmpFormDesignerLoadControl(Sender: TObject;
  TheControl: TControl; IniFile: TIniFile);
begin
  if TheControl=Self then
    with IniFile do
    begin
      Left:=ReadInteger('@Form','Left',Left);
      Top:=ReadInteger('@Form','Top',Top);
      Width:=ReadInteger('@Form','Width',Width);
      Height:=ReadInteger('@Form','Height',Height);
    end;
end;

procedure TfrmDesign.cmpFormDesignerSaveControl(Sender: TObject;
  TheControl: TControl; IniFile: TIniFile);
begin
  if TheControl=Self then
    with IniFile do
    begin
      WriteInteger('@Form','Left',Left);
      WriteInteger('@Form','Top',Top);
      WriteInteger('@Form','Width',Width);
      WriteInteger('@Form','Height',Height);
    end;
  with IniFile do
    if TheControl is TButton then
      with TButton(TheControl) do
      begin
        WriteString(Name,'OnClick',Self.MethodName(@OnClick));
      end;
end;

procedure TfrmDesign.FormCreate(Sender: TObject);
begin
  cmpFormDesigner.PopupMenu:=frmToolForm.pmnMain;
end;

procedure TfrmDesign.cmpFormDesignerControlDblClick(Sender: TObject;
  TheControl: TControl);
begin
  if Assigned(TheControl) then
  begin
    ShowMessage('Double-click on '+TheControl.Name);
    ActiveControl:=nil;
  end;
end;

procedure TfrmDesign.cmpFormDesignerKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  with frmToolForm do
    case Key of
      VK_INSERT:
        if Shift=[ssShift] then evePaste(nil)
        else
          if Shift=[ssCtrl] then eveCopy(nil);
      VK_DELETE:
        if Shift=[ssShift] then eveCut(nil)
        else
          if Shift=[] then eveDelete(nil);
    end;
end;

procedure TfrmDesign.cmpFormDesignerMoveSizeControl(Sender: TObject;
  TheControl: TControl);
begin
  UpdateInfo;
end;

procedure TfrmDesign.cmpFormDesignerDeleteControl(Sender: TObject;
  TheControl: TControl);
begin
  UpdateInfo;
end;

end.