zoukankan      html  css  js  c++  java
  • 解决Delphi窗体缩放の疑难杂症

    http://anony3721.blog.163.com/blog/static/511974201082235754423/

    解决Delphi窗体缩放の疑难杂症  

    2010-09-22 15:57:54|  分类: 默认分类 |  标签:delphi  |举报|字号 订阅

     
     

    No.1 Delphi中如何限制窗体大小?

    Delphi中可以限制窗体或者元件的大小,只要指定它的Constraints属性即可(默认是0,就是不限制)。但是Delphi这个属性有个很大的缺陷,比如从上往下调整,达到最小后,窗体高度虽然不会缩小了,但是窗体会继续往下移动,这样看起来会有些不正常(Delphi自己的窗体没有这个现象)。要解决这个问题,还是只有截取windows的消息,自己进行处理。

    const
      MinWidth = 500
    ;
      MinHeight = 400
    ;

    procedure WMSIZING(var Msg: TMessage); message WM_SIZING
    ;

    procedure TfrmMain.WMSIZING(var Msg: TMessage
    );
    begin
      Msg.Result := 1
    ;

      
    //限制最小高度
      if (PRect(Msg.LPARAM)^.Bottom - PRect(Msg.LPARAM)^.Top) < MinHeight then
      begin
        if PRect(Msg.LPARAM)^.Top = Top then
          PRect(Msg.LPARAM)^.Bottom := PRect(Msg.LPARAM)^.Top + MinHeight
        
    else
          PRect(Msg.LPARAM)^.Top := PRect(Msg.LPARAM)^.Bottom - MinHeight
    ;
      end
    ;

      
    //限制最小宽度
      if (PRect(Msg.LPARAM)^.Right - PRect(Msg.LPARAM)^.Left) < MinWidth then
      begin
        if PRect(Msg.LPARAM)^.Left = Left then
          PRect(Msg.LPARAM)^.Right := PRect(Msg.LPARAM)^.Left + MinWidth
        
    else
          PRect(Msg.LPARAM)^.Left := PRect(Msg.LPARAM)^.Right - MinWidth
    ;
      end
    ;
    end;

     
    No2. Delphi中可视控件随窗口的缩放自动改变大小的方法

    找了很久,發現下面的寫法可以實現,在form改變大小時,畫面上的控件的相對位置不變,但控件的大小及控件上的文字大小隨之改變。

    unit Unit1;   
    interface     
    uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, Buttons; 

    type 
    TForm1 = class(TForm) 
    Button1: TButton; 
    SpeedButton1: TSpeedButton; 
    procedure FormResize(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    private 
    { Private declarations } 
    FWidth: Integer; 
    public 
    { Public declarations } 
    end; 

    var 
    Form1: TForm1; 

    implementation 

    {$R *.dfm} 

    procedure TForm1.FormResize(Sender: TObject); 
    begin 
    ScaleBy(Width, FWidth); 
    FWidth := Width; 
    end; 

    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    FWidth := Width; 
    end; 

    end.  

    delphi 程序窗体及控件自适应分辨率

    代码如下:
    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;



    --
    Anony
    专注的力量成就梦想
    delphi lazarus opengl 网页操作自动化, 图像分析破解,游戏开发
  • 相关阅读:
    zoj 3279 线段树 OR 树状数组
    fzu 1962 树状数组 OR 线段树
    hdu 5057 块状链表
    hdu3487 Play with Chain
    bzoj 1588营业额统计(HNOI 2002)
    poj2823 Sliding Window
    poj2828 Buy Tickets
    poj2395 Out of Hay
    poj3667 Hotel
    poj1703 Lost Cows
  • 原文地址:https://www.cnblogs.com/delphi-xe5/p/5377186.html
Copyright © 2011-2022 走看看