Delphi自动适应屏幕大小
//自动适应屏幕大小:作者:海宏软件,周承昊。
function autoFitScreen640_480(oContainer:TWinControl):Boolean;
const defaultScreenWidth=800; defaultScreenHeight=600;
var i,j:integer; n:double; v:Variant;
cmt:TComponent; obj:TObject;
ppi:pPropInfo; fnt:TFont;
begin
result:=false;
//分辨率自适应
if (screen.width < defaultScreenWidth) then with oContainer do begin
height:=longint(height) * longint(screen.height) DIV defaultScreenHeight;
width := longint(width) * longint(screen.width) DIV defaultScreenWidth;
scaleBy(screen.width, defaultScreenWidth);
//缩放字体,属性设置部分参考:http://topic.csdn.net/t/20030423/20/1699661.html
n:=(screen.Width / defaultScreenWidth);
for i:=ComponentCount-1 downto 0 do begin
cmt:=components[i];
with cmt do begin
ppi:=GetPropInfo(cmt, 'font'); //ClassInfo取对象的属性值
//有此属性 PropInfo^.PropType^.Kind = tkClass
if (ppi<>nil) and (ppi^.PropType^.Kind=tkClass) then begin
obj:=GetObjectProp(cmt, 'font'); //获取对象的属性对象
if (not assigned(obj)) then continue;
fnt:=obj as TFont; //取得字体
//计算出新的字体
j:=trunc( (fnt.size * screen.Width) / defaultScreenWidth);
if j<7 then j:=9 else if j<8 then j:=9;
//设置字体font.size := j;
fnt.Size:=j;
SetObjectProp(cmt, 'font', fnt);
end;
end;
end;
end;
end;
Delphi自动适应屏幕大小
最新推荐文章于 2024-06-22 12:22:55 发布