?? proxy.pas
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -