proxy.pas

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

           fHandles[Pos].MultiSelected:= True;
           fHandles[Pos].Color:= fColor;
           fHandles[Pos].SetGrabBounds;
           fHandles[Pos].Show;
        end;
      end;
   end;
end;

{TDragRectItem}
constructor TDragRectItem.Create;
begin
   Clear;
end;

procedure TDragRectItem.Clear;
var
  I:Integer;
begin
   for I:= Low(TDragRectArray) to High(TDragRectArray) do
      fRectArray[I].Left:= -1;
end;

function TDragRectItem.GetItem(Index: Integer): TRect;
begin
   Result:= fRectArray[Index];
end;

procedure TDragRectItem.SetItem(Index:Integer; Value:TRect);
begin
   fRectArray[Index]:= Value;
end;

{TDragRectList}

{TDragRectList绰 咯矾俺狼 哪欺惩飘甫 急琶茄 饶 靛贰弊且 锭
 靛贰弊登绰 哪欺惩飘狼 困摹甫 焊咯林扁 困秦 荤侩茄促.}
constructor TDragRectList.Create;
begin
   fRectItem:= TDragRectItem.Create;
   Clear;
end;

procedure TDragRectList.Add(Control:TControl);
begin
   if fCount >= High(TDragRectArray) then Exit;
   fCount:= fCount + 1;
   fRectItem.Item[fCount]:= Control.BoundsRect;
end;

procedure TDragRectList.Clear;
begin
   fRectItem.Clear;
   fCount:=0;
end;

{TWrapperControl}

{ 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;

procedure TWrapperControl.UpdateControl;
begin
  if Bitmap = nil then
  begin
      fBitmap       := TBitmap.Create;
      Bitmap.Height := 28;
      Bitmap.Width  := 28;
      fComponent    := OriginComponent;
      if fComponent <> nil then MakeBitmap
      else Bitmap.Handle := LoadBitmap(hInstance, 'DEFAULT');
  end;
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;

{TProxyForm}

{ 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;

{ 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;

{ Start moving the component by hiding its grab handles and
  drawing the frame to represent the component. }
procedure TProxyForm.StartDragging(Pt: TPoint);
var
  I:Integer;
  R:TRect;
begin
  if ProxyDesigner =  nil then Exit;
  if ProxyDesigner.MultiSelected then Exit;
  if not IsMouseDrag(fDragPoint, Pt) then Exit;
  fDragging := True;
  fDragPoint := Pt;
  ClipChildren(False);
  for I:= Low(TDragRectArray) to High(TDragRectArray) do
  begin
     if DragRectList.Items.Item[I].Left = -1 then Break;
     R := DragRectList.Items.Item[I];
     DrawRect(R);
  end;
  ClipCursorToComponentArea;
end;

{ Draw the component's frame and redraw it. }
procedure TProxyForm.DragTo(Pt: TPoint);
var
  R: TRect;
  I:Integer;
  Control:TControl;
begin
  if ProxyDesigner =  nil then Exit;
  for I:=Low(TDragRectArray) to High(TDragRectArray) do
  begin
     if DragRectList.Items.Item[I].Left = -1 then Break;
     Control:= TControl(ProxyDesigner.SelectList[I-1]);
     DrawRect(DragRectList.Items.Item[I]);
     R        := DragRectList.Items.Item[I];
     R.Left   := R.Left + Pt.X - DragPoint.X;
     R.Top    := R.Top  + Pt.Y - DragPoint.Y;
     R.Right  := R.Left + Control.Width;
     R.Bottom := R.Top  + Control.Height;
     DrawRect(R);
     DragRectList.Items.Item[I]:= R;
  end;
  fDragPoint := Pt;
end;

// 哪欺惩飘狼 靛贰弊甫 场郴绊 , 哪欺惩飘狼 困摹甫 盎脚茄促.
procedure TProxyForm.EndDragging(Pt: TPoint);
var
  I:Integer;
  Control:TControl;
  R:TRect;
begin
  ClipChildren(True);
  if (Pt.X <> DragPoint.X) or (Pt.Y <> DragPoint.Y) then DragTo(Pt);
  for I:= Low(TDragRectArray) to High(TDragRectArray) do
  begin
     if DragRectList.Items.Item[I].Left = -1 then Break;
     Control:= TControl(ProxyDesigner.SelectList[I-1]);
     R := DragRectList.Items.Item[I];
     DrawRect(R);
     Control.Left := R.Left;
     Control.Top  := R.Top;
  end;
  fDragging := False;
  ClipCursor(nil);
  if not (SelectControl is TWrapperControl) then
    if ProxyDesigner.SelectList.Count = 1 then
       ObjectInspector.DisplayProperty(SelectControl,SelectControl); // Update Properties
  ProxyDesigner.UpdateGrabHandle;
  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
   if ProxyDesigner = nil then Exit;
   SelClass:= FMainForm.GetSelectComponent;
   if SelClass <> nil then
   begin
      if (SelectControl <> nil) and (SelectControl is TCustomControl) then
         ProxyDesigner.CreateComponent(SelClass, SelectControl, X, Y, 0, 0)
      else ProxyDesigner.CreateComponent(SelClass, ProxyDesigner.Form, X, Y, 0, 0);
      Exit;
   end;
   if (SelectControl = nil) then Exit;
   Pt := Point(X, Y);
   Pt := Self.ScreenToClient(SelectControl.ClientToScreen(Pt));
   if PtInRect(GetCompBounds, Pt) then  StartDragging(Pt)
   else
   begin
      ObjectInspector.DisplayProperty(nil,self);
      SetCapture(Handle);  { WIN API function, grabs all mouse actions to this window }
      GotMouse := True;    { need to keep track of who has teh mouse }
      Anchor.X := X; Anchor.Y := Y;  { where we started from }
      Rover := Anchor;               { where we are now}
      Canvas.MoveTo(X,Y);
   end;
end;

procedure TProxyForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  P:TPoint;
begin
  if ProxyDesigner = nil then Exit;
  // Shift 虐肺 哪欺惩飘甫 急琶窍绊 乐绰 版快俊绰 靛贰弊甫 倾侩窍瘤 臼绰促.
  if ProxyDesigner.MultiSelected then Exit;
  P:= Point(X, Y);
  // 漂沥茄 芭府父怒 付快胶甫 捞悼秦具 靛贰弊窍绰 巴栏肺 埃林茄促.
  if not IsMouseDrag(fDragPoint, P) then Exit;
  if DraggingTo then DragTo(Point(X, Y));
  if GotMouse then MakeARubber(X,Y);
end;

procedure TProxyForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if ProxyDesigner = nil then Exit;
   if DraggingTo then
   begin
      EndDragging(Point(X, Y));
      FMainForm.UpdateControl(psChange);
      Exit;
   end;
   if GotMouse then
   begin
     with Canvas do
     begin
       SetROP2(Handle,R2_NOTXORPEN);
       Pen.Style   := psDot;
       Brush.Style := bsClear;
       Rectangle(Anchor.X,Anchor.Y,Rover.X,Rover.Y);
     end;
     ReleaseCapture;
     SelectComponentsInRect(Rect(Anchor.X,Anchor.Y,Rover.X,Rover.Y));
     GotMouse := False;
   end;
end;

procedure TProxyForm.FormCreate(Sender: TObject);
begin
   {$IFDEF DELPHI3}
     Designer := ProxyDesigner;
   {$ENDIF}
   {$IFDEF DELPHI4}
     Designer := IFormDesigner(ProxyDesigner);
   {$ENDIF}
   fComponentList:= TStringList.Create;
   fDragRectList := TDragRectList.Create;
  // ProxyDesigner.SetProxyForm(self);
end;

procedure TProxyForm.FormActivate(Sender: TObject);
begin
   FMainForm.ActiveForm:= self;
   FMainForm.ToggleFormUnit:= True;
   ProxyDesigner.SetProxyForm(self);
end;

procedure TProxyForm.SaveTempForm;
var
  Output:TMemoryStream;
  I:Integer;
begin
    Output:=TMemoryStream.Create;
    for I:= ComponentCount-1 downto 0 do
    begin
       if Components[I] is TGrabHandle then  Components[I].Free
       else if Components[I].Name = 'ProxyPopupMenu1' then Components[I].Free;
    end;
    OutPut.WriteComponentRes(FilePath + TempForm,self);
    Output.SaveToFile(FilePath+TempForm);
    Output.Free;
end;

// Event handler for component's popup menu
procedure TProxyForm.OnMenuClick(Sender:TObject);
var
  Name:string;
begin
   Name:= TMenuItem(Sender).Name;
   if      Name = 'pmFront' then SelectControl.BringToFront
   else if Name = 'pmBack'  then SelectControl.SendToBack
   else if Name = 'pmCopy'  then ProxyDesigner.CopyComponent
   else if Name = 'pmCut'   then ProxyDesigner.CutComponent
   else if Name = 'pmPaste' then ProxyDesigner.PasteComponent
   else if Name = 'pmSize'  then FMainForm.EditSizeItemClick(self)
   else if Name = 'pmScale' then FMainForm.EditScaleItemClick(self)
   else if Name = 'pmAlign' then FMainForm.EditAlignItemClick(self)
   else if Name = 'pmViewAsText' then
   begin
      SaveTempForm;
      FMainForm.OpenFormAsText(FilePath+TempForm);
      EditorForm.PageControl1.ActivePage.Caption:= FileName;
   end
   else if Name = 'pmDelete' then ProxyDesigner.DeleteSelectList ;
end;

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

procedure TProxyForm.MakeARubber(X, Y : integer);
begin
  with Canvas do
  begin
    SetROP2(Handle,R2_NOTXORPEN);  { use to Raster Op codes to make the rubberband }
    Pen.Style   := psDot;
    Brush.Style := bsClear;        { don't fill the interior of the shape, please }
    Rectangle(Anchor.X,Anchor.Y,Rover.X,Rover.Y);
    Rover.X := X;
    Rover.Y := Y;
    Rectangle(Anchor.X,Anchor.Y,Rover.X,Rover.Y);
  end;
end;

procedure TProxyForm.SelectComponentsInRect(Rect: TRect);
// Select components in Rect
var
  I: Integer;
  Control: TControl;
  rec: TRect;
  List: TComponentList;
  rgn: HRGN;
begin
   rgn:= CreateRectRgn(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
   List:= TComponentList.Create;
   for I:= 0 to ComponentCount - 1 do
   begin
      Control:= TControl(Components[I]);
      rec:= Control.BoundsRect;
      if RectInRegion(rgn, rec) then List.Add(Control);
   end;
   {$IFDEF DELPHI4UP}
   //ProxyDesigner.SetSelections(List);
   ProxyDesigner.SetSelectionList(List);
   {$ENDIF}
   List.Free;
end;

procedure TProxyForm.OnFindMethodHandler(Reader: TReader; const MethodName: string;
    var Address: Pointer; var Error: Boolean);
begin
    Address:= ProxyDesigner.Form.MethodAddress(MethodName);
    if Address <> nil then
       ProxyDesigner.Methods[Integer(Address)]:= MethodName
    else
    begin
       ProxyDesigner.Methods.AddObject(MethodName, Address);
       Error:= False;
    end;
end;

procedure TProxyForm.OnReaderErrorHandler(Reader: TReader; const Message: string;
    var Handled: Boolean);
begin
   ShowMessage(Message);
   Handled:= True;
end;

end.