views:

586

answers:

2

Is there a way to suspend all anchored controls on a form from moving or resizing themselves temporarily? i.e.:

procedure ScaleFormBy(AForm: TForm; n, d: Integer);
begin
    AForm.SuspendAnchors();
    try
       AForm.ScaleBy(n, d);
    finally
       AForm.ResumeAnchors();
    end;
end;

I need to do this because I'm calling

AForm.ScaleBy(m, d);

Which does not handle anchored controls properly. (it pushes left+right or top+bottom anchored controls off the edge of the form.

Note: I want to disable Anchors, not Alignment.

+6  A: 

SuspendAnchors sound like a base method but I don't think it's part of the base Delphi language :) Here is some code that does the trick:


var aAnchorStorage: Array of TAnchors;
procedure AnchorsDisable(AForm: TForm);
var
  iCounter: integer;
begin
  SetLength(aAnchorStorage, AForm.ControlCount);
  for iCounter := 0 to AForm.ControlCount - 1 do begin
    aAnchorStorage[iCounter] := AForm.Controls[iCounter].Anchors;
    AForm.Controls[iCounter].Anchors := [];
  end;
end;

procedure AnchorsEnable(AForm: TForm);
var
  iCounter: integer;
begin
  SetLength(aAnchorStorage, AForm.ControlCount);
  for iCounter := 0 to AForm.ControlCount - 1 do
    AForm.Controls[iCounter].Anchors := aAnchorStorage[iCounter];
end;

procedure TForm1.btnAnchorsDisableClick(Sender: TObject);
begin
  AnchorsDisable(Self);
end;

procedure TForm1.btnAnchorsEnableClick(Sender: TObject);
begin
  AnchorsEnable(Self);
end;


Enjoy

Kris De Decker
I would replace the global variable by extra parameters to the procedures, or make some kind of map between the TForm reference and the saved anchors, but apart from that it's a +1.
mghie
Yes - this code needs to be adjusted for production use. I tested the code with a simple form and it works fine with regards to scaling, adjusting size and width.
Kris De Decker
It doesn't handle nested control - i.e. TPanel, TTabSheet
Ian Boyd
+2  A: 

Guy had a good idea, but it didn't handle child control (i.e. TPanel, TPageControl, etc)

Here's a variant that uses recursion. Also, notice that i don't actually disable anchors - turn out that ScaleBy doesn't work with no anchors either.

So now you can scale a form using:

procedure ScaleFormBy(AForm: TForm; M, D: Integer);
var
   StoredAnchors: TAnchorsArray;
begin
   StoredAnchors := DisableAnchors(AForm);
   try
       AForm.ScaleBy(M, D);
   finally
       EnableAnchors(AForm, StoredAnchors);
   end;
end;

With the support library functions:

TAnchorsArray = array of TAnchors;

function DisableAnchors(ParentControl: TWinControl): TAnchorsArray;
var
   StartingIndex: Integer;
begin
   StartingIndex := 0;
   DisableAnchors_Core(ParentControl, Result, StartingIndex);
end;

procedure EnableAnchors(ParentControl: TWinControl; aAnchorStorage: TAnchorsArray);
var
   StartingIndex: Integer;
begin
   StartingIndex := 0;
   EnableAnchors_Core(ParentControl, aAnchorStorage, StartingIndex);
end;

procedure DisableAnchors_Core(ParentControl: TWinControl; var aAnchorStorage: TAnchorsArray; var StartingIndex: Integer);
var
   iCounter: integer;
   ChildControl: TControl;
begin
   if (StartingIndex+ParentControl.ControlCount+1) > (Length(aAnchorStorage)) then
      SetLength(aAnchorStorage, StartingIndex+ParentControl.ControlCount+1);

   for iCounter := 0 to ParentControl.ControlCount - 1 do
   begin
      ChildControl := ParentControl.Controls[iCounter];
      aAnchorStorage[StartingIndex] := ChildControl.Anchors;

      if ([akLeft, akRight ] * ChildControl.Anchors) = [akLeft, akRight] then
         ChildControl.Anchors := ChildControl.Anchors - [akRight];

      if ([akTop, akBottom] * ChildControl.Anchors) = [akTop, akBottom] then
         ChildControl.Anchors := ChildControl.Anchors - [akBottom];

      Inc(StartingIndex);
   end;

   //Add children
   for iCounter := 0 to ParentControl.ControlCount - 1 do
   begin
      ChildControl := ParentControl.Controls[iCounter];
      if ChildControl is TWinControl then
         DisableAnchors_Core(TWinControl(ChildControl), aAnchorStorage, StartingIndex);
   end;
end;

procedure EnableAnchors_Core(ParentControl: TWinControl; aAnchorStorage: TAnchorsArray; var StartingIndex: Integer);
var
   iCounter: integer;
   ChildControl: TControl;
begin
   for iCounter := 0 to ParentControl.ControlCount - 1 do
   begin
      ChildControl := ParentControl.Controls[iCounter];
      ChildControl.Anchors := aAnchorStorage[StartingIndex];

      Inc(StartingIndex);
   end;

   //Restore children
   for iCounter := 0 to ParentControl.ControlCount - 1 do
   begin
      ChildControl := ParentControl.Controls[iCounter];
      if ChildControl is TWinControl then
         EnableAnchors_Core(TWinControl(ChildControl), aAnchorStorage, StartingIndex);
   end;
end;


end;
Ian Boyd
All this hackery to fix problems Borland could.
Ian Boyd