delphi显示器设置

己开发的程序是在WIN2000系统下,计算机为17纯平,1024*   768。在该机器上显示非常好,但到了其它机器(WIN98、15寸、800*600),显示界面非常难看,即使设为1024   *   768,也非常变形。怎么办?

/////////////////////////////////////////////////////

Type
    TFooClass   =   class(TControl);   //在此加入聲明
var
    BaseForm:   TBaseForm;
Const
    ScreenWidth=1024;     //此為設計時的分辨率的寬       現假設為:800   x   1024

implementation

{$R   *.DFM}

procedure   TBaseForm.FormCreate(Sender:   TObject);
var  
        I,NewFormWidth,OldFormWidth:   Integer;
begin
    if   (screen.width   <>   ScreenWidth)   then         //變更窗體及控件大小及字體,以適應不同分辨率的要求
    begin
        OldFormWidth   :=   Width;
        Scaled   :=   True;
        ScaleBy(Screen.Width,   ScreenWidth);
        NewFormWidth   :=   Width;
        for   i   :=   ControlCount   -   1   downto   0   do
            TFooClass(Controls[i]).Font.Size   :=   (NewFormWidth   div   OldFormWidth)*TFooClass(Controls[i]).Font.Size;
    end;
end;
///////////////////////////////////////////////////////////

可以让显示器适应你的软件,软件运行时变成你设置的,退出后回到原来状态.
var
    main:   Tmain;
    oldwidth,oldheight,oldfreq:integer;//记录原来状态
procedure   Tmain.FormCreate(Sender:   TObject);
begin
    setscreen(1024,768,85);//设置新的状态
end;
procedure   Tmain.FormDestroy(Sender:   TObject);
begin
setscreen(oldwidth,oldheight,oldfreq);//恢复原来的状态
end;
procedure   Tmain.setscreen(newwidth,   newheight,   newfrquency:integer);
var
    devmode:Tdevicemode;
begin
    OldWidth:=GetSystemMetrics(SM_CXSCREEN);
    OldHeight:=GetSystemMetrics(SM_CYSCREEN);
    if   (oldwidth <> newwidth)   and   (oldheight <> newheight)   then
    begin
    DevMode.dmSize:=sizeof(TDeviceMode);
    EnumDisplaySettings(nil,   DWORD(-1),   DevMode);
    DevMode.dmFields:=DM_PELSWIDTH   or   DM_PELSHEIGHT   or   DM_DISPLAYFREQUENCY;
    DevMode.dmPelsWidth:=NewWidth;
    DevMode.dmPelsHeight:=NewHeight;
    OldFreq:=   DevMode.dmDisplayFrequency;
    DevMode.dmDisplayFrequency:=newfrquency;
    ChangeDisplaySettings(DevMode,0);
    end;
end;
//显示器烧了可别怪我!:)
////////////////////////////////////////////////////

本人用delphi开发程序是在1024×768分辨率的机器上,但现在要在800*600上使用,有些比较大的窗体就显示不全了,要拖来拖去,请高手讲下如何才能自动的适应啊?谢谢!


inplementation
const
    ScreenWidth:   LongInt   =   1024;   {I   designed   my   form   in   1024×768   mode.}
    ScreenHeight:   LongInt   =   768;

{$R   *.DFM}

procedure   TForm1.FormCreate(Sender:   TObject);
begin
    scaled   :=   true;
    if   (screen.width   <>   ScreenWidth)   then
    begin
        height   :=   longint(height)   *   longint(screen.height)   div   ScreenHeight;
        width   :=   longint(width)   *   longint(screen.width)   div   ScreenWidth;
        scaleBy(screen.width,   ScreenWidth);
    end;
end;

下一步,要每個子控制的字体改變到合适的大小:
type
    TFooClass   =   class(TControl);   {   needed   to   get   at   protected   }
                                                              {   font   property   }

var
    i:   integer;
begin
    for   i   :=   ControlCount   -   1   downto   0   do
        TFooClass(Controls[i]).Font.Size   :=
                (NewFormWidth   div   OldFormWidth)   *
                TFooClass(Controls[i]).Font.Size;
end;
 
/////////////////////////////////////////////////////////
参阅:(   程序如何自适应显示器界面?   )
    http://expert.csdn.net/Expert/topic/1495/1495295.xml?temp=.6090814
我这里有一个现成的,我自己正在用:
const
    DefaultWidth   =   800;
    DefaultHeight   =   600;

type
    TfrmJtBaseScale   =   class(TfrmJtBase)
        procedure   FormCreate(Sender:   TObject);
    private
        {   Private   declarations   }
    public
        {   Public   declarations   }
    end;

    TMyControl   =   class(TControl); //这句声明是加的位置例子如下

 {   

public
    { Public declarations }
  end;
 TMyControl= class(TControl); //在此加入聲明
var
  Form1: TForm1;
  
implementation

{$R *.dfm}

}
implementation

{$R   *.dfm}

procedure   TfrmJtBaseScale.FormCreate(Sender:   TObject);
var
    i:   integer;
    a:   real;
begin
    if   Screen.Width   <>   DefaultWidth   then
    begin
        height:=longint(height)*longint(screen.height)   div   DefaultHeight;
        =longint(width)*longint(screen.width)   div   DefaultWidth;
        scaleby(screen.width   ,   DefaultWidth);
        for   i   :=   0   to   self.ControlCount   -1   do
        begin
            a   :=   screen.Height   /   DefaultHeight   *   TMyControl(self.Controls[i]).Font.Size;
            TMyControl(self.Controls[i]).Font.Size   :=   trunc(a);
        end;
    end;
end;
/////////////////////////////////////////

在程序的初始化中,先得到
screen.height   和   screen.width   来判断显示器的分辨率,再设置窗体

原文地址:https://www.cnblogs.com/hssbsw/p/2183030.html