dcmain.pas.svn-base

来自「TFormDesigner allows you move and resize」· SVN-BASE 代码 · 共 2,066 行 · 第 1/5 页

begin
  Result:=GetKeyState(Key) and $80 <> 0;
end;

procedure TCustomDesignerComponent.CreateContainers;
var
  i: Integer;
begin
  if FShowNonVisual then
    with ParentForm do
      for i:=0 to Pred(ComponentCount) do
        if not (Components[i] is TControl) and
          not (Components[i] is TMenuItem) and
          not (Components[i] is TCustomDesignerComponent) and
          (caEditable in ComponentAttributes(Components[i])) and
          not Assigned(FindComponentContainer(Components[i])) then
          TComponentContainer.CreateWithComponent(ParentForm,Components[i]).Parent:=ParentForm;
end;

procedure TCustomDesignerComponent.DestroyContainers;
var
  i: Integer;
begin
  i:=0;
  FInternalDestroy:=True;
  try
    with ParentForm do
      while i<ComponentCount do
        if Components[i] is TComponentContainer then Components[i].Free
        else Inc(i);
  finally
    FInternalDestroy:=False;
  end;
end;

function TCustomDesignerComponent.SelectControl(AControl: TControl): Boolean;
var
  E: Boolean;
  I: Integer;
  OldControl: TControl;
  CA: TComponentAttributes;
begin
  Result:=False;
  if Assigned(AControl) then
  begin
    CA:=ComponentAttributes(AControl);
    if IsSelectableControl(AControl) then
    begin
      E:=True;
      DoBeforeSelect(AControl,E);
      if E then
      begin
        OldControl:=Control;
        with FSelected do
        begin
          I:=IndexOf(AControl);
          if I=-1 then
          begin
            Insert(0,AControl);
            Result:=True;
          end
          else Move(I,0);
        end;
        if Result then
        begin
          DoAfterSelect(AControl);
          if SelectedControlCount>1 then
          begin
            DrawMultiSelect(AControl);
            DrawMultiSelect(OldControl);
          end;
          Update;
        end;
      end;
    end;
  end;
end;

function TCustomDesignerComponent.DeselectControl(AControl: TControl): Boolean;
var
  E: Boolean;
  I: Integer;
begin
  Result:=False;
  if Assigned(AControl) then
  begin
    E:=True;
    DoBeforeDeselect(AControl,E);
    if E then
    begin
      with FSelected do
      begin
        I:=IndexOf(AControl);
        if I<>-1 then
        begin
          Delete(I);
          Result:=True;
        end;
      end;
      if Result then
      begin
        DoAfterDeselect(AControl);
        if SelectedControlCount>0 then RemoveMultiSelect(AControl);
        if SelectedControlCount=1 then RemoveMultiSelect(Control);
        Update;
      end;
    end;
  end;
end;

procedure TCustomDesignerComponent.DeselectAllControls;
begin
  Control:=nil;
end;

function TCustomDesignerComponent.IsSelectedControl(AControl: TControl): Boolean;
begin
  Result:=FSelected.IndexOf(AControl)<>-1;
end;

function TCustomDesignerComponent.IsSelectableControl(AControl: TControl): Boolean;
var
  CA: TComponentAttributes;
begin
  CA:=ComponentAttributes(AControl);
  Result:=
    (caEditable in CA) and
    {$IFNDEF NOCSSUBCOMPONENT}
    not (csSubComponent in AControl.ComponentStyle) and
    {$ENDIF}
    not (caTransparent in CA) and
    not (caProtected in CA);
end;

function TCustomDesignerComponent.ComponentToControl(AComponent: TComponent): TControl;
begin
  if Assigned(AComponent) then
    if AComponent is TControl then Result:=TControl(AComponent)
    else Result:=FindComponentContainer(AComponent)
  else Result:=nil;
end;

function TCustomDesignerComponent.ControlToComponent(AComponent: TComponent): TComponent;
begin
  if Assigned(AComponent) then
    if AComponent is TComponentContainer then Result:=TComponentContainer(AComponent).Component
    else Result:=AComponent
  else Result:=nil;
end;

procedure TCustomDesignerComponent.ClearForm;
var
  OldActive: Boolean;
  i: Integer;
begin
  OldActive:=Active;
  Active:=False;
  try
    if Assigned(ParentForm) then
    begin
      i:=0;
      with ParentForm do
        while i<ComponentCount do
          if Components[i]=Self then Inc(i)
          else Components[i].Free;
    end;
  finally
    Active:=OldActive;
  end;
end;

procedure TCustomDesignerComponent.PaintGrid(Canvas: TCanvas; R: TRect);
var
  X,Y,StartY: Integer;
begin
  with ParentForm do
  begin
    X:=R.Left-GetScrollPos(Handle,SB_HORZ) mod FGridStep;
    StartY:=R.Top-GetScrollPos(Handle,SB_VERT) mod FGridStep;
  end;
  with Canvas,R do
  begin
    Brush.Color:=FDesignerColor;
    FillRect(R);
    if FDisplayGrid then
      while X<=Right do
      begin
        Y:=StartY;
        while Y<=Bottom do
        begin
          SetPixel(Handle,X,Y,FGridColor);
          Inc(Y,FGridStep);
        end;
        Inc(X,FGridStep);
      end;
  end;
end;

procedure TCustomDesignerComponent.PaintGrab(Canvas: TCanvas; R: TRect; GrabType: TGrabType; GrabPosition: TGrabPosition);
begin
  with Canvas do
  begin
    case GrabType of
      gtLocked:
      begin
        Pen.Color:=LockedGrabBorder;
        Brush.Color:=LockedGrabFill;
      end;
      gtMulti:
      begin
        Pen.Color:=MultiGrabBorder;
        Brush.Color:=MultiGrabFill;
      end;
      else
        Pen.Color:=NormalGrabBorder;
        Brush.Color:=NormalGrabFill;
    end;
    with R do Rectangle(Left,Top,Right,Bottom);
  end;
end;

type
  TPopupControl = class(TControl)
  public
    property PopupMenu;
  end;

function TCustomDesignerComponent.MessageProcessor(Sender: TControl; var Message: TMessage): Boolean;

var
  i: Integer;
  E,MS: Boolean;
  ISender: TControl;
  R: TRect;
  NewDrag: TPoint;

  function GetControlsOrigin: TPoint;
  var
    i: Integer;
  begin
    case SelectedControlCount of
      0: Result:=Point(0,0);
      1: with Control do Result:=Point(Left,Top);
    else
      Result:=Point(MaxInt,MaxInt);
      for i:=0 to Pred(SelectedControlCount) do
        with SelectedControls[i],Result do
        begin
          if Left<X then X:=Left;
          if Top<Y then Y:=Top;
        end;
    end;
  end;

  function GetFormOwned(C: TControl): TControl;
  begin
    Result:=C;
    while Assigned(Result) and (FindHandle(C)=gpNone) and (Result<>ParentForm) and (Result.Owner<>ParentForm)
      and not (Result.Owner is TCustomForm)
      and not (Result is TCustomForm)
      {$IFNDEF NOFRAMES}
      and not (Result.Owner is TCustomFrame)
      {$ENDIF}
      do Result:=TControl(Result.Owner);
  end;

  function GetNonTransparent(C: TControl): TControl;
  begin
    Result:=C;
    while Assigned(Result) and
      Assigned(Result.Parent) and
      (caTransparent in ComponentAttributes(Result)) do
      Result:=Result.Parent;
    if not Assigned(Result) then Result:=ParentForm;
  end;

  function NormalizeRect(Rect: TRect): TRect;
  begin
    with Rect do
    begin
      if Left<Right then
      begin
        Result.Left:=Left;
        Result.Right:=Right;
      end
      else
      begin
        Result.Left:=Right;
        Result.Right:=Left;
      end;
      if Top<Bottom then
      begin
        Result.Top:=Top;
        Result.Bottom:=Bottom;
      end
      else
      begin
        Result.Top:=Bottom;
        Result.Bottom:=Top;
      end;
    end;
  end;

  function FindNextControl(GoForward: Boolean): TControl;
  var
    i,StartIndex: Integer;
    CurControl: TControl;
  begin
    Result:=nil;
    CurControl:=Control;
    if Assigned(ParentForm) then
      with ParentForm do
      begin
        if Assigned(CurControl) then
          if ComponentCount>0 then
          begin
            for StartIndex:=0 to Pred(ComponentCount) do
              if Components[StartIndex]=Control then Break
          end
          else StartIndex:=-1
        else StartIndex:=-1;
        if ComponentCount>0 then
        begin
          if StartIndex=-1 then
            if GoForward then StartIndex:=Pred(ComponentCount)
            else StartIndex:=0;
          i:=StartIndex;
          repeat
            if GoForward then
            begin
              Inc(i);
              if i=ComponentCount then i:=0;
            end
            else
            begin
              if i=0 then i:=ComponentCount;
              Dec(i);
            end;
            if Components[i] is TControl then
            begin
              CurControl:=TControl(Components[i]);
              if not (CurControl is TGrabHandle) and
                IsSelectableControl(CurControl) and
                (CurControl<>Control) then Result:=CurControl;
            end;
          until (Result<>nil) or (i=StartIndex);
        end;
      end;
  end;

  procedure ProcessKey(Key: Word);

  type
    TKeyType = (ktSelect,ktMove,ktFastMove,ktSize);

  var
    R: TRect;
    i: Integer;
    E,MS: Boolean;
    KeyType: TKeyType;

    procedure GrowRect(var R: TRect; X,Y: Integer);
    begin
      Inc(R.Right,X);
      Inc(R.Bottom,Y);
    end;

  begin
    if IsPressed(VK_SHIFT) then
      if IsPressed(VK_CONTROL) then KeyType:=ktFastMove
      else KeyType:=ktSize
    else
      if IsPressed(VK_CONTROL) then KeyType:=ktMove
      else KeyType:=ktSelect;
    if KeyType=ktMove then
    begin
      i:=0;
      MS:=SelectedControlCount>1;
      while i<SelectedControlCount do
      begin
        if MS then E:=not (caLocked in ComponentAttributes(SelectedControls[i]))
        else E:=True;
        if E then DoBeforeDrag(SelectedControls[i],E);
        if not E then
        begin
          if not DeselectControl(SelectedControls[i]) then Inc(i);
        end
        else Inc(i);
      end;
    end;
    for i:=0 to Pred(SelectedControlCount) do
      with SelectedControls[i] do
      begin
        R:=BoundsRect;
        case Key of
          VK_RIGHT:
            case KeyType of
              ktSelect: Control:=FindNextControl(True);
              ktMove: OffsetRect(R,1,0);
              ktFastMove: OffsetRect(R,FGridStep,0);
              ktSize: GrowRect(R,1,0);
            end;
          VK_LEFT:
            case KeyType of
              ktSelect: Control:=FindNextControl(False);
              ktMove: OffsetRect(R,-1,0);
              ktFastMove: OffsetRect(R,-FGridStep,0);
              ktSize: GrowRect(R,-1,0);
            end;
          VK_UP:
            case KeyType of
              ktSelect: Control:=FindNextControl(False);
              ktMove: OffsetRect(R,0,-1);
              ktFastMove: OffsetRect(R,0,-FGridStep);