如何限制窗体改变大小时按照某种比例？ (100分)

  • 主题发起人 主题发起人 叮叮当当
  • 开始时间 开始时间
叮

叮叮当当

Unregistered / Unconfirmed
GUEST, unregistred user!
使窗体改变大小时Width和Height保持某种比例（比如4:3），即截获窗体改变大小前的消息，在消息处理中将窗体宽度和高度的增减按一定比例进行。显然在窗体的OnResize事件中简单地设置Width和Height的比例是不行的，那样的话将使窗体改变大小时产生难看的抖动效果。

应该拦截窗体的哪个消息？请为这个简单功能给出例程。谢谢！
 
拦截WM_SIZE一样会出现抖动
type
TForm1 = class(TForm)
private
{ Private declarations }
procedure ReSize(var Msg: TMessage); message WM_SIZE;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }


procedure TForm1.ReSize(var Msg: TMessage);
begin
form1.Width := form1.Height div 2;
end;
 
在form的onCanResize事件中写程序：
procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
NewHeight:=NewWidth div 2
end;
就可以了,这种做法的好处是不会造成抖动
 
TO: 方栩

谢谢，方法是没错了，但是按你的程序，窗体就只能水平拉伸而不能垂直拉伸了。怎么办才好？
 
哇靠！你不会宽度除以2啊
 
To: 完颜康

方栩的程序是让高度随宽度变化，这样水平拉伸窗体改变大小的时候是没有问题的。但是当上下（垂直）拉伸窗体的时候问题就出来了，你可以自己试一下那段代码。由于限定了高度随宽度改变，高度主动改变的情况相当于就被屏蔽了。
 
我试了：

procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
if NewWidth <> Width then
NewHeight := NewWidth div 2
else if NewHeight <> Height then
NewWidth := NewHeight * 2;
end;

也是不行的，垂直拉伸时抖动得厉害！
 
procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
var
k:real;
x1,y1:integer;
begin
k:=0.5;
x1:=newwidth;
y1:=newheight;
if width<>x1 then
NewHeight:=Trunc(x1*k)
else
if height<>y1 then
NewWidth:=Trunc(y1/k);
end;
 
To: daxia
不行，垂直拉伸窗体时还是抖动得很厉害。
 
我认为对于普通的窗体界面的程序来说，在重绘时产生抖动现象是难以避免的，窗体越复杂，
重绘时的抖动现象越明显。这涉及Windows GUI机制方面的问题，现状是难以改变的，除非
所有组件都采用图形方式，用绘图函数画上去，或者用DirectX也许效果会更好，当然，这
是不太现实的。还有一个办法可以部分的改善问题——用最快的CPU和显卡。^_^
 
To: Sachow
我明白你的意思，但请不要误解，我所说的“抖动”当然不是这种正常的“抖动”啦。
 
我在DELPHI6上试了，没有感到抖动呀？
 
我的也没有抖动，你的窗体设置有问题吧？
 
To: tanhua、jstkof
你们不要光横着拉呀，竖着拉拉看。

To: daxia
“windows的动画显示菜单和工具提示”默认是打开的吧？有没有什么解决办法？我看到别人做的锁定比例缩放窗体（多为视频播放软件）都是没这种问题的啊。
 
当你在重新计算你的窗口的时候屏蔽掉 Form 的 WM_PAINT 事件，计算完了在 Update
 
应该是拖动窗口时显示其内容。所以，最笨的办法是把它关掉。
 
var b:boolean;
b:=false;
procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
if NewHeight <> Height then
if b then NewHeight := NewWidth div 2
else NewWidth := NewHeight * 2
else if newwidth<>width then
begin
b:=true;
NewHeight := NewWidth div 2;
end;
end;
还有一些问题。比如，我不知道应该在哪里重设b:=false;显然，在onsize中
是不行的。还有，垂直拉动时最后要反弹一下，不知道是什么缘故？
 
解决了。
var a,b:boolean;
a:=false;b:=false;
procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
if NewHeight <> Height then
if b then NewHeight := trunc(NewWidth/1.5)
else
begin
a:=true;
NewWidth := trunc(NewHeight * 1.5);
end
else if newwidth<>width then
if a then NewWidth := trunc(NewHeight * 1.5)
else
begin
b:=true;
NewHeight := trunc(NewWidth/1.5);
end;
end;
procedure WMEXITSIZEMOVE(var Message: TMessage);
message WM_EXITSIZEMOVE;
procedure TForm1.WMEXITSIZEMOVE(var Message: TMessage);
begin
a:=false;
b:=false;
end;
感谢张工，WM_EXITSIZEMOVE这条消息是他提供的。
在高手眼里，我的程序可能有点笨。我的水平也就这样了，
请大家多多包涵。
 
这主要是你把windows的"拖动时显示窗口的内容"打开了这时你改变height和width时就会
重复发出窗口改变消息所以就抖动的历害。
 
谢谢jstkof。
 
您必须登录或注册才可回复。

Similar threads

Ray
[转]终于可以发布Delphi下收点OSGI精髓皮毛而设计的插件框架WisdomPluginFramework
回复
4
查看
4K
chlkuei
C
迷
窗体中的控件不少，当窗体改变大小时，如何使窗体不闪动得太厉害？(50分)
回复
9
查看
203
迷幻星
迷
F
送分题,请问如何在resize的时候,保持窗体的比例?(100分)
回复
3
查看
131
一只没有缺点的狼
一
L
关于改变窗体大小的问题(50分)
回复
11
查看
193
lfpsoft
L
H
怎样改变BorderStyle设为bsNone的窗体的大小？(100分)
回复
7
查看
345
wwolf
W
后退
顶部