Re:不同分辨率下的程序设计问题

[zhao1210]

我在csdn上找到了关于不同分辨率下的程序设计问题的答案，其中有一个是这样写的

最好的方法，可能就是程序启动时首先检测系统分辨率，如果不符合要求，就更改为符合要求的。比如你的分辨率是1024X768，用户是800X600。那就在程序启动的时候把系统分辨率更改。在程序退出的时候再把分辨率修改回原来状态。我觉得这样可能是最好，最完美，最省事的方法了。
我的方法根据高手的指点定义两个全局变量。SCREENX，SCREENY：INTEGER；
procedure Tmainwinform.FormCreate(Sender: TObject);
var
sx, sy: Integer;
DevMode: TDeviceMode;
begin
sx := GetSystemMetrics(SM_CXSCREEN); //分辨率宽
sy := GetSystemMetrics(SM_CYSCREEN); //分辨率高
//用于在程序结束时把分辨率 改回原始状态
screenx := sx; //分辨率宽
screeny := sy; //分辨率高
if (sx <> 1024) and (sy <> 768) then
begin
DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
DevMode.dmPelsWidth := 1024;
DevMode.dmPelsHeight := 768;
ChangeDisplaySettings(DevMode,0); //设置新的显示参数
end;


程序关闭时把分辨率修改为原来状态：
procedure Tmainwinform.FormClose(Sender: TObject;
var Action: TCloseAction);
var
sx, sy: Integer;
DevMode: TDeviceMode;
begin
sx := GetSystemMetrics(SM_CXSCREEN); //分辨率宽
sy := GetSystemMetrics(SM_CYSCREEN); //分辨率高
if (sx <> screenx) and (sy <> screeny) then
begin
DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
DevMode.dmPelsWidth := screenx;
DevMode.dmPelsHeight := screeny;
ChangeDisplaySettings(DevMode,0); //设置新的显示参数
end;
actiON:=cafree;
end;
我拿create的代码试了一下（我在1024*768下设计，在800×600下运行），创建的时候分辨率确实能改过来（但最下面的状态栏改不过来，还是处在相对于800×600的位置），但是在fromClose的时候就不行了，不知道为什么？请大家帮忙看看

[Erice]

我写了个窗体基类，对你有用 （这个基类，具有自动居中，自适应分辨率等动能

可以将窗体加载到另一个的TPanel （Create(AOwner: TComponent; AParent: TWinControl)）
，也可以独立显示 （Create(AOwner: TComponent); overload; override;）！！）
代码如下

unit ChildFrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls, Menus,math,typinfo,DBCtrls
,dbGrids,DBGridEh,ComCtrls;
const
ScreenHeight=768; //根据你设计时的屏幕分辩率设定
Screenwidth =1024;
type

TChildForm = class(TForm)
Panel1: TPanel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure WMWindowPosChanging(var msg:TWMWindowPosChanging);
message WM_WINDOWPOSCHANGING;
procedure FormResize(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
private
FAsChild: Boolean;
FTempParent: TWinControl;
procedure CentalPanel;
procedure SetScaleBy; //自适应分辨率
Procedure SetColor;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); overload; override;
constructor Create(AOwner: TComponent; AParent: TWinControl); reintroduce; overload;

// The method below must be overriden to return either the main menu
// of the form, or nil.
function GetFormMenu: TMainMenu; virtual; abstract;
function CanChange: Boolean; virtual;
end;

var
ChildForm: TChildForm;

implementation

uses Main;

{$R *.DFM}
procedure TChildForm.CentalPanel;
var
i:Integer;
begin
if (panel1.Visible) or (panel1.Tag<>0) then
begin
if panel1.Width < ClientWidth then
panel1.Left := (ClientWidth - panel1.Width ) div 2
else
panel1.Left := 0;
if panel1.Height <ClientHeight then
panel1.Top :=(ClientHeight - panel1.Height ) div 2
else
panel1.Top := 0;
end else
begin
for i:=0 to self.ComponentCount-1 do
begin
if (self.Components[i] is Tpanel ) then
begin
if (((self.Components[i] As Tpanel ).Parent) is TTabSheet) And ((self.Components[i] As Tpanel ).Tag=1)then
begin
if (self.Components[i] As Tpanel ).Width < (((self.Components[i] As Tpanel ).Parent) As TTabSheet).ClientWidth then
(self.Components[i] As Tpanel ).Left := ((((self.Components[i] As Tpanel ).Parent) As TTabSheet).ClientWidth - (self.Components[i] As Tpanel ).Width ) div 2
else
(self.Components[i] As Tpanel ).Left := 0;
if (self.Components[i] As Tpanel ).Height <(((self.Components[i] As Tpanel ).Parent) As TTabSheet).ClientHeight then
(self.Components[i] As Tpanel ).Top :=((((self.Components[i] As Tpanel ).Parent) As TTabSheet).ClientHeight - (self.Components[i] As Tpanel ).Height ) div 2
else
(self.Components[i] As Tpanel ).Top := 0;
end;
end;
end;
end;
//SetScaleBy;
end;
procedure TChildForm.SetScaleBy; //自适应分辨率
var
i :integer;
begin
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 ;
for i := componentCount - 1 downto 0 do
with components[i] do
begin
if GetPropInfo(ClassInfo, 'font') <> nil then
font.size := (screen.width DIV screenwidth) * font.size;
end;
end;
procedure TChildForm.WMWindowPosChanging(var msg:TWMWindowPosChanging);
var
CaptionHeight:integer;
begin
CaptionHeight := GetSystemMetrics(SM_CYCAPTION);
msg.WindowPos ^.cx :=Max(msg.WindowPos ^.cx,panel1.Width+20);
msg.WindowPos ^.cy :=Max(msg.WindowPos ^.cy,panel1.Height+20+CaptionHeight);
inherited;
end;

constructor TChildForm.Create(AOwner: TComponent);
begin
FAsChild := False;
inherited Create(AOwner);
SetScaleBy;
end;

constructor TChildForm.Create(AOwner: TComponent; AParent: TWinControl);
begin
FAsChild := True;
FTempParent := aParent;
inherited Create(AOwner);
SetScaleBy;
SetColor;
end;

procedure TChildForm.Loaded;
begin
inherited;
if FAsChild then
begin
align := alClient;
BorderStyle := bsNone;
BorderIcons := [];
Parent := FTempParent;
Position := poDefault;
end;
end;

procedure TChildForm.CreateParams(var Params: TCreateParams);
Begin
Inherited CreateParams(Params);
if FAsChild then
Params.Style := Params.Style or WS_CHILD;
end;

function TChildForm.CanChange: Boolean;
begin
Result := True;
end;

procedure TChildForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action :=cafree;
end;

procedure TChildForm.FormDestroy(Sender: TObject);
begin
ChildForm :=nil;
end;

procedure TChildForm.FormResize(Sender: TObject);
begin
CentalPanel;
end;

procedure TChildForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
{if Key = #13 Then
Begin
SelectNext(ActiveControl,True,True);
Key := #0;
End;}
end;

procedure TChildForm.SetColor;
var
i,j:integer;
begin
Panel1.Color:=$00F8E4D8;
for i:=0 to self.ControlCount-1 do
begin
//$00F8E4D8

If (self.Components[i] is TEdit) tHEN
Begin
(self.Components[i] As TEdit).ImeName:=screen.DefaultIme;
End;
If (self.Components[i] is TDbEdit) tHEN
Begin
(self.Components[i] As TdbEdit).ImeName:=screen.DefaultIme;
End;
If (self.Components[i] is TDBGrid) tHEN
Begin
For j:=0 to (self.Components[i] As TDBGrid).Columns.Count-1 do
Begin
(self.Components[i] As TDBGrid).Columns.Items[j].ImeName:=screen.DefaultIme;
End;
End;
If (self.Components[i] is TDBGridEh) tHEN
Begin
For j:=0 to (self.Components[i] As TDBGridEh).Columns.Count-1 do
Begin
(self.Components[i] As TDBGridEh).Columns.Items[j].ImeName:=screen.DefaultIme;
End;
End;
end;

end;

end.

[zhao1210]

还有其他的分辨率做法在http://search.csdn.net/Expert/topic/1071/1071596.xml?temp=.4480554

[wsqwang884]

我也遇到过,虽然可以改动.但不是所有的机子都能改.

如果用户的不能改到800*600或者1024*768,而只能改到640*480,其它的都不能改的情况下,那怎么办?

如果按照您的思路,那么是不是所有的都要改动?

我觉得最好的是做模式窗体,在800*600下做,针对个别用户的情况改动

或者做两个,一个是1024*768和800*600,软件起动时检测,根据不同的调用不同的窗体.

特殊情况,个别处理.!

[小呆之家]

ChangeDisplaySettings(DevMode,0); //设置新的显示参数
上面的函数第二个参数不为0，改成：dev_regupdate什么的。
我及不清了，反正是要改注册表。
你查一下帮助吧，^_^

[skynew2004]

把所有的控件都按屏幕的大小比例所相应的放大与缩小.
我源程序是按800*600做的。
在form的create中加入
case Getsystemmetrics(0) of
1024: begin scaleby(128,100); end;
800: begin scaleby(100,100); end;
640: begin scaleby(100,125); end;
//自己加吧
end;