Bagaimana cara membuat GUI saya berfungsi dengan baik ketika skala font Windows lebih besar dari 100%


107

Saat memilih ukuran font besar di panel kontrol Windows (seperti 125%, atau 150%), maka ada masalah dalam aplikasi VCL, setiap kali ada sesuatu yang disetel dengan piksel.

Ambil TStatusBar.Panel. Saya telah menyetel lebarnya sehingga hanya berisi satu label, sekarang dengan font besar label "meluap". Masalah yang sama dengan komponen lainnya.

Beberapa laptop baru dari Dell telah dikirimkan dengan 125% sebagai pengaturan default, jadi sebelumnya masalah ini jarang terjadi sekarang ini sangat penting.

Apa yang bisa dilakukan untuk mengatasi masalah ini?

Jawaban:


56

Catatan: Silakan lihat jawaban lain karena mengandung teknik yang sangat berharga. Jawaban saya di sini hanya memberikan peringatan dan peringatan agar tidak mengasumsikan kesadaran DPI itu mudah.

Saya biasanya menghindari penskalaan yang sadar DPI TForm.Scaled = True. Kesadaran DPI hanya penting bagi saya ketika menjadi penting bagi pelanggan yang menelepon saya dan bersedia membayarnya. Alasan teknis di balik sudut pandang itu adalah bahwa kesadaran DPI atau tidak, Anda membuka jendela ke dunia yang terluka. Banyak kontrol VCL standar dan pihak ketiga tidak berfungsi dengan baik di DPI Tinggi. Pengecualian penting bahwa bagian VCL yang membungkus Windows Common Control bekerja sangat baik pada DPI tinggi. Sejumlah besar pihak ketiga dan kontrol kustom Delphi VCL built-in tidak berfungsi dengan baik, atau sama sekali, pada DPI tinggi. Jika Anda berencana untuk mengaktifkan TForm.Scaled pastikan untuk menguji pada 96, 125, dan 150 DPI untuk setiap formulir dalam proyek Anda, dan setiap pihak ketiga dan kontrol bawaan yang Anda gunakan.

Delphi sendiri ditulis dalam bahasa Delphi. Bendera kesadaran DPI Tinggi telah diaktifkan, untuk sebagian besar formulir, meskipun baru-baru ini seperti di Delphi XE2, pembuat IDE sendiri memutuskan untuk TIDAK mengaktifkan tanda manifes Kesadaran DPI Tinggi itu. Perhatikan bahwa di Delphi XE4 dan yang lebih baru, flag kesadaran DPI TINGGI diaktifkan, dan IDE terlihat bagus.

Saya menyarankan agar Anda tidak menggunakan TForm.Scaled = true (yang merupakan default di Delphi jadi kecuali Anda telah memodifikasinya, sebagian besar formulir Anda memiliki Scaled = true) dengan flag High DPI Aware (seperti yang ditunjukkan dalam jawaban David) dengan Aplikasi VCL yang dibangun menggunakan desainer bentuk delphi built-in.

Saya telah mencoba di masa lalu untuk membuat sampel minimal dari jenis kerusakan yang dapat Anda lihat saat TForm.Scaled benar, dan saat penskalaan bentuk Delphi mengalami kesalahan. Gangguan ini tidak selalu dan hanya dipicu oleh nilai DPI selain 96. Saya tidak dapat menentukan daftar lengkap hal-hal lain, yang mencakup perubahan ukuran font Windows XP. Tetapi karena sebagian besar gangguan ini hanya muncul di aplikasi saya sendiri, dalam situasi yang cukup kompleks, saya memutuskan untuk menunjukkan beberapa bukti yang dapat Anda verifikasi sendiri.

Delphi XE terlihat seperti ini saat Anda menyetel DPI Scaling ke "Fonts @ 200%" di Windows 7, dan Delphi XE2 juga rusak pada Windows 7 dan 8, tetapi gangguan ini tampaknya telah diperbaiki pada Delphi XE4:

masukkan deskripsi gambar di sini

masukkan deskripsi gambar di sini

Ini sebagian besar adalah kontrol VCL Standar yang berperilaku buruk pada DPI tinggi. Perhatikan bahwa kebanyakan hal belum diskalakan sama sekali, sehingga pengembang Delphi IDE telah memutuskan untuk mengabaikan kesadaran DPI, serta mematikan virtualisasi DPI. Pilihan yang sangat menarik.

Matikan virtualisasi DPI hanya jika menginginkan sumber rasa sakit tambahan baru ini, dan pilihan yang sulit. Saya sarankan Anda biarkan saja. Perhatikan bahwa kontrol umum Windows sebagian besar tampaknya berfungsi dengan baik. Perhatikan bahwa kontrol penjelajah data Delphi adalah pembungkus C # WinForms di sekitar kontrol umum Windows Tree standar. Itu kesalahan microsoft murni, dan memperbaikinya mungkin memerlukan Embarcadero untuk menulis ulang kontrol pohon Net asli asli untuk penjelajah data mereka, atau untuk menulis beberapa kode DPI-periksa-dan-ubah-properti untuk mengubah ketinggian item dalam kontrol. Bahkan Microsoft WinForms tidak dapat menangani DPI tinggi dengan bersih, otomatis dan tanpa kode kludge khusus.

Pembaruan: Factoid yang menarik: Meskipun delphi IDE tampaknya tidak "divirtualisasi", ia tidak menggunakan konten manifes yang ditunjukkan oleh David untuk mencapai "non-DPI-virtualisasi". Mungkin itu menggunakan beberapa fungsi API saat runtime.

Pembaruan 2: Menanggapi bagaimana saya akan mendukung 100% / 125% DPI, saya akan membuat rencana dua fase. Tahap 1 adalah menginventarisir kode saya untuk kontrol khusus yang perlu diperbaiki untuk DPI tinggi, dan kemudian membuat rencana untuk memperbaikinya atau menghentikannya secara bertahap. Tahap 2 akan mengambil beberapa area kode saya yang dirancang sebagai formulir tanpa manajemen tata letak dan mengubahnya menjadi formulir yang menggunakan beberapa jenis manajemen tata letak sehingga DPI atau perubahan ketinggian font dapat bekerja tanpa pemotongan. Saya menduga bahwa pekerjaan tata letak "antar-kontrol" ini akan jauh lebih kompleks di sebagian besar aplikasi daripada pekerjaan "intra-kontrol".

Pembaruan: Pada tahun 2016, Delphi 10.1 Berlin terbaru bekerja dengan baik di workstation 150 dpi saya.



2
Luar biasa. Terima kasih untuk factoid baru. Saya sarankan Anda mengubah jawaban Anda untuk menyarankan itu sebagai salah satu rute yang memungkinkan. Mungkin pelanggan bahkan ingin mengonfigurasi opsi itu (matikan jika tidak berhasil untuk mereka).
Warren P

Splash screen Delphi menggunakan Virtualisasi DPI, mungkin karena panggilan ke SetDPIAware dilakukan setelah formulir Splash dibuat terlihat.
Warren P

6
RAD Studio adalah campuran besar dari kontrol VCL standar, kontrol kustom, bentuk .NET WinForms dan FireMonkey. Tidak mengherankan jika ada masalah. Dan itulah mengapa RAD Studio bukanlah contoh yang baik.
Torbins

1
Jika Anda benar, itu VCL itu sendiri yang memiliki kepalanya di pasir. Bahkan Microsoft memiliki kepalanya di pasir. Satu-satunya kerangka kerja yang pernah saya gunakan yang melakukan pekerjaan yang lumayan dari jarak jauh adalah COCOA di Mac.
Warren P

63

Pengaturan Anda di file .dfm akan ditingkatkan dengan benar, selama Scaleditu True.

Jika Anda menetapkan dimensi dalam kode, maka Anda perlu menskalakannya dengan Screen.PixelsPerInchdibagi Form.PixelsPerInch. Gunakan MulDivuntuk melakukan ini.

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

Ini adalah apa bentuk ketekunan kerangka lakukan saat Scaledini True.

Faktanya, Anda dapat membuat argumen yang meyakinkan untuk mengganti fungsi ini dengan versi yang mengkodekan nilai 96 untuk penyebutnya. Hal ini memungkinkan Anda untuk menggunakan nilai dimensi absolut dan tidak khawatir tentang perubahan artinya jika Anda kebetulan mengubah penskalaan font di mesin pengembangan dan menyimpan ulang file .dfm. Alasan yang penting adalah bahwa PixelsPerInchproperti yang disimpan dalam file .dfm adalah nilai mesin tempat file .dfm terakhir disimpan.

const
  SmallFontsPixelsPerInch = 96;

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

Jadi, melanjutkan tema, hal lain yang harus diperhatikan adalah jika proyek Anda dikembangkan pada beberapa mesin dengan nilai DPI yang berbeda, Anda akan menemukan bahwa penskalaan yang digunakan Delphi saat menyimpan file .dfm menghasilkan kontrol yang berkeliaran di serangkaian pengeditan. . Di tempat kerja saya, untuk menghindari hal ini, kami memiliki kebijakan ketat bahwa formulir hanya diedit pada 96dpi (penskalaan 100%).

Bahkan, versi saya ScaleFromSmallFontsDimensionjuga memberikan kelonggaran untuk kemungkinan font bentuk berbeda saat runtime dari yang ditetapkan pada waktu desain. Pada mesin XP, formulir aplikasi saya menggunakan Tahoma 8pt. Pada Vista dan 9pt Segoe UI digunakan. Ini memberikan derajat kebebasan yang lain. Penskalaan harus memperhitungkan hal ini karena nilai dimensi absolut yang digunakan dalam kode sumber diasumsikan relatif terhadap garis dasar Tahoma 8pt pada 96dpi.

Jika Anda menggunakan gambar atau mesin terbang apa pun di UI Anda, maka ini juga perlu diskalakan. Contoh umum adalah mesin terbang yang digunakan pada bilah alat dan menu. Anda akan ingin menyediakan mesin terbang ini sebagai sumber daya ikon yang ditautkan ke executable Anda. Setiap ikon harus berisi berbagai ukuran dan kemudian pada waktu proses Anda memilih ukuran yang paling sesuai dan memuatnya ke dalam daftar gambar. Beberapa detail tentang topik tersebut dapat ditemukan di sini: Bagaimana cara memuat ikon dari sumber daya tanpa mengalami aliasing?

Trik berguna lainnya adalah untuk menentukan dimensi dalam unit relatif, relatif terhadap TextWidthatau TextHeight. Jadi, jika Anda ingin sesuatu berukuran sekitar 10 garis vertikal, Anda dapat menggunakan 10*Canvas.TextHeight('Ag'). Ini adalah metrik yang sangat kasar dan siap karena tidak memungkinkan adanya spasi baris dan sebagainya. Namun, seringkali yang perlu Anda lakukan hanyalah dapat mengatur agar GUI dapat diskalakan dengan benar PixelsPerInch.

Anda juga harus menandai aplikasi Anda sebagai aplikasi dengan DPI tinggi . Cara terbaik untuk melakukannya adalah melalui manifes aplikasi. Karena alat build Delphi tidak mengizinkan Anda menyesuaikan manifes yang Anda gunakan, ini memaksa Anda untuk menautkan sumber daya manifes Anda sendiri.

<?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>

Skrip sumber daya terlihat seperti ini:

1 24 "Manifest.txt"

dimana Manifest.txtberisi manifes sebenarnya. Anda juga perlu memasukkan bagian comctl32 v6 dan mengatur requestedExecutionLevelke asInvoker. Anda kemudian menautkan sumber daya yang dikompilasi ini ke aplikasi Anda dan memastikan bahwa Delphi tidak mencoba melakukan hal yang sama dengan manifesnya. Dalam Delphi modern, Anda dapat mencapainya dengan menyetel opsi proyek Tema Waktu Proses ke Tidak Ada.

Manifes adalah cara yang tepat untuk mendeklarasikan aplikasi Anda sebagai aplikasi dengan DPI tinggi. Jika Anda hanya ingin mencobanya dengan cepat tanpa mengotak-atik manifes Anda, hubungi SetProcessDPIAware. Lakukan itu sebagai hal pertama yang Anda lakukan saat aplikasi Anda berjalan. Lebih disukai di salah satu bagian inisialisasi unit awal, atau sebagai hal pertama dalam file .dpr Anda.

Jika Anda tidak mendeklarasikan aplikasi Anda sebagai DPI yang tinggi, maka Vista dan yang lebih baru akan menampilkannya dalam mode lama untuk semua font yang diskalakan di atas 125%. Ini terlihat sangat mengerikan. Cobalah untuk menghindari jatuh ke dalam jebakan itu.

Pembaruan DPI Windows 8.1 per monitor

Mulai Windows 8.1, sekarang ada dukungan OS untuk pengaturan DPI per monitor ( http://msdn.microsoft.com/en-ca/magazine/dn574798.aspx ). Ini adalah masalah besar untuk perangkat modern yang mungkin memiliki layar berbeda yang terpasang dengan kemampuan yang sangat berbeda. Anda mungkin memiliki layar laptop DPI sangat tinggi, dan proyektor eksternal DPI rendah. Mendukung skenario seperti itu membutuhkan lebih banyak pekerjaan daripada yang dijelaskan di atas.


2
Itu tidak selalu benar. Faktanya, Setting Scaled = true, dan kemudian pengaturan High DPI aware juga dapat menyebabkan beberapa kerusakan aneh di sebagian besar aplikasi delphi. Saya telah menghabiskan ratusan jam mencoba membuat aplikasi saya berfungsi dalam DPI tinggi dan menemukan bahwa lebih baik memiliki pixelation yang tampak mengerikan daripada kontrol yang dipotong, dipindahkan dari layar, scrollbar ekstra atau hilang pada berbagai kontrol, dll.
Warren P

@WarrenP Menurut saya masalah tersebut khusus untuk aplikasi Anda. Pengalaman pribadi saya adalah bahwa aplikasi Delphi saya menampilkan dan menskalakan dengan sempurna bahkan pada penskalaan font 200%.
David Heffernan

2
@ WarrenP Jadi apa? Sangat mungkin menggunakan Delphi untuk membangun aplikasi yang berperilaku lebih baik daripada Delphi IDE.
David Heffernan

1
Saya telah melihat banyak dialog dengan batas tetap yang dibuat dengan Delphi 5,6,7 dan pengaturan berskala benar untuk gagal. Menyembunyikan ok, tombol batal dll. Bahkan beberapa dialog di Delphi2006 menurutnya digigit oleh ini. Mencampur komponen Delphi asli dan komponen windows juga memberikan efek yang aneh. Saya selalu mengembangkan GUI dalam penskalaan font 125% dan menempatkan properti yang diskalakan ke false.
LU RD

2
Barang bagus. 1 untuk informasi yang fantastis. Pendapat saya (jangan lakukan itu) adalah yang terpenting kedua dari kebutuhan untuk mengetahui BAGAIMANA melakukannya ketika Anda benar-benar ingin melakukan ini ...
Warren P

42

Penting juga untuk diperhatikan bahwa menghormati DPI pengguna hanyalah sebagian dari pekerjaan Anda yang sebenarnya:

menghormati ukuran font pengguna

Selama beberapa dekade, Windows telah memecahkan masalah ini dengan gagasan melakukan tata letak menggunakan Dialog Units , bukan piksel. Sebuah "unit dialog" didefinisikan sehingga karakter rata - rata font adalah

  • 4 unit dialog (dlus) lebar, dan
  • 8 unit dialog (clus) tinggi

masukkan deskripsi gambar di sini

Delphi memang dikirimkan dengan gagasan (buggy) Scaled, di mana formulir mencoba untuk menyesuaikan secara otomatis berdasarkan

  • Pengaturan DPI Windows pengguna, ayat
  • pengaturan DPI di mesin pengembang yang terakhir kali menyimpan formulir

Itu tidak menyelesaikan masalah ketika pengguna menggunakan font yang berbeda dari yang Anda desain formulir dengan, misalnya:

  • pengembang merancang formulir dengan MS Sans Serif 8pt (di mana karakter rata-rata 6.21px x 13.00px, pada 96dpi)
  • pengguna menjalankan Tahoma 8pt (di mana karakter rata-rata 5.94px x 13.00px, pada 96dpi)

    Seperti halnya dengan siapa pun yang mengembangkan aplikasi untuk Windows 2000 atau Windows XP.

atau

  • pengembang merancang formulir dengan ** Tahoma 8pt * (di mana karakter rata-rata 5.94px x 13.00px, pada 96dpi)
  • pengguna yang menjalankan dengan Segoe UI 9pt (di mana karakter rata-rata adalah 6.67px x 15px, pada 96dpi)

Sebagai pengembang yang baik, Anda akan menghormati preferensi font pengguna Anda. Ini berarti Anda juga perlu menskalakan semua kontrol pada formulir Anda agar sesuai dengan ukuran font baru:

  • perluas semuanya secara horizontal sebesar 12,29% (6,67 / 5,94)
  • regangkan semuanya secara vertikal sebesar 15,38% (15/13)

Scaled tidak akan menangani ini untuk Anda.

Ini menjadi lebih buruk ketika:

  • mendesain formulir Anda di Segoe UI 9pt (Windows Vista, Windows 7, Windows 8 default)
  • pengguna menjalankan Segoe UI 14pt , (misalnya preferensi saya) yang mana10.52px x 25px

Sekarang Anda harus mengukur semuanya

  • secara horizontal sebesar 57,72%
  • secara vertikal sebesar 66,66%

Scaled tidak akan menangani ini untuk Anda.


Jika Anda pintar, Anda dapat melihat betapa menghormati DPI tidak relevan:

  • formulir yang dirancang dengan Segoe UI 9pt @ 96dpi (6.67px x 15px)
  • pengguna menjalankan dengan Segoe UI 9pt @ 150dpi (10.52px x 25px)

Anda tidak boleh melihat pengaturan DPI pengguna, Anda harus melihat ukuran fontnya . Dua pengguna berjalan

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

menjalankan font yang sama . DPI hanyalah satu hal yang mempengaruhi ukuran font; preferensi pengguna adalah yang lain.

StandardizeFormFont

Clovis memperhatikan bahwa saya mereferensikan fungsi StandardizeFormFontyang memperbaiki font pada formulir, dan menskalakannya ke ukuran font baru. Ini bukan fungsi standar, tapi seluruh rangkaian fungsi yang menyelesaikan tugas sederhana yang tidak pernah ditangani Borland.

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 memiliki 6 font berbeda; tidak ada "pengaturan font" tunggal di Windows.
Tapi kita tahu dari pengalaman bahwa formulir kita harus mengikuti pengaturan Font Judul Ikon

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;

Setelah kita mengetahui ukuran font kita akan skala bentuk untuk , kita mendapatkan tinggi font saat form ( dalam pixel ), dan skala oleh faktor itu.

Misalnya, jika saya menyetel formulir ke -16, dan formulir saat ini di -11, maka kita perlu menskalakan seluruh formulir dengan:

-16 / -11 = 1.45454%

Standarisasi terjadi dalam dua tahap. Pertama, skala formulir dengan rasio ukuran font baru: lama. Kemudian ubah kontrol (secara rekursif) untuk menggunakan font baru.

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;

Inilah tugas untuk benar-benar menskalakan formulir. Ia bekerja di sekitar bug dalam Form.ScaleBymetode Borland sendiri . Pertama, ia harus menonaktifkan semua jangkar di formulir, lalu melakukan penskalaan, lalu mengaktifkan kembali jangkar:

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;

dan kemudian kita harus benar-benar menggunakan font baru secara rekursif :

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;

Dengan jangkar dinonaktifkan secara rekursif:

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;

Dan jangkar diaktifkan kembali secara rekursif:

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;

Dengan pekerjaan benar-benar mengubah font kontrol kiri menjadi:

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;

Itu jauh lebih banyak kode daripada yang Anda kira; aku tahu. Yang menyedihkan adalah tidak ada pengembang Delphi di dunia, kecuali saya, yang benar-benar membuat aplikasinya benar.

Pengembang Delphi yang terhormat : Setel font Windows Anda ke Segoe UI 14pt , dan perbaiki aplikasi buggy Anda

Catatan : Kode apa pun dilepaskan ke domain publik. Tidak diperlukan atribusi.


1
Terima kasih atas jawabannya, tetapi apa yang Anda sarankan untuk dunia nyata? Terapkan pengubahan ukuran semua kontrol secara manual?
LaBracca

3
"Yang menyedihkan adalah tidak ada pengembang Delphi di bumi, kecuali saya, yang benar-benar membuat aplikasinya benar." Itu pernyataan yang sangat arogan dan tidak benar. Dari jawaban saya: Sebenarnya versi ScaleFromSmallFontsDimension saya juga memberikan kelonggaran untuk kemungkinan font bentuk berbeda pada saat runtime dari yang ditetapkan pada waktu desain. Penskalaan harus memperhitungkan hal ini karena nilai dimensi absolut yang digunakan dalam kode sumber diasumsikan relatif terhadap garis dasar Tahoma 8pt pada 96dpi. Jawaban Anda bagus, +1.
David Heffernan

1
@Ian Bukan aku yang mengatakan itu. Kedengarannya seperti Warren.
David Heffernan

2
Ini luar biasa, Ian. Terima kasih.
Warren P

2
Baru-baru ini menemukan pertanyaan dan jawaban ini. Saya telah mengumpulkan semua kode Ian ke dalam unit kerja di sini: pastebin.com/dKpfnXLc dan memposting tentangnya di Google+ di sini: goo.gl/0ARdq9 Memposting di sini jika ada yang menganggap ini berguna.
W. Prins

11

Ini hadiah saya. Sebuah fungsi yang dapat membantu Anda dengan posisi horizontal elemen dalam tata letak GUI Anda. Gratis untuk semua.

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;

2
Saya senang Anda menyukainya Warren. Itu sekitar 15 tahun ketika tidak ada solusi yang tersedia untuk masalah yang harus saya selesaikan. Dan bahkan saat ini bisa ada situasi di mana itu bisa diterapkan. B-)
avra
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.