proxy.pas

一个模拟Delphi的快速开发环境RAD

unit Proxy;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,TypInfo, Buttons, DsgnIntf,ExtCtrls, Menus;

type
  TGrabPosition = (gpBottomLeft, gpLeft, gpTopLeft, gpTop,
                   gpTopRight, gpRight, gpBottomRight, gpBottom);
  TGrabHandles = class;
  TGrabHandle = class(TCustomControl)
  private
    fPosition: TGrabPosition;
    fControl: TControl;
    fDragging: Boolean;
    fDragPoint: TPoint;
    fDragRect: TRect;
    fSize: Cardinal;
    fHandles: TGrabHandles;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure StartDrag(X, Y: Integer);
    procedure DoDrag(X, Y: Integer);
    procedure EndDrag(X, Y: Integer);
    procedure ChooseCursor;
  public
    constructor Create(Control: TControl; Position: TGrabPosition; Handles: TGrabHandles);
    procedure Paint; override;
    procedure SetBounds; virtual;
    function Center: TPoint;
    property GrabPosition: TGrabPosition read fPosition;
    property Control: TControl read fControl;
    property Dragging: Boolean read fDragging;
    property DragPoint: TPoint read fDragPoint;
    property DragRect: TRect read fDragRect;
    property GrabHandles: TGrabHandles read fHandles;
    property Size: Cardinal read fSize;
  end;

  { Array of grab handles at strategic locations around a component. }
  TGrabHandleArray = array[Low(TGrabPosition)..High(TGrabPosition)] of TGrabHandle;
  TGrabHandles = class
  private
    fHandles: TGrabHandleArray;
    fVisible: Boolean;
    function GetHandle(Index: TGrabPosition): TGrabHandle;
    procedure SetVisible(Value: Boolean);
  public
    constructor Create(Control: TControl);
    destructor Destroy; override;
    property  Handle[Index: TGrabPosition]: TGrabHandle read GetHandle;
    procedure Hide;
    procedure Show;
    procedure Update;
    property  Visible: Boolean read fVisible write SetVisible;
  end;

  { A control wrapper for non-visual components. }
  TWrapperControl = class(TCustomControl)
  private
    fComponent: TComponent;
    fBitmap: TBitmap;
  protected
    procedure MakeBitmap;
  public
    constructor Create(Owner: TComponent; Component: TComponent);
    destructor Destroy; override;
    procedure Paint; override;
    property  Component: TComponent read fComponent;
    property  Bitmap: TBitmap read fBitmap;
  end;

  TProxyForm = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    fControl: TControl;
    fDragging: Boolean;
    fDragPoint: TPoint;
    fDragRect: TRect;
    fGrabHandles: TGrabHandles;
    fComponentList: TStringList;
    procedure DrawRect(const Rect: TRect);
  protected
    property  Dragging: Boolean read fDragging;
    property  DragPoint: TPoint read fDragPoint;
    property  DragRect: TRect read fDragRect;
    procedure ClipChildren(Clipping: Boolean);
  public
    { Public declarations }
    FileName:string;
    procedure StartDragging(Pt: TPoint);
    procedure EndDragging(Pt: TPoint);
    procedure DragTo(Pt: TPoint);
    procedure ClipCursorToComponentArea;
    procedure SetCompBounds(const Bounds: TRect);
    function  GetCompBounds: TRect;
    procedure OnMenuClick(Sender:TObject);
    property  ComponentList:TStringList read fComponentList write fComponentList;
    // Control 加己篮 汽俊辑 急琶茄 牧飘费狼 沥焊甫 爱绊 乐绰促.
    property  SelectControl: TControl read fControl write fControl;
    property  GrabHandles: TGrabHandles read fGrabHandles write fGrabHandles;
  end;

var
  ProxyForm: TProxyForm;

implementation

uses ObjectInspec, MainForm, Uconst,utype, Editor;

{$R *.DFM}
// 厚矫阿利 哪欺惩飘狼 厚飘甘阑 掘扁 困秦 酒贰狼 哪欺惩飘 府家胶啊 鞘夸窍促.
{$R STDREG.DCR}
{$R SYSREG.DCR}
{$R DBREG.DCR}

{ Create a grab handle at a specific position, for a control. }
constructor TGrabHandle.Create(Control: TControl; Position: TGrabPosition; Handles: TGrabHandles);
begin
  inherited Create(Control.Owner);
  ControlStyle := ControlStyle - [csOpaque];
  Parent := Control.Parent;
  fControl := Control;
  fHandles := Handles;
  fPosition := Position;
  fSize := Screen.PixelsPerInch div 32;
  SetBounds;
  ChooseCursor;
end;

{ Return the center coordinates of the grab handle. }
function TGrabHandle.Center: TPoint;
begin
  case GrabPosition of
  gpTopLeft:    Center := Point(Control.Left, Control.Top);
  gpTop:        Center := Point(Control.Left + Control.Width div 2, Control.Top);
  gpTopRight:   Center := Point(Control.Left + Control.Width, Control.Top);
  gpRight:      Center := Point(Control.Left + Control.Width, Control.Top + Control.Height div 2);
  gpBottomRight:Center := Point(Control.Left + Control.Width, Control.Top + Control.Height);
  gpBottom:     Center := Point(Control.Left + Control.Width div 2, Control.Top + Control.Height);
  gpBottomLeft: Center := Point(Control.Left, Control.Top + Control.Height);
  gpLeft:       Center := Point(Control.Left, Control.Top + Control.Height div 2);
  end;
end;

{ Set the cursor, depending on the position of the handle. }
procedure TGrabHandle.ChooseCursor;
begin
  case GrabPosition of
  gpTopLeft, gpBottomRight: Cursor := crSizeNWSE;
  gpTop, gpBottom:          Cursor := crSizeNS;
  gpTopRight, gpBottomLeft: Cursor := crSizeNESW;
  gpRight, gpLeft:          Cursor := crSizeWE;
  end;
end;

{ Set the boundaries of the grab handle. }
procedure TGrabHandle.SetBounds;
begin
  with Center do
    inherited SetBounds(X - Size, Y - Size, Size*2, Size*2);
end;

{ Paint the grab handle as a black rectangle. Actually, use
  clWindowText, since that should show up well against the background
  of clBtnFace. }
procedure TGrabHandle.Paint;
begin
  if GrabHandles.Visible then
  begin
    Canvas.Brush.Color := clWindowText;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(ClientRect);
  end;
end;

{ Left button down on a grab handle means the user is resizing the control. }
procedure TGrabHandle.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then StartDrag(X, Y);
end;

{ While resizing, drag the sizing rectangle. }
procedure TGrabHandle.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Dragging then  DoDrag(X, Y);
end;

{ Mouse up: stop dragging. }
procedure TGrabHandle.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Dragging then  EndDrag(X, Y);
end;

{ Start dragging to resize the control. Hide the handles, and
  show the sizing rectangle. Restrict the cursor to the editing
  area, so the user doesn't move nto the method list. }
procedure TGrabHandle.StartDrag(X, Y: Integer);
var
  ControlPt: TPoint;
begin
  fDragging := True;
  ControlPt := Center;
  fDragPoint := Point(X - ControlPt.X, Y - ControlPt.Y);
  GrabHandles.Hide;

  fDragRect := Control.BoundsRect;
  with Owner as TProxyForm do
  begin
    ClipCursorToComponentArea;
    ClipChildren(False);
    DrawRect(Self.DragRect);
  end;
end;

{ Continue dragging the sizing rectangle. If the user drags the corner
  across the control, the corners might need to be swapped. }
procedure TGrabHandle.DoDrag(X, Y: Integer);
  procedure Swap(var A, B: Integer);
  var
    Tmp: Integer;
  begin
    Tmp := A;
    A := B;
    B := Tmp;
  end;
var
  OldRect, NewRect: TRect;
begin
  with Owner as TProxyForm do
   DrawRect(Self.DragRect);
  X := X - DragPoint.X;
  Y := Y - DragPoint.Y;
  OldRect := Control.BoundsRect;
  case GrabPosition of
  gpTopLeft:     NewRect := Rect(X, Y, OldRect.Right, OldRect.Bottom);
  gpTop:         NewRect := Rect(OldRect.Left, Y, OldRect.Right, OldRect.Bottom);
  gpTopRight:    NewRect := Rect(OldRect.Left, Y, X, OldRect.Bottom);
  gpRight:       NewRect := Rect(OldRect.Left, OldRect.Top, X, OldRect.Bottom);
  gpBottomRight: NewRect := Rect(OldRect.Left, OldRect.Top, X, Y);
  gpBottom:      NewRect := Rect(OldRect.Left, OldRect.Top, OldRect.Right, Y);
  gpBottomLeft:  NewRect := Rect(X, OldRect.Top, OldRect.Right, Y);
  gpLeft:        NewRect := Rect(X, OldRect.Top, OldRect.Right, OldRect.Bottom);
  end;
  with NewRect do
  begin
    if Top > Bottom then
      Swap(Top, Bottom);
    if Left > Right then
      Swap(Left, Right);
  end;
  fDragRect := NewRect;
  with Owner as TProxyForm do
    DrawRect(Self.DragRect);
end;

{ Stop dragging the sizing rectangle. }
procedure TGrabHandle.EndDrag(X, Y: Integer);
var
  Rect: TRect;
begin
  with Owner as TProxyForm do
  begin
    ClipChildren(True);
    DrawRect(Self.DragRect);
  end;
  fDragging := False;
  ClipCursor(nil);

  { Some components are fixed size. If so, keep the origin,
    but reset the size to the fixed size. }
  Rect := DragRect;
  if csFixedWidth in Control.ControlStyle then
    Rect.Right := Rect.Left + Control.Width;
  if csFixedHeight in Control.ControlStyle then
    Rect.Bottom := Rect.Top + Control.Height;
  with Rect do
    Control.SetBounds(Left, Top, Right-Left, Bottom-Top);
  GrabHandles.Show;
  // 函拳等 加己蔼阑 盎脚茄促.
  //ObjectInspector.ComponentListChange(self);
  ObjectInspector.DisplayProperty(nil,Control);  // Update Properties
end;

{ Create a set of grab handles, at the corners and sides of a control. }
constructor TGrabHandles.Create(Control: TControl);
var
  Pos: TGrabPosition;
begin
  inherited Create;
  fVisible := True;
  for Pos := Low(TGrabPosition) to High(TGrabPosition) do
    fHandles[Pos] := TGrabHandle.Create(Control, Pos, Self);
end;

destructor TGrabHandles.Destroy;
var
  Pos: TGrabPosition;
begin
  for Pos := Low(TGrabPosition) to High(TGrabPosition) do
    fHandles[Pos].Free;