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

 

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

2009-04-24 11:47

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;