zoukankan      html  css  js  c++  java
  • delphi 程序窗体及控件自适应分辨率(通过ComponentCount遍历改变字体大小以及上下左右)

    unit untFixForm;
    
    interface
    
    uses
    Classes, SysUtils, Controls, Forms;
    
    type
    TFontedControl = class(TControl)
    public
        property Font;
    end;
    
    TFontMapping = record
        SWidth:Integer;
        SHeight:Integer;
        FName:string;
        FSize:Integer;
    end;
    
    procedure FixForm(AForm:TForm);
    procedure SetFontMapping;
    
    var
    FontMapping:array of TFontMapping;
    
    implementation
    
    procedure SetFontMapping;
    begin
    SetLength(FontMapping, 3);
    
    // 800 x 600
    FontMapping[0].SWidth := 800;
    FontMapping[0].SHeight := 600;
    FontMapping[0].FName := '宋体';
    FontMapping[0].FSize := 7;
    
    // 1024 x 768
    FontMapping[1].SWidth := 1024;
    FontMapping[1].SHeight := 768;
    FontMapping[1].FName := '宋体';
    FontMapping[1].FSize := 9;
    
    // 1280 x 1024
    FontMapping[2].SWidth := 1280;
    FontMapping[2].SHeight := 1024;
    FontMapping[2].FName := '宋体';
    FontMapping[2].FSize := 11;
    
    end;
    
    procedure FixForm(AForm:TForm);
    var
    i, j:integer;
    t:TControl;
    begin
    with AForm do
    begin
        for i := 0 to ComponentCount - 1 do
        begin
          try
            t := TControl(Components[i]);
            t.left := Trunc(t.left * (Screen.width / 1024));
            t.top := Trunc(t.Top * (Screen.Height / 768));
            t.Width := Trunc(t.Width * (Screen.Width / 1024));
            t.Height := Trunc(t.Height * (Screen.Height / 768));
          except
          end; { try }
        end; { for i }
    
        for i := 0 to Length(FontMapping) - 1 do
        begin
          if (Screen.Width = FontMapping[i].SWidth) and (Screen.Height =
            FontMapping[i].SHeight) then
          begin
            for j := 0 to ComponentCount - 1 do
            begin
              try
                TFontedControl(Components[j]).Font.Name := FontMapping[i].FName;
                TFontedControl(Components[j]).FONT.Size := FontMapping[i].FSize;
              except
              end; { try }
            end; { for j }
          end; { if }
        end; { for i }
    end; { with }
    end;
    
    initialization
    SetFontMapping;
    
    end.

    SetFontMapping 方法可以自行修改,以适应更多的分辨率。
    调用也非常简单,如下所示:

    procedure TForm1.FormShow(Sender:TObject);
    begin
    if MessageBox(Handle, '要使用屏幕自适应吗?', '提示', MB_YESNO or
        MB_ICONINFORMATION) = idno then Exit;
    untFixForm.FixForm(Self);
    end;

    http://blog.csdn.net/han_348154920/article/details/4762928

  • 相关阅读:
    选择排序的C、C++实现
    冒泡排序的C、C++实现
    Node.js使用UDP通讯
    Node.js使用TCP通讯
    栈的C语言实现
    顺序表的C、C++实现
    vim的几种模式&快捷键
    ubuntu安装discourse论坛----结合在apache服务上建立虚拟主机
    Ubuntu下使用mail命令发送邮件
    深入解读EOS源代码之——区块链内核
  • 原文地址:https://www.cnblogs.com/findumars/p/5789004.html
Copyright © 2011-2022 走看看