Hi,

This problem has bugged me for ages but it's not one I bump into too often
fortunately.  It is that when your set your Windows font size (as set in the
advanced display options) to Large (125%) as opposed to Small (the default),
then when you try to run (or open) a Delphi app originally designed in say
Small mode with anchor's and Aligned properties set, then all the controls
and stuff seems to scale wrong and some are off the edge of the form.  Why
is this?  And how can I keep this from happening?  This is quite annoying.

TIA

Walter Prins

Hello,

news:3b8e8168_2@dnews...

Wow, just mentioned this in the reply to the other posting.

That is actually very simple - just two things to do:

1. Set Scaled property of all your forms to FALSE to avoid form layout
distortion.
2. Use only TrueType fonts throughout the application to avoid font
distortion. Note: by default Delphi uses Sans Serif font, which is NOT
TrueType.

That's it.

Regards,
Dmitri Papichev

Rule #1: only use truetype fonts (MS Sans Serif is not TT on Win9x).

Rule #2: set the forms Scaled property to false, this way the fonts will keep
         their pixel height (which is stored in the DFM file) and the controls
         that use autosizing will stay the same size.

Rule #2 somewhat defeats the purpose of large fonts, unfortunately. So you may
try to augment it with *manually* scaling the form by the ratio of run-time to
design-time Screen.PixelsPerich in the forms OnCreate handler, using the forms
ScaleBy method. Using fixed values for demonstration this would look like

  ScaleBy( 120, 96 );
  SetBounds( left, top, width * 120 div 96, height *120 div 96 );

ScaleBy does not adjust the form itself, so that has to be done manually.
The automatic scaling is done before the anchor rules have been stored and
that tends to{*word*222}up the automatic positioning.

Peter Below (TeamB)  100113.1...@compuserve.com)
No e-mail responses, please, unless explicitly requested!
Note: I'm unable to visit the newsgroups every day at the moment,
so be patient if you don't get a reply immediately.

Hi Walter!

On Thu, 30 Aug 2001 19:07:44 +0100, "Walter Prins"

Please try my routine, call it for a form in an oncreate handler or
after the creation! It works for me just the way I wanted with the
problem you mentioned.

tomi.

procedure FixDPI(f: TForm; DesignDPI: integer);

(*
        Small/Large system font solution
        Have a TForm's properties Scaled and AutoScroll set to false
        and after creating your form call this procedure like:
                FixDPI (TForm1, 96) // If you designed in small fonts

        Author: Tomislav Kardas
        Platform: Delphi 4 C/S
*)

var
        ScaleM, ScaleD: integer;

        function Scale(x: longint): longint;
        begin
                result := (x*ScaleM + ScaleD div 2) div ScaleD;
        end;

        procedure FixControl(c: TControl);
        var
                x: integer;
                p: TWinControl;
                fixheight: boolean;
        begin
                p := c.Parent;
                if c.Align <> alNone then
                        begin
                                // Fixing width
                                if ((c.Align = alLeft) and (akRight in c.Anchors)) or
                                         ((c.Align = alRight) and (akLeft in c.Anchors)) then
                                        c.Width := p.ClientWidth - Scale(p.ClientWidth - c.Width)
                                else if (c.Align = alLeft) or (c.Align = alRight) then
                                        c.Width := Scale(c.Width);
                                // Fixing height
                                if ((c.Align = alTop) and (akBottom in c.Anchors)) or
                                         ((c.Align = alBottom) and (akTop in c.Anchors)) then
                                        c.Height := p.ClientHeight - Scale(p.ClientHeight -
c.Height)
                                else if (c.Align = alTop) or (c.Align = alBottom) then
                                        c.Height := Scale(c.Height);
                        end
                else
                        begin
                                // Fixing width
                                x := p.ClientWidth - c.Width - c.Left;
                                if akLeft in c.Anchors then
                                        begin
                                                c.Left := Scale(c.Left);
                                                if akRight in c.Anchors then
                                                        c.Width := p.ClientWidth - c.Left - Scale(x)
                                                else
                                                        c.Width := Scale(c.Width);
                                        end
                                else if akRight in c.Anchors then
                                        begin
                                                c.Width := Scale(c.Width);
                                                c.Left := p.ClientWidth - c.Width - Scale(x);
                                        end
                                else
                                        begin
                                                c.Left := Scale(c.Left);
                                                c.Width := Scale(c.Width);
                                        end;

                                // Fixing height
                                fixheight := true;
                                if (c is TCustomEdit) and not (c is TCustomMemo) then
                                        fixheight := false;

                                x := p.ClientHeight - c.Height - c.Top;
                                if akTop in c.Anchors then
                                        begin
                                                c.Top := Scale(c.Top);
                                                if fixheight then
                                                        begin
                                                                if akBottom in c.Anchors then
                                                                        c.Height := p.ClientHeight - c.Top - Scale(x)
                                                                else
                                                                        c.Height := Scale(c.Height);
                                                        end;
                                        end
                                else if akBottom in c.Anchors then
                                        begin
                                                if fixheight then
                                                        c.Height := Scale(c.Height);
                                                c.Top := p.ClientHeight - c.Height - Scale(x);
                                        end
                                else
                                        begin
                                                c.Top := Scale(c.Top);
                                                if fixheight then
                                                        c.Height := Scale(c.Height);
                                        end;
                        end;
        end;

        procedure FixControls(c: TWinControl);
        var
                i: integer;
        begin
                for i := 0 to c.ControlCount - 1 do
                        if c.Controls[i].Owner = f then
                                begin
                                        FixControl(c.Controls[i]);
                                        if c.Controls[i] is TWinControl then
                                                FixControls(TWinControl(c.Controls[i]));
                                end;
        end;

begin
        if DesignDPI <> Screen.PixelsPerInch then
                begin
                        ScaleM := Screen.PixelsPerInch;
                        ScaleD := DesignDPI;
                        f.ClientWidth := Scale(f.ClientWidth);
                        f.ClientHeight := Scale(f.ClientHeight);
                        FixControls(f);
                end;
end;