dcmain.pas.svn-base

来自「TFormDesigner allows you move and resize」· SVN-BASE 代码 · 共 2,066 行 · 第 1/5 页

{ TGrabHandle }

constructor TGrabHandle.Create(AOwner: TComponent);
begin
  inherited;
  with (Owner as TGrabHandles).Designer do
  begin
    Width:=FGrabSize;
    Height:=FGrabSize;
    Parent:=ParentForm;
  end;
  ControlStyle:=ControlStyle+[csReplicatable];
end;

procedure TGrabHandle.Paint;
var
  GrabType: TGrabType;
begin
  if Assigned(Parent) then
    with TGrabHandles(Owner).Designer do
    begin
      if Locked then GrabType:=gtLocked
      else GrabType:=gtNormal;
      PaintGrab(Canvas,ClientRect,GrabType,Position);
    end;
end;

procedure TGrabHandle.SetPosition(const Value: TGrabPosition);
begin
  if Value<>FPosition then
  begin
    FPosition:=Value;
    Cursor:=GetGrabCursor(FPosition);
    UpdateCoords;
  end;
end;

procedure TGrabHandle.SetRect(const Value: TRect);
begin
  if not EqualRect(FRect,Value) then
  begin
    FRect:=Value;
    UpdateCoords;
  end;
end;

procedure TGrabHandle.SetLocked(const Value: Boolean);
begin
  if Value<>FLocked then
  begin
    FLocked:=Value;
    if Visible then Invalidate;
  end;
end;

procedure TGrabHandle.UpdateCoords;
var
  ALeft,ATop: Integer;
begin
  if Assigned(Parent) then
    with (Owner as TGrabHandles).Designer do
    begin
      case FPosition of
        gpLeftTop,gpLeftMiddle,gpLeftBottom: ALeft:=FRect.Left-FGrabSize div 2;
        gpMiddleTop,gpMiddleBottom: ALeft:=(FRect.Left+FRect.Right-FGrabSize) div 2;
        gpRightTop,gpRightMiddle,gpRightBottom: ALeft:=Pred(FRect.Right-FGrabSize div 2);
      else ALeft:=0;
      end;
      case FPosition of
        gpLeftTop,gpMiddleTop,gpRightTop: ATop:=FRect.Top-FGrabSize div 2;
        gpLeftMiddle,gpRightMiddle: ATop:=(FRect.Top+FRect.Bottom-FGrabSize) div 2;
        gpLeftBottom,gpMiddleBottom,gpRightBottom: ATop:=Pred(FRect.Bottom-FGrabSize div 2);
      else ATop:=0;
      end;
      BoundsRect:=Classes.Rect(ALeft,ATop,ALeft+FGrabSize,ATop+FGrabSize);
    end;
end;

{ TGrabHandles }

procedure TGrabHandles.SetControl(const Value: TControl);
begin
  FControl:=Value;
  Update;
end;

procedure TGrabHandles.SetVisible(const Value: Boolean);
var
  GP: TGrabPosition;
begin
  if Value<>FVisible then
  begin
    FVisible:=Value;
    for GP:=Succ(Low(GP)) to High(GP) do
      with FItems[GP] do
      begin
        Visible:=FVisible;
        if Assigned(Parent) then
          if FVisible then ShowWindow(Handle,SW_SHOW)
          else ShowWindow(Handle,SW_HIDE);
      end;
  end;
end;

function TGrabHandles.GetDesigner: TCustomDesignerComponent;
begin
  if Assigned(Owner) then Result:=Owner as TCustomDesignerComponent
  else Result:=nil;
end;

constructor TGrabHandles.Create(AOwner: TComponent);
var
  GP: TGrabPosition;
begin
  inherited;
  for GP:=Succ(Low(GP)) to High(GP) do
  begin
    FItems[GP]:=TGrabHandle.Create(Self);
    with FItems[GP] do
    begin
      Position:=GP;
      Visible:=False;
    end;
  end;
end;

procedure TGrabHandles.Update;
var
  GP: TGrabPosition;
begin
  if Designer.Active then
  begin
    for GP:=Succ(Low(GP)) to High(GP) do
      if Assigned(FItems[GP]) then
        with FItems[GP] do
          if Assigned(FControl) then
          begin
            Rect:=FControl.BoundsRect;
            Parent:=FControl.Parent;
            Locked:=caLocked in Designer.ComponentAttributes(FControl);
            if FVisible then ShowWindow(Handle,SW_SHOW)
            else ShowWindow(Handle,SW_HIDE);
            if Visible then BringToFront;
          end
          else
          try
            ShowWindow(Handle,SW_HIDE);
          except
          end;
  end;
end;

procedure TGrabHandles.UpdateCoords;
var
  GP: TGrabPosition;
begin
  if Assigned(FControl) then
    for GP:=Succ(Low(GP)) to High(GP) do
      FItems[GP].Rect:=FControl.BoundsRect;
end;

procedure TGrabHandles.BringToFront;
var
  GP: TGrabPosition;
begin
  for GP:=Succ(Low(GP)) to High(GP) do
    if Assigned(FItems[GP]) then FItems[GP].BringToFront;
end;

function TGrabHandles.FindHandle(AComponent: TComponent): TGrabPosition;
var
  GP: TGrabPosition;
begin
  Result:=gpNone;
  for GP:=Succ(Low(GP)) to High(GP) do
    if Assigned(FItems[GP]) and (FItems[GP]=AComponent) then
    begin
      Result:=GP;
      Break;
    end;
end;

function TGrabHandles.IsGrabHandle(AComponent: TComponent): Boolean;
begin
  Result:=FindHandle(AComponent)<>gpNone;
end;

{TCustomDesignerInterface}

procedure TDesignerInterface.ValidateRename(AComponent: TComponent; const CurName, NewName: string);
begin
end;

procedure TDesignerInterface.PaintGrid;
begin
  if Assigned(FDesignerComponent) and Assigned(FDesignerComponent.ParentForm) then
    with FDesignerComponent,ParentForm do
      PaintGrid(Canvas,ClientRect);
end;

function TDesignerInterface.IsDesignMsg(Sender: TControl; var Message: TMessage): Boolean;
begin
  if Assigned(FDesignerComponent) and
    not (csDestroying in FDesignerComponent.ComponentState) and
    not (csLoading in FDesignerComponent.ComponentState) and
    (FDesignerComponent.ParentForm.Showing) then
    Result:=FDesignerComponent.MessageProcessor(Sender,Message)
  else Result:=False;
end;

{$IFDEF DESIGNERASCLASS}

procedure TDesignerInterface.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if Assigned(FDesignerComponent) and not (csDestroying in FDesignerComponent.ComponentState) then
    FDesignerComponent.NotificationProcessor(AComponent,Operation);
end;

{$ELSE}

function TDesignerInterface.GetCustomForm: TCustomForm;
begin
  if Assigned(FDesignerComponent) and not (csDestroying in FDesignerComponent.ComponentState) then
    Result:=FDesignerComponent.ParentForm
  else Result:=nil;
end;

procedure TDesignerInterface.SetCustomForm(Value: TCustomForm);
begin
end;

function TDesignerInterface.GetIsControl: Boolean;
begin
  Result:=False;
end;

procedure TDesignerInterface.SetIsControl(Value: Boolean);
begin
end;

procedure TDesignerInterface.Notification(AnObject: TPersistent; Operation: TOperation);
begin
  if (AnObject is TComponent) and (AnObject=FDesignerComponent) then FDesignerComponent:=nil
  else
    if Assigned(FDesignerComponent) and not (csDestroying in FDesignerComponent.ComponentState) and (AnObject is TComponent) then
      FDesignerComponent.NotificationProcessor(TComponent(AnObject),Operation);
end;

function TDesignerInterface.GetRoot: TComponent;
begin
  Result:=Form;
end;

function TDesignerInterface.UniqueName(const BaseName: string): string;
begin
  Result:=BaseName;
end;

{$ENDIF}

procedure TDesignerInterface.Modified;
begin
end;

constructor TDesignerInterface.Create(ADesignerComponent: TCustomDesignerComponent);
begin
  inherited Create;
  FDesignerComponent:=ADesignerComponent;
end;

{ TComponentContainer }

procedure TComponentContainer.Paint;
begin
  with Canvas do
  begin
    Brush.Color:=clBtnFace;
    FillRect(ClientRect);
    Pen.Color:=clBtnHighlight;
    MoveTo(0,Pred(Height));
    LineTo(0,0);
    LineTo(Width,0);
    Pen.Color:=clBtnShadow;
    MoveTo(0,Pred(Height));
    LineTo(Pred(Width),Pred(Height));
    LineTo(Pred(Width),0);
    with FBitmap do
    begin
      Handle:=LoadBitmap(HInstance,PChar(string(Component.ClassName)));
      if Handle=0 then Handle:=LoadBitmap(HInstance,'TCOMPONENT');
    end;
    Draw(2,2,FBitmap);
  end;
end;

procedure TComponentContainer.WndProc(var Msg: TMessage);
begin
  with Msg do
    case Msg of
      WM_SIZE:
      begin
        Width:=28;
        Height:=28;
      end;
      WM_MOVE:
      begin
        inherited;
        if Assigned(FComponent) then
          FComponent.DesignInfo:=Left+Top shl 16;
      end;
    else inherited;
    end;
end;

constructor TComponentContainer.CreateWithComponent(AOwner,AComponent: TComponent);
begin
  inherited Create(AOwner);
  FBitmap:=TBitmap.Create;
  with FBitmap do
  begin
    Handle:=LoadBitmap(HInstance,'CONTAINER');
    Transparent:=True;
  end;
  FComponent:=AComponent;
  Visible:=Assigned(FComponent);
  Width:=28;
  Height:=28;
  ShowHint:=True;
  with FComponent do
  begin
    Left:=LoWord(DesignInfo);
    Top:=HiWord(DesignInfo);
    Hint:=Name;
  end;
end;

destructor TComponentContainer.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

{ TCustomDesignerComponent }

function TCustomDesignerComponent.GetControl: TControl;
begin
  if SelectedControlCount>0 then Result:=SelectedControls[0]
  else Result:=nil;
end;

procedure TCustomDesignerComponent.SetControl(const Value: TControl);
var
  i: Integer;
begin
  with FSelected do
  begin
    i:=0;
    while i<Count do
      if not DeselectControl(Items[0]) then Inc(i);
    if Assigned(Value) then SelectControl(Value);
  end;
end;

function TCustomDesignerComponent.GetSelectedControlCount: Integer;
begin
  Result:=FSelected.Count;
end;

function TCustomDesignerComponent.GetSelectedControl(Index: Integer): TControl;
begin
  with FSelected do
    if (Index>=0) and (Index<Count) then Result:=FSelected[Index]
    else Result:=nil;
end;

function TCustomDesignerComponent.GetComponent: TComponent;
begin
  Result:=Control;
  if Assigned(Result) and (Result is TComponentContainer) then
    Result:=TComponentContainer(Result).Component;
end;

procedure TCustomDesignerComponent.SetComponent(const Value: TComponent);
begin
  Control:=ComponentToControl(Value);
end;

function TCustomDesignerComponent.GetSelectedCount: Integer;
begin
  Result:=SelectedControlCount;
end;

function TCustomDesignerComponent.GetSelected(Index: Integer): TComponent;
begin
  Result:=SelectedControls[Index];
  if Assigned(Result) and (Result is TComponentContainer) then
    Result:=TComponentContainer(Result).Component;
end;

function TCustomDesignerComponent.GetParentForm: TCustomForm;
var
  IOwner: TComponent;
begin
  IOwner:=Owner;
  while Assigned(IOwner) and not (IOwner is TCustomForm) do IOwner:=IOwner.Owner;
  Result:=TCustomForm(IOwner);
end;

type
  TDesignAccessComponent = class(TComponent)
  public
    procedure SetDesigningPublic(const Value: Boolean);
  end;