designhookutils.pas

delphi 运行进行设计模式,象delphi的编辑环境一样

      ShowGrabHandle(True);
    end;
  end
  else
    if (ssCtrl in Shift) or (Sender = FRoot) then //按住Shift或者点击的是Root就框选
    begin
      Clear();
      if (Sender is TWinControl) then
      begin
        if (TWinControl(Sender).ControlCount = 0) then
        begin
          if CtrlIndex = -1 then
          begin
            Add(Sender);
            ShowGrabHandle(True);
          end;
        end
        else
        begin
          FPointStart := Sender.ClientToScreen(Point(X, Y));
          FOldRect := Rect(X, Y, X + 1, Y + 1);
          FSelecting := True;
          SetCaptureControl(Sender);
        end;
        Exit;
      end;
    end
    else   //没按Shift也没按Ctrl点击.那就添加自己到选择的控件组中 .Root和Form不能和别的控件同时在组中
    begin
      begin
        if (Sender = FRoot)or(Sender = FForm) then
          Exit;
        if CtrlIndex = -1 then
        begin
          Clear();
          Add(Sender);
        end;
      end;

      Dragging := True;
      FDraggingControl := Sender;
      MouseLock(Sender);
      FBeforDragPos := Sender.ClientToScreen(Point(X, Y));
    end;
end;

procedure TDesignerHook.MouseFree;
begin
  SetCaptureControl(nil);
  ClipCursor(@FMouseRect);
end;

procedure TDesignerHook.MouseLock(Sender: TControl);
var
  R                 : TRect;
begin
  SetCaptureControl(Sender);
  GetClipCursor(FMouseRect);

  if Sender.Parent = nil then
    Exit;
  
  R := Sender.Parent.ClientRect;
  R.TopLeft := Sender.Parent.ClientToScreen(R.TopLeft);
  R.BottomRight := Sender.Parent.ClientToScreen(R.BottomRight);
  ClipCursor(@R); //把鼠标锁定在固定区域
end;

procedure TDesignerHook.MouseMove(Sender: TControl; Shift: TShiftState; X,
  Y: Integer);
var
  I                 : Integer;
  CPos              : TPoint;
  DC                : HDC;
begin

  if Dragging then
  begin
    CPos := Mouse.CursorPos;
    for I := FControls.Count - 1 downto 0 do
      if Controls[I].Parent = Sender.Parent then //如果都是同一个Paren的话
      begin
        Controls[I].Left := Controls[I].Left - (FBeforDragPos.X - CPos.X);
        Controls[I].Top := Controls[I].Top - (FBeforDragPos.Y - CPos.Y);
      end
      else
      begin
        Remove(I);
      end;
    FBeforDragPos := CPos;
  end
  else
    if FSelecting then
    begin
      FPointEnd := Sender.ClientToScreen(Point(X, Y));
      FNewRect := PointToRect(FPointStart, FPointEnd);

      DC := GetDC(0);
      DrawFocusRect(DC, FOldRect);
      DrawFocusRect(DC, FNewRect);
      ReleaseDC(0, DC);
      FOldRect := FNewRect;

    end;
end;

procedure TDesignerHook.MouseUp(Sender: TControl; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  DC                : HDC;
begin
  if Dragging then
  begin
    MouseFree();
    Dragging := False;
  end;
  if FSelecting then
  begin
    DC := GetDC(0);
    DrawFocusRect(DC, FOldRect);
    ReleaseDC(0, DC);
    FSelecting := False;
    SetCaptureControl(nil);
    if Sender is TWinControl then
    begin
      FOldRect.TopLeft := Sender.ScreenToClient(FOldRect.TopLeft);
      FOldRect.BottomRight := Sender.ScreenToClient(FOldRect.BottomRight);
      FOldRect := PointToRect(FOldRect.TopLeft, FOldRect.BottomRight);
      AddRectControls(TWinControl(Sender), FOldRect);
      ShowGrabHandle(True);
    end;
  end;
end;

procedure TDesignerHook.Notification(AnObject: TPersistent; Operation: TOperation);
var
  Index             : Integer;
begin
  case Operation of
    opRemove:
      begin
        Index := FControls.IndexOf(AnObject);
        if Index <> -1 then
          Remove(Index);
        if AnObject = FForm then
        begin
          TCrackComponent(FForm).SetDesigning(False, True);
          FForm := nil;
        end;
      end;
    opInsert:
      begin
      end;
  end;

end;

procedure TDesignerHook.PaintGrid;
begin
  //self.FForm.Canvas.Rectangle(10,10,100,100);
end;

procedure TDesignerHook.PaintMenu;
begin

end;

function TDesignerHook.OwnerCheck(Sender: TControl; CheckOnwer: TComponent): Boolean;
var
  W                 : TComponent;
begin
  Result := False;
  W := Sender.Owner;
  while W <> nil do
  begin
    if W = CheckOnwer then
    begin
      Result := True;
      Exit;
    end;
    W := W.Owner;
  end;
end;

procedure TDesignerHook.Remove(Index: Integer);
var
  I                 : Integer;
  Control           : TControl;
begin
  if Index = -1 then
    Exit;
  Control := TControl(FControls[Index]);
  FControls.Delete(Index);
  ClearGrabHandle(Control);
end;

procedure TDesignerHook.Remove(AControl: TControl);
begin
  Remove(FControls.IndexOf(AControl));
end;

procedure TDesignerHook.SetCustomForm(Value: TCustomForm);
begin
  FForm := Value;
  if Value <> nil then
    Value.Designer := Self;
end;

procedure TDesignerHook.SetDragging(const Value: Boolean);
var
  I                 : Integer;
begin
  FDragging := Value;
  ShowGrabHandle(not Value);
end;

procedure TDesignerHook.SetIsControl(Value: Boolean);
begin
  if FForm is TControl then
    TCrackControl(FForm).IsControl := Value;
end;

procedure TDesignerHook.ShowGrabHandle(const Show: boolean);
var
  I                 : Integer;
begin
  for I := 0 to FGrabHandleManager.ComponentCount - 1 do
    if (FGrabHandleManager.Components[I] is TGrabHandle)
      then
    begin
      if ControlCount > 1 then
      begin
        TGrabHandle(FGrabHandleManager.Components[I]).Color := clAppWorkSpace;
      end
      else
      begin
        TGrabHandle(FGrabHandleManager.Components[I]).Color := clBlack;
      end;

      TGrabHandle(FGrabHandleManager.Components[I]).Pos();
      TGrabHandle(FGrabHandleManager.Components[I]).Visible := Show and
        ((ControlCount = 1) or
        ((ControlCount > 1)
        and (TGrabHandle(FGrabHandleManager.Components[I]).FDirect in [fdLeftUp, fdLeftDown, fdRightUp, fdRightDown])));
    end;
end;

function TDesignerHook.UniqueName(const BaseName: string): string;
var
  guid              : TGuid;
  s                 : string;
begin
  OleCheck(CoCreateGuid(guid));
  s := GuidToString(guid);
  s := Copy(s, 2, Length(s) - 2); //
  s := StringReplace(s, '-', '', []);
  Result := BaseName + s;
end;

procedure TDesignerHook.ValidateRename(AComponent: TComponent;
  const CurName, NewName: string);
begin

end;

{ TGrabHandle }

constructor TGrabHandle.Create(AManager: TComponent; AControl: TControl; ADirect: TGrabHandleDirect);
begin
  inherited Create(AManager);
  FManager := TGrabHandleManager(AManager);
  FDesigner := FManager.FDesigner;
  Color := clBlack;
  FDirect := ADirect;
  FControl := AControl;
  Visible := False;
  Parent := AControl.Parent;
  Pos();
end;

destructor TGrabHandle.Destroy;
begin

  inherited Destroy;
end;

function TGrabHandle.GetDesigner: TDesignerHook;
begin
  Result := FManager.FDesigner;
end;

procedure TGrabHandle.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Designer.ControlCount > 1 then
    Exit;
  Designer.Dragging := True;
  Designer.FBeforDragPos := ClientToScreen(Point(X, Y));
  MouseCapture := True;
end;

procedure TGrabHandle.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  I                 : Integer;
  CPos              : TPoint;
  cX, cY            : Integer;
begin
  inherited MouseMove(Shift, X, Y);
  if not Designer.Dragging then
    Exit;
  CPos := ClientToScreen(Point(X, Y));
  {
  for I := 0 to Designer.ControlCount - 1 do
  begin
    Designer.Controls[I].Left := Designer.Controls[I].Left + (X - Designer.FBeforDragPos.X);
    Designer.Controls[I].Top := Designer.Controls[I].Top + (Y - Designer.FBeforDragPos.Y);
  end;
  }
  cX := Designer.FBeforDragPos.X - CPos.X;
  cY := Designer.FBeforDragPos.Y - CPos.Y;
  if (Abs(cX) < 2) and (Abs(cY) < 2) then
    Exit;

  case FDirect of
    fdLeftUp:
      begin
        if FControl.Width + cX > 1 then
        begin
          FControl.Left := FControl.Left - cX;
          FControl.Width := FControl.Width + cX;
          Designer.FBeforDragPos.X := CPos.X;
        end;
        if FControl.Height + cY > 1 then
        begin
          FControl.Top := FControl.Top - cY;
          FControl.Height := FControl.Height + cY;
          Designer.FBeforDragPos.Y := CPos.Y;
        end;
      end;
    fdUp:
      begin
        if FControl.Height + cY > 1 then
        begin
          FControl.Top := FControl.Top - cY;
          FControl.Height := FControl.Height + cY;
          Designer.FBeforDragPos.Y := CPos.Y;
        end;
      end;
    fdRightUp:
      begin
        if FControl.Width - cX > 1 then
        begin
          FControl.Width := FControl.Width - cX;
          Designer.FBeforDragPos.X := CPos.X;
        end;
        if FControl.Height + cY > 1 then
        begin
          FControl.Top := FControl.Top - cY;
          FControl.Height := FControl.Height + cY;
          Designer.FBeforDragPos.Y := CPos.Y;
        end;
      end;
    fdRight:
      begin
        if FControl.Width - cX > 1 then
        begin
          FControl.Width := FControl.Width - cX;
          Designer.FBeforDragPos.X := CPos.X;
        end;
      end;
    fdRightDown:
      begin
        if FControl.Width - cX > 1 then
        begin
          FControl.Width := FControl.Width - cX;
          Designer.FBeforDragPos.X := CPos.X;
        end;
        if FControl.Height - cY > 1 then
        begin
          FControl.Height := FControl.Height - cY;
          Designer.FBeforDragPos.Y := CPos.Y;
        end;
      end;
    fdDown:
      begin
        if FControl.Height - cY > 1 then
        begin
          FControl.Height := FControl.Height - cY;
          Designer.FBeforDragPos.Y := CPos.Y;
        end;
      end;
    fdLeftDown:
      begin
        if FControl.Width + cX > 1 then
        begin
          FControl.Left := FControl.Left - cX;
          FControl.Width := FControl.Width + cX;
          Designer.FBeforDragPos.X := CPos.X;
        end;
        if FControl.Height - cY > 1 then
        begin
          FControl.Height := FControl.Height - cY;
          Designer.FBeforDragPos.Y := CPos.Y;
        end;
      end;
    fdLeft:
      begin
        if FControl.Width + cX > 1 then
        begin
          FControl.Left := FControl.Left - cX;
          FControl.Width := FControl.Width + cX;
          Designer.FBeforDragPos.X := CPos.X;
        end;
      end;
  end;

end;

procedure TGrabHandle.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  MouseCapture := False;
  Designer.Dragging := False;
end;

procedure TGrabHandle.Pos();
var
  X                 : array[0..2] of Integer;
  Y                 : array[0..2] of Integer;
begin
  X[0] := FControl.Left - GrabHandleSize div 2;
  X[1] := FControl.Left + (FControl.Width - GrabHandleSize) div 2;
  X[2] := FControl.Left + FControl.Width - GrabHandleSize div 2;
  Y[0] := FControl.Top - GrabHandleSize div 2;
  Y[1] := FControl.Top + (FControl.Height - GrabHandleSize) div 2;
  Y[2] := FControl.Top + FControl.Height - GrabHandleSize div 2;
  case FDirect of
    fdLeftUp:
      begin
        Cursor := crSizeNWSE;
        SetBounds(X[0], Y[0], GrabHandleSize, GrabHandleSize);
      end;
    fdUp:
      begin
        Cursor := crSizeNS;
        SetBounds(X[1], Y[0], GrabHandleSize, GrabHandleSize);
      end;
    fdRightUp:
      begin
        Cursor := crSizeNESW;
        SetBounds(X[2], Y[0], GrabHandleSize, GrabHandleSize);
      end;
    fdRight:
      begin
        Cursor := crSizeWE;
        SetBounds(X[2], Y[1], GrabHandleSize, GrabHandleSize);
      end;
    fdRightDown:
      begin
        Cursor := crSizeNWSE;
        SetBounds(X[2], Y[2], GrabHandleSize, GrabHandleSize);
      end;
    fdDown:
      begin
        Cursor := crSizeNS;
        SetBounds(X[1], Y[2], GrabHandleSize, GrabHandleSize);
      end;
    fdLeftDown:
      begin
        Cursor := crSizeNESW;
        SetBounds(X[0], Y[2], GrabHandleSize, GrabHandleSize);
      end;
    fdLeft:
      begin
        Cursor := crSizeWE;
        SetBounds(X[0], Y[1], GrabHandleSize, GrabHandleSize);
      end;
  end;
  if FDesigner.ControlCount > 1 then
     Cursor := crDefault;
  BringToFront;
end;

{ TGrabHandleManager }

constructor TGrabHandleManager.Create(ADesigner: TDesignerHook);
begin
  inherited Create(nil);
  FDesigner := ADesigner;
end;

end.