delphi tamaño - ¿Cómo hago para que mi GUI se comporte bien cuando la escala de la fuente de Windows es mayor al 100%?




cambiar sin (5)

Su configuración en el archivo .dfm se ampliará correctamente, siempre que Scaled sea True .

Si está configurando dimensiones en el código, entonces necesita escalarlas por Screen.PixelsPerInch dividido por Form.PixelsPerInch . Usa MulDiv para hacer esto.

function TMyForm.ScaleDimension(const X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, PixelsPerInch);
end;

Esto es lo que hace el marco de persistencia de formularios cuando Scaled es True .

De hecho, puede hacer un argumento convincente para reemplazar esta función con una versión que codifica con un valor de 96 para el denominador. Esto le permite usar valores de dimensión absoluta y no preocuparse por el cambio de significado si cambia la escala de fuente en su máquina de desarrollo y vuelve a guardar el archivo .dfm. El motivo que importa es que la propiedad PixelsPerInch almacenada en el archivo .dfm es el valor de la máquina en la que se guardó por última vez el archivo .dfm.

const
  SmallFontsPixelsPerInch = 96;

function ScaleFromSmallFontsDimension(const X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, SmallFontsPixelsPerInch);
end;

Entonces, continuando con el tema, otra cosa de la que hay que desconfiar es que si su proyecto se desarrolla en varias máquinas con diferentes valores de DPI, encontrará que la escala que utiliza Delphi al guardar archivos .dfm genera controles que deambulan por una serie de ediciones . En mi lugar de trabajo, para evitar esto, tenemos una política estricta de que los formularios solo se editan a 96dpi (escala del 100%).

De hecho, mi versión de ScaleFromSmallFontsDimension también permite la posibilidad de que la fuente del formulario difiera en tiempo de ejecución de ese conjunto en designtime. En las máquinas XP, los formularios de mi aplicación usan 8pt Tahoma. En Vista y hasta 9pt se usa Segoe UI. Esto proporciona otro grado de libertad. La escala debe tener esto en cuenta porque se supone que los valores de dimensión absoluta utilizados en el código fuente son relativos a la línea base de 8pt Tahoma a 96 ppp.

Si usa imágenes o glifos en su UI, estos también necesitan escalar. Un ejemplo común sería los glifos que se usan en barras de herramientas y menús. Deberá proporcionar estos glifos como recursos de iconos vinculados a su ejecutable. Cada icono debe contener un rango de tamaños y luego, en tiempo de ejecución, debe elegir el tamaño más apropiado y cargarlo en una lista de imágenes. Algunos detalles sobre ese tema se pueden encontrar aquí: ¿Cómo cargo iconos de un recurso sin sufrir alias?

Otro truco útil es definir las dimensiones en unidades relativas, relativas a TextWidth o TextHeight . Por lo tanto, si desea que algo tenga alrededor de 10 líneas verticales de tamaño, puede usar 10*Canvas.TextHeight('Ag') . Esta es una métrica muy aproximada y lista porque no permite el espaciado entre líneas, etc. Sin embargo, a menudo todo lo que necesita hacer es organizar que la GUI se PixelsPerInch correctamente con PixelsPerInch .

También debe marcar su aplicación como de alto DPI consciente . La mejor forma de hacerlo es a través del manifiesto de la aplicación. Dado que las herramientas de compilación de Delphi no te permiten personalizar el manifiesto que usas, esto te obliga a vincular tu propio recurso de manifiesto.

<?xml version='1.0' encoding='UTF-8' standalone='yes'?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
    <asmv3:windowsSettings
         xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
      <dpiAware>true</dpiAware>
    </asmv3:windowsSettings>
  </asmv3:application>
</assembly>

El script de recursos se ve así:

1 24 "Manifest.txt"

donde Manifest.txt contiene el manifiesto real. También necesitaría incluir la sección comctl32 v6 y establecer requestedExecutionLevel en asInvoker . A continuación, vincula este recurso compilado a su aplicación y se asegura de que Delphi no intente hacer lo mismo con su manifiesto. En Delphi moderno lo logra estableciendo la opción del proyecto Temas de tiempo de ejecución en Ninguno.

El manifiesto es la forma correcta de declarar que tu aplicación tiene un alto reconocimiento de DPI. Si solo quiere probarlo rápidamente sin interferir con su manifiesto, llame a SetProcessDPIAware . Hazlo como lo primero que haces cuando se ejecuta tu aplicación. Preferiblemente en una de las primeras secciones de inicialización de la unidad, o como la primera cosa en su archivo .dpr.

Si no declaras que tu aplicación tiene un alto reconocimiento de DPI, entonces Vista y arriba lo renderizarán en un modo heredado para cualquier escala de fuente superior al 125%. Esto se ve bastante terrible. Intenta evitar caer en esa trampa.

Windows 8.1 por actualización de monitor de DPI

A partir de Windows 8.1, ahora existe compatibilidad con el sistema operativo para la configuración de DPI por monitor ( http://msdn.microsoft.com/en-ca/magazine/dn574798.aspx ). Este es un gran problema para los dispositivos modernos que pueden tener pantallas diferentes conectadas con capacidades muy diferentes. Es posible que tenga una pantalla de portátil DPI muy alta y un proyector externo de PPP bajo. Apoyar tal escenario requiere aún más trabajo que el descrito anteriormente.

Al elegir tamaños de letra grandes en el panel de control de Windows (como 125%, o 150%), entonces hay problemas en una aplicación VCL, cada vez que algo se ha configurado en píxeles.

Tome el TStatusBar.Panel . He configurado su ancho para que contenga exactamente una etiqueta, ahora con letras grandes, la etiqueta "se desborda". Mismo problema con otros componentes.

Algunas computadoras portátiles nuevas de Dell ya vienen con un 125% como configuración predeterminada, por lo que, si bien en el pasado este problema era bastante raro, ahora es realmente importante.

¿Qué se puede hacer para superar este problema?


Nota: Por favor, vea las otras respuestas, ya que contienen técnicas muy valiosas. Mi respuesta aquí solo proporciona advertencias y precauciones en contra de asumir DPI-awareness es fácil.

Por lo general, evito el escalado con TForm.Scaled = True DPI con TForm.Scaled = True . La conciencia DPI es solo importante para mí cuando se vuelve importante para los clientes que me llaman y están dispuestos a pagar por ello. La razón técnica detrás de ese punto de vista es que, con conocimiento de DPI o no, está abriendo una ventana a un mundo de dolor. Muchos controles de VCL estándar y de terceros no funcionan bien en DPI alto. La notable excepción es que las partes de VCL que envuelven los Controles Comunes de Windows funcionan extraordinariamente bien con DPI alto. Una gran cantidad de controles personalizados Delphi VCL de terceros y integrados no funcionan bien, o en absoluto, a un alto nivel de DPI. Si planea activar TForm.Scaled, asegúrese de realizar una prueba a 96, 125 y 150 ppp para cada formulario en su proyecto y para cada tercero y control integrado que utilice.

Delphi en sí está escrito en Delphi. Tiene activada la bandera de reconocimiento Alto DPI, para la mayoría de los formularios, aunque incluso tan recientemente como en Delphi XE2, los propios autores IDE decidieron NO activar ese indicador de manifiesto de Alto DPI. Tenga en cuenta que en Delphi XE4 y posterior, la bandera de conciencia de HIGH DPI está activada, y el IDE se ve bien.

Sugiero que no uses TForm.Scaled = true (que es un valor predeterminado en Delphi, a menos que lo hayas modificado, la mayoría de tus formularios tengan Scaled = true) con las banderas de High DPI Aware (como se muestra en las respuestas de David) con Las aplicaciones VCL que se crean utilizando el diseñador de formularios delphi incorporado.

He intentado en el pasado hacer una muestra mínima del tipo de rotura que puedes esperar cuando TForm.Scaled es verdadero, y cuando Delphi forma escalado tiene una falla. Estos fallos técnicos no siempre se desencadenan solo por un valor de DPI distinto de 96. No he podido determinar una lista completa de otras cosas, que incluye cambios en el tamaño de fuente de Windows XP. Pero dado que la mayoría de estos fallos técnicos solo aparecen en mis propias aplicaciones, en situaciones bastante complejas, he decidido mostrarles algunas pruebas de que pueden verificarse.

Delphi XE tiene este aspecto cuando configuras DPI Scaling en "Fonts @ 200%" en Windows 7, y Delphi XE2 también se rompe en Windows 7 y 8, pero estas fallas técnicas parecen estar solucionadas a partir de Delphi XE4:

Estos son en su mayoría controles de VCL estándar que se comportan mal a un nivel alto de DPI. Tenga en cuenta que la mayoría de las cosas no han sido escaladas en absoluto, por lo que los desarrolladores de Delphi IDE han decidido ignorar el conocimiento de DPI, así como también desactivar la virtualización de DPI. Una elección tan interesante.

Desactive la virtualización DPI solo si desea esta nueva fuente adicional de dolor y opciones difíciles. Te sugiero que lo dejes en paz. Tenga en cuenta que los controles comunes de Windows parecen funcionar bien. Tenga en cuenta que el control Delphi data-explorer es un contenedor C # WinForms alrededor de un control común estándar de Windows Tree. Esa es una falla pura de microsoft, y corregirlo podría requerir que Embarcadero reescriba un control de árbol nativo .Net para su explorador de datos, o escribir algún código DPI-check-and-modify-properties para cambiar las alturas de los elementos en el control. Ni siquiera microsoft WinForms puede manejar DPI alta de manera limpia, automática y sin código de kludge personalizado.

Actualización: Factoid interesante: si bien el delphi IDE parece no estar "virtualizado", no está utilizando el contenido de manifiesto que muestra David para lograr "virtualización sin DPI". Tal vez esté usando alguna función API en tiempo de ejecución.

Actualización 2: en respuesta a cómo apoyaría 100% / 125% DPI, se me ocurriría un plan de dos fases. La fase 1 es inventariar mi código para controles personalizados que deben ser reparados para DPI alto, y luego hacer un plan para solucionarlos o eliminarlos gradualmente. La fase 2 consistiría en tomar algunas áreas de mi código que están diseñadas como formularios sin gestión de diseño y cambiarlas a formularios que utilizan algún tipo de gestión de diseño para que los DPI o los cambios de altura de fuente puedan funcionar sin recorte. Sospecho que este trabajo de diseño "intercontroles" sería mucho más complejo en la mayoría de las aplicaciones que el trabajo "intracontrolar".

Actualización: en 2016, la última Delphi 10.1 Berlin está funcionando bien en mi estación de trabajo de 150 ppp.


También es importante tener en cuenta que respetar el DPI del usuario es solo un subconjunto de su trabajo real:

honrando el tamaño de fuente del usuario

Durante décadas, Windows ha resuelto este problema con la idea de realizar diseño utilizando unidades de diálogo , en lugar de píxeles. Se define una "unidad de diálogo" para que el carácter promedio de la fuente sea

  • 4 unidades de diálogo (dlus) de ancho, y
  • 8 unidades de diálogo (clus) alto

Delphi se envía con una noción (con errores) de Scaled , donde una forma intenta ajustar automáticamente en función de la

  • Configuración de Windows DPI del usuario, versos
  • la configuración de DPI en la máquina del desarrollador que guardó por última vez el formulario

Eso no resuelve el problema cuando el usuario usa una fuente diferente a la que diseñó el formulario, por ejemplo:

  • el desarrollador diseñó el formulario con MS Sans Serif 8pt (donde el carácter promedio es 6.21px x 13.00px , a 96dpi)
  • usuario corriendo con Tahoma 8pt (donde el personaje promedio es 5.94px x 13.00px , a 96dpi)

    Como fue el caso con cualquier persona que desarrolla una aplicación para Windows 2000 o Windows XP.

o

  • el desarrollador diseñó el formulario con ** Tahoma 8pt * (donde el personaje promedio es 5.94px x 13.00px , a 96dpi)
  • un usuario corriendo con Segoe UI 9pt (donde el personaje promedio es 6.67px x 15px , a 96dpi)

Como buen desarrollador, respetará las preferencias de fuente de su usuario. Esto significa que también necesita escalar todos los controles en su formulario para que coincida con el nuevo tamaño de fuente:

  • expanda todo horizontalmente en 12.29% (6.67 / 5.94)
  • estirar todo verticalmente en 15.38% (15/13)

Scaled no manejará esto por ti.

Empeora cuando:

  • diseñó su formulario en Segoe UI 9pt (Windows Vista, Windows 7, Windows 8 por defecto)
  • el usuario está ejecutando Segoe UI 14pt , (por ejemplo, mi preferencia) que es 10.52px x 25px

Ahora tienes que escalar todo

  • horizontalmente por 57.72%
  • verticalmente por 66.66%

Scaled no manejará esto por ti.

Si eres inteligente, puedes ver cómo honrar DPI es irrelavent:

  • formulario diseñado con Segoe UI 9pt @ 96dpi (6.67px x 15px)
  • usuario corriendo con Segoe UI 9pt @ 150dpi (10.52px x 25px)

No debería mirar la configuración de PPP del usuario, debería ver su tamaño de fuente . Dos usuarios corriendo

  • IU de Segoe 14pt a 96dpi (10.52px x 25px)
  • Segoe UI 9pt @ 150dpi (10.52px x 25px)

están ejecutando la misma fuente . DPI es solo una cosa que afecta el tamaño de fuente; las preferencias del usuario son la otra.

StandardizeFormFont

Clovis notó que hago referencia a una función StandardizeFormFont que corrige la fuente en un formulario, y lo escala al nuevo tamaño de fuente. No es una función estándar, sino un conjunto completo de funciones que logran la tarea simple que Borland nunca manejó.

function StandardizeFormFont(AForm: TForm): Real;
var
    preferredFontName: string;
    preferredFontHeight: Integer;
begin
    GetUserFontPreference({out}preferredFontName, {out}preferredFontHeight);

    //e.g. "Segoe UI",     
    Result := Toolkit.StandardizeFormFont(AForm, PreferredFontName, PreferredFontHeight);
end;

Windows tiene 6 fuentes diferentes; no hay una sola "configuración de fuente" en Windows.
Pero sabemos por experiencia que nuestros formularios deben seguir la configuración de Fuente de título de icono

procedure GetUserFontPreference(out FaceName: string; out PixelHeight: Integer);
var
   font: TFont;
begin
   font := Toolkit.GetIconTitleFont;
   try
      FaceName := font.Name; //e.g. "Segoe UI"

      //Dogfood testing: use a larger font than we're used to; to force us to actually test it    
      if IsDebuggerPresent then
         font.Size := font.Size+1;

      PixelHeight := font.Height; //e.g. -16
   finally
      font.Free;
   end;
end;

Una vez que conozcamos el tamaño de la fuente, escalaremos el formulario, obtenemos la altura de la fuente actual del formulario ( en píxeles ) y aumentamos ese factor.

Por ejemplo, si estoy configurando el formulario en -16 , y el formulario está actualmente en -11 , entonces tenemos que escalar el formulario completo de la siguiente manera:

-16 / -11 = 1.45454%

La estandarización ocurre en dos fases. Primero escale la forma por la proporción de los tamaños de fuente nuevos: antiguos. Entonces cambie los controles (recursivamente) para usar la nueva fuente.

function StandardizeFormFont(AForm: TForm; FontName: string; FontHeight: Integer): Real;
var
    oldHeight: Integer;
begin
    Assert(Assigned(AForm));

    if (AForm.Scaled) then
    begin
        OutputDebugString(PChar('WARNING: StandardizeFormFont: Form "'+GetControlName(AForm)+'" is set to Scaled. Proper form scaling requires VCL scaling to be disabled, unless you implement scaling by overriding the protected ChangeScale() method of the form.'));
    end;

    if (AForm.AutoScroll) then
    begin
        if AForm.WindowState = wsNormal then
        begin
            OutputDebugString(PChar('WARNING: StandardizeFormFont: Form "'+GetControlName(AForm)+'" is set to AutoScroll. Form designed size will be suseptable to changes in Windows form caption height (e.g. 2000 vs XP).'));
                    if IsDebuggerPresent then
                        Windows.DebugBreak; //Some forms would like it (to fix maximizing problem)
        end;
    end;

    if (not AForm.ShowHint) then
    begin
        AForm.ShowHint := True;
        OutputDebugString(PChar('INFORMATION: StandardizeFormFont: Turning on form "'+GetControlName(AForm)+'" hints. (ShowHint := True)'));
                    if IsDebuggerPresent then
                        Windows.DebugBreak; //Some forms would like it (to fix maximizing problem)
    end;

    oldHeight := AForm.Font.Height;

    //Scale the form to the new font size
//  if (FontHeight <> oldHeight) then    For compatibility, it's safer to trigger a call to ChangeScale, since a lot of people will be assuming it always is called
    begin
        ScaleForm(AForm, FontHeight, oldHeight);
    end;

    //Now change all controls to actually use the new font
    Toolkit.StandardizeFont_ControlCore(AForm, g_ForceClearType, FontName, FontHeight,
            AForm.Font.Name, AForm.Font.Size);

    //Return the scaling ratio, so any hard-coded values can be multiplied
    Result := FontHeight / oldHeight;
end;

Este es el trabajo de escalar realmente un formulario. Funciona alrededor de errores en el propio método Form.ScaleBy Borland. Primero tiene que deshabilitar todos los anclajes en el formulario, luego realizar la escala y luego volver a habilitar los anclajes:

TAnchorsArray = array of TAnchors;

procedure ScaleForm(const AForm: TForm; const M, D: Integer);
var
    aAnchorStorage: TAnchorsArray;
    RectBefore, RectAfter: TRect;
    x, y: Integer;
    monitorInfo: TMonitorInfo;
    workArea: TRect;
begin
    if (M = 0) and (D = 0) then
        Exit;

    RectBefore := AForm.BoundsRect;

    SetLength(aAnchorStorage, 0);
    aAnchorStorage := DisableAnchors(AForm);
    try
        AForm.ScaleBy(M, D);
    finally
        EnableAnchors(AForm, aAnchorStorage);
    end;

    RectAfter := AForm.BoundsRect;

    case AForm.Position of
    poScreenCenter, poDesktopCenter, poMainFormCenter, poOwnerFormCenter,
    poDesigned: //i think i really want everything else to also follow the nudging rules...why did i exclude poDesigned
        begin
            //This was only nudging by one quarter the difference, rather than one half the difference
//          x := RectAfter.Left - ((RectAfter.Right-RectBefore.Right) div 2);
//          y := RectAfter.Top - ((RectAfter.Bottom-RectBefore.Bottom) div 2);
            x := RectAfter.Left - ((RectAfter.Right-RectAfter.Left) - (RectBefore.Right-RectBefore.Left)) div 2;
            y := RectAfter.Top - ((RectAfter.Bottom-RectAfter.Top)-(RectBefore.Bottom-RectBefore.Top)) div 2;
        end;
    else
        //poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly:
        x := RectAfter.Left;
        y := RectAfter.Top;
    end;

    if AForm.Monitor <> nil then
    begin
        monitorInfo.cbSize := SizeOf(monitorInfo);
        if GetMonitorInfo(AForm.Monitor.Handle, @monitorInfo) then
            workArea := monitorInfo.rcWork
        else
        begin
            OutputDebugString(PChar(SysErrorMessage(GetLastError)));
            workArea := Rect(AForm.Monitor.Left, AForm.Monitor.Top, AForm.Monitor.Left+AForm.Monitor.Width, AForm.Monitor.Top+AForm.Monitor.Height);
        end;

//      If the form is off the right or bottom of the screen then we need to pull it back
        if RectAfter.Right > workArea.Right then
            x := workArea.Right - (RectAfter.Right-RectAfter.Left); //rightEdge - widthOfForm

        if RectAfter.Bottom > workArea.Bottom then
            y := workArea.Bottom - (RectAfter.Bottom-RectAfter.Top); //bottomEdge - heightOfForm

        x := Max(x, workArea.Left); //don't go beyond left edge
        y := Max(y, workArea.Top); //don't go above top edge
    end
    else
    begin
        x := Max(x, 0); //don't go beyond left edge
        y := Max(y, 0); //don't go above top edge
    end;

    AForm.SetBounds(x, y,
            RectAfter.Right-RectAfter.Left, //Width
            RectAfter.Bottom-RectAfter.Top); //Height
end;

y luego tenemos que recursivamente usar la nueva fuente:

procedure StandardizeFont_ControlCore(AControl: TControl; ForceClearType: Boolean;
        FontName: string; FontSize: Integer;
        ForceFontIfName: string; ForceFontIfSize: Integer);
const
    CLEARTYPE_QUALITY = 5;
var
    i: Integer;
    RunComponent: TComponent;
    AControlFont: TFont;
begin
    if not Assigned(AControl) then
        Exit;

    if (AControl is TStatusBar) then
    begin
        TStatusBar(AControl).UseSystemFont := False; //force...
        TStatusBar(AControl).UseSystemFont := True;  //...it
    end
    else
    begin
        AControlFont := Toolkit.GetControlFont(AControl);

        if not Assigned(AControlFont) then
            Exit;

        StandardizeFont_ControlFontCore(AControlFont, ForceClearType,
                FontName, FontSize,
                ForceFontIfName, ForceFontIfSize);
    end;

{   If a panel has a toolbar on it, the toolbar won't paint properly. So this idea won't work.
    if (not Toolkit.IsRemoteSession) and (AControl is TWinControl) and (not (AControl is TToolBar)) then
        TWinControl(AControl).DoubleBuffered := True;
}

    //Iterate children
    for i := 0 to AControl.ComponentCount-1 do
    begin
        RunComponent := AControl.Components[i];
        if RunComponent is TControl then
            StandardizeFont_ControlCore(
                    TControl(RunComponent), ForceClearType,
                    FontName, FontSize,
                    ForceFontIfName, ForceFontIfSize);
    end;
end;

Con los anclajes siendo deshabilitados recursivamente:

function DisableAnchors(ParentControl: TWinControl): TAnchorsArray;
var
    StartingIndex: Integer;
begin
    StartingIndex := 0;
    DisableAnchors_Core(ParentControl, Result, 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;

        //doesn't work for set of stacked top-aligned panels
//      if ([akRight, akBottom ] * ChildControl.Anchors) <> [] then
//          ChildControl.Anchors := [akLeft, akTop];

        if (ChildControl.Anchors) <> [akTop, akLeft] then
            ChildControl.Anchors := [akLeft, akTop];

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

Y los anclajes se vuelven a habilitar recursivamente:

procedure EnableAnchors(ParentControl: TWinControl; aAnchorStorage: TAnchorsArray);
var
    StartingIndex: Integer;
begin
    StartingIndex := 0;
    EnableAnchors_Core(ParentControl, aAnchorStorage, StartingIndex);
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;

Con el trabajo de cambiar realmente una fuente de controles a la izquierda para:

procedure StandardizeFont_ControlFontCore(AControlFont: TFont; ForceClearType: Boolean;
        FontName: string; FontSize: Integer;
        ForceFontIfName: string; ForceFontIfSize: Integer);
const
    CLEARTYPE_QUALITY = 5;
var
    CanChangeName: Boolean;
    CanChangeSize: Boolean;
    lf: TLogFont;
begin
    if not Assigned(AControlFont) then
        Exit;

{$IFDEF ForceClearType}
    ForceClearType := True;
{$ELSE}
    if g_ForceClearType then
        ForceClearType := True;
{$ENDIF}

    //Standardize the font if it's currently
    //  "MS Shell Dlg 2" (meaning whoever it was opted into the 'change me' system
    //  "MS Sans Serif" (the Delphi default)
    //  "Tahoma" (when they wanted to match the OS, but "MS Shell Dlg 2" should have been used)
    //  "MS Shell Dlg" (the 9x name)
    CanChangeName :=
            (FontName <> '')
            and
            (AControlFont.Name <> FontName)
            and
            (
                (
                    (ForceFontIfName <> '')
                    and
                    (AControlFont.Name = ForceFontIfName)
                )
                or
                (
                    (ForceFontIfName = '')
                    and
                    (
                        (AControlFont.Name = 'MS Sans Serif') or
                        (AControlFont.Name = 'Tahoma') or
                        (AControlFont.Name = 'MS Shell Dlg 2') or
                        (AControlFont.Name = 'MS Shell Dlg')
                    )
                )
            );

    CanChangeSize :=
            (
                //there is a font size
                (FontSize <> 0)
                and
                (
                    //the font is at it's default size, or we're specifying what it's default size is
                    (AControlFont.Size = 8)
                    or
                    ((ForceFontIfSize <> 0) and (AControlFont.Size = ForceFontIfSize))
                )
                and
                //the font size (or height) is not equal
                (
                    //negative for height (px)
                    ((FontSize < 0) and (AControlFont.Height <> FontSize))
                    or
                    //positive for size (pt)
                    ((FontSize > 0) and (AControlFont.Size <> FontSize))
                )
                and
                //no point in using default font's size if they're not using the face
                (
                    (AControlFont.Name = FontName)
                    or
                    CanChangeName
                )
            );

    if CanChangeName or CanChangeSize or ForceClearType then
    begin
        if GetObject(AControlFont.Handle, SizeOf(TLogFont), @lf) <> 0 then
        begin
            //Change the font attributes and put it back
            if CanChangeName then
                StrPLCopy(Addr(lf.lfFaceName[0]), FontName, LF_FACESIZE);
            if CanChangeSize then
                lf.lfHeight := FontSize;

            if ForceClearType then
                lf.lfQuality := CLEARTYPE_QUALITY;
            AControlFont.Handle := CreateFontIndirect(lf);
        end
        else
        begin
            if CanChangeName then
                AControlFont.Name := FontName;
            if CanChangeSize then
            begin
                if FontSize > 0 then
                    AControlFont.Size := FontSize
                else if FontSize < 0 then
                    AControlFont.Height := FontSize;
            end;
        end;
    end;
end;

Eso es mucho más código de lo que pensaste que iba a ser; Lo sé. Lo triste es que no hay un desarrollador de Delphi en la tierra, a excepción de mí, que realmente hace que sus aplicaciones sean correctas.

Estimado desarrollador de Delphi : configure su fuente de Windows para Segoe UI 14pt y solucione su error de aplicación

Nota : Cualquier código se libera en el dominio público. No se requiere atribución.


Aquí está mi regalo. Una función que puede ayudarlo con el posicionamiento horizontal de los elementos en sus diseños de GUI. Gratuita para todos.

function CenterInParent(Place,NumberOfPlaces,ObjectWidth,ParentWidth,CropPercent: Integer): Integer;
  {returns formated centered position of an object relative to parent.
  Place          - P order number of an object beeing centered
  NumberOfPlaces - NOP total number of places available for object beeing centered
  ObjectWidth    - OW width of an object beeing centered
  ParentWidth    - PW width of an parent
  CropPercent    - CP percentage of safe margin on both sides which we want to omit from calculation
  +-----------------------------------------------------+
  |                                                     |
  |        +--------+       +---+      +--------+       |
  |        |        |       |   |      |        |       |
  |        +--------+       +---+      +--------+       |
  |     |              |             |            |     |
  +-----------------------------------------------------+
  |     |<---------------------A----------------->|     |
  |<-C->|<------B----->|<-----B----->|<-----B---->|<-C->|
  |                    |<-D>|
  |<----------E------------>|

  A = PW-C   B = A/NOP  C=(CP*PW)/100  D = (B-OW)/2
  E = C+(P-1)*B+D }

var
  A, B, C, D: Integer;
begin
  C := Trunc((CropPercent*ParentWidth)/100);
  A := ParentWidth - C;
  B := Trunc(A/NumberOfPlaces);
  D := Trunc((B-ObjectWidth)/2);
  Result := C+(Place-1)*B+D;
end;

Eche un vistazo más de cerca a TTabControl / TTabItem en la unidad FMX.TabControl. Este es tu ejemplo perfecto porque básicamente necesita resolver el mismo problema.

La siguiente función es lo que necesita anular:

procedure DoAddObject(const AObject: TFmxObject); override;

Esto se llama cuando se agrega un control a su control. Anule esta función para que su control se agregue al control FpnlClientArea. Obtendrás algo similar a esto:

procedure TNaharFMXPopup.DoAddObject(const AObject: TFmxObject);
// ...
begin
  if (FpnlClientArea <> nil) and not AObject.Equals(FpnlClientArea) and not AObject.Equals(ResourceLink) then
  begin
    FpnlClientArea.AddObject(AObject);
  end
  else
    inherited;
end;

Asegúrese de que AObject.Equals también excluya sus otros controles "no almacenados".

Sin la anulación de DoAddObject, FMX TabControl mostraría el mismo problema que tiene actualmente su componente.

El TPopup no está destinado a aceptar controles. Entonces eso necesita algunos trucos más. Aquí hay una versión modificada de tu unidad que funciona para mí. He agregado algunos comentarios:

unit NaharFMXPopup;

interface

uses
  System.UITypes,
  System.Variants,
  System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Layouts, FMX.StdCtrls;

type
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 or pidiOSSimulator or pidiOSDevice or pidAndroid)]
  TNaharFMXPopup = class(TPopup)
  private
    procedure   ApplyControlsProp;
  protected
    FpnlMain       : TPanel;
    FlytToolBar    : TLayout;
    FbtnClose      : TButton;
    FbtnSave       : TButton;
    FbtnEdit       : TButton;
    FpnlClientArea : TContent; // change to TContent. 
    // For TPanel we'd have to call SetAcceptControls(False), 
    // but that is not easily possible because that is protected
    FlblTitle      : TLabel;
    procedure   Loaded; override;
    procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure   DoAddObject(const AObject: TFmxObject); override;
  public
    procedure   InternalOnClose(Sender: TObject);
    procedure   InternalOnSave(Sender: TObject);
    procedure   InternalOnEdit(Sender: TObject);
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   SetEvents;
  published
  end;

implementation


{ TNaharFMXPopup }

constructor TNaharFMXPopup.Create(AOwner: TComponent);
begin
  inherited;

  FpnlMain         := TPanel.Create(Self);
  FlblTitle        := TLabel.Create(Self);
  FlytToolBar      := TLayout.Create(Self);
  FbtnEdit         := TButton.Create(Self);
  FpnlClientArea   := TContent.Create(Self); // change to TContent
  FbtnClose         := TButton.Create(FlytToolBar);
  FbtnSave          := TButton.Create(FlytToolBar);

  Height         := 382;
  Placement      := TPlacement.Center;
  StyleLookup    := 'combopopupstyle';
  Width          := 300;

  // A TPopup is not intended to accept controls
  // so we have to undo those restrictions:
  Visible := True;
  SetAcceptsControls(True);

  ApplyControlsProp;
end;

destructor TNaharFMXPopup.Destroy;
begin

  inherited;
end;

procedure TNaharFMXPopup.ApplyControlsProp;
begin
  with FpnlMain do
  begin
    Parent         := Self;
    Align          := TAlignLayout.Bottom;
    StyleLookup    := 'grouppanel';
    TabOrder       := 0;
    Height         := 50;
    Margins.Bottom := 10;
    Margins.Left   := 10;
    Margins.Right  := 10;
    Margins.Top    := 10;
    Stored         := false;
  end;
  with FpnlClientArea do
  begin
    Parent         := Self; // we have to change this to Self (it refuses working if the parent is FPnlMain)
    Align          := TAlignLayout.Client;
    Margins.Left   := 3;
    Margins.Right  := 3;
    Margins.Top    := 3;
    Margins.Bottom := 3;
    Stored         := false;
  end;
  with FlytToolBar do
  begin
    Parent         := FpnlMain;
    Align          := TAlignLayout.Bottom;
    Height         := 50;
    Stored         := false;
  end;
  with FbtnClose do
  begin
    Parent         := FlytToolBar;
    Text           := 'Close';
    Align          := TAlignLayout.Left;
    Height         := 50;
    StyleLookup    := 'tilebutton';
    TabOrder       := 0;
    Width          := 70;
    ModalResult    := mrClose;
    Stored         := false;
  end;
  with FbtnEdit do
  begin
    Parent         := FlytToolBar;
    Text           := '';//'Edita';
    Align          := TAlignLayout.Left;
    Height         := 50;
    StyleLookup    := 'tilebutton';
    TabOrder       := 1;
    Width          := 70;
    ModalResult    := mrContinue;
    Stored         := false;
    Enabled        := false;
  end;
  with FbtnSave do
  begin
    Parent         := FlytToolBar;
    Text           := 'Save';
    Align          := TAlignLayout.Left;
    Height         := 50;
    StyleLookup    := 'tilebutton';
    TabOrder       := 2;
    Width          := 70;
    ModalResult    := mrOk;
    Stored         := false;
  end;
end;

procedure TNaharFMXPopup.Loaded;
begin
  inherited;

  ApplyControlsProp;
//  SetEvents;

end;

procedure TNaharFMXPopup.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

end;

procedure TNaharFMXPopup.InternalOnClose(Sender: TObject);
begin
end;

procedure TNaharFMXPopup.InternalOnEdit(Sender: TObject);
begin
end;

procedure TNaharFMXPopup.InternalOnSave(Sender: TObject);
begin
end;

procedure TNaharFMXPopup.SetEvents;
begin
  FbtnClose.OnClick := InternalOnClose;
  FbtnSave.OnClick := InternalOnSave;
  FbtnEdit.OnClick := InternalOnEdit;
end;


procedure TNaharFMXPopup.DoAddObject(const AObject: TFmxObject);
begin
//inherited; try commenting the block bellow and uncommenting this one
//Exit;

  if (FpnlClientArea <> nil)
    and not AObject.Equals(FpnlClientArea)
    and not AObject.Equals(ResourceLink)
    and not AObject.Equals(FpnlMain)
    and not AObject.Equals(FlblTitle)
    and not AObject.Equals(FlytToolBar)
    and not AObject.Equals(FbtnEdit)
    and not AObject.Equals(FpnlClientArea)
    and not AObject.Equals(FbtnClose)
    and not AObject.Equals(FbtnSave) then

  begin
    FpnlClientArea.AddObject(AObject);
  end
  else
    inherited;
end;

end.






windows delphi windows-7