fdmain.pas.svn-base

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

{$BOOLEVAL OFF}
{$RANGECHECKS OFF}

{$IFDEF VER100}
{$DEFINE NOFRAMES}
{$ENDIF}
{$IFDEF VER110}
{$DEFINE NOFRAMES}
{$ENDIF}
{$IFDEF VER120}
{$DEFINE NOFRAMES}
{$ENDIF}
{$IFDEF VER125}
{$DEFINE NOFRAMES}
{$ENDIF}

{$IFNDEF VER150}
{$DEFINE NOCSSUBCOMPONENT}
{$ENDIF}

uses FDEditor, FDAlign, FDSize, FDAlPal, FDTab;

var
  Designers: TList;
  HookID: HHook = 0;
const
  WM_SECONDARYPAINT = WM_USER + 1000;
  BufSize = 2048;

function HookProc(Code,WParam,LParam: Integer): LResult; stdcall;
var
  i,ILockCounter: Integer;
begin
  if Assigned(Designers) then
    for i:=0 to Pred(Designers.Count) do
      with TCustomFormDesigner(Designers[i]) do
      begin
        ILockCounter:=FLockCounter;
        try
          MessageProc(PMsg(LParam)^);
        finally
          if FLockCounter>ILockCounter then FLockCounter:=ILockCounter;
          if Locked then
            case PMsg(LParam)^.Message of
              WM_LBUTTONUP,WM_NCLBUTTONUP,WM_RBUTTONUP,WM_NCRBUTTONUP:
              begin
                Unlock;
                MessageProc(PMsg(LParam)^);
              end;
              WM_LBUTTONDOWN: Unlock;
            end;
        end;
      end;
  Result:=CallNextHookEx(HookID,Code,WParam,LParam);
end;

function GetGrabCursor(GP: TGrabPosition): TCursor;
begin
  case GP of
    gpLeftTop,gpRightBottom: Result:=crSizeNWSE;
    gpLeftMiddle,gpRightMiddle: Result:=crSizeWE;
    gpLeftBottom,gpRightTop: Result:=crSizeNESW;
    gpMiddleTop,gpMiddleBottom: Result:=crSizeNS;
  else Result:=crArrow;
  end;
end;

{ TComponentContainer }

procedure TComponentContainer.Paint;
begin
  with Canvas do
  begin
    Brush.Color:=clBtnFace;
    FillRect(ClientRect);
    Pen.Color:=clBtnHighlight;
    MoveTo(0,Pred(Height));
    LineTo(0,0);
    LineTo(Width,0);
    Pen.Color:=clBtnShadow;
    MoveTo(0,Pred(Height));
    LineTo(Pred(Width),Pred(Height));
    LineTo(Pred(Width),0);
    Draw(2,2,FBitmap);
  end;
end;

procedure TComponentContainer.WndProc(var Msg: TMessage);
begin
  with Msg do
    case Msg of
      WM_SIZE:
      begin
        Width:=28;
        Height:=28;
      end;
      WM_MOVE:
      begin
        inherited;
        if Assigned(FComponent) then
          FComponent.DesignInfo:=Left+Top shl 16;
      end;
    else inherited;
    end;
end;

constructor TComponentContainer.CreateWithComponent(AOwner,AComponent: TComponent);
begin
  inherited Create(AOwner);
  FBitmap:=TBitmap.Create;
  with FBitmap do
  begin
    Handle:=LoadBitmap(HInstance,'CONTAINER');
    Transparent:=True;
  end;
  FComponent:=AComponent;
  Visible:=Assigned(FComponent);
  Width:=28;
  Height:=28;
  ShowHint:=True;
  with FComponent do
  begin
    Left:=LoWord(DesignInfo);
    Top:=HiWord(DesignInfo);
    Hint:=Name;
  end;
end;

destructor TComponentContainer.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

{ TFDReader }

function TFDReader.Error(const Message: string): Boolean;
begin
  Result:=True;
  if Assigned(Designer) and Assigned(Designer.FOnReadError) then
    Designer.FOnReadError(Self,Message,Result);
end;

procedure TFDReader.SetName(Component: TComponent; var Name: string);

  procedure RenameComponent(AComponent: TComponent);
  var
    Index: Integer;
    AName: string;
  begin
    Index:=1;
    if Name<>'' then
    begin
      AName:=Name;
      while Assigned(AComponent.Owner.FindComponent(AName)) do
      begin
        Inc(Index);
        AName:=Copy(AComponent.ClassName,2,Length(AComponent.ClassName))+IntToStr(Index);
      end;
      AComponent.Name:=AName;
      with AComponent do
        for Index:=0 to Pred(ComponentCount) do RenameComponent(Components[Index]);
    end;
  end;

begin
  if Assigned(Designer) and Assigned(Designer.ParentForm) then
    RenameComponent(Component);
end;

constructor TFDReader.Create(AStream: TStream; ADesigner: TCustomFormDesigner);
begin
  inherited Create(AStream,BufSize);
  Designer:=ADesigner;
end;

{ TGrabHandle }

constructor TGrabHandle.Create(AOwner: TComponent);
begin
  inherited;
  with (Owner as TGrabHandles).Designer do
  begin
    Width:=FGrabSize;
    Height:=FGrabSize;
  end;
  ControlStyle:=ControlStyle+[csReplicatable];
end;

procedure TGrabHandle.Paint;
begin
  if Assigned(Parent) then
    with Canvas,(Owner as TGrabHandles).Designer do
      if FLocked then Draw(Self.Width-FGrabSize,Self.Height-FGrabSize,FLockedGrab)
      else Draw(Self.Width-FGrabSize,Self.Height-FGrabSize,FNormalGrab);
end;

procedure TGrabHandle.WndProc(var Msg: TMessage);
begin
  inherited;
  if not FLocked then
    case Msg.Msg of
      CM_MOUSEENTER: Screen.Cursor:=crDefault;
      CM_MOUSELEAVE: SetArrowCursor;
    end;
end;

procedure TGrabHandle.SetPosition(Value: TGrabPosition);
begin
  if Value<>FPosition then
  begin
    FPosition:=Value;
    Cursor:=GetGrabCursor(FPosition);
    UpdateCoords;
  end;
end;

procedure TGrabHandle.SetRect(Value: TRect);
begin
  FRect:=Value;
  UpdateCoords;
end;

procedure TGrabHandle.SetLocked(Value: Boolean);
begin
  if Value<>FLocked then
  begin
    FLocked:=Value;
    if Visible then Invalidate;
  end;
end;

procedure TGrabHandle.UpdateCoords;
var
  ALeft,ATop: Integer;
  R: TRect;
begin
  if Assigned(Parent) then
    with (Owner as TGrabHandles).Designer do
    begin
      case FPosition of
        gpLeftTop,gpLeftMiddle,gpLeftBottom: ALeft:=FRect.Left-FGrabSize div 2;
        gpMiddleTop,gpMiddleBottom: ALeft:=(FRect.Left+FRect.Right-FGrabSize) div 2;
        gpRightTop,gpRightMiddle,gpRightBottom: ALeft:=Pred(FRect.Right-FGrabSize div 2);
      else ALeft:=0;
      end;
      case FPosition of
        gpLeftTop,gpMiddleTop,gpRightTop: ATop:=FRect.Top-FGrabSize div 2;
        gpLeftMiddle,gpRightMiddle: ATop:=(FRect.Top+FRect.Bottom-FGrabSize) div 2;
        gpLeftBottom,gpMiddleBottom,gpRightBottom: ATop:=Pred(FRect.Bottom-FGrabSize div 2);
      else ATop:=0;
      end;
      R:=Classes.Rect(ALeft,ATop,ALeft+FGrabSize,ATop+FGrabSize);
      IntersectRect(R,R,Parent.ClientRect);
      with R do SetWindowPos(Handle,0,Left,Top,Right-Left,Bottom-Top,SWP_NOZORDER);
    end;
end;

procedure TGrabHandle.SetArrowCursor;
begin
  {$IFNDEF STDCURSORS}
  Screen.Cursor:=crArrow;
  {$ELSE}
  Screen.Cursor:=crDefault;
  {$ENDIF}
end;

{ TGrabHandles }

procedure TGrabHandles.SetControl(Value: TControl);
begin
  FControl:=Value;
  if FEnabled then Update(False);
end;

procedure TGrabHandles.SetVisible(Value: Boolean);
var
  GP: TGrabPosition;
begin
  if Value<>FVisible then
  begin
    FVisible:=Value;
    for GP:=Succ(Low(GP)) to High(GP) do
      FItems[GP].Visible:=FEnabled and FVisible;
  end;
end;

procedure TGrabHandles.SetEnabled(Value: Boolean);
begin
  FEnabled:=Value;
  Visible:=FEnabled and FVisible;
end;

function TGrabHandles.GetParentForm: TCustomForm;
begin
  if Assigned(Designer) then Result:=Designer.ParentForm
  else Result:=nil;
end;

function TGrabHandles.GetDesigner: TCustomFormDesigner;
begin
  if Assigned(Owner) then Result:=Owner as TCustomFormDesigner
  else Result:=nil;
end;

constructor TGrabHandles.Create(AOwner: TComponent);
var
  GP: TGrabPosition;
begin
  inherited;
  for GP:=Succ(Low(GP)) to High(GP) do
  begin
    FItems[GP]:=TGrabHandle.Create(Self);
    with FItems[GP] do
    begin
      Position:=GP;
      Visible:=False;
      Parent:=Designer.ParentForm;
    end;
  end;
  FEnabled:=True;
end;

procedure TGrabHandles.Update(MustHide: Boolean);
var
  GP: TGrabPosition;
begin
  if Designer.Active then
  begin
    Application.ProcessMessages;
    FVisible:=
      FEnabled and
      Assigned(FControl) and
      FControl.Visible and
      not Designer.IsProtected(FControl) and
      (Designer.ControlCount<=1);
    for GP:=Succ(Low(GP)) to High(GP) do
      if Assigned(FItems[GP]) then
        with FItems[GP] do
          if Assigned(FControl) then
          begin
            if MustHide then Visible:=False;
            Parent:=FControl.Parent;
            Rect:=FControl.BoundsRect;
            Locked:=Designer.IsLocked(FControl);
            Visible:=FVisible;
            if FVisible then BringToFront;
          end
          else
          try
            Visible:=False;
            Parent:=Designer.ParentForm;
          except
          end;
    Application.ProcessMessages;
  end;
end;

procedure TGrabHandles.BringToFront;
var
  GP: TGrabPosition;
begin
  for GP:=Succ(Low(GP)) to High(GP) do
    if Assigned(FItems[GP]) then FItems[GP].BringToFront;
end;

function TGrabHandles.FindHandle(AHandle: HWND): TGrabPosition;
var
  GP: TGrabPosition;
begin
  Result:=gpNone;
  for GP:=Succ(Low(GP)) to High(GP) do
    if Assigned(FItems[GP]) and (FItems[GP].Handle=AHandle) then
    begin
      Result:=GP;
      Break;
    end;
end;

function TGrabHandles.FindHandleControl(AHandle: HWND): TGrabHandle;
var
  GP: TGrabPosition;
begin
  GP:=FindHandle(AHandle);
  if GP<>gpNone then Result:=FItems[GP]
  else Result:=nil;
end;

function TGrabHandles.IsGrabHandle(AControl: TControl): Boolean;
var
  GP: TGrabPosition;
begin
  Result:=False;
  for GP:=Succ(Low(GP)) to High(GP) do
    if FItems[GP]=AControl then
    begin
      Result:=True;
      Break;
    end;
end;

{ TCustomFormDesigner }

constructor TCustomFormDesigner.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAPForm:=TfrmAlignmentPalette.Create(Self);
  FAlignmentPalette:=[apStayOnTop,apShowHints];
  FGrabSize:=5;
  FMultiGrabBorder:=clGray;
  FMultiGrabFill:=clGray;
  FLockedGrabFill:=clGray;
  FLockedGrab:=TBitmap.Create;
  FMultiGrab:=TBitmap.Create;
  FNormalGrab:=TBitmap.Create;
  FHintWindow:=THintWindow.Create(Self);
  FHintWindow.Color:=clInfoBk;
  FCanvas:=TCanvas.Create;
  FControls:=TList.Create;
  FLockedControls:=TStringList.Create;
  TStringList(FLockedControls).OnChange:=ListChange;
  FProtectedControls:=TStringList.Create;
  TStringList(FProtectedControls).OnChange:=ListChange;
  FTransparentControls:=TStringList.Create;
  FGridStep:=8;
  FDesignerColor:=clNone;
  FGridColor:=clNone;
  FShowMoveSizeHint:=True;
  FDesignerBrush:=TBitmap.Create;
  FDefaultBrush:=TBrush.Create;
  UpdateGrid;
  {$IFDEF TFDTRIAL}
  if not (csDesigning in ComponentState) then
    MessageBox(
      0,
      'You are using trial version of Greatis Form Designer with some functional limitations.'#13+
        'To get full-functional component visit http://www.greatis.com/formdesbuy.htm',
      'Greatis Form Designer - Trial Version',
      MB_OK or MB_ICONEXCLAMATION);
  {$ENDIF}
  //FUseContainer:=True;
end;

destructor TCustomFormDesigner.Destroy;
begin
  Active:=False;
  FLockedControls.Free;
  FProtectedControls.Free;
  FTransparentControls.Free;