proxy.pas

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

  inherited Destroy;
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].SetBounds;
      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
      fHandles[Pos].SetBounds;
end;

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

{ The wrapper control is used for non-visual components. The component
  is drawn as a button, so the user can move it, double click on it, etc. }
constructor TWrapperControl.Create(Owner: TComponent; Component: TComponent);
begin
  inherited Create(Owner);
  Parent := Owner as TWinControl;
  ControlStyle := ControlStyle + [csFixedWidth, csFixedHeight];
  fComponent := Component;
  fBitmap := TBitmap.Create;
  Bitmap.Height := 28;
  Bitmap.Width := 28;
  Height := Bitmap.Height;
  Width := Bitmap.Width;
  MakeBitmap;
end;

destructor TWrapperControl.Destroy;
begin
  Bitmap.Free;
  inherited Destroy;
end;

{ Make the button bitmap by looking up its bitmap resource, which
  was in its .DCR file. }
procedure TWrapperControl.MakeBitmap;
var
  ResName: array[0..64] of Char;
  ResBitmap: TBitmap;
  R: TRect;
  X, Y: Integer;
begin
  ResBitmap := TBitmap.Create;
  try
    StrPLCopy(ResName, Component.ClassName, SizeOf(ResName));
    AnsiUpper(ResName);
    ResBitmap.Handle := LoadBitmap(hInstance, ResName);
    if ResBitmap.Handle = 0 then
      ResBitmap.Handle := LoadBitmap(hInstance, 'DEFAULT');

    Bitmap.Canvas.Brush.Color := clBtnFace;
    Bitmap.Canvas.Pen.Color := clWindowText;
    Bitmap.Canvas.Rectangle(0, 0, Bitmap.Width, Bitmap.Height);
    R := Rect(1, 1, Bitmap.Width-1, Bitmap.Height-1);
    Frame3D(Bitmap.Canvas, R, clBtnHighlight, clBtnShadow, 2);

    X := (Bitmap.Width - ResBitmap.Width) div 2;
    Y := (Bitmap.Height - ResBitmap.Height) div 2;
    Bitmap.Canvas.BrushCopy(Bounds(X, Y, ResBitmap.Width, ResBitmap.Height),
                            ResBitmap,
                            Rect(0, 0, ResBitmap.Width, ResBitmap.Height),
                            ResBitmap.TransparentColor);
  finally
    ResBitmap.Free;
  end;
end;

{ Paint the button. }
procedure TWrapperControl.Paint;
var
  X, Y: Integer;
begin
  if Bitmap = nil then begin
  // 汽 颇老阑 佬绰 版快 俊绰 厚飘甘阑 叼弃飘 厚飘甘阑 焊咯霖促.
      fBitmap := TBitmap.Create;
      Bitmap.Height := 28;
      Bitmap.Width := 28;
      Bitmap.Handle := LoadBitmap(hInstance, 'DEFAULT');
  end;
  X := (ClientWidth - Bitmap.Width) div 2;
  Y := (ClientHeight - Bitmap.Height) div 2;
  Canvas.Draw(X, Y, Bitmap);
end;

{积己茄 哪欺惩飘狼 ComponentState甫 csDesigning肺 父甸扁 困茄 努贰胶.
 SetDesiging 皋辑靛啊 protected捞扁 锭巩俊 public栏肺 官操扁 困秦
 货肺款 努贰胶甫 父电促. SetDesigning狼 蔼阑 True肺 汲沥窍搁
 ComponentState 加己俊 csDesigning啊 器窃等促.}
type
  TExposeComponent = class(TComponent)
  public
    procedure SetDesigning(Value: Boolean);
  end;

procedure TExposeComponent.SetDesigning(Value: Boolean);
begin
  inherited SetDesigning(Value);
end;

{ Draw the component's frame while moving it. }
procedure TProxyForm.DrawRect(const Rect: TRect);
begin
  with Canvas do begin
     Pen.Color := Color;
     Pen.Mode := pmXor;
    // Pen.Style:= psDot;
     Pen.Width := 2;
     Brush.Style := bsClear;
  end;
  with Rect do
    Canvas.Rectangle(Left, Top, Right, Bottom);
  fDragRect := Rect;
end;

{ Set the component's boundaries. }
procedure TProxyForm.SetCompBounds(const Bounds: TRect);
begin
  with Bounds do
    SelectControl.SetBounds(Left, Top, Right-Left, Bottom-Top);
end;

{ Return the component's boundaries. }
function TProxyForm.GetCompBounds: TRect;
begin
  Result := SelectControl.BoundsRect;
end;

{ Set the cursor clipping region to the component editing area.
  This prevents the user from dragging the component into the
  method list or status bar. }
procedure TProxyForm.ClipCursorToComponentArea;
var
  Rect: TRect;
begin
  Rect.TopLeft := ClientToScreen(Point(0, 0));
  Rect.BottomRight := ClientToScreen(Point(Width, ClientHeight));
  ClipCursor(@Rect);
end;

{ Start moving the component by hiding its grab handles and
  drawing the frame to represent the component. }
procedure TProxyForm.StartDragging(Pt: TPoint);
begin
  fDragging := True;
  fDragPoint := Pt;
 // GrabHandles.Hide;
  ClipChildren(False);
  DrawRect(SelectControl.BoundsRect);
  ClipCursorToComponentArea;
end;

{ Draw the component's frame and redraw it. }
procedure TProxyForm.DragTo(Pt: TPoint);
var
  R: TRect;
begin
  DrawRect(DragRect);
  R := DragRect;
  R.Left := R.Left + Pt.X - DragPoint.X;
  R.Top := R.Top + Pt.Y - DragPoint.Y;
  R.Right := R.Left + SelectControl.Width;
  R.Bottom := R.Top + SelectControl.Height;
  DrawRect(R);
  fDragPoint := Pt;
end;

// 哪欺惩飘狼 靛贰弊甫 场郴绊 , 哪欺惩飘狼 困摹甫 盎脚茄促.
procedure TProxyForm.EndDragging(Pt: TPoint);
begin
  ClipChildren(True);
  if (Pt.X <> DragPoint.X) or (Pt.Y <> DragPoint.Y) then   DragTo(Pt);
  DrawRect(DragRect);
  SelectControl.Left := DragRect.Left;
  SelectControl.Top := DragRect.Top;
 // GrabHandles.Update;
  fDragging := False;
  ClipCursor(nil);
  SelectControl.Invalidate;
  ObjectInspector.DisplayProperty(nil,SelectControl); // Update Properties
  ProxyDesigner.PaintGrid;
end;

{ Turn on or off clipping for child components. When dragging
  the separator panel or the component, turning off the clipping
  draws the highlight over all controls. }
procedure TProxyForm.ClipChildren(Clipping: Boolean);
var
  Style: LongInt;
begin
  Style := GetWindowLong(Handle, Gwl_Style);
  if Clipping then
    Style := Style or Ws_ClipChildren
  else
    Style := Style and not Ws_ClipChildren;
  SetWindowLong(Handle, Gwl_Style, Style);
end;

// 汽俊 付快胶甫 努腐茄 版快 货肺款 哪欺惩飘甫 积己秦具 窍绰瘤客
// 靛贰弊 咯何甫 搬沥茄促.
procedure TProxyForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Pt: TPoint;
  SelClass:TComponentClass;
begin
   SelClass:= FMainForm.GetSelectComponent;
   if SelClass <> nil then begin
      ProxyDesigner.CreateComponent(SelClass,ProxyDesigner.Form,X,Y,0,0);
      Exit;
   end;
  // else if ControlAtPos(Point(X,Y),True) = nil then     ObjectInspector.DisplayProperty(nil,self);
   if SelectControl = nil then Exit;
   Pt := Point(X, Y);
   Pt := Self.ScreenToClient(SelectControl.ClientToScreen(Pt));
   if PtInRect(GetCompBounds, Pt) then  StartDragging(Pt)
   else ObjectInspector.DisplayProperty(nil,self);
end;

procedure TProxyForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Dragging then  DragTo(Point(X, Y));
end;

procedure TProxyForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if Dragging then  begin
      EndDragging(Point(X, Y));
      ProxyDesigner.UpdateGrabHandle;
   end;
end;

procedure TProxyForm.FormCreate(Sender: TObject);
begin
   Designer := TProxyDesigner.Create(self);
   fComponentList:= TStringList.Create;
   ProxyDesigner:= TProxyDesigner(Designer);
   ObjectInspector.DisplayProperty(nil,ProxyDesigner.Form);
end;

procedure TProxyForm.FormPaint(Sender: TObject);
begin
   ProxyDesigner.PaintGrid;
end;

procedure TProxyForm.FormActivate(Sender: TObject);
begin
   FMainForm.ActiveForm:= self;
   ProxyDesigner:= TProxyDesigner(self.Designer);
   ObjectInspector.InitializeInspector;
end;

// 扑诀 皋春甫 努腐沁阑 锭狼 捞亥飘 勤甸矾
procedure TProxyForm.OnMenuClick(Sender:TObject);
var
  Cap:string;
begin
   Cap:= TMenuItem(Sender).Caption;
   if Cap = 'Bring to Front' then  SelectControl.BringToFront
   else if Cap = 'Send to Back' then SelectControl.SendToBack
   else if Cap = 'Delete' then ProxyDesigner.DeleteSelectList ;
end;

procedure TProxyForm.FormDestroy(Sender: TObject);
begin
   fComponentList.Free;
end;

end.