Почему мой контроль формы Delphi обрезается, когда моя форма больше моего экрана?

Question

Сценарий таков:

• Я создал (XE2) формы Delphi.
• На нем находится один TGroupBox (или другой элемент управления), растянутый так, что он занимает всю ширину формы с вершиной.
• Установлен правый якорь (в дополнение к левому и верхнему) на TGroupBox.
• Ширина формы установлена ​​на 1200 пикселей (для иллюстрации точки).

Если я запустить это приложение на мониторе которого Screen.Width свойство больше 1200px (я бегу без виртуализации AFAIK DPI), то TGroupBox делает, как и следовало ожидать.

Однако, если ширина монитора меньше 1200 пикселей, тогда на экране отсутствует правая часть элемента управления, независимо от того, как изменить размер формы.

Я переопределил метод Create() моей формы с помощью директивы override; и подтвердил, что я правильно установил свойство width, однако элемент управления все еще обрезается.

Может кто-нибудь посоветовать либо как:

а) установить свойство ширины формы таким образом, что оно влияет на позиционирование дочерних компонентов или ...

б) предложить способ заставить ретрансляция всех дочерних компонентов после визуализации формы?

Answer 1

Отслеживание кода, чтобы узнать, что произойдет, я придумал следующую настройку.

procedure TForm1.WMWindowPosChanging(var Message: TWMWindowPosChanging); 
var 
    MessageWidth: Integer; 
begin 
    MessageWidth := Message.WindowPos.cx; 
    inherited; 
    if MessageWidth > Message.WindowPos.cx then 
    GroupBox1.Width := GroupBox1.Width - MessageWidth + Message.WindowPos.cx; 
end; 

Это не обобщенное решение, но ясно, в чем проблема. VCL запрашивает размер окна для своей формы, который не предоставляется ОС, поскольку он больше, чем рабочий стол. С этого момента форма возобновляет привязку дочернего элемента управления с заданной шириной его дизайна, которая больше ширины клиента формы, поэтому правая сторона дочерних контрольных переполнений.

Другим решением может быть переопределение обработки сообщения WM_GETMINMAXINFO, чтобы предоставить ОС заданную ширину.

procedure TForm1.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); 
begin 
    inherited; 
    Message.MinMaxInfo.ptMaxTrackSize.X := 1200; 
end; 

Это не может быть хорошим решением, потому что тогда форма будет больше, чем рабочий стол.

Что касается ваших позиций «a» и «b», я не думаю, что «b» возможно - или, по крайней мере, невозможно сделать ретрансляцию VCL самостоятельно - поскольку VCL откладывает применение правил привязки до тех пор, пока компонент (форма) делается погрузка. К тому времени ширина формы отличается от ширины времени проектирования, но размещение дочерних элементов управления остается незатронутым. Никакое количество форсирования для компоновки не заставит их синхронизировать снова.

Однако при необходимости можно пересчитать все с нуля, если ваш собственный код содержит ссылку на ширину времени проектирования. Ниже приведен неполный код.

type 
    TForm1 = class(TForm) 
    .. 
    private 
    FAdjustShrinkWidth, FAdjustShrinkHeight: Integer; 
    protected 
    procedure Loaded; override; 
    public 
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; 
     AHeight: Integer); override; 
    end; 

... 

procedure TForm1.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 
var 
    TrackWidth, TrackHeight: Boolean; 
begin 
    TrackWidth := AWidth = 1200; 
    TrackHeight := AHeight = ??; 
    inherited; 
    if TrackWidth and (Width < AWidth) then 
    FAdjustShrinkWidth := AWidth - Width; 
    if TrackHeight and (Height < AHeight) then 
    FAdjustShrinkHeight := AHeight - Height; 
end; 

procedure TForm1.Loaded; 

    procedure ReadjustControlAnchors(Control: TWinControl); 
    var 
    i: Integer; 
    begin 
    for i := 0 to Control.ControlCount - 1 do 
     if (akRight in Control.Controls[i].Anchors) or (akBottom in Control.Controls[i].Anchors) then begin 
     Control.Controls[i].Left := // some complex calculation depending on the anchors set; 
     Control.Controls[i].Top := // same as above; 
     Control.Controls[i].Width := // same as above; 
     Control.Controls[i].Height := // same as above; 
     if (Control.Controls[i] is TWinControl) and (TWinControl(Control.Controls[i]).ControlCount > 0) then 
      ReadjustControlAnchors(TWinControl(Control.Controls[i])); 
     end; 
    end; 

begin 
    inherited; 
    ReadjustControlAnchors(Self); 
end; 

Я понятия не имею, как заполнить пробелы в приведенном выше коде. Чтение и отслеживание кода VCL может быть обязательным для имитации VCL-привязки.

Я ничего не могу придумать для 'a'.

---

Update:

VCL фактически оставил лазейку для управления лгать своим непосредственным детям о размере своих родителей, когда они якорь. Documentation объясняет это немного по-другому:

UpdateControlOriginalParentSize является защищенным методом, который обновляет оригинального размера родительского контроля. Он используется внутренне для обновления правил привязки элемента управления.

Мы можем использовать его, чтобы сообщить групповому боксу предполагаемый оригинальный размер.

type 
    TForm1 = class(TForm) 
    .. 
    private 
    FWidthChange, FHeightChange: Integer; 
    protected 
    procedure UpdateControlOriginalParentSize(AControl: TControl; 
     var AOriginalParentSize: TPoint); override; 
    public 
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; 
     AHeight: Integer); override; 
    end; 

... 

procedure TForm1.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 
var 
    RequestedWidth, RequestedHeight: Integer; 
begin 
    RequestedWidth := AWidth; 
    RequestedHeight := AHeight; 
    inherited; 
    if csLoading in ComponentState then begin 
    if RequestedWidth <> Width then 
     FWidthChange := Width - AWidth; 
    if RequestedHeight <> Height then 
     FHeightChange := Height - AHeight; 
    end; 
end; 

procedure TForm1.UpdateControlOriginalParentSize(AControl: TControl; 
    var AOriginalParentSize: TPoint); 
begin 
    inherited; 
    if akRight in AControl.Anchors then 
    AOriginalParentSize.X := AOriginalParentSize.X - FWidthChange; 
    if akBottom in AControl.Anchors then 
    AOriginalParentSize.Y := AOriginalParentSize.Y - FHeightChange; 
end; 

Я еще раз отметить, что это будет влиять только непосредственные дочерние формы. Если групповой пакет содержит элементы управления, которые привязываются справа и внизу, он также должен переопределять один и тот же метод.

Также обратите внимание, что это не отменяет тот факт, что ширина формы изменилась. Это если бы был левый привязанный элемент управления, который находится в крайнем правом углу формы, он не заменит себя на границу клиента. Он будет действовать так, как если бы ширина формы была уменьшена, то есть оставалась вне поля зрения.