proxy.pas

delphi 写的delphi的程序 Handel is a free, standalone development tool created with Delphi 3 that enable

unit Proxy;

interface

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

  {$Include handel.inc}

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;
    fColor:TColor;
    fMultiSelected:Boolean;
    procedure SetMultiSelected(Value:Boolean);
  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 SetGrabBounds;
    function Center: TPoint;
    property Color:TColor read fColor write fColor default clWhite;
    property GrabPosition: TGrabPosition read fPosition;
    property Control: TControl read fControl;
    property DraggingTo: Boolean read fDragging;
    property DragPoint: TPoint read fDragPoint;
    property DragRect: TRect read fDragRect;
    property GrabHandles: TGrabHandles read fHandles;
    property MultiSelected:Boolean read fMultiSelected write SetMultiSelected;
    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;
    fColor:TColor;
    fControl:TControl;
    fMultiSelected:Boolean;
    function GetHandle(Index: TGrabPosition): TGrabHandle;
    procedure SetVisible(Value: Boolean);
    procedure SetColor(Value:TColor);
    procedure SetMultiSelected(Value:Boolean);
  public
    constructor Create(Control: TControl);
    destructor Destroy; override;
    property  Color:TColor read fColor write SetColor;
    property  Handle[Index: TGrabPosition]: TGrabHandle read GetHandle;
    procedure Hide;
    procedure Show;
    procedure Update;
    property  Control:TControl read fControl write fControl;
    property  MultiSelected:Boolean read fMultiSelected write SetMultiSelected;
    property  Visible: Boolean read fVisible write SetVisible;
  end;

  TDragRectArray = array [1..255] of TRect;

  TDragRectItem = class
  private
     fRectArray: TDragRectArray;
     function GetItem(Index: Integer): TRect;
     procedure SetItem(Index:Integer;Value:TRect);
  public
     constructor Create;
     procedure Clear;
     property Item[Index:Integer]: TRect read GetItem write SetItem ;
  end;

  TDragRectList = class
  private
     fCount: Integer;
     fRectItem: TDragRectItem;
  public
     constructor Create;
     procedure Add(Control:TControl);
     procedure Clear;
     property Items: TDragRectItem read fRectItem write fRectItem ;
  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;
    procedure UpdateControl;
    property  Component: TComponent read fComponent;
    property  Bitmap: TBitmap read fBitmap;
  published
    property  OriginComponent:TComponent read fComponent write fComponent;
  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 FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    fControl: TControl;
    fDragging: Boolean;
    fDragPoint: TPoint;
    fDragRect: TRect;
    fGrabHandles: TGrabHandles;
    fComponentList: TStringList;
    fDragRectList: TDragRectList;
    GotMouse : boolean;
    Anchor, Rover : TPoint;
    procedure MakeARubber(X, Y : integer);
    procedure DrawRect(const Rect: TRect);
    procedure SaveTempForm;
  protected
    procedure ClipChildren(Clipping: Boolean);
    procedure SelectComponentsInRect(Rect: TRect);
    property  DraggingTo: Boolean read fDragging;
    property  DragPoint: TPoint read fDragPoint;
    property  DragRect: TRect read fDragRect;
  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);
    procedure OnFindMethodHandler(Reader: TReader; const MethodName: string;
              var Address: Pointer; var Error: Boolean);
    procedure OnReaderErrorHandler(Reader: TReader; const Message: string; var Handled: Boolean);
    property  ComponentList:TStringList read fComponentList write fComponentList;
    property  DragRectList: TDragRectList read fDragRectList write fDragRectList;
    // 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}

// 付快胶狼 困摹啊 靛贰弊俊 秦寸窍绰 芭府父怒 框流看绰啊甫 炼荤茄促.
function IsMouseDrag(Old, New: TPoint): Boolean;
var
  DifX, DifY:Integer;
begin
   Result:= False;
   DifX  := Abs(New.x - Old.x);
   DifY  := Abs(New.y - Old.y);
   if (DifX > 5) or (DifY > 5) then Result:= True
   else Result:= False;
end;

{ 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;
  fColor       := clWhite;
  fControl     := Control;
  fHandles     := Handles;
  fPosition    := Position;
  fSize        := Screen.PixelsPerInch div 32;
  // exclude csDesigning flag from grab control's componentstate for sizing control 
  TExposeComponent(self).SetDesigning(False);
  SetGrabBounds;
  ChooseCursor;
end;

{ Return the center coordinates of the grab handle. }
function TGrabHandle.Center: TPoint;
begin
  case GrabPosition of
    gpTopLeft:
       if fMultiSelected then Center := Point(Control.Left+2, Control.Top+2)
       else Center := Point(Control.Left, Control.Top);
    gpTop:
       Center := Point(Control.Left + Control.Width div 2, Control.Top);
    gpTopRight:
       if fMultiSelected then Center := Point(Control.Left + Control.Width -2, Control.Top+2)
       else Center := Point(Control.Left + Control.Width, Control.Top);
    gpRight:
       if fMultiSelected then
            Center := Point(Control.Left + Control.Width - 2, Control.Top + Control.Height div 2)
       else Center := Point(Control.Left + Control.Width, Control.Top + Control.Height div 2);
    gpBottomRight:
       if fMultiSelected then Center := Point(Control.Left + Control.Width-2, Control.Top + Control.Height-2)
       else Center := Point(Control.Left + Control.Width, Control.Top + Control.Height);
    gpBottom:
       Center := Point(Control.Left + Control.Width div 2, Control.Top + Control.Height);
    gpBottomLeft:
       if fMultiSelected then Center := Point(Control.Left+2, Control.Top + Control.Height-2)
       else Center := Point(Control.Left, Control.Top + Control.Height);
    gpLeft:
       if fMultiSelected then
            Center := Point(Control.Left + 2, Control.Top + Control.Height div 2)
       else 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.SetGrabBounds;
begin
  with Center do
    inherited SetBounds(X - LongInt(Size), Y - LongInt(Size), Size*2, Size*2);
  Invalidate;
end;

procedure TGrabHandle.Paint;
begin
  if GrabHandles.Visible then
  begin
    Canvas.Brush.Color := FColor;
    Canvas.Brush.Style := bsSolid;
   // Canvas.FillRect(ClientRect);
    Canvas.Rectangle(ClientRect.Left, ClientRect.Top, ClientRect.Right, ClientRect.Bottom);
  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 DraggingTo then  DoDrag(X, Y);
end;

{ Mouse up: stop dragging. }
procedure TGrabHandle.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if DraggingTo 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.DisplayProperty(Control,Control);  // Update Properties
end;

procedure TGrabHandle.SetMultiSelected(Value:Boolean);
begin
  if fMultiSelected = Value then Exit;
  fMultiSelected:= Value;
end;

{TGrabHandles}

{ 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;
  fColor   := clWhite;
  fControl := Control;
  fMultiSelected:= False;
  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;
  inherited Destroy;
end;

procedure TGrabHandles.SetColor(Value:TColor);
begin
   if fColor = Value then Exit;
   fColor:= Value;
   Update;
end;

{ Return a specific handle. }
function TGrabHandles.GetHandle(Index: TGrabPosition): TGrabHandle;
begin
  Result := fHandles[Index];
end;

{ Hide all the grab handles, when dragging. }
procedure TGrabHandles.Hide;
var
  Pos: TGrabPosition;
begin
  if Visible then
  begin
    fVisible := False;
    for Pos := Low(TGrabPosition) to High(TGrabPosition) do
      fHandles[Pos].Hide;
  end;
end;

{ Show all the grab handles again. }
procedure TGrabHandles.Show;
var
  Pos: TGrabPosition;
begin
  if not Visible then
  begin
    fVisible := True;
    for Pos := Low(TGrabPosition) to High(TGrabPosition) do
    begin
      if fHandles[Pos] = nil then Exit;
      fHandles[Pos].SetGrabBounds;
      fHandles[Pos].Color:= fColor;
      fHandles[Pos].Show;
    end;
  end;
end;

{ Update the position of the grab handles after resizing or moving. }
procedure TGrabHandles.Update;
var
  Pos: TGrabPosition;
begin
  if Visible then
    for Pos := Low(TGrabPosition) to High(TGrabPosition) do
    begin
      fHandles[Pos].SetGrabBounds;
      fHandles[Pos].Color:= fColor;
    end;
end;

{ Set the visibility of the grab handles. }
procedure TGrabHandles.SetVisible(Value: Boolean);
begin
  if Value then Show
  else  Hide
end;

// 咯矾 哪欺惩飘甫 悼矫俊 急琶窍绰 版快俊
// GrabHandle狼 困摹客 祸惑,Visible 咯何甫 搬沥茄促.
procedure TGrabHandles.SetMultiSelected(Value:Boolean);
var
  Pos: TGrabPosition;
begin
   if fMultiSelected = Value then Exit;
   fMultiSelected:= Value;
   if fMultiSelected then
   begin
      for Pos := Low(TGrabPosition) to High(TGrabPosition) do
      begin
       { if not (Pos in [gpBottomLeft,  gpTopLeft, gpTopRight,  gpBottomRight]) then
           fHandles[Pos].Visible:= False
        else}
        begin