ctrldes.pas

类似Delphi Ide的对象查看器 可以在RUNTIME时使用

begin
  with Message do
    case Msg of
      WM_SETCURSOR:
      begin
        GetCursorPos(P);
        P:=ScreenToClient(P);
        case MouseZone(P.X,P.Y) of
          mzFrame: SetCursor(LoadCursor(0,IDC_SIZEALL));
          mzLeftTop,mzRightBottom: SetCursor(LoadCursor(0,IDC_SIZENWSE));
          mzLeftBottom,mzRightTop: SetCursor(LoadCursor(0,IDC_SIZENESW));
          mzCenterTop,mzCenterBottom: SetCursor(LoadCursor(0,IDC_SIZENS));
          mzLeftCenter,mzRightCenter: SetCursor(LoadCursor(0,IDC_SIZEWE));
        end;
      end;
      WM_LBUTTONDOWN:
      begin
        Visible:=False;
        FDragRect:=FControl.Parent.ClientRect;
        MapWindowPoints(FControl.Parent.Handle,HWND_DESKTOP,FDragRect,2);
        ClipCursor(@FDragRect);
        FDragRect:=FControl.BoundsRect;
        FDragZone:=MouseZone(lParamLo,lParamHi);
        GetCursorPos(FDragPoint);
        if not FDirectDrag then DrawDragRect;
        SetCapture(Handle);
      end;
      WM_MOUSEMOVE:
        if FDragZone<>mzNone then
        begin
          GetCursorPos(P);
          R:=FDragRect;
          with R do
          begin
            X:=P.X-FDragPoint.X;
            Y:=P.Y-FDragPoint.Y;
            case FDragZone of
              mzFrame: OffsetRect(R,X,Y);
              mzLeftTop:
              begin
                Inc(Left,X);
                Inc(Top,Y);
              end;
              mzCenterTop: Inc(Top,Y);
              mzRightTop:
              begin
                Inc(Right,X);
                Inc(Top,Y);
              end;
              mzLeftCenter: Inc(Left,X);
              mzRightCenter: Inc(Right,X);
              mzLeftBottom:
              begin
                Inc(Left,X);
                Inc(Bottom,Y);
              end;
              mzCenterBottom: Inc(Bottom,Y);
              mzRightBottom:
              begin
                Inc(Right,X);
                Inc(Bottom,Y);
              end;
            end;
            if Right-Left<FMinSize then
              case FDragZone of
                mzLeftTop,mzLeftCenter,mzLeftBottom: Left:=Right-FMinSize;
                mzRightTop,mzRightCenter,mzRightBottom: Right:=Left+FMinSize;
              end;
            if Bottom-Top<FMinSize then
              case FDragZone of
                mzLeftTop,mzCenterTop,mzRightTop: Top:=Bottom-FMinSize;
                mzLeftBottom,mzCenterBottom,mzRightBottom: Bottom:=Top+FMinSize;
              end;
            if not EqualRect(R,FDragRect) then
            begin
              HideDragHint;
              if not FDirectDrag then DrawDragRect;
              FDragRect:=R;
              GetCursorPos(FDragPoint);
              if not FDirectDrag then DrawDragRect
              else FControl.BoundsRect:=FDragRect;
              if FDragZone=mzFrame then ShowDragHint(Format('%d, %d',[Left,Top]))
              else ShowDragHint(Format('%d x %d',[Right-Left,Bottom-Top]));
            end;
          end;
        end;
      WM_LBUTTONUP:
      begin
        ClipCursor(nil);
        if GetCapture=Handle then ReleaseCapture;
        HideDragHint;
        if not FDirectDrag then
        begin
          DrawDragRect;
          Control.BoundsRect:=FDragRect;
        end;
        FDragZone:=mzNone;
        UpdatePosition;
        Visible:=Assigned(FControl);
        if Assigned(FControl) and Assigned(FOnDragControl) then FOnDragControl(Self,FControl);
      end;
      WM_LBUTTONDBLCLK:
        if Assigned(Designer) and Assigned(Designer.OnDblClick) then
          Designer.OnDblClick(Designer)
        else
          if not FDirectDrag then DrawDragRect;
      WM_NCPAINT: if FEnableKeys then SetFocus;
      CM_CHILDKEY:
        if Assigned(FControl) then
        begin
          if GetKeyState(VK_CONTROL) and $80 <> 0 then Step:=8
          else Step:=1;
          Shift:=GetKeyState(VK_SHIFT) and $80 <> 0;
          with FControl do
            case wParam of
              VK_LEFT:
                if Shift then
                begin
                  X:=Width-Step;
                  if X<FMinSize then X:=FMinSize;
                  if X<>Width then Width:=X;
                end
                else Left:=Left-Step;
              VK_RIGHT:
                if Shift then Width:=Width+Step
                else Left:=Left+Step;
              VK_UP:
                if Shift then
                begin
                  Y:=Height-Step;
                  if Y<FMinSize then Y:=FMinSize;
                  if Y<>Height then Height:=Y;
                end
                else Top:=Top-Step;
              VK_DOWN:
                if Shift then Height:=Height+Step
                else Top:=Top+Step;
            else
            begin
              inherited;
              Exit;
            end;
            end;
          UpdatePosition;
          Result:=1;
        end;
      else inherited;
    end;
end;

constructor TControlDesignerFrame.Create(AOwner: TComponent);
begin
  inherited;
  FHintWindow:=THintWindow.Create(Self);
  FHintWindow.Color:=clInfoBk;
  FThickness:=8;
  FMinSize:=8;
  FShowMoveSizeHint:=True;
  FBorderColor:=clGray;
  FGrabColor:=clWhite;
  FFrameColor:=clGray;
end;

destructor TControlDesignerFrame.Destroy;
begin
  DeleteObject(FRegion);
  inherited;
end;

procedure TControlDesignerFrame.UpdatePosition;
var
  R: TRect;
begin
  if not (csDesigning in ComponentState) and Assigned(FControl) then
  begin
    R:=FControl.BoundsRect;
    InflateRect(R,FThickness,FThickness);
    BoundsRect:=R;
    Parent:=FControl.Parent;
    BringToFront;
    UpdateShape;
  end;
end;

procedure TCustomControlDesigner.SetActive(const Value: Boolean);
begin
  FActive:=Value;
  if Assigned(FFrame) then FFrame.Visible:=FActive and not (csDesigning in ComponentState);
end;

function TCustomControlDesigner.GetControl: TControl;
begin
  if Assigned(FFrame) then Result:=FFrame.Control
  else Result:=nil;
end;

procedure TCustomControlDesigner.SetControl(const Value: TControl);
begin
  if Assigned(FFrame) then FFrame.Control:=Value;
end;

function TCustomControlDesigner.GetThickness: Integer;
begin
  if Assigned(FFrame) then Result:=FFrame.Thickness
  else Result:=0;
end;

procedure TCustomControlDesigner.SetThickness(const Value: Integer);
begin
  if Assigned(FFrame) then FFrame.Thickness:=Value;
end;

function TCustomControlDesigner.GetDirectDrag: Boolean;
begin
  if Assigned(FFrame) then Result:=FFrame.DirectDrag
  else Result:=False;
end;

procedure TCustomControlDesigner.SetDirectDrag(const Value: Boolean);
begin
  if Assigned(FFrame) then FFrame.DirectDrag:=Value;
end;

function TCustomControlDesigner.GetMinSize: Integer;
begin
  if Assigned(FFrame) then Result:=FFrame.MinSize
  else Result:=0;
end;

procedure TCustomControlDesigner.SetMinSize(const Value: Integer);
begin
  if Assigned(FFrame) then FFrame.MinSize:=Value;
end;

function TCustomControlDesigner.GetShowMoveSizeHint: Boolean;
begin
  if Assigned(FFrame) then Result:=FFrame.ShowMoveSizeHint
  else Result:=False;
end;

procedure TCustomControlDesigner.SetShowMoveSizeHint(const Value: Boolean);
begin
  if Assigned(FFrame) then FFrame.ShowMoveSizeHint:=Value;
end;

function TCustomControlDesigner.GetBorderColor: TColor;
begin
  if Assigned(FFrame) then Result:=FFrame.BorderColor
  else Result:=clBlack;
end;

procedure TCustomControlDesigner.SetBorderColor(const Value: TColor);
begin
  if Assigned(FFrame) then FFrame.BorderColor:=Value;
end;

function TCustomControlDesigner.GetFrameColor: TColor;
begin
  if Assigned(FFrame) then Result:=FFrame.FrameColor
  else Result:=clBlack;
end;

procedure TCustomControlDesigner.SetFrameColor(const Value: TColor);
begin
  if Assigned(FFrame) then FFrame.FrameColor:=Value;
end;

function TCustomControlDesigner.GetGrabColor: TColor;
begin
  if Assigned(FFrame) then Result:=FFrame.GrabColor
  else Result:=clBlack;
end;

procedure TCustomControlDesigner.SetGrabColor(const Value: TColor);
begin
  if Assigned(FFrame) then FFrame.GrabColor:=Value;
end;

function TCustomControlDesigner.GetEnableKeys: Boolean;
begin
  if Assigned(FFrame) then Result:=FFrame.EnableKeys
  else Result:=False;
end;

procedure TCustomControlDesigner.SetEnableKeys(const Value: Boolean);
begin
  if Assigned(FFrame) then FFrame.EnableKeys:=Value;
end;

function TCustomControlDesigner.GetOnAllowSelectControl: TControlAllowEvent;
begin
  if Assigned(FFrame) then Result:=FFrame.OnAllowSelectControl
  else Result:=nil;
end;

procedure TCustomControlDesigner.SetOnAllowSelectControl(const Value: TControlAllowEvent);
begin
  if Assigned(FFrame) then FFrame.OnAllowSelectControl:=Value;
end;

function TCustomControlDesigner.GetOnSelectControl: TControlEvent;
begin
  if Assigned(FFrame) then Result:=FFrame.OnSelectControl
  else Result:=nil;
end;

procedure TCustomControlDesigner.SetOnSelectControl(const Value: TControlEvent);
begin
  if Assigned(FFrame) then FFrame.OnSelectControl:=Value;
end;

function TCustomControlDesigner.GetOnAllowDragControl: TControlAllowEvent;
begin
  if Assigned(FFrame) then Result:=FFrame.OnAllowDragControl
  else Result:=nil;
end;

procedure TCustomControlDesigner.SetOnAllowDragControl(const Value: TControlAllowEvent);
begin
  if Assigned(FFrame) then FFrame.OnAllowDragControl:=Value;
end;

function TCustomControlDesigner.GetOnDragControl: TControlEvent;
begin
  if Assigned(FFrame) then Result:=FFrame.OnDragControl
  else Result:=nil;
end;

procedure TCustomControlDesigner.SetOnDragControl(const Value: TControlEvent);
begin
  if Assigned(FFrame) then FFrame.OnDragControl:=Value;
end;

function TCustomControlDesigner.GetOnDblClick: TNotifyEvent;
begin
  if Assigned(FFrame) then Result:=FFrame.OnDblClick
  else Result:=nil;
end;

procedure TCustomControlDesigner.SetOnDblClick(const Value: TNotifyEvent);
begin
  if Assigned(FFrame) then FFrame.FOnDblClick:=Value;
end;

constructor TCustomControlDesigner.Create(AOwner: TComponent);
begin
  inherited;
  FFrame:=TControlDesignerFrame.Create(Self);
end;

procedure TCustomControlDesigner.Update;
begin
  if Assigned(Control) then FFrame.UpdatePosition;
end;

{procedure Register;
begin
  RegisterComponents('MyDesigners', [TControlDesigner]);
end;}

end.